FSO判断本地文件是否存在-Asp

baizoo — Thu, 09 Apr 2009 12:44:57 +0000

在网上找判断远程文件是否存在的asp代码时，看到了这个代码，也顺便记录一下。

<%
url=request.querystring("url")
Set fs = Server.CreateObject("Scripting.FileSystemObject")
File = Server.MapPath(url)
If fs.FileExists(File) Then '判断url文件是否存在
Response.Write File & "文件存在"
Else
Response.Write File & "文件不存在"
End If
%>

使用时，在地址后面加 ?url=本地文件名

XMLHTTP判断远程文件是否存在-Asp

baizoo — Thu, 09 Apr 2009 10:12:46 +0000

XMLHTTP在采集建站中非常常用，用它来判断网页是否存在也是个不错的方法。今天测试这个使用方法，并做些整理。

基于asp的应用

<%
Function testURL(url)
set XMLHTTP =Server.CreateObject("Microsoft.XMLHTTP")
XMLHTTP.open "HEAD",url,false
XMLHTTP.send()
'这里的200表示访问正常
‘如果是404是的话则说明页面不存在
if XMLHTTP.status=200 then
testURL = 1
Else
testURL = 0
end If
Set XMLHTTP = Nothing
End Function

if testURL("http://www.baizoo.cn/index.php")=0 then
response.write "文件不存在"
else
response.write "文件存在"
end if
%>

ASP实现域名IP查询

baizoo — Wed, 01 Apr 2009 09:32:40 +0000

想要在网页程序中查找域名的IP，ASP的方法据我了解有两种。

一、使用wscript.shell运行ping或者nslookup命令获取已知域名的服务器的IP。

<form method="post">
<input type=text name="name" size=60>
<input type=submit value="run">
</form>

<%if request("name")<>"" then response.write server.createobject("wscript.shell").exec(server.mappath("nslookup.exe")&" "&request.form("name")).stdout.readall%>

虽然wscript.shell组件可用。上面的代码刚开始在我电脑上测试时通过不过。
将c:\windows\system32下nslookup复制到asp文件的目录下，可以了。

方法二、使用TCPIP.DNS组件

<%Set DNS=CreateObject("TCPIP.DNS")
IP=DNS.GetIPByHost("www.baizoo.cn")%>

下载：TCPIP.DNS组件
需要注意的一点：双击安装组件的时候，默认是安装在系统盘，比如”C:\Program Files\PSTRUH\TCPIP\”，这里不要修改，否则可能无法使用。

ASP获取网站alexa排名的源码

baizoo — Mon, 16 Feb 2009 00:08:43 +0000

主要是用MSXML2.XMLHTTP获取页面内容的方式采集到alexa的值

如本站的真实alexa获取地址为：http://www.alexa.com/data/details/traffic_details/baizoo.cn

具体代码如下：

<%

'获取主域名
Function getDomainUrl(url)
tempurl=replace(url,""external" href="http://" target="_blank">http://","")
if instr(tempurl,"/")>0 then
  tempurl=left(tempurl,instr(tempurl,"/")-1)
end If
getDomainurl=tempurl
End Function

'返回页面源代码内容，<a rel="external" href="http://www.baizoo.cn/article.asp?id=322" target="_blank">MSXML2.XMLHTTP手册下载a>
Function GetHttpPage(HttpUrl)
   If IsNull(HttpUrl)=True or Len(HttpUrl)<18 or HttpUrl="$False$" Then
      GetHttpPage="$False$"
      Exit Function
   End If
   Dim Http
   Set Http=server.createobject("MSXML2.XMLHTTP")
   Http.open "GET",HttpUrl,False
   Http.Send()
   If Http.Readystate<>4 then
      Set Http=Nothing
      GetHttpPage="$False$"
      Exit function
   End if
   GetHTTPPage=Http.responseText
   Set Http=Nothing
   If Err.number<>0 then
      Err.Clear
   End If
End Function

'==================================================
'函数名：ScriptHtml
'作  用：过滤html标记
'参  数：ConStr ------ 要过滤的字符串
'   TagName ------要过滤的标签
'   FType 1表示过滤左边标签  2表示过滤左右标签及中间的值  3表示过滤左边标签和右边标签，保留内容。
'==================================================
Function ScriptHtml(Byval ConStr,TagName,FType,includestr)
    Dim Re
    Set Re=new RegExp
    Re.IgnoreCase =true
    Re.Global=True
    Select Case FType
    Case 1
       Re.Pattern="<" & TagName & "([^>])*("&includestr&"){1,}([^>])*>"
       ConStr=Re.Replace(ConStr,"")
    Case 2
       Re.Pattern="<" & TagName & "([^>])*("&includestr&"){1,}([^>])*>.*?</" & TagName & "([^>])*>"
    'response.write constr&"<br>"
       ConStr=Re.Replace(ConStr,"")
    'response.write server.htmlencode(constr)&"<br>"
    Case 3
  Re.Pattern="<" & TagName & "([^>])*("&includestr&"){1,}([^>])*>"
       ConStr=Re.Replace(ConStr,"")
       Re.Pattern="</" & TagName & "([^>])*>"
       ConStr=Re.Replace(ConStr,"")
    End Select
    ScriptHtml=ConStr
    Set Re=Nothing
End Function

'==================================================
'函数名：GetBody
'作  用：截取页面源码字符串
'参  数：ConStr ------将要截取的字符串
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True or StartStr="" or IsNull(StartStr)=True or OverStr="" or IsNull(OverStr)=True Then
      GetBody="$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   'response.write Start&"<br>"&IncluL&"<br>"
   'response.end
   If Start<=0 then
      GetBody="$False$"
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   'response.write Over
   'response.end
   'response.write Start&"  "&Over&"  "&Over-Start
   'response.end
   If Over<=0 or Over<=Start then
      GetBody="$False$"
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If

   GetBody=MidB(ConStr,Start,Over-Start)
   'response.write getBody
   'response.end
End Function

'==================================================
'函数名：GetArray
'作  用：提取链接地址，以$Array$分隔
'参  数：ConStr ------提取地址的原字符
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True or StartStr="" or OverStr="" or  IsNull(StartStr)=True or IsNull(OverStr)=True Then
      GetArray="$False$"
      Exit Function
   End If
   Dim TempStr,TempStr2,objRegExp,Matches,Match
   TempStr=""
   Set objRegExp = New Regexp
   objRegExp.IgnoreCase = True
   objRegExp.Global = True
   objRegExp.Pattern = "("&StartStr&").+?("&OverStr&")"
   Set Matches =objRegExp.Execute(ConStr)
   For Each Match in Matches
      TempStr=TempStr & "$Array$" & Match.Value
   Next
   Set Matches=nothing

   If TempStr="" Then
      GetArray="$False$"
      Exit Function
   End If
   TempStr=Right(TempStr,Len(TempStr)-7)
   If IncluL=False then
      objRegExp.Pattern =StartStr
      TempStr=objRegExp.Replace(TempStr,"")
   End if
   If IncluR=False then
      objRegExp.Pattern =OverStr
      TempStr=objRegExp.Replace(TempStr,"")
   End if
   Set objRegExp=nothing
   Set Matches=nothing

   If TempStr="" then
      GetArray="$False$"
   Else
      GetArray=TempStr
   End if
End Function

Function getAlexaRank(weburl)
tempurl=getDomainUrl(weburl)
'读取<a rel="external" href="http://client.alexa.com/common/css/scramble.css" target="_blank">http://client.alexa.com/common/css/scramble.cssa>中的数据
alexacss="<a rel="external" href="http://" target="_blank">http://a>client.alexa.com/common/css/scramble.css"
strAlexaCss=GetHttpPage(alexacss)
'response.write strAlexaCss
'response.end
alexarankqueryurl="<a rel="external" href="http://" target="_blank">http://a>www.alexa.com/data/details/traffic_details/"&tempurl

strAlexaContent=GetHttpPage(alexarankqueryurl)

rankcontent=getBody(strAlexaContent,"Information Service.-->","",false,false)
'注：其实没必要获取span的class并替换，后面对span的处理部分可直接去除
'获取其中的span的class
strspan=GetArray(rankcontent,"<span class=""","""",false,false)
response.write rankcontent&"<br>"
response.write strspan&"<br>"
'response.end
If strspan<>"$False$" Then
  aspan=split(strspan,"$Array$")

  For i=0 To UBound(aspan)
   'response.write "."&aspan(i)
   '判定aspan(i)即span的class是否在alexacss中存在，如果存在，则需要将这个span和span中的数据去掉。
   If InStr(strAlexaCss,"."&aspan(i))>=1 Then
    'response.write aspan(i)&"<br>"
    'response.end
    '表示属性为none.需要替换掉。
    rankcontent=ScriptHtml(rankcontent,"span",2,aspan(i))
   Else
    rankcontent=ScriptHtml(rankcontent,"span",1,aspan(i))
   End if
  Next
  '替换上面少去掉的右边的span标签。
  rankcontent=Replace(rankcontent,"</span>","")


End If
If rankcontent="$False$" Then
  rankcontent="No Data"
End if
getAlexaRank=Replace(rankcontent,",","")

End Function

url=request.querystring("url")
%>

<form name="alexaform" method=get>
输入网址:<input type="" name="url" value="<%=url%>" size=40> <input type="submit" value="查询">
</form>

<%
If url<>"" Then

response.write "您的网站在ALEXA的排名为："
response.flush
rank=getAlexaRank(url)
response.write rank
End if

白舟空间 » asp

FSO判断本地文件是否存在-Asp

XMLHTTP判断远程文件是否存在-Asp

ASP实现域名IP查询

ASP获取网站alexa排名的源码