Das Google-Pagerank-Abfragesystem (das keine Website-Daten Dritter stiehlt) enthält drei Beispielseiten dieses Programms, und die
Demonstration der Remote-Akquise-Kategorie für die Google-Pagerank-Abfrageseite ist sehr gut: http://www.knowsky.com/tools/ . PR/
三Seiten:
CLS_Asphttp.asp
<%
Klasse FlyCms_AspHttp
Öffentliches oForm, oXml, Ados
Öffentliche strHeader
Öffentliche Methode
Öffentliche URL
Öffentlicher sReferer
Öffentliches sSetCookie
Öffentliche Sprache
Öffentlicher Inhalt
Öffentlicher Agent
Öffentliche Verschlüsselung
Öffentliches Akzeptieren
Öffentliche sData
Öffentliche sCodeBase
Privates slresolveTimeout, slconnectTimeout, slsendTimeout, slreceiveTimeout
' ==========================================
'Initialisierung des Klassenmoduls
' ==========================================
Private Sub Class_Initialize()
oForm = ""
Setze oXml = Server.CreateObject("MSXML2.ServerXMLHTTP")
set Ados = Server.CreateObject("Adodb.Stream")
slresolveTimeout = 20000 'Timeout für die Auflösung von DNS-Namen, 20 Sekunden
slconnectTimeout = 20000 ' Timeout für den Aufbau einer Winsock-Verbindung, 20 Sekunden
slsendTimeout = 30000 ' Timeout für das Senden von Daten, 30 Sekunden
slreceiveTimeout = 30000 ' Timeout für den Empfang einer Antwort, 30 Sekunden
End Sub
' ===========================================
'Zeitüberschreitung beim Auflösen von DNS-Namen
' ==========================================
Öffentliche Eigenschaft Let lresolveTimeout(LngSize)
If IsNumeric(LngSize) Then
slresolveTimeout = Clng(LngSize)
Ende wenn
End-Eigenschaft
' ==========================================
' Zeitüberschreitung beim Herstellen einer Winsock-Verbindung
' ==========================================
Öffentliche Eigenschaft Let lconnectTimeout(LngSize)
If IsNumeric(LngSize) Then
slconnectTimeout = Clng(LngSize)
Ende wenn
End-Eigenschaft
' ==========================================
' Timeout für das Senden von Daten
' ==========================================
Öffentliche Eigenschaft Let lsendTimeout(LngSize)
If IsNumeric(LngSize) Then
slsendTimeout = Clng(LngSize)
Ende wenn
End-Eigenschaft
' ==========================================
' Zeitüberschreitung beim Empfang einer Antwort
' ==========================================
Öffentliche Eigenschaft Let lreceiveTimeout(LngSize)
If IsNumeric(LngSize) Then
slreceiveTimeout = Clng(LngSize)
Ende wenn
End-Eigenschaft
' ==========================================
'Verfahren
' ==========================================
Let-Methode für öffentliches Eigentum (strMethod)
sMethod = strMethod
End-Eigenschaft
' ==========================================
'URL senden
' ==========================================
Öffentliches Eigentum Let Url(strUrl)
sUrl = strUrl
End-Eigenschaft
' ==========================================
'Daten
' ==========================================
Let Data für öffentliches Eigentum (strData)
sData = strData
End-Eigenschaft
' ==========================================
'Überweiser
' ==========================================
Öffentliches Eigentum Let Referer(strReferer)
sReferer = strReferer
End-Eigenschaft
' ==========================================
'SetCookie
' ==========================================
Öffentliches Eigentum Let SetCookie(strCookie)
sSetCookie = strCookie
End-Eigenschaft
' ==========================================
'Sprache
' ==========================================
Öffentliches Eigentum Let Language(strLanguage)
sLanguage = strLanguage
End-Eigenschaft
' ==========================================
'CONTENT-Typ
' ==========================================
Öffentliches Eigentum vermieten CONTENT(strCONTENT)
sCONTENT = strCONTENT
End-Eigenschaft
' ==========================================
'Benutzeragent
' ==========================================
Öffentlicher Immobilienvermietungsagent (strAgent)
sAgent = strAgent
End-Eigenschaft
' ==========================================
'Akzeptieren-Kodierung
' ==========================================
Let Encoding für öffentliches Eigentum (strEncoding)
sEncoding = strEncoding
End-Eigenschaft
' ==========================================
'Akzeptieren
' ==========================================
Öffentliches Eigentum Let Accept(strAccept)
sAccept = strAccept
End-Eigenschaft
' ==========================================
'CodeBase
' ==========================================
Öffentliche Eigenschaft Let CodeBase(strCodeBase)
sCodeBase = strCodeBase
End-Eigenschaft
' ==========================================
'Datenübertragungsrichtung erstellen!
' ==========================================
Öffentliche Funktion AddItem(Key, Value)
Bei Fehler Weiter fortsetzen
Dim TempStr
Wenn oForm = "" Dann
oForm = Schlüssel + "=" + Server.URLEncode(Wert)
Anders
oForm = oForm + "&" + Schlüssel + "=" + Server.URLEncode(Wert)
Ende wenn
Funktion beenden
' ==========================================
„Daten senden und Remote-Daten abrufen.“
' ==========================================
Öffentliche Funktion HttpGet()
Dimmen Sie sReturn
Mit oXml
.setTimeouts slresolveTimeout, slconnectTimeout, slsendTimeout, slreceiveTimeout
.Open sMethod,sUrl,False
Wenn sSetCookie<>"" Dann
.setRequestHeader "Cookie", sSetCookie 'Cookie setzen
Ende wenn
Wenn sReferer<>"" Dann
.setRequestHeader "Referer", sReferer 'Seitenquelle festlegen
Anders
.setRequestHeader „Referer“, URL
Ende wenn
Wenn sLanguage<>"" Dann
.setRequestHeader "Accept-Language", sLanguage 'Sprache festlegen
Ende wenn
.setRequestHeader "Content-Length",Len(sData) 'Datenlänge festlegen
Wenn sCONTENT<>"" Dann
.setRequestHeader "CONTENT-Type",sCONTENT 'Legt den akzeptierten Datentyp fest
Ende wenn
Wenn sAgent<>"" Dann
.setRequestHeader „User-Agent“, sAgent 'Browser festlegen
Ende wenn
Wenn sEncoding<>"" Dann
.setRequestHeader "Accept-Encoding", sEncoding 'Gzip-Komprimierung festlegen
Ende wenn
Wenn sAccept<>"" Dann
.setRequestHeader "Accept", sAccept 'Dokumenttyp
Ende wenn
Antwort. sData schreiben
.Send sData 'Daten senden
Während .readyState <> 4
.waitForResponse 1000
Wend
strHeaders = .getAllResponseHeaders()
Wenn sCodeBase<>"" Dann
sReturn = bytes2BSTR(.responseBody)
Anders
sReturn = .responseBody
Ende wenn
Ende mit
HttpGet = sReturn
Funktion beenden
' ==========================================
' Binärdaten verarbeiten
' ==========================================
Private Funktion bytes2BSTR(vIn)
strReturn = ""
Für i = 1 Zu LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Wenn ThisCharCode < &H80 Dann
strReturn = strReturn & Chr(ThisCharCode)
Anders
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
ich = ich + 1
Ende wenn
Nächste
bytes2BSTR = strReturn
Funktion beenden
' ==========================================
' Abmeldung vom Klassenmodul
' ==========================================
Private Unterklasse_Terminate
oForm = ""
Setze oXml = Nichts
Setze Ados=Nichts
Sub beenden
Unterricht beenden
%>
google.asp
<%
Const GOOGLE_MAGIC = &HE6359A60
Funktion sl(ByVal x, ByVal n)
Wenn n = 0, dann
sl = x
Anders
Dim k
k = CLng(2 ^ (32 - n - 1))
Dim d
d = x Und (k - 1)
Schwaches c
c = d * CLng(2^n)
Wenn x und k dann
c = c Oder &H80000000
Ende wenn
sl = c
Ende wenn
Funktion beenden
Private Funktion uadd(ByVal L1, ByVal L2)
Dimmen Sie L11, L12, L21, L22, L31, L32
L11 = L1 und &HFFFFFF
L12 = (L1 und &H7F000000) &H1000000
Wenn L1 < 0, dann ist L12 = L12 oder &H80
L21 = L2 und &HFFFFFF
L22 = (L2 und &H7F000000) &H1000000
Wenn L2 < 0, dann ist L22 = L22 oder &H80
L32 = L12 + L22
L31 = L11 + L21
Wenn (L31 und &H1000000), dann ist L32 = L32 + 1
uadd = (L31 und &HFFFFFF) + (L32 und &H7F) * &H1000000
Wenn L32 und &H80, dann uadd = uadd oder &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
Endfunktion
Funktion gc(ByVal s, ByVal i)
gc = Asc(Mid(s, i + 1, 1))
Endfunktion
Funktion 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
Machen Sie 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
Schleife
c = uadd(c, iLength)
Select Case iLen ' alle case-Anweisungen fallen durch
Fall 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))
Fall 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))
Fall 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))
Fall 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))
Fall 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))
Fall 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))
Fall 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))
Fall 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))
Fall 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))
Fall 2
a = uadd(a, sl(gc(sUrl, k + 1), 8))
a = uadd(a, gc(sUrl, k + 0))
Fall 1
a = uadd(a, gc(sUrl, k + 0))
Ende Select
m = mix(a, b, c)
GoogleCH = m(2)
Endfunktion
Funktion CalculateChecksum(sUrl)
CalculateChecksum = "6" & CStr(GoogleCH("info:" & sUrl))
Funktion beenden
%>
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)
Setzen Sie DoGet = New FlyCms_AspHttp
DoGet.lresolveTimeout = lresolveTimeout
DoGet.lconnectTimeout = lconnectTimeout
DoGet.lsendTimeout = lsendTimeout
DoGet.lreceiveTimeout = lreceiveTimeout
DoGet.Method = Methode
DoGet.Url = URL
DoGet.Referer = Referrer
DoGet.Data = Daten
DoGet.SetCookie = SetCookie
DoGet.Language = Sprache
DoGet.CONTENT = INHALT
DoGet.Agent = Agent
DoGet.Encoding = Kodierung
DoGet.Accept = Akzeptieren
DoGet.CodeBase = CodeBase
HttpGet = DoGet.HttpGet()
Setze DoGet = Nothing
Endfunktion
Funktion GGPR(ByVal URL)
Dim strRet
sURL = " http://www.google.com/search?client=navclient&ch =" & CalculateCheck(URL) & "&features=Rank&q=info:" & URL
Rw „Abfrageadresse: „ & sURL & „<br />“
strRet = HttpGet(10000,10000,20000,20000,"GET",sUrl,"","","","zh-cn","","Mozilla/4.0 (kompatibel; MSIE 6.0; Windows NT 5.1) ","","*/*","gb2312")
Wenn InStr(strRet,::) Dann
R = Split(strRet,::)
GGPR = R(2)
Anders
GGPR = 0
Ende wenn
Rw „Ergebnis zurückgeben: „ & strRet & „<br />“
Rw " PR-Wert: " & GGPR & "<br />"
Endfunktion
iURL = Request("iURL")
Wenn iURL="" Dann iURL=" http://www.downcodes.com "
AnrufGGPR(iURL)
%>
<html>
<Kopf></Kopf>
<title>Google Pagerank-Abfrage (PR-Abfragedieb)</title>
<Körper>
<h1>Geben Sie die vollständige Seitenadresse ein, um den Pagerank (Seiten-PR-Wert) zu überprüfen:</h1>
<form action="" method="post">
URL <input type="text" name="iURL" style="width:200px" /><input type="submit" value="pr query" />
</form>
</body>
<html>