複製代碼代碼如下:
<%@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值查詢程序</title>
</head>
<body><h3>輸入網址，查詢GooglePageRank值</h3>
<formname="form1"method="post"action="?act=ok">
<p>輸入網址
<inputtype="text"name="domain">
<inputtype="submit"name="Submit"value="提交">
</p>
</form>
<%
iftrim(Request.QueryString("act"))="ok"then
domain=trim(Request.Form("domain"))
ifdomain<>""then
Response.Write("<b>"&domain&"</b>的GooglePageRank值為<fontcolor=red>"&getPr(domain)&"</font>")
endif
endif
FunctiongetPr(domain)
getContent=GetURL("http://so.5eo.com/pr/rank.asp?domain="&domain)
getPrLine=RegExpText(getContent,"在GooglePageRank滿分10分評價中獲得.*(//d).*分")
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'建立變量。
SetregEx=NewRegExp'建立正則表達式。
regEx.Pattern=regStr'設置模式。
regEx.IgnoreCase=True'設置是否區分字符大小寫。