PR值查询代码制作

复制代码 代码如下:

<%@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 ' 建立正则表达式。 

内容版权声明:除非注明,否则皆为本站原创文章。

转载注明出处:http://www.heiqu.com/3493.html