Система запроса рейтинга страниц Google (без кражи данных сторонних веб-сайтов) включает в себя три примера страниц этой программы, а категория удаленного получения данных очень хороша.
Демонстрация страницы запроса рейтинга страниц Google: http://www.knowsky.com/tools/ . PR/
三страницы:
CLS_Asphttp.asp
<%
Класс FlyCms_AspHttp
Публичная oForm, oXml, Ados
Публичные заголовки строк
Публичный метод
Публичный URL
Публичный реферер
Публичный файл sSetCookie
Публичный язык
Публичный контент
Общественный агент
Публичное кодирование
Общественное одобрение
Публичные данные
Публичная база кода
Частный slresolveTimeout, slconnectTimeout, slsendTimeout, slreceiveTimeout
' ==========================================
'Инициализация модуля класса
' ==========================================
Частный подкласс_Initialize()
oФорма = ""
Установите oXml = Server.CreateObject("MSXML2.ServerXMLHTTP")
установите Ados = Server.CreateObject("Adodb.Stream")
slresolveTimeout = 20000 'Тайм-аут разрешения DNS-имен, 20 секунд
slconnectTimeout = 20000 'Таймаут установления соединения Winsock, 20 секунд
slsendTimeout = 30000 'Таймаут отправки данных, 30 секунд
slreceiveTimeout = 30000 'Таймаут получения ответа, 30 секунд
Конец подзаголовка
' ==========================================
'Тайм-аут для разрешения DNS-имен
' ==========================================
Открытое свойство Let lresolveTimeout(LngSize)
Если IsNumeric(LngSize) Тогда
slresolveTimeout = Clng(LngSize)
Конец, если
Конечная собственность
' ==========================================
'Тайм-аут для установления соединения Winsock
' ==========================================
Открытое свойство Let lconnectTimeout(LngSize)
Если IsNumeric(LngSize) Тогда
slconnectTimeout = Clng(LngSize)
Конец, если
Конечная собственность
' ==========================================
' Таймаут отправки данных
' ==========================================
Открытое свойство Let lsendTimeout(LngSize)
Если IsNumeric(LngSize) Тогда
slsendTimeout = Clng(LngSize)
Конец, если
Конечная собственность
' ==========================================
' Таймаут на получение ответа
' ==========================================
Открытое свойство Let lreceiveTimeout(LngSize)
Если IsNumeric(LngSize) Тогда
slreceiveTimeout = Clng(LngSize)
Конец, если
Конечная собственность
' ==========================================
'Метод
' ==========================================
Открытый метод Let (strMethod)
sMethod = стрМетод
Конечная собственность
' ==========================================
'Отправить URL
' ==========================================
Публичная собственность Let Url(strUrl)
sUrl = strUrl
Конечная собственность
' ==========================================
'Данные
' ==========================================
Открытая собственность Let Data(strData)
сДанные = стрДанные
Конечная собственность
' ==========================================
'Реферер
' ==========================================
Публичная собственность Let Referer(strReferer)
sReferer = стрReferer
Конечная собственность
' ==========================================
'SetCookie
' ==========================================
Открытая собственность Let SetCookie(strCookie)
sSetCookie = стрCookie
Конечная собственность
' ==========================================
'Язык
' ==========================================
Открытая собственность Let Language(strLanguage)
sLanguage = strLanguage
Конечная собственность
' ==========================================
'CONTENT-Тип
' ==========================================
Открытая собственность Let CONTENT(strCONTENT)
sCONTENT = стрCONTENT
Конечная собственность
' ==========================================
'Пользовательский агент
' ==========================================
Агент по передаче общественной собственности (strAgent)
sAgent = стрАгент
Конечная собственность
' ==========================================
'Принять-Кодирование
' ==========================================
Открытое свойство Let Encoding(strEncoding)
sEncoding = стрEncoding
Конечная собственность
' ==========================================
'Принимать
' ==========================================
Публичная собственность Let Accept(strAccept)
сПринять = стрПринять
Конечная собственность
' ==========================================
'Кодовая база
' ==========================================
Открытое свойство Let CodeBase(strCodeBase)
sCodeBase = стрCodeBase
Конечная собственность
' ==========================================
'Создать направление передачи данных!
' ==========================================
Открытая функция AddItem (ключ, значение)
При ошибке Возобновить Далее
Дим ТемпСтр
Если oForm = "" Тогда
oForm = Ключ + "=" + Server.URLEncode(значение)
Еще
oForm = oForm + "&" + Key + "=" + Server.URLEncode(значение)
Конец, если
Конечная функция
' ==========================================
'Отправка данных и получение удаленных данных
' ==========================================
Открытая функция HttpGet()
Тусклый возврат
С oXml
.setTimeouts slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout
.Откройте sMethod,sUrl,False
Если sSetCookie<>"" Тогда
.setRequestHeader "Cookie", sSetCookie 'Установить файл cookie
Конец, если
Если sReferer<>"" Тогда
.setRequestHeader "Referer", sReferer 'Установить источник страницы
Еще
.setRequestHeader "Referer", sUrl
Конец, если
Если sLanguage<>"" Тогда
.setRequestHeader "Accept-Language", sLanguage 'Установить язык
Конец, если
.setRequestHeader "Content-Length",Len(sData) 'Установить длину данных
Если sCONTENT<>"" Тогда
.setRequestHeader "CONTENT-Type",sCONTENT 'Установить принятый тип данных
Конец, если
Если sAgent<>"" Тогда
.setRequestHeader "Агент пользователя", sAgent 'Установить браузер
Конец, если
Если sEncoding<>"" Тогда
.setRequestHeader "Accept-Encoding", sEncoding 'Установить сжатие gzip
Конец, если
Если sAccept<>"" Тогда
.setRequestHeader "Принять", sAccept 'Тип документа
Конец, если
Response.Write sData
.Send sData 'Отправить данные
Пока .readyState <> 4
.waitForResponse 1000
Венд
strHeaders = .getAllResponseHeaders()
Если sCodeBase<>"" Тогда
sReturn = bytes2BSTR(.responseBody)
Еще
sReturn = .responseBody
Конец, если
Конец с
HttpGet = свозврат
Конечная функция
' ==========================================
' Обрабатываем двоичные данные
' ==========================================
Частная функция bytes2BSTR(vIn)
стрReturn = ""
Для i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn,i,1))
Если ЭтотCharCode < &H80 Тогда
стрReturn = strReturn & Chr(ThisCharCode)
Еще
NextCharCode = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
я = я + 1
Конец, если
Следующий
bytes2BSTR = стрReturn
Конечная функция
' ==========================================
' Выход из модуля класса
' ==========================================
Частный подкласс_Terminate
oФорма = ""
Установить oXml = Ничего
Установить рекламу=Ничего
Конец субтитра
Конечный класс
%>
google.asp
<%
Const GOOGLE_MAGIC = &HE6359A60
Функция sl(ByVal x, ByVal n)
Если n = 0 Тогда
сл = х
Еще
Дим к
k = CLng(2 ^ (32 - n - 1))
Дим д
d = х И (к - 1)
Дим с
с = d * CLng(2^n)
Если х и к Тогда
с = с или &H80000000
Конец, если
сл = с
Конец, если
Конечная функция
Частная функция 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.
Л32 = Л12 + Л22
Л31 = Л11 + Л21
Если (L31 И &H1000000) Тогда L32 = L32 + 1
uadd = (L31 и &HFFFFFF) + (L32 и &H7F) * &H1000000
Если L32 и &H80, то uadd = uadd или &H80000000
Конечная функция
Комбинация функций (ByVal ia, ByVal ib, ByVal ic)
Дим а, б, в
а = иа
б=ib
c = ic
a = usub(a, b)
а = usub(а, с)
a = a Xили ZeroFill(c, 13)
b = usub(b, c)
б = usub(б, а)
b = b Xor sl(a, 8)
b = usub(b, c)
б = usub(б, а)
b = b Xor sl(a, 10)
c = usub(c, a)
с = usub(с, б)
c = c Xor ZeroFill(b, 15)
Dim ret(3)
ret(0) = a
врет(1) = б
ret(2) = c
mix = ret
Конечная функция
Функция gc(ByVal s, ByVal i)
gc = Asc(Mid(s, i + 1, 1))
Конечная функция
Функция GoogleCH(ByVal sUrl)
Размер iLength, a, b, c, k, iLen, м
iLength = Len(sUrl)
a = &H9E3779B9
б = &H9E3779B9
в = 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)
б = м(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))
а = uadd(a, sl(gc(sUrl, k + 3), 24))
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = 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))
а = uadd(a, sl(gc(sUrl, k + 3), 24))
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = 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))
а = uadd(a, sl(gc(sUrl, k + 3), 24))
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = uadd(a, gc(sUrl, k + 0))
Случай 6
b = uadd(b, sl(gc(sUrl, k + 5), 8))
b = uadd(b, gc(sUrl, k + 4))
а = uadd(a, sl(gc(sUrl, k + 3), 24))
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = uadd(a, gc(sUrl, k + 0))
Случай 5
b = uadd(b, gc(sUrl, k + 4))
а = uadd(a, sl(gc(sUrl, k + 3), 24))
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = uadd(a, gc(sUrl, k + 0))
Случай 4
а = uadd(a, sl(gc(sUrl, k + 3), 24))
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = uadd(a, gc(sUrl, k + 0))
Случай 3
а = uadd(a, sl(gc(sUrl, k + 2), 16))
а = uadd(a, sl(gc(sUrl, k + 1), 8))
а = uadd(a, gc(sUrl, k + 0))
Случай 2
a = uadd(a, sl(gc(sUrl, k + 1), 8))
а = uadd(a, gc(sUrl, k + 0))
Случай 1
а = uadd(a, gc(sUrl, k + 0))
Конец выбора
m = mix(a, b, c)
GoogleCH = m(2)
Конечная функция
Функция CalculateChecksum(sUrl)
CalculateChecksum = "6" & CStr(GoogleCH("info:" & sUrl))
Конечная функция
%>
PR.asp
<!--#include file="google.asp"-->
<!--#include file="Cls_AspHttp.asp"-->
<%
Sub Rw(Str)
Response.Write Str & vbCrLf
Ответ.Flush
Конечная
подфункция 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 (URL-адрес ByVal)
Дим стрРет
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")
Если InStr(strRet,":") Тогда
R = Разделить(strRet,":")
GGPR = Р(2)
Еще
ГГПР = 0
Конец, если
Rw "Вернуть результат: " & strRet & "<br />"
Rw "Значение PR: " & GGPR & "<br />"
Конечная функция
iURL = Request("iURL")
Если iURL="" Тогда iURL = " http://www.downcodes.com "
ВызовGGPR(iURL)
%>
<html>
<голова></голова>
<title>Запрос Google Pagerank (вор запросов PR)</title>
<тело>
<h1>Введите полный адрес страницы, чтобы проверить рейтинг страницы (значение PR страницы):</h1>
<form action="" метод="post">
URL <input type="text" name="iURL" style="width:200px" /><input type="submit" value="pr query" />
</форма>
</тело>
<html>