Le système de requête de pagerank de Google (qui ne vole pas les données de sites Web tiers) est livré avec trois exemples de pages de ce programme, et la catégorie d'acquisition à distance est une très bonne
démonstration de la page de requête de pagerank de Google : http://www.knowsky.com/tools/ . pr/
三pages :
CLS_Asphttp.asp
<%
Classe FlyCms_AspHttp
oForm public, oXml, Ados
En-têtes de str publics
Méthode s publique
URL publique
Référent public
sSetCookie public
Langue publique
CONTENU public
Agent public
Codage public
Public sAccepter
Données publiques
sCodeBase publique
Privé slresolveTimeout, slconnectTimeout, slsendTimeout, slreceiveTimeout
' =============================================
'Initialisation du module de classe
' =============================================
Sous-classe privée_Initialize()
oFormulaire = ""
Définir oXml = Server.CreateObject("MSXML2.ServerXMLHTTP")
set Ados = Server.CreateObject("Adodb.Stream")
slresolveTimeout = 20000 'Délai d'expiration pour la résolution des noms DNS, 20 secondes
slconnectTimeout = 20000 ' Délai d'expiration pour établir la connexion Winsock, 20 secondes
slsendTimeout = 30000 ' Délai d'expiration pour l'envoi des données, 30 secondes
slreceiveTimeout = 30000 ' Délai d'expiration pour la réception de la réponse, 30 secondes
Fin du sous-marin
' =============================================
'Délai d'expiration pour la résolution des noms DNS
' =============================================
Propriété publique Let lresolveTimeout(LngSize)
Si EstNumérique (LngSize) Alors
slresolveTimeout = Clng (LngSize)
Fin si
Propriété de fin
' =============================================
' Délai d'expiration pour l'établissement de la connexion Winsock
' =============================================
Propriété publique Laissez lconnectTimeout(LngSize)
Si EstNumérique (LngSize) Alors
slconnectTimeout = Clng (LngSize)
Fin si
Propriété de fin
' =============================================
' Délai d'expiration pour l'envoi des données
' =============================================
Propriété publique Let lsendTimeout(LngSize)
Si EstNumérique (LngSize) Alors
slsendTimeout = Clng(LngSize)
Fin si
Propriété de fin
' =============================================
' Délai d'attente pour recevoir la réponse
' =============================================
Propriété publique Let lreceiveTimeout(LngSize)
Si EstNumérique (LngSize) Alors
slreceiveTimeout = Clng (LngSize)
Fin si
Propriété de fin
' =============================================
'Méthode
' =============================================
Méthode Let de propriété publique (strMethod)
sMéthode = strMéthode
Propriété de fin
' =============================================
'Envoyer l'URL
' =============================================
URL de location de propriété publique (strUrl)
sUrl = strUrl
Propriété de fin
' =============================================
'Données
' =============================================
Propriété publique Let Data (strData)
sData = strData
Propriété de fin
' =============================================
'Référent
' =============================================
Propriété publique Let Referer (strReferer)
sRéférent = strRéférent
Propriété de fin
' =============================================
'SetCookie
' =============================================
Propriété publique Let SetCookie(strCookie)
sSetCookie = strCookie
Propriété de fin
' =============================================
'Langue
' =============================================
Langue de location de propriété publique (strLanguage)
sLangue = strLangue
Propriété de fin
' =============================================
'Type de CONTENU
' =============================================
Propriété publique louée CONTENT(strCONTENT)
sCONTENT = strCONTENT
Propriété de fin
' =============================================
'Agent utilisateur
' =============================================
Agent de location de propriété publique (strAgent)
sAgent = strAgent
Propriété de fin
' =============================================
'Accepter-Encodage
' =============================================
Propriété publique Let Encoding(strEncoding)
sEncodage = strEncodage
Propriété de fin
' =============================================
'Accepter
' =============================================
Propriété publique Laisser Accepter(strAccept)
sAccepter = strAccepter
Propriété de fin
' =============================================
'CodeBase
' =============================================
Propriété publique Laissez CodeBase (strCodeBase)
sCodeBase = strCodeBase
Propriété de fin
' =============================================
'Créez une direction de transfert de données !
' =============================================
Fonction publique AddItem (clé, valeur)
En cas d'erreur, reprendre ensuite
Dim TempStr
Si oForm = "" Alors
oForm = Clé + "=" + Server.URLEncode (Valeur)
Autre
oForm = oForm + "&" + Clé + "=" + Server.URLEncode (Valeur)
Fin si
Fonction de fin
' =============================================
'Envoyer des données et récupérer des données distantes
' =============================================
Fonction publique HttpGet()
Dim sRetour
Avec oXml
.setTimeouts slresolveTimeout, slconnectTimeout, slsendTimeout, slreceiveTimeout
.Ouvrir sMéthode,sUrl,False
Si sSetCookie<>"" Alors
.setRequestHeader "Cookie", sSetCookie 'Définir le cookie
Fin si
Si sReferer<>"" Alors
.setRequestHeader "Referer", sReferer 'Définir la source de la page
Autre
.setRequestHeader "Référent", sUrl
Fin si
Si sLanguage<>"" Alors
.setRequestHeader "Accept-Language", sLanguage 'Définir la langue
Fin si
.setRequestHeader "Content-Length",Len(sData) 'Définir la longueur des données
Si sCONTENT<>"" Alors
.setRequestHeader "CONTENT-Type",sCONTENT 'Définit le type de données accepté
Fin si
Si sAgent<>"" Alors
.setRequestHeader "User-Agent", sAgent 'Définir le navigateur
Fin si
Si sEncoding<>"" Alors
.setRequestHeader "Accept-Encoding", sEncoding 'Définir la compression gzip
Fin si
Si sAccept<>"" Alors
.setRequestHeader "Accepter", sAccepter 'Type de document
Fin si
Réponse.Écrire sData
.Send sData 'Envoyer des données
Tandis que .readyState <> 4
.waitForResponse 1000
Wende
strHeaders = .getAllResponseHeaders()
Si sCodeBase<>"" Alors
sReturn = octets2BSTR (.responseBody)
Autre
sRetour = .responseBody
Fin si
Terminer par
HttpGet = sRetour
Fonction de fin
' =============================================
' Traiter les données binaires
' =============================================
Fonction privée bytes2BSTR(vIn)
strRetour = ""
Pour i = 1 À LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Si ThisCharCode < &H80 Alors
strReturn = strReturn & Chr(ThisCharCode)
Autre
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
je = je + 1
Fin si
Suivant
octets2BSTR = strReturn
Fonction de fin
' =============================================
' Déconnexion du module de classe
' =============================================
Sous-classe privée_Terminate
oFormulaire = ""
Définir oXml = Rien
Définir Ados=Rien
Fin du sous-marin
Fin du cours
%>
google.asp
<%
Const GOOGLE_MAGIC = &HE6359A60
Fonction sl(ByVal x, ByVal n)
Si n = 0 Alors
sl = x
Autre
Dim k
k = CLng(2 ^ (32 - n - 1))
Faible d
d = x Et (k - 1)
Faible c
c = d * CLng(2^n)
Si x Et k Alors
c = c Ou &H80000000
Fin si
sl = c
Fin si
Fonction de fin
Fonction privée uadd (ByVal L1, ByVal L2)
Dim. L11, L12, L21, L22, L31, L32
L11 = L1 et &HFFFFFF
L12 = (L1 et &H7F000000) &H1000000
Si L1 < 0 Alors L12 = L12 Ou &H80
L21 = L2 et &HFFFFFF
L22 = (L2 et &H7F000000) &H1000000
Si L2 < 0 Alors L22 = L22 Ou &H80
L32 = L12 + L22
L31 = L11 + L21
Si (L31 et &H1000000) Alors L32 = L32 + 1
uadd = (L31 et &HFFFFFF) + (L32 et &H7F) * &H1000000
Si L32 et &H80 Alors uadd = uadd Ou &H80000000
Fin Fonction
Mélange de fonctions (ByVal ia, ByVal ib, ByVal ic)
Dim a, b, c
une = je
b=ib
c = ic
a = usub(a, b)
une = usub(une, 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
mélange = ret
Fin de la fonction
Fonction gc(ByVal s, ByVal i)
gc = Asc(Mid(s, i + 1, 1))
Fin de la fonction
Fonction GoogleCH(ByVal sUrl)
Dim iLongueur, a, b, c, k, iLen, m
iLongueur = Len(sUrl)
a = &H9E3779B9
b = &H9E3779B9
c = GOOGLE_MAGIQUE
k = 0
iLen = iLongueur
Faire pendant que 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 = mélanger(a, b, c)
a = m(0)
b = m(1)
c = m(2)
k = k + 12
iLen = iLen - 12
Boucle
c = uadd(c, iLength)
Sélectionnez Case iLen ' toutes les instructions case échouent
Cas 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))
Cas 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))
Cas 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))
une = uadd(une, sl(gc(sUrl, k + 3), 24))
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 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))
une = uadd(une, sl(gc(sUrl, k + 3), 24))
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 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))
une = uadd(une, sl(gc(sUrl, k + 3), 24))
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 6
b = uadd(b, sl(gc(sUrl, k + 5), 8))
b = uadd(b, gc(sUrl, k + 4))
une = uadd(une, sl(gc(sUrl, k + 3), 24))
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 5
b = uadd(b, gc(sUrl, k + 4))
une = uadd(une, sl(gc(sUrl, k + 3), 24))
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 4
une = uadd(une, sl(gc(sUrl, k + 3), 24))
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 3
une = uadd(une, sl(gc(sUrl, k + 2), 16))
une = uadd(une, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 2
a = uadd(a, sl(gc(sUrl, k + 1), 8))
une = uadd(une, gc(sUrl, k + 0))
Cas 1
une = uadd(une, gc(sUrl, k + 0))
Fin Sélectionner
m = mix(a, b, c)
GoogleCH = m(2)
Fin de la fonction
Fonction CalculateChecksum(sUrl)
CalculateChecksum = "6" & CStr(GoogleCH("info:" & sUrl))
Fonction de fin
%>
PR.asp
<!--#include file="google.asp"-->
<!--#include file="Cls_AspHttp.asp"-->
<%
Sous-Rw(Str)
Réponse.Write Str & vbCrLf
Réponse.Flush
Fin de sous-
fonction HttpGet (lresolveTimeout, lconnectTimeout, Method, Url, Referer, Data, SetCookie, Language, CONTENT, Agent, Encoding, Accept, CodeBase)
Définir DoGet = Nouveau FlyCms_AspHttp
DoGet.lresolveTimeout = lresolveTimeout
DoGet.lconnectTimeout = lconnectTimeout
DoGet.lsendTimeout = lsendTimeout
DoGet.lreceiveTimeout = lreceiveTimeout
DoGet.Method = Méthode
DoGet.Url = URL
DoGet.Referer = Référent
DoGet.Data = Données
DoGet.SetCookie = SetCookie
DoGet.Language = Langue
DoGet.CONTENT = CONTENU
DoGet.Agent = Agent
DoGet.Encoding = Encodage
DoGet.Accept = Accepter
DoGet.CodeBase = CodeBase
HttpGet = DoGet.HttpGet()
Définir DoGet = Rien
Fin de la fonction
Fonction GGPR (URL ByVal)
Dim strRet
sURL = " http://www.google.com/search?client=navclient&ch =" & CalculateCheck(URL) & "&features=Rank&q=info:" & URL
Rw "Adresse de requête : " & sURL & "<br />"
strRet = HttpGet(10000,10000,20000,20000,"GET",sUrl,"","","","zh-cn","","Mozilla/4.0 (compatible ; MSIE 6.0 ; Windows NT 5.1) ","","*/*","gb2312")
Si InStr(strRet,":") Alors
R = Fractionner(strRet,":")
GGPR = R(2)
Autre
GGP = 0
Fin si
Rw "Résultat renvoyé : " & strRet & "<br />"
Rw " Valeur PR : " & GGPR & "<br />"
Fin de la fonction
iURL = Requête("iURL")
Si iURL="" Alors iURL = " http://www.downcodes.com "
AppelerGGPR(iURL)
%>
<html>
<tête></tête>
<title>Requête Google Pagerank (voleur de requêtes pr)</title>
<corps>
<h1>Entrez l'adresse complète de la page pour vérifier le classement (valeur PR de la page) :</h1>
<form action="" méthode="post">
URL <input type="text" name="iURL" style="width:200px" /><input type="submit" value="pr query" />
</form>
</corps>
<html>