El sistema de consulta de pagerank de Google (que no roba datos de sitios web de terceros) viene con tres páginas de ejemplo de este programa, y la categoría de adquisición remota es muy buena
para la demostración de la página de consulta de pagerank de Google: http://www.knowsky.com/tools/ . pr/
三páginas:
CLS_Asphttp.asp
<%
Clase FlyCms_AspHttp
Público oForm,oXml,Ados
Encabezados públicos
Método público
URL pública
Referido público
Conjunto público de cookies
Idioma público
CONTENIDO público
Agente público
Codificación pública
Público Aceptar
Datos públicos
Base de código pública
Privado slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout
' ===============================================
'Inicialización del módulo de clase
' ===============================================
Subclase privada_Initialize()
oFormulario = ""
Establecer oXml = Server.CreateObject ("MSXML2.ServerXMLHTTP")
establecer Ados = Server.CreateObject("Adodb.Stream")
slresolveTimeout = 20000 'Tiempo de espera para resolver nombres DNS, 20 segundos
slconnectTimeout = 20000 'Tiempo de espera para establecer la conexión Winsock, 20 segundos
slsendTimeout = 30000 'Tiempo de espera para enviar datos, 30 segundos
slreceiveTimeout = 30000 'Tiempo de espera para recibir respuesta, 30 segundos
Fin Sub
' ===============================================
'Tiempo de espera para resolver nombres DNS
' ===============================================
Propiedad pública Let lresolveTimeout(LngSize)
Si es numérico (tamaño largo) entonces
slresolveTimeout = Clng(LngSize)
Terminar si
Propiedad final
' ===============================================
'Tiempo de espera para establecer la conexión Winsock
' ===============================================
Propiedad pública Let lconnectTimeout(LngSize)
Si es numérico (tamaño largo) entonces
slconnectTimeout = Clng(LngSize)
Terminar si
Propiedad final
' ===============================================
'Tiempo de espera para enviar datos
' ===============================================
Propiedad pública Let lsendTimeout(LngSize)
Si es numérico (tamaño largo) entonces
slsendTimeout = Clng(LngSize)
Terminar si
Propiedad final
' ===============================================
'Tiempo de espera para recibir respuesta
' ===============================================
Propiedad pública Let lreceiveTimeout(LngSize)
Si es numérico (tamaño largo) entonces
slreceiveTimeout = Clng(LngSize)
Terminar si
Propiedad final
' ===============================================
'Método
' ===============================================
Método Let de propiedad pública (strMethod)
sMétodo = strMétodo
Propiedad final
' ===============================================
'Enviar URL
' ===============================================
Propiedad pública Let Url (strUrl)
URL = cadena URL
Propiedad final
' ===============================================
'Datos
' ===============================================
Propiedad pública Let Data (strData)
sDatos = strDatos
Propiedad final
' ===============================================
'Referente
' ===============================================
Propiedad pública Let Referer (strReferer)
sReferer = strReferer
Propiedad final
' ===============================================
'Establecer cookie
' ===============================================
Propiedad pública Let SetCookie(strCookie)
sSetCookie = strCookie
Propiedad final
' ===============================================
'Idioma
' ===============================================
Idioma de propiedad pública Let (strLanguage)
sIdioma = strIdioma
Propiedad final
' ===============================================
'Tipo de CONTENIDO
' ===============================================
Propiedad pública alquila CONTENIDO (strCONTENT)
sCONTENIDO = strCONTENIDO
Propiedad final
' ===============================================
'Agente de usuario
' ===============================================
Agente de alquiler de propiedad pública (strAgent)
sAgente = strAgente
Propiedad final
' ===============================================
'Codificación de aceptación
' ===============================================
Propiedad pública Let Codificación (strEncoding)
sCodificación = strCodificación
Propiedad final
' ===============================================
'Aceptar
' ===============================================
Propiedad pública Let Accept (strAccept)
sAceptar = strAceptar
Propiedad final
' ===============================================
'Código base
' ===============================================
Propiedad pública Let CodeBase (strCodeBase)
sCódigoBase = strCódigoBase
Propiedad final
' ===============================================
'¡Crear dirección de transferencia de datos!
' ===============================================
Función pública AddItem (clave, valor)
En caso de error Continuar siguiente
TempStr tenue
Si oForm = "" Entonces
oForm = Clave + "=" + Server.URLEncode(Valor)
Demás
oForm = oForm + "&" + Clave + "=" + Server.URLEncode(Valor)
Terminar si
Función final
' ===============================================
'Enviar datos y recuperar datos remotos
' ===============================================
Función pública HttpGet()
Oscuro sRegresar
Con oXml
.setTimeouts slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout
.Abrir sMethod,sUrl,False
Si sSetCookie<>"" Entonces
.setRequestHeader "Cookie", sSetCookie 'Establecer cookie
Terminar si
Si sReferer<>"" Entonces
.setRequestHeader "Referer", sReferer 'Establecer fuente de página
Demás
.setRequestHeader "Referente", dirección URL
Terminar si
Si sLanguage<>"" Entonces
.setRequestHeader "Aceptar-Idioma", sLanguage 'Establecer idioma
Terminar si
.setRequestHeader "Content-Length",Len(sData) 'Establecer longitud de datos
Si CONTENIDO<>"" Entonces
.setRequestHeader "CONTENT-Type",sCONTENT 'Establece el tipo de datos aceptado
Terminar si
Si sAgent<>"" Entonces
.setRequestHeader "Agente de usuario", sAgent 'Establecer navegador
Terminar si
Si sEncoding<>"" Entonces
.setRequestHeader "Aceptar-codificación", sEncoding 'Establecer compresión gzip
Terminar si
Si sAceptar<>"" Entonces
.setRequestHeader "Aceptar", sAceptar 'Tipo de documento
Terminar si
Respuesta.Escribir sData
.Send sData 'Enviar datos
Mientras que .readyState <> 4
.waitForResponse 1000
Encaminarse a
strHeaders = .getAllResponseHeaders()
Si sCodeBase<>"" Entonces
sReturn = bytes2BSTR(.responseBody)
Demás
sReturn = .responseBody
Terminar si
Terminar con
HttpGet = sRetorno
Función final
' ===============================================
' Procesar datos binarios
' ===============================================
Función privada bytes2BSTR(vIn)
strRetorno = ""
Para i = 1 a LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Si ThisCharCode < & H80 Entonces
strReturn = strReturn & Chr(ThisCharCode)
Demás
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
yo = yo + 1
Terminar si
Próximo
bytes2BSTR = strReturn
Función final
' ===============================================
'Cerrar sesión en el módulo de clase
' ===============================================
Subclase privada_Terminar
oFormulario = ""
Establecer oXml = Nada
Establecer Ados = Nada
Subtítulo final
Fin de clase
%>
google.asp
<%
Const GOOGLE_MAGIC = &HE6359A60
Función sl(ByVal x, ByVal n)
Si n = 0 entonces
sl = x
Demás
tenue k
k = CLng(2 ^ (32 - n - 1))
tenue d
d = x y (k - 1)
tenue c
c = d * CLng(2^n)
Si x y k entonces
c = c O &H80000000
Terminar si
sl = c
Terminar si
Función final
Función privada uadd(ByVal L1, ByVal L2)
Atenuado L11, L12, L21, L22, L31, L32
L11 = L1 y &HFFFFFF
L12 = (L1 y &H7F000000) &H1000000
Si L1 < 0 entonces L12 = L12 o &H80
L21 = L2 y &HFFFFFF
L22 = (L2 y &H7F000000) &H1000000
Si L2 < 0 entonces L22 = L22 o &H80
L32 = L12 + L22
L31 = L11 + L21
Si (L31 y &H1000000) entonces L32 = L32 + 1
uadd = (L31 y &HFFFFFF) + (L32 y &H7F) * &H1000000
Si L32 y &H80 entonces uadd = uadd o &H80000000
Función final
Mezcla de funciones (ByVal ia, ByVal ib, ByVal ic)
Atenuar a, b, c
a = yo
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
retiro(1) = b
ret(2) = c
mezcla = ret
Función final
Función gc(ByVal s, ByVal i)
gc = Asc(Medio(s, i + 1, 1))
Función final
Función GoogleCH(ByVal sUrl)
Dim iLongitud, a, b, c, k, iLen, m
iLongitud = Len(sUrl)
a = &H9E3779B9
segundo = &H9E3779B9
c = GOOGLE_MAGIC
k = 0
iLen = iLongitud
Hacer mientras 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 = mezclar(a, b, c)
a = m(0)
segundo = m(1)
c = m(2)
k = k + 12
iLen = iLen - 12
Loop
c = uadd(c, iLength)
Select Case iLen ' todas las declaraciones de casos fracasan
Caso 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))
Caso 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))
Caso 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))
Caso 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))
Caso 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))
Caso 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))
Caso 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))
Caso 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))
Caso 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))
Caso 2
a = uadd(a, sl(gc(sUrl, k + 1), 8))
a = uadd(a, gc(sUrl, k + 0))
Caso 1
a = uadd(a, gc(sUrl, k + 0))
Seleccionar fin
m = mix(a, b, c)
GoogleCH = m(2)
Función final
Función CalculateChecksum(sUrl)
CalcularSuma de comprobación = "6" & CStr(GoogleCH("info:" & sUrl))
Función final
%>
PR.asp
<!--#include file="google.asp"-->
<!--#include file="Cls_AspHttp.asp"-->
<%
Sub Rw(Str)
Respuesta.Escribir Str y vbCrLf
Respuesta.Flush
Fin de la
subfunción HttpGet(lresolveTimeout,lconnectTimeout,Método,Url,Referer,Datos,SetCookie,Idioma,CONTENIDO,Agente,Codificación,Aceptar,CodeBase)
Establecer DoGet = Nuevo FlyCms_AspHttp
DoGet.lresolveTimeout = lresolveTimeout
DoGet.lconnectTimeout = lconnectTimeout
DoGet.lsendTimeout = lsendTimeout
DoGet.lreceiveTimeout = lreceiveTimeout
DoGet.Method = Método
DoGet.Url = URL
DoGet.Referer = Referente
DoGet.Data = Datos
DoGet.SetCookie = EstablecerCookie
DoGet.Language = Idioma
DoGet.CONTENIDO = CONTENIDO
DoGet.Agent = Agente
DoGet.Encoding = Codificación
DoGet.Accept = Aceptar
DoGet.CodeBase = CódigoBase
HttpGet = DoGet.HttpGet()
Establecer DoGet = Nada
Función final
Función GGPR (URL ByVal)
Dim strRet
sURL = " http://www.google.com/search?client=navclient&ch =" & CalculateCheck(URL) & "&features=Rank&q=info:" & URL
Rw "Dirección de consulta: " & 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,":") Entonces
R = Dividir(strRet,":")
GGPR = R(2)
Demás
GGPR = 0
Terminar si
Rw "Resultado devuelto: " & strRet & "<br />"
Rw " Valor PR: " & GGPR & "<br />"
Función final
iURL = Solicitud ("iURL")
Si iURL="" Entonces iURL = " http://www.downcodes.com "
LlamarGGPR(iURL)
%>
<html>
<cabeza></cabeza>
<title>Consulta de Pagerank de Google (pr ladrón de consultas)</title>
<cuerpo>
<h1>Ingrese la dirección completa de la página para verificar el pagerank (valor PR de la página):</h1>
<formulario acción="" método="publicación">
URL <tipo de entrada="texto" nombre="iURL" estilo="ancho: 200px" /><tipo de entrada="enviar" valor="consulta pr" />
</formulario>
</cuerpo>
<html>