Sistem kueri pagerank Google (tidak mencuri data situs web pihak ketiga) dilengkapi dengan tiga halaman contoh program ini, dan kategori akuisisi jarak jauh sangat bagus.
Demonstrasi halaman kueri pagerank Google: http://www.knowsky.com/tools/
halaman三:
CLS_Asphttp.asp
<%
Kelas FlyCms_AspHttp
oForm Publik, oXml, Ados
strHeader publik
Metode Publik
URL publik
Perujuk Publik
sSetCookie publik
Bahasa Publik
KONTEN Publik
Agen Publik
Pengodean publik
Terima Publik
Data Publik
Basis Kode Publik
SlresolveTimeout pribadi, slconnectTimeout, slsendTimeout, slreceiveTimeout
' ===============
'Inisialisasi modul kelas
' ===============
Sub Kelas Pribadi_Inisialisasi()
oBentuk = ""
Setel oXml = Server.CreateObject("MSXML2.ServerXMLHTTP")
setel Ados = Server.CreateObject("Adodb.Stream")
slresolveTimeout = 20000 'Batas waktu penyelesaian nama DNS, 20 detik
slconnectTimeout = 20000 ' Batas waktu untuk membuat koneksi Winsock, 20 detik
slsendTimeout = 30000 ' Batas waktu pengiriman data, 30 detik
slreceiveTimeout = 30000 ' Batas waktu untuk menerima respons, 30 detik
Akhir Sub
' ===============
'Batas waktu untuk menyelesaikan nama DNS
' ===============
Properti Publik Biarkan lresolveTimeout(LngSize)
Jika IsNumeric(LngSize) Lalu
slresolveTimeout = Clng(Ukuran Lng)
Akhiri Jika
Properti Akhir
' ===============
' Batas waktu untuk membuat koneksi Winsock
' ===============
Properti Publik Biarkan lconnectTimeout(LngSize)
Jika IsNumeric(LngSize) Lalu
slconnectTimeout = Clng(Ukuran Lng)
Akhiri Jika
Properti Akhir
' ===============
' Batas waktu pengiriman data habis
' ===============
Properti Publik Biarkan lsendTimeout(LngSize)
Jika IsNumeric(LngSize) Lalu
slsendTimeout = Clng(Ukuran Lng)
Akhiri Jika
Properti Akhir
' ===============
' Batas waktu untuk menerima respons
' ===============
Properti Publik Biarkan lreceiveTimeout(LngSize)
Jika IsNumeric(LngSize) Lalu
slreceiveTimeout = Clng(Ukuran Lng)
Akhiri Jika
Properti Akhir
' ===============
'Metode
' ===============
Metode Izin Milik Umum (Metode str)
sMetode = strMetode
Properti Akhir
' ===============
'Kirim url
' ===============
Properti Publik Biarkan Url(strUrl)
sUrl = strUrl
Properti Akhir
' ===============
'Data
' ===============
Data Izin Properti Publik (strData)
sData = strData
Properti Akhir
' ===============
'Referensi
' ===============
Perujuk Properti Umum (strReferer)
sReferer = strReferer
Properti Akhir
' ===============
'Set Kue
' ===============
Properti Publik Biarkan SetCookie(strCookie)
sSetCookie = strCookie
Properti Akhir
' ===============
'Bahasa
' ===============
Bahasa Izinkan Properti Publik (strBahasa)
sBahasa = strBahasa
Properti Akhir
' ===============
'Jenis KONTEN
' ===============
Milik Umum Biarkan KONTEN(strCONTENT)
sKONTEN = strKONTEN
Properti Akhir
' ===============
'Agen-Pengguna
' ===============
Agen Izin Properti Publik (strAgent)
sAgent = strAgent
Properti Akhir
' ===============
'Terima-Encoding
' ===============
Properti Publik Biarkan Pengkodean (strEncoding)
sEncoding = strEncoding
Properti Akhir
' ===============
'Menerima
' ===============
Milik Umum Biarkan Diterima(strTerima)
sTerima = strTerima
Properti Akhir
' ===============
'Basis Kode
' ===============
Properti Publik Biarkan CodeBase(strCodeBase)
sCodeBase = strCodeBase
Properti Akhir
' ===============
'Buat arah transfer data!
' ===============
AddItem Fungsi Publik (Kunci, Nilai)
Pada Kesalahan Lanjutkan Berikutnya
Redupkan TempStr
Jika oForm = "" Lalu
oForm = Kunci + "=" + Server.URLEncode(Nilai)
Kalau tidak
oForm = oForm + "&" + Kunci + "=" + Server.URLEncode(Nilai)
Akhiri Jika
Fungsi Akhir
' ===============
'Kirim data dan ambil data jarak jauh
' ===============
Fungsi Publik HttpGet()
Redupkan sKembali
Dengan oXml
.setTimeouts slresolveTimeout,slconnectTimeout,slsendTimeout,slreceiveTimeout
.Buka sMethod,sUrl,False
Jika sSetCookie<>"" Lalu
.setRequestHeader "Cookie", sSetCookie 'Setel Cookie
Akhiri Jika
Jika sReferer<>"" Lalu
.setRequestHeader "Referer", sReferer 'Setel sumber halaman
Kalau tidak
.setRequestHeader "Referensi", sUrl
Akhiri Jika
Jika sBahasa<>"" Lalu
.setRequestHeader "Terima-Bahasa", sLanguage 'Setel bahasa
Akhiri Jika
.setRequestHeader "Content-Length",Len(sData) 'Setel panjang data
Jika sCONTENT<>"" Lalu
.setRequestHeader "CONTENT-Type",sCONTENT 'Setel tipe data yang diterima
Akhiri Jika
Jika sAgent<>"" Lalu
.setRequestHeader "Agen-Pengguna", sAgent 'Setel browser
Akhiri Jika
Jika sEncoding<>"" Lalu
.setRequestHeader "Terima-Encoding", sEncoding 'Setel kompresi gzip
Akhiri Jika
Jika sTerima<>"" Lalu
.setRequestHeader "Terima", sTerima 'Jenis dokumen
Akhiri Jika
Respon.Tulis sData
.Kirim sData 'Kirim data
Sedangkan .readyState <> 4
.waitForResponse 1000
Pergi ke
strHeaders = .getAllResponseHeaders()
Jika sCodeBase<>"" Lalu
sReturn = bytes2BSTR(.responseBody)
Kalau tidak
sKembali = .responseBody
Akhiri Jika
Akhiri Dengan
HttpGet = sKembali
Fungsi Akhir
' ===============
' Memproses data biner
' ===============
Fungsi Pribadi bytes2BSTR(vIn)
strKembali = ""
Untuk i = 1 Ke LenB(vIn)
KodeKar ini = AscB(MidB(vIn,i,1))
Jika ThisCharCode < &H80 Lalu
strReturn = strReturn & Chr(KodeCharIni)
Kalau tidak
KodeChar Berikutnya = AscB(MidB(vIn,i+1,1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
saya = saya + 1
Akhiri Jika
Berikutnya
bytes2BSTR = strKembali
Fungsi Akhir
' ===============
' Logout modul kelas
' ===============
Sub Kelas Pribadi_Terminate
oBentuk = ""
Setel oXml = Tidak Ada
Tetapkan Ados=Tidak Ada
Akhiri Sub
Kelas Akhir
%>
google.asp
<%
Const GOOGLE_MAGIC = &HE6359A60
Fungsi sl(ByVal x, ByVal n)
Jika n = 0 Maka
sl = x
Kalau tidak
Redupkan k
k = CLng(2 ^ (32 - n - 1))
Redup d
d = x Dan (k - 1)
Redup c
c = d * CLng(2^n)
Jika x dan k maka
c = c Atau &H80000000
Akhiri Jika
sl = c
Akhiri Jika
Fungsi Akhir
Fungsi Pribadi uadd(ByVal L1, ByVal L2)
Redupkan L11, L12, L21, L22, L31, L32
L11 = L1 Dan &HFFFFFF
L12 = (L1 Dan &H7F000000) &H1000000
Jika L1 < 0 Maka L12 = L12 Atau &H80
L21 = L2 Dan &HFFFFFF
L22 = (L2 Dan &H7F000000) &H1000000
Jika L2 < 0 Maka L22 = L22 Atau &H80
L32 = L12 + L22
L31 = L11 + L21
Jika (L31 Dan &H1000000) Maka L32 = L32 + 1
uadd = (L31 Dan &HFFFFFF) + (L32 Dan &H7F) * &H1000000
Jika L32 Dan &H80 Maka uadd = uadd Atau &H80000000
Fungsi Akhir
(ByVal ia, ByVal ib, ByVal ic)
Redupkan 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 Xatau sl(a, 8)
b = usub(b, c)
b = usub(b, a)
b = b Xatau sl(a, 10)
c = usub(c, a)
c = usub(c, b)
c = c Xor zeroFill(b, 15)
Redupkan ret(3)
ret(0) = a
kembali(1) = b
ret(2) = c
campuran = ret
Fungsi Akhir
Fungsi gc(ByVal s, ByVal i)
gc = Asc(Pertengahan(s, i + 1, 1))
Fungsi Akhir
Fungsi GoogleCH(ByVal sUrl)
Redupkan iPanjangnya, a, b, c, k, iLen, m
iPanjang = Len(sUrl)
a = &H9E3779B9
b = &H9E3779B9
c = GOOGLE_MAGIC
k = 0
iLen = iPanjang
Lakukan Sementara 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 = campuran(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 ' semua pernyataan case gagal
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 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))
Kasus 2
a = uadd(a, sl(gc(sUrl, k + 1), 8))
a = uadd(a, gc(sUrl, k + 0))
Kasus 1
a = uadd(a, gc(sUrl, k + 0))
Pilihan Akhir
m = campur(a, b, c)
GoogleCH = m(2)
Fungsi Akhir
Fungsi HitungChecksum(sUrl)
HitungChecksum = "6" & CStr(GoogleCH("info:" & sUrl))
Fungsi Akhir
%>
PR.asp
<!--#include file="google.asp"-->
<!--#termasuk file="Cls_AspHttp.asp"-->
<%
Sub Rw(Str)
Respon.Tulis Str & vbCrLf
Respon. Siram
Sub Fungsi Akhir
HttpGet(lresolveTimeout,lconnectTimeout,Metode,Url,Referer,Data,SetCookie,Bahasa,ISI,Agen,Pengkodean,Terima,CodeBase)
Setel DoGet = FlyCms_AspHttp baru
DoGet.lresolveTimeout = lresolveTimeout
DoGet.lconnectTimeout = lconnectTimeout
DoGet.lsendTimeout = lsendTimeout
DoGet.lreceiveTimeout = lreceiveTimeout
DoGet.Method = Metode
DoGet.Url = Url
DoGet.Referer = Referensi
DoGet.Data = Data
DoGet.SetCookie = SetCookie
DoGet.Bahasa = Bahasa
DoGet.CONTENT = KONTEN
DoGet.Agent = Agen
DoGet.Encoding = Pengkodean
DoGet.Accept = Terima
DoGet.CodeBase = Basis Kode
HttpGet = DoGet.HttpGet()
Setel DoGet = Tidak Ada
Fungsi Akhir
Fungsi GGPR (URL ByVal)
Redupkan strRet
sURL = " http://www.google.com/search?client=navclient&ch =" & HitungPeriksa(URL) & "&features=Rank&q=info:" & URL
Rw "Alamat permintaan: " & sURL & "<br />"
strRet = HttpGet(10000,10000,20000,20000,"GET",sUrl,"","","","zh-cn","","Mozilla/4.0 (kompatibel; MSIE 6.0; Windows NT 5.1) ","","*/*","gb2312")
Jika InStr(strRet,":") Lalu
R = Pisahkan(strRet,":")
GGPR = R(2)
Kalau tidak
GGPR = 0
Akhiri Jika
Rw "Kembalikan hasil: " & strRet & "<br />"
Rw " Nilai PR: " & GGPR & "<br />"
Fungsi Akhir
iURL = Permintaan("iURL")
Jika iURL="" Maka iURL = " http://www.downcodes.com "
PanggilanGGPR(iURL)
%>
<html>
<kepala></kepala>
<title>Kueri Pagerank Google (pencuri kueri pr)</title>
<tubuh>
<h1>Masukkan alamat halaman lengkap untuk memeriksa pagerank (nilai PR halaman):</h1>
<formulir tindakan="" metode="posting">
URL <input type="text" name="iURL" style="width:200px" /><input type="submit" value="pr query" />
</bentuk>
</tubuh>
<html>