%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%> 
!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> 
html> 
head> 
meta http-equiv="Content-Type" content="text/html; charset=gb2312"> 
title>Google PR值查詢程序/title> 
/head> 

body>h3>輸入網址，查詢Google PageRank值/h3> 
form name="form1" method="post" action="?act=ok"> 
p>輸入網址 
input type="text" name="domain"> 
input type="submit" name="Submit" value="提交"> 
/p> 
/form> 
% 
if trim(Request.QueryString("act"))="ok" then 
domain=trim(Request.Form("domain")) 
if domain>"" then 
Response.Write("b>"domain"/b> 的Google PageRank值為font color=red>"getPr(domain)"/font>") 
end if 
end if 

Function getPr(domain) 
getContent=GetURL("http://so.5eo.com/pr/rank.asp?domain="domain) 
getPrLine=RegExpText(getContent,"在Google PageRank滿分10分評價中獲得.*(\\d).*分") 
getPr=RegExpText(getPrLine,"\\s\\d\\s") 
End Function 

Function bstr(vIn) 
Dim strReturn,i,ThisCharCode,innerCode,Hight8,Low8,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 

bstr = strReturn 
End Function 

Function GetURL(url) 
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP") 
With Retrieval 
.Open "GET", url, false 
.setRequestHeader "Content-Type","application/x-www-form-urlencoded" 
.Send 
GetURL = .ResponseBody 
End With 
Set Retrieval = Nothing 
GetURL=bstr(GetURL) 
End Function 

Function RegExpText(strng,regStr) 
'Dim regEx, Match, Matches ' 建立變量。 
Set regEx = New RegExp ' 建立正則表達式。 
regEx.Pattern = regStr ' 設置模式。 
regEx.IgnoreCase = True ' 設置是否區(qū)分字符大小寫。 
regEx.Global = True ' 設置全局可用性。 
Set Matches = regEx.Execute(strng) ' 執(zhí)行搜索。 
For Each Match in Matches ' 遍歷匹配集合。 
RetStr = RetStr  Match.value'"|||" 
Next 
RegExpText = RetStr 
set regEx=nothing 
End Function 
%> 
/body> 
/html>