当前位置: 首页 > 图文教程 > 网络编程 > ASP > PR值查询代码制作

ASP
对连串英文自动换行的解决方法 IE5.5
怎样写你自己的EMAIL组件(原理)
ASP中有关timeout超时的体会
用ASP实现从SQL Server导出数据到Access
ASP向NT域中加一个用户
ASP乱码的解决方法
关于 aspsmartupload 注册问题
利用XML不离开页面刷新数据
IIS 处理 SEARCH 请求漏洞
不用组件实现上载功能(1)
不用组件实现上载功能(2)
在网页中实现OICQ里的头像选择的下拉框
仅用xsl和asp实现分页功能
如何使用context()方法将数据置入表格(XML)
利用ASP从远程服务器上接收XML数据
将数据库里面的内容生成EXCEL
怎样在ASP里面创建统计图表
加密你的Access数据库
利用global.asp定时执行ASP
加密QueryString数据

ASP 中的 PR值查询代码制作


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 88 ::
收藏到网摘: n/a

复制代码 代码如下:

<%@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 ' 设置是否区分字符大小写。
regEx.Global = True ' 设置全局可用性。
Set Matches = regEx.Execute(strng) ' 执行搜索。
For Each Match in Matches ' 遍历匹配集合。
RetStr = RetStr & Match.value'&"|||"
Next
RegExpText = RetStr
set regEx=nothing
End Function
%>
</body>
</html>