保定网络公司+保定网站建设+保定做网站 保定市网络公司 保定市网站设计 保定市网站建设 保定市网站制作 保定市网站推广
保定制作网站,保定建设网站,保定优化网站的公司 设为首页
保定市网站设计,保定市网站建设,保定市网站优化,保定市网站推广
保定网站设计,保定网站建设,保定网站优化,保定网站推广 给我留言
首页       关于我们   作品展示   项目服务   域名空间   公司新闻   建站学院   SEO优化   网站建设   建站知识   联系我们   
保定建站真心为您服务!承接网站建设 + 网页设计 + FLASH设计 + 网站开发 + 平面设计,专业技术人员一对一服务让建站更加专业更加放心……二十小时服务热线:+86)13730168216。欢迎来电咨询…… 现在时间是
文章展示
网站建设 网站推广 一切竟掌握

ASP版Google pagerank查询系统=非偷取第三方网站数据

发布者:网站建设 保定做网站  发布时间:2009-5-31    点击次数:29326
Google pagerank查询系统(非偷取第三方网站数据)带本程序示例三个页面,其中的远程获取类非常不错.

Google pagerank查询页面演示:http://www.knowsky.com/tools/pr/ 

三个页面:
CLS_Asphttp.asp

<% 
Class FlyCms_AspHttp 
Public oForm,oXml,Ados 
Public strHeaders 
Public sMethod 
Public sUrl 
Public sReferer 
Public sSetCookie 
Public sLanguage 
Public sCONTENT 
Public sAgent 
Public sEncoding 
Public sAccept 
Public sData 
Public sCodeBase 
Private slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout 
’ ============================================ 
’ 类模块初始化 
’ ============================================ 
Private Sub Class_Initialize() 
oForm = "" 
Set oXml = Server.CreateObject("MSXML2.ServerXMLHTTP") 
set Ados = Server.CreateObject("Adodb.Stream") 
slresolveTimeout = 20000 ’ 解析DNS名字的超时时间,20秒 
slconnectTimeout = 20000 ’ 建立Winsock连接的超时时间,20秒 
slsendTimeout = 30000 ’ 发送数据的超时时间,30秒 
slreceiveTimeout = 30000 ’ 接收response的超时时间,30秒 
End Sub 

’ ============================================ 
’ 解析DNS名字的超时时间 
’ ============================================ 
Public Property Let lresolveTimeout(LngSize) 
If IsNumeric(LngSize) Then 
slresolveTimeout = Clng(LngSize) 
End If 
End Property 
’ ============================================ 
’ 建立Winsock连接的超时时间 
’ ============================================ 
Public Property Let lconnectTimeout(LngSize) 
If IsNumeric(LngSize) Then 
slconnectTimeout = Clng(LngSize) 
End If 
End Property 
’ ============================================ 
’ 发送数据的超时时间 
’ ============================================ 
Public Property Let lsendTimeout(LngSize) 
If IsNumeric(LngSize) Then 
slsendTimeout = Clng(LngSize) 
End If 
End Property 
’ ============================================ 
’ 接收response的超时时间 
’ ============================================ 
Public Property Let lreceiveTimeout(LngSize) 
If IsNumeric(LngSize) Then 
slreceiveTimeout = Clng(LngSize) 
End If 
End Property 
’ ============================================ 
’ Method 
’ ============================================ 
Public Property Let Method(strMethod) 
sMethod = strMethod 
End Property 
’ ============================================ 
’ 发送url 
’ ============================================ 
Public Property Let Url(strUrl) 
sUrl = strUrl 
End Property 
’ ============================================ 
’ Data 
’ ============================================ 
Public Property Let Data(strData) 
sData = strData 
End Property 
’ ============================================ 
’ Referer 
’ ============================================ 
Public Property Let Referer(strReferer) 
sReferer = strReferer 
End Property 
’ ============================================ 
’ SetCookie 
’ ============================================ 
Public Property Let SetCookie(strCookie) 
sSetCookie = strCookie 
End Property 
’ ============================================ 
’ Language 
’ ============================================ 
Public Property Let Language(strLanguage) 
sLanguage = strLanguage 
End Property 
’ ============================================ 
’ CONTENT-Type 
’ ============================================ 
Public Property Let CONTENT(strCONTENT) 
sCONTENT = strCONTENT 
End Property 
’ ============================================ 
’ User-Agent 
’ ============================================ 
Public Property Let Agent(strAgent) 
sAgent = strAgent 
End Property 
’ ============================================ 
’ Accept-Encoding 
’ ============================================ 
Public Property Let Encoding(strEncoding) 
sEncoding = strEncoding 
End Property 
’ ============================================ 
’ Accept 
’ ============================================ 
Public Property Let Accept(strAccept) 
sAccept = strAccept 
End Property 
’ ============================================ 
’ CodeBase 
’ ============================================ 
Public Property Let CodeBase(strCodeBase) 
sCodeBase = strCodeBase 
End Property 
’ ============================================ 
’ 建立数据传送对向! 
’ ============================================ 
Public Function AddItem(Key, Value) 
On Error Resume Next 
Dim TempStr 
If oForm = "" Then 
oForm = Key + "=" + Server.URLEncode(Value) 
Else 
oForm = oForm + "&" + Key + "=" + Server.URLEncode(Value) 
End If 
End Function 
’ ============================================ 
’ 发送数据并取回远程数据 
’ ============================================ 
Public Function HttpGet() 
Dim sReturn 
With oXml 
.setTimeouts slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout 
.Open sMethod,sUrl,False 
If sSetCookie<>"" Then 
.setRequestHeader "Cookie", sSetCookie ’设定Cookie 
End If 
If sReferer<>"" Then 
.setRequestHeader "Referer", sReferer ’设定页面来源 
Else 
.setRequestHeader "Referer", sUrl 
End If 
If sLanguage<>"" Then 
.setRequestHeader "Accept-Language", sLanguage ’设定语言 
End If 
.setRequestHeader "Content-Length",Len(sData) ’设定数据长度 
If sCONTENT<>"" Then 
.setRequestHeader "CONTENT-Type",sCONTENT ’设定接受数据类型 
End If 
If sAgent<>"" Then 
.setRequestHeader "User-Agent", sAgent ’设定浏览器 
End If 
If sEncoding<>"" Then 
.setRequestHeader "Accept-Encoding", sEncoding ’设定gzip压缩 
End If 
If sAccept<>"" Then 
.setRequestHeader "Accept", sAccept ’文档类型 
End If 
Response.Write sData 
.Send sData ’发送数据 
While .readyState <> 4 
.waitForResponse 1000 
Wend 
strHeaders = .getAllResponseHeaders() 
If sCodeBase<>"" Then 
sReturn = bytes2BSTR(.responseBody) 
Else 
sReturn = .responseBody 
End If 
End With 
HttpGet = sReturn 
End Function 
’ ============================================ 
’ 处理二进制数据 
’ ============================================ 
Private Function bytes2BSTR(vIn) 
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 
bytes2BSTR = strReturn 
End Function 
’ ============================================ 
’ 类模块注销 
’ ============================================ 
Private Sub Class_Terminate 
oForm = "" 
Set oXml = Nothing 
Set Ados = Nothing 
End Sub 
End Class 
%>

google.asp

<% 
Const GOOGLE_MAGIC = &HE6359A60 

Function sl(ByVal x, ByVal n) 
If n = 0 Then 
sl = x 
Else 
Dim k 
k = CLng(2 ^ (32 - n - 1)) 
Dim d 
d = x And (k - 1) 
Dim c 
c = d * CLng(2 ^ n) 
If x And k Then 
c = c Or &H80000000 
End If 
sl = c 
End If 
End Function 


Private Function uadd(ByVal L1, ByVal L2) 
Dim L11, L12, L21, L22, L31, L32 
L11 = L1 And &HFFFFFF 
L12 = (L1 And &H7F000000) \ &H1000000 
If L1 < 0 Then L12 = L12 Or &H80 
L21 = L2 And &HFFFFFF 
L22 = (L2 And &H7F000000) \ &H1000000 
If L2 < 0 Then L22 = L22 Or &H80 
L32 = L12 + L22 
L31 = L11 + L21 
If (L31 And &H1000000) Then L32 = L32 + 1 
uadd = (L31 And &HFFFFFF) + (L32 And &H7F) * &H1000000 
If L32 And &H80 Then uadd = uadd Or &H80000000 
End Function 

Function mix(ByVal ia, ByVal ib, ByVal ic) 
Dim a, b, c 
a = ia 
b = ib 
c = ic 

a = usub(a, b) 
a = usub(a, c) 
a = a Xor zeroFill(c, 13) 

b = usub(b, c) 
b = usub(b, a) 
b = b Xor sl(a, 8) 

b = usub(b, c) 
b = usub(b, a) 
b = b Xor sl(a, 10) 

c = usub(c, a) 
c = usub(c, b) 
c = c Xor zeroFill(b, 15) 

Dim ret(3) 

ret(0) = a 
ret(1) = b 
ret(2) = c 

mix = ret 
End Function 

Function gc(ByVal s, ByVal i) 
gc = Asc(Mid(s, i + 1, 1)) 
End Function 

Function GoogleCH(ByVal sUrl) 
Dim iLength, a, b, c, k, iLen, m 
iLength = Len(sUrl) 

a = &H9E3779B9 
b = &H9E3779B9 
c = GOOGLE_MAGIC 
k = 0 

iLen = iLength 
Do While iLen >= 12 
a = uadd(a, (uadd(gc(sUrl, k + 0), uadd(sl(gc(sUrl, k + 1), 8), uadd(sl(gc(sUrl, k + 2), 16), sl(gc(sUrl, k + 3), 24)))))) 
b = uadd(b, (uadd(gc(sUrl, k + 4), uadd(sl(gc(sUrl, k + 5), 8), uadd(sl(gc(sUrl, k + 6), 16), sl(gc(sUrl, k + 7), 24)))))) 

m = mix(a, b, c) 

a = m(0) 
b = m(1) 
c = m(2) 

k = k + 12 

iLen = iLen - 12 
Loop 

c = uadd(c, iLength) 

Select Case iLen ’ all the case statements fall through 
Case 11 
c = uadd(c, sl(gc(sUrl, k + 10), 24)) 
c = uadd(c, sl(gc(sUrl, k + 9), 16)) 
c = uadd(c, sl(gc(sUrl, k + 8), 8)) 
b = uadd(b, sl(gc(sUrl, k + 7), 24)) 
b = uadd(b, sl(gc(sUrl, k + 6), 16)) 
b = uadd(b, sl(gc(sUrl, k + 5), 8)) 
Case 10 
c = uadd(c, sl(gc(sUrl, k + 9), 16)) 
c = uadd(c, sl(gc(sUrl, k + 8), 8)) 
b = uadd(b, sl(gc(sUrl, k + 7), 24)) 
b = uadd(b, sl(gc(sUrl, k + 6), 16)) 
b = uadd(b, sl(gc(sUrl, k + 5), 8)) 
b = uadd(b, gc(sUrl, k + 4)) 
Case 9 
c = uadd(c, sl(gc(sUrl, k + 8), 8)) 
b = uadd(b, sl(gc(sUrl, k + 7), 24)) 
b = uadd(b, sl(gc(sUrl, k + 6), 16)) 
b = uadd(b, sl(gc(sUrl, k + 5), 8)) 
b = uadd(b, gc(sUrl, k + 4)) 
a = uadd(a, sl(gc(sUrl, k + 3), 24)) 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 8 
b = uadd(b, sl(gc(sUrl, k + 7), 24)) 
b = uadd(b, sl(gc(sUrl, k + 6), 16)) 
b = uadd(b, sl(gc(sUrl, k + 5), 8)) 
b = uadd(b, gc(sUrl, k + 4)) 
a = uadd(a, sl(gc(sUrl, k + 3), 24)) 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 7 
b = uadd(b, sl(gc(sUrl, k + 6), 16)) 
b = uadd(b, sl(gc(sUrl, k + 5), 8)) 
b = uadd(b, gc(sUrl, k + 4)) 
a = uadd(a, sl(gc(sUrl, k + 3), 24)) 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 6 
b = uadd(b, sl(gc(sUrl, k + 5), 8)) 
b = uadd(b, gc(sUrl, k + 4)) 
a = uadd(a, sl(gc(sUrl, k + 3), 24)) 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 5 
b = uadd(b, gc(sUrl, k + 4)) 
a = uadd(a, sl(gc(sUrl, k + 3), 24)) 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 4 
a = uadd(a, sl(gc(sUrl, k + 3), 24)) 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 3 
a = uadd(a, sl(gc(sUrl, k + 2), 16)) 
a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 2 

a = uadd(a, sl(gc(sUrl, k + 1), 8)) 
a = uadd(a, gc(sUrl, k + 0)) 
Case 1 
a = uadd(a, gc(sUrl, k + 0)) 
End Select 

m = mix(a, b, c) 

GoogleCH = m(2) 
End Function 

Function CalculateChecksum(sUrl) 
CalculateChecksum = "6" & CStr(GoogleCH("info:" & sUrl)) 
End Function 
%>

PR.asp

<!--#include file="google.asp"--> 
<!--#include file="Cls_AspHttp.asp"--> 
<% 
Sub Rw(Str) 
Response.Write Str & vbCrLf 
Response.Flush 
End Sub 

Function HttpGet(lresolveTimeout,lconnectTimeout,Method,Url,Referer,Data,SetCookie,Language,CONTENT,Agent,Encoding,Accept,CodeBase) 
Set DoGet = New FlyCms_AspHttp 
DoGet.lresolveTimeout = lresolveTimeout 
DoGet.lconnectTimeout = lconnectTimeout 
DoGet.lsendTimeout = lsendTimeout 
DoGet.lreceiveTimeout = lreceiveTimeout 
DoGet.Method = Method 
DoGet.Url = Url 
DoGet.Referer = Referer 
DoGet.Data = Data 
DoGet.SetCookie = SetCookie 
DoGet.Language = Language 
DoGet.CONTENT = CONTENT 
DoGet.Agent = Agent 
DoGet.Encoding = Encoding 
DoGet.Accept = Accept 
DoGet.CodeBase = CodeBase 
HttpGet = DoGet.HttpGet() 
Set DoGet = Nothing 
End Function 

Function GGPR(ByVal URL) 
Dim strRet 
sURL = "http://www.google.com/search?client=navclient&ch=" & CalculateCheck(URL) & "&features=Rank&q=info:" & URL 
Rw "查询地址: " & sURL & "<br />" 
strRet = HttpGet(10000,10000,20000,20000,"GET",sUrl,"","","","zh-cn","","Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)","","*/*","gb2312") 
If InStr(strRet,":") Then 
R = Split(strRet,":") 
GGPR = R(2) 
Else 
GGPR = 0 
End If 
Rw "返回结果: " & strRet & "<br />" 
Rw "  PR值: " & GGPR & "<br />" 
End Function 

iURL = Request("iURL") 
If iURL="" Then iURL = "http://www.knowsky.com" 
Call GGPR(iURL) 
%> 
<html> 
<head></head> 
<title>Google Pagerank 查询(pr查询小偷)</title> 
<body> 
<h1>输入完整页面地址查选pagerank(页面pr值):</h1> 
<form action="" method="post"> 
URL <input type="text" name="iURL" style="width:200px" /><input type="submit" value="pr查询" /> 
</form> 
</body> 
<html>
 
相关文章展示: 关键词: ASP  Google  pagerank  查询  系统  pr值 
Asp编码优化技巧8则 [38227]
asp生成UTF-8格式的文件 [37926]
ASP利用缓存提高数据显示效率 [39603]
Oracle数据库查询十个小技巧 [42871]
ACCESS的参数化查询 [40162]
JS判断新旧密码一致 [33196]
解决网站被反复挂马的问题 [28638]
网站优化的六个必须的步骤 [27778]
遭遇百度快照日期回档 [28853]
5种不可取的网站推广方法 [26617]
 
保定建站欢迎您的咨询
详细地址
  资询热线:
  0312-5975933
业务咨询QQ
业务咨询QQ
业务咨询QQ
空间域名QQ
技术支持QQ
MSN客服
推荐文章
查看更多
· 蛇形溯源-通过话题链接,跨平台获取相关话题的关键词与出现频次
· 社群营销第一人:陈艺明【社群推广首选】社群宣传费用
· 信息发布技巧:产品诱人,卖点突出
· 保定网络公司哪家好?保定最好的网络公司
· 高阳经济开发区与我公司司签订网站建设服务
· 保定微营销报名啦!落地操作(微生活学院)别和钱较劲- 陈艺明
· 保定微营销【最好的】微营销活动报名开始了,陈艺明讲述微生活营
· 保定微营销:陈艺明F2F微生活营销课程开始了!保定微营销最好
· 保定做网站最便宜的多少钱?保定哪家做网站最便宜?
· 保定手机网站建设,保定APP手机网站制作
· 祝贺保定职业技术学院武术协会与我司签订网站建设
· 陈老师讲解:保定中小企业网络微营销的困难困难“解决”低小丑的
   最新作品
亿家能商贸(中英文网站制作-美国服务器)-北京网站建设
亿家能商贸(中英文网站制作-美国服务器)
(网站设计)北京君闻香酒业有限公司-北京网站建设
(网站设计)北京君闻香酒业有限公司
河北保定博时广告(网站设计)-北京网站建设
河北保定博时广告(网站设计)
保定IDO婚庆公司(网站优化)-北京网站建设
保定IDO婚庆公司(网站优化)
保定天生桥牌红枣贡酒(网站设计)-北京网站建设
保定天生桥牌红枣贡酒(网站设计)
保定党史研究史(网站制作)-北京网站建设
保定党史研究史(网站制作)
保定达瑞设备有限公司(网站优化)-北京网站建设
保定达瑞设备有限公司(网站优化)
VI设计公司(网站设计制作)-北京网站建设
VI设计公司(网站设计制作)
|   网站建设  |   关于我们  |   建站学院  |   域名空间  |   作品展示  |   招聘岗位  |   服务项目  |   联系我们  |   建站常识  |   建站论坛  |  

客服中心:河北省保定市永华路与西大街交汇处(查看地图路线)秀兰公寓B座4楼右转即到(428号)。
网络公司联系电话:0312-5975933 / 2035252 / 3146161 二十小时联系电话:13730168216   网络公司售后服务电话:15603212829 传真:0312-3146161
工作时间:周一至周六.上午:8:00-12:00 下午:2:00-6:00 周日全天服务电话:13730168216
客服企业邮箱:kefu@jihewang.com   技术企业邮箱:jishu@jihewang.com   经理企业邮箱:admin@jihewang.com
网络公司名称:   工商注册号:130604000010106   邮编:07100
保定网络公司永久网址:http://www.jihewang.com
Copyright © 2003-2012 保定建站 All rights reserved. 冀ICP备05000154号
本公司业务:保定网站建设_保定网站制作_保定网站推广_保定网页网站设计_保定400电话_软件群发_保定网络公司以敬业、负责的态度为您做网站,以客户的成功为成功。

    
客服
客服
技术
域名
空间
售后
咨询
MSN
电邮