ASP 查询PR的代码

刚才群里有人在发布.查询googlepr的地址…哎…这个N年前就流行过了啊。..马上写个代码…以后用,不过还是有点慢

<%@ LANGUAGE = VBScript CodePage = 936%>

<%

Option Explicit

Response.Buffer = True

Session.CodePage=936

dim Url,Domain,Content

Domain = Request.QueryString("url")

url = "

http://rankwh&#101;re.com/google-page-rank.php?url

=" & Domain

if Domain<>"" then

Content=GetHttpPage(url)

Response.Write Domain & " "

Response.Write GetDate()

else

Response.Write "没有" 

end if

Function getHTTPPage(url)

dim http

set http=cr&#101;ateobject("MSXML2.XMLHTTP")

Http.open "GET",url,false

Http.send()

if Http.readystate<>4 then

exit function

end if

getHTTPPage=bytes2BSTR(Http.responseBody)

set http=nothing

if err.number<>0 then err.Clear

End Function

‘字节转化成字符串函数

Function bytes2BSTR(vIn)

dim strReturn

dim i,ThisCharCode,NextCharCode

strReturn = ""

For i = 1 To LenB(vIn)

ThisCharCode = AscB(MidB(vIn,i,1))

If ThisCharCode < &H80 Then

strReturn = strReturn & Chr(ThisCharCode)

Else

NextCharCode = AscB(MidB(vIn,i+1,1))

strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))

i = i + 1

End If

Next

bytes2BSTR = strReturn

End Function

Function GetDate()

Dim re,Matches,Match

Set re=new RegExp

re.IgnoreCase =True

re.Global=True

re.Pattern = "has Google PageRank .+? out of 10"

Set Matches = re.Execute(Content)

GetDate = Matches(0)

Set Re = Nothing

Set Matches = Nothing

End Function

%>