The code copy is as follows:
<%@LANGUAGE="VBSCRIPT"CODEPAGE="936"%>
<!DOCTYPEHTMLPUBLIC"-//W3C//DTDHTML4.01Transitional//EN""http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<metahttp-equiv="Content-Type"content="text/html;charset=gb2312">
<title>GooglePR value query program</title>
</head>
<body><h3>Enter the URL and query the GooglePageRank value</h3>
<formname="form1"method="post"action="?act=ok">
<p>Enter the URL
<inputtype="text"name="domain">
<inputtype="submit"name="Submit"value="submit">
</p>
</form>
<%
iftrim(Request.QueryString("act"))="ok"then
domain=trim(Request.Form("domain"))
ifdomain<>""then
Response.Write("<b>"&domain&"</b>'s GooglePageRank value is <fontcolor=red>"&getPr(domain)&"</font>")
endif
endif
FunctiongetPr(domain)
getContent=GetURL("http://so.5eo.com/pr/rank.asp?domain="&domain)
getPrLine=RegExpText(getContent,"Get .*(//d).* points in GooglePageRank full score 10 points rating")
getPr=RegExpText(getPrLine,"//s//d//s")
EndFunction
Functionbstr(vIn)
DimstrReturn,i,ThisCharCode,innerCode,Hight8,Low8,NextCharCode
strReturn=""
Fori=1ToLenB(vIn)
ThisCharCode=AscB(MidB(vIn,i,1))
IfThisCharCode<&H80Then
strReturn=strReturn&Chr(ThisCharCode)
Else
NextCharCode=AscB(MidB(vIn,i+1,1))
strReturn=strReturn&Chr(CLng(ThisCharCode)*&H100+CInt(NextCharCode))
i=i+1
EndIf
Next
bstr=strReturn
EndFunction
FunctionGetURL(url)
SetRetrieval=Server.CreateObject("Microsoft.XMLHTTP")
WithRetrieval
.Open"GET",url,false
.setRequestHeader"Content-Type","application/x-www-form-urlencoded"
.Send
GetURL=.ResponseBody
EndWith
SetRetrieval=Nothing
GetURL=bstr(GetURL)
EndFunction
FunctionRegExpText(strng,regStr)
'DimregEx,Match,Matches' creates variables.
SetregEx=NewRegExp' creates a regular expression.
regEx.Pattern=regStr' Set mode.
regEx.IgnoreCase=True' Set whether to be case sensitive.