Google ページランク クエリ システム (サードパーティの Web サイト データを盗用しない) には、このプログラムの 3 つのサンプル ページが付属しており、リモート取得カテゴリの
Google ページランク クエリ ページのデモは非常に優れています: http://www.knowsky.com/tools/。 pr/
3ページ:
CLS_Asphttp.asp
<%
クラスFlyCms_AspHttp
パブリック oForm、oXml、Ados
パブリック strHeaders
パブリック sMethod
公開URL
パブリックリファラー
パブリック sSetCookie
公共言語
公開コンテンツ
パブリックエージェント
パブリック sEncoding
パブリック承認
公開sData
パブリック sCodeBase
プライベート slresolveTimeout、slconnectTimeout、slsendTimeout、slreceiveTimeout
' ===========================================
'クラスモジュールの初期化
' ===========================================
プライベートサブクラス_Initialize()
oフォーム = ""
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 ' 応答受信のタイムアウト、30 秒
End Sub
' ===========================================
'DNS 名解決のタイムアウト
' ===========================================
Public プロパティ Let lresolveTimeout(LngSize)
IsNumeric(LngSize) の場合
slresolveTimeout = Clng(LngSize)
終了の場合
終了プロパティ
' ===========================================
' Winsock 接続確立のタイムアウト
' ===========================================
Public プロパティ Let lconnectTimeout(LngSize)
IsNumeric(LngSize) の場合
slconnectTimeout = Clng(LngSize)
終了の場合
終了プロパティ
' ===========================================
' データ送信のタイムアウト
' ===========================================
Public プロパティ Let lsendTimeout(LngSize)
IsNumeric(LngSize) の場合
slsendTimeout = Clng(LngSize)
終了の場合
終了プロパティ
' ===========================================
' 応答受信のタイムアウト
' ===========================================
Public プロパティ Let lreceiveTimeout(LngSize)
IsNumeric(LngSize) の場合
slreceiveTimeout = Clng(LngSize)
終了の場合
終了プロパティ
' ===========================================
'方法
' ===========================================
Public プロパティ Let Method(strMethod)
sメソッド = strメソッド
終了プロパティ
' ===========================================
'URLを送信
' ===========================================
Public プロパティ Let Url(strUrl)
sURL = strURL
終了プロパティ
' ===========================================
'データ
' ===========================================
Public プロパティ Let Data(strData)
sData = strData
終了プロパティ
' ===========================================
'リファラー
' ===========================================
Public プロパティ Let Referer(strReferer)
sReferer = strReferer
終了プロパティ
' ===========================================
'SetCookie
' ===========================================
Public プロパティ Let SetCookie(strCookie)
sSetCookie = strCookie
終了プロパティ
' ===========================================
'言語
' ===========================================
Public プロパティ Let Language(strLanguage)
sLanguage = strLanguage
終了プロパティ
' ===========================================
'コンテンツタイプ
' ===========================================
Public プロパティ Let CONTENT(strCONTENT)
sCONTENT = strCONTENT
終了プロパティ
' ===========================================
'ユーザーエージェント
' ===========================================
Public プロパティ Let Agent(strAgent)
sAgent = strAgent
終了プロパティ
' ===========================================
'エンコーディングを受け入れる
' ===========================================
Public プロパティ Let Encoding(strEncoding)
sEncoding = strEncoding
終了プロパティ
' ===========================================
'受け入れる
' ===========================================
Public プロパティ Let Accept(strAccept)
sAccept = strAccept
終了プロパティ
' ===========================================
'コードベース
' ===========================================
Public プロパティ Let CodeBase(strCodeBase)
sCodeBase = strCodeBase
終了プロパティ
' ===========================================
『データ転送方向を作成！
' ===========================================
パブリック関数 AddItem(キー, 値)
エラー時は次へ再開
薄暗い温度強度
oForm = "" の場合
oForm = キー + "= + Server.URLEncode(値)
それ以外
oForm = oForm + "&" + キー + "= + Server.URLEncode(値)
終了の場合
終了機能
' ===========================================
'データの送信とリモートデータの取得
' ===========================================
パブリック関数 HttpGet()
ディムズリターン
oXmlを使用する
.setTimeouts slresolveTimeout、slconnectTimeout、slsendTimeout、slreceiveTimeout
.Open sMethod,sUrl,False
sSetCookie<>"" の場合
.setRequestHeader "Cookie", sSetCookie 'Cookieを設定します
終了の場合
sReferer<>"" の場合
.setRequestHeader "Referer", sReferer 'ページソースを設定
それ以外
.setRequestHeader "リファラー"、sUrl
終了の場合
sLanguage<>"" の場合、次に
.setRequestHeader "Accept-Language", sLanguage '言語を設定します
終了の場合
.setRequestHeader "Content-Length",Len(sData) 'データ長を設定
sCONTENT<>"" の場合
.setRequestHeader "CONTENT-Type",sCONTENT '受け入れられるデータ型を設定します
終了の場合
sAgent<>"" の場合
.setRequestHeader "User-Agent", sAgent 'ブラウザの設定
終了の場合
sEncoding<>"" の場合
.setRequestHeader "Accept-Encoding", sEncoding 'gzip 圧縮を設定します
終了の場合
sAccept<>"" の場合
.setRequestHeader "Accept", sAccept 'ドキュメントタイプ
終了の場合
応答.sData の書き込み
.Send sData 'データを送信
.readyState <> 4 の間
.waitForResponse 1000
ウェン
strHeaders = .getAllResponseHeaders()
sCodeBase<>"" の場合、次に
sReturn = bytes2BSTR(.responseBody)
それ以外
sReturn = .responseBody
終了の場合
で終わる
HttpGet = sReturn
終了機能
' ===========================================
' バイナリデータを処理します
' ===========================================
プライベート関数 bytes2BSTR(vIn)
strReturn = ""
For i = 1 から LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
If ThisCharCode < &H80 then
strReturn = strReturn & Chr(ThisCharCode)
それ以外
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
終了の場合
次
bytes2BSTR = strReturn
終了機能
' ===========================================
' クラスモジュールのログアウト
' ===========================================
プライベートサブクラス_Terminate
oフォーム = ""
oXml = なしを設定します
Ados=Nothing を設定します
エンドサブ
終了クラス
%>
google.asp
<%
Const GOOGLE_MAGIC = &HE6359A60
関数 sl(ByVal x, ByVal n)
n = 0 の場合
sl = x
それ以外
ディムk
k = CLng(2 ^ (32 - n - 1))
ディム・ディ
d = x および (k - 1)
ディムc
c = d * CLng(2^n)
x と k の場合
c = c または &H80000000
終了の場合
sl = c
終了の場合
終了機能
プライベート関数 uadd(ByVal L1, ByVal L2)
ディム L11、L12、L21、L22、L31、L32
L11 = L1 および &HFFFFFF
L12 = (L1 と &H7F000000) &H1000000
L1 < 0 の場合、L12 = L12 または &H80
L21 = L2 および &HFFFFFF
L22 = (L2 と &H7F000000) &H1000000
L2 < 0 の場合、L22 = L22 または &H80
L32 = L12 + L22
L31 = L11 + L21
(L31 と &H1000000) の場合、L32 = L32 + 1
uadd = (L31 と &HFFFFFF) + (L32 と &H7F) * &H1000000
L32 かつ &H80 の場合、uadd = uadd または &H80000000
終了関数
関数 mix(ByVal ia、ByVal ib、ByVal ic)
薄暗い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
ミックス = ret
終了関数
Function gc(ByVal s, ByVal i)
gc = Asc(Mid(s, i + 1, 1))
終了関数
Function GoogleCH(ByVal sUrl)
ディム iLength、a、b、c、k、iLen、m
iLength = Len(sUrl)
a = &H9E3779B9
b = &H9E3779B9
c = GOOGLE_MAGIC
k = 0
iLen = iLength
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 ' すべての 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))
事例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))
事例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))
事例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))
事例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))
ケース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))
事例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))
ケース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))
ケース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))
ケース 2
a = uadd(a, sl(gc(sUrl, k + 1), 8))
a = uadd(a, gc(sUrl, k + 0))
ケース1
a = uadd(a, gc(sUrl, k + 0))
終了選択
m = mix(a, b, c)
GoogleCH = m(2)
終了関数
Function CalculateChecksum(sUrl)
CalculateChecksum = "6" & CStr(GoogleCH("info:" & sUrl))
終了機能
%>
PR.asp
<!--#include file="google.asp"-->
<!--#include file="Cls_AspHttp.asp"-->
<%
サブ Rw(Str)
Response.Str と vbCrLf を書き込む
レスポンス.フラッシュ
End Sub
Function HttpGet(lresolveTimeout,lconnectTimeout,Method,Url,Referer,Data,SetCookie,Language,CONTENT,Agent,Encoding,Accept,CodeBase)
DoGet = 新しい FlyCms_AspHttp を設定します
DoGet.lresolveTimeout = lresolveTimeout
DoGet.lconnectTimeout = lconnectTimeout
DoGet.lsendTimeout = lsendTimeout
DoGet.lreceiveTimeout = lreceiveTimeout
DoGet.Method = メソッド
DoGet.Url = URL
DoGet.Referer = リファラー
DoGet.Data = データ
DoGet.SetCookie = SetCookie
DoGet.Language = 言語
DoGet.CONTENT = コンテンツ
DoGet.Agent = エージェント
DoGet.Encoding = エンコーディング
DoGet.Accept = 受け入れる
DoGet.CodeBase = コードベース
HttpGet = DoGet.HttpGet()
DoGet = なしを設定します
終了関数
関数 GGPR(ByVal URL)
ディムストラレット
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 (互換性、MSIE 6.0、Windows NT 5.1) "、""、"*/*"、"gb2312")
If InStr(strRet,":") then
R = Split(strRet,":")
GGPR = R(2)
それ以外
GGPR = 0
終了の場合
Rw "返される結果: " & strRet & "<br />"
Rw " PR 値: " & GGPR & "<br />"
関数終了
iURL = Request("iURL")
iURL="" の場合、iURL = " http://www.downcodes.com "
CallGGPR(iURL)
%>
<html>
<頭></頭>
<title>Google ページランク クエリ (pr クエリ泥棒)</title>
<本文>
<h1>ページランク (ページ PR 値) を確認するには、完全なページ アドレスを入力してください:</h1>
<フォームアクション=""メソッド="ポスト">
URL <input type="text" name="iURL" style="width:200px" /><input type="submit" value="pr query" />
</form>
</body>
<html>