Program pencuri Alexa yang relatif sederhana. Teman-teman yang menyukai fungsi ini dapat mempelajari prinsip-prinsipnya. Saya yakin Anda akan segera dapat menulis program ini<%
'Untuk mendukung orisinalitas, harap simpan komentar ini, terima kasih!
'Penulis: Fei Caoshang
'Dapatkan nama domain utama
Fungsi getDomainUrl(url)
tempurl=ganti(url,http://,)
jika instr(tempurl,/)>0 maka
tempurl=kiri(tempurl,instr(tempurl,/)-1)
akhirJika
getDomainurl=tempurl
Fungsi Akhir
Fungsi DapatkanHttpPage(HttpUrl)
Jika IsNull(HttpUrl)=Benar Atau Len(HttpUrl)<18 Atau HttpUrl=$False$ Maka
GetHttpPage=$Salah$
Fungsi Keluar
Akhiri Jika
Redupkan Http
Setel Http=server.buat objek(MSXML2.XMLHTTP)
Http.buka GET,HttpUrl,False
Http.Kirim()
Jika Http.Readystate<>4 maka
Setel Http=Tidak Ada
GetHttpPage=$Salah$
Fungsi keluar
Berakhir jika
GetHTTPage=Http.responseText
Setel Http=Tidak Ada
Jika Err.number<>0 maka
Err. Jelas
Akhiri Jika
Fungsi Akhir
' ===== = =
'Nama fungsi: ScriptHtml
'Fungsi: memfilter tag html
'Parameter: ConStr ------ String yang akan difilter
'TagName ------ Tag yang akan difilter
' FType 1 berarti memfilter label kiri, 2 berarti memfilter label kiri dan kanan, dan nilai tengah 3 berarti memfilter label kiri dan label kanan, mempertahankan konten.
' ===== = =
Fungsi ScriptHtml(Byval ConStr,TagName,FType,includestr)
Redupkan Ulang
Setel Re=RegExp baru
Re.IgnoreCase=benar
Re.Global=Benar
Pilih Kasus FType
Kasus 1
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Ganti(ConStr,)
Kasus 2
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>.*?</ & TagName & ([^>])*>
'response.tulis konstr&<br>
ConStr=Re.Ganti(ConStr,)
'response.write server.htmlencode(constr)&<br>
Kasus 3
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Ganti(ConStr,)
Re.Pattern=</ & TagName & ([^>])*>
ConStr=Re.Ganti(ConStr,)
Pilihan Akhir
ScriptHtml=KontraStr
Tetapkan Re=Tidak Ada
Fungsi Akhir
' ===== = =
'Nama fungsi: GetBody
'Fungsi: mencegat string
'Parameter: ConStr ------ String yang akan dicegat
'Parameter: StartStr ------ string awal
'Parameter: OverStr ------ String akhir
'Parameter: IncluL ------ Apakah StartStr disertakan
'Parameter:IncluR ------apakah akan menyertakan OverStr
' ===== = =
Fungsi GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
Jika ConStr=$False$ atau ConStr= atau IsNull(ConStr)=True Atau StartStr= atau IsNull(StartStr)=True Atau OverStr= atau IsNull(OverStr)=True Maka
DapatkanBody=$Salah$
Fungsi Keluar
Akhiri Jika
DimConStrTemp
Redupkan Mulai, Selesai
ConStrTemp=Lcase(ConStr)
MulaiStr=Lkasus(MulaiStr)
OverStr=Lkasus(OverStr)
Mulai = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
'response.write Mulai&<br>&Termasuk&<br>
'respons.akhir
Jika Mulai<=0 maka
DapatkanBody=$Salah$
Fungsi Keluar
Kalau tidak
Jika Termasuk = Salah Maka
Mulai=Mulai+LenB(MulaiStr)
Akhiri Jika
Akhiri Jika
Over=InStrB(Mulai,ConStrTemp,OverStr,vbBinaryCompare)
'respons.tulis Selesai
'respons.akhir
'response.write Mulai& &Atas& &Atas-Awal
'respons.akhir
Jika Lebih<=0 Atau Lebih<=Mulai maka
DapatkanBody=$Salah$
Fungsi Keluar
Kalau tidak
Jika InclR=Benar Maka
Atas=Atas+LenB(AtasStr)
Akhiri Jika
Akhiri Jika
GetBody=MidB(ConStr,Mulai,Awal-Awal)
'respons.tulis getBody
'respons.akhir
Fungsi Akhir
' ===== = =
'Nama fungsi: GetArray
'Fungsi: Ekstrak alamat tautan, dipisahkan dengan $Array$
'Parameter: ConStr ------Ekstrak karakter asli alamat
'Parameter: StartStr ------ string awal
'Parameter: OverStr ------ String akhir
'Parameter: IncluL ------ Apakah StartStr disertakan
'Parameter:IncluR ------apakah akan menyertakan OverStr
' ===== = =
Fungsi GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
Jika ConStr=$False$ atau ConStr= Atau IsNull(ConStr)=True atau StartStr= Atau OverStr= atau IsNull(StartStr)=True Atau IsNull(OverStr)=True Maka
DapatkanArray=$Salah$
Fungsi Keluar
Akhiri Jika
Redupkan TempStr,TempStr2,objRegExp,Cocok,Cocok
SuhuStr=
Setel objRegExp = Regexp Baru
objRegExp.IgnoreCase = Benar
objRegExp.Global = Benar
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
Tetapkan Kecocokan =objRegExp.Execute(ConStr)
Untuk Setiap Pertandingan dalam Pertandingan
TempStr=TempStr & $Array$ & Cocok.Nilai
Berikutnya
Tetapkan Kecocokan=tidak ada
Jika TempStr = Maka
DapatkanArray=$Salah$
Fungsi Keluar
Akhiri Jika
TempStr=Kanan(TempStr,Len(TempStr)-7)
Jika IncluL=False maka
objRegExp.Pattern =StartStr
TempStr=objRegExp.Ganti(TempStr,)
Berakhir jika
Jika InclR=False maka
objRegExp.Pattern =OverStr
TempStr=objRegExp.Ganti(TempStr,)
Berakhir jika
Setel objRegExp=tidak ada
Tetapkan Kecocokan=tidak ada
Jika TempStr= maka
DapatkanArray=$Salah$
Kalau tidak
DapatkanArray=TempStr
Berakhir jika
Fungsi Akhir
Fungsi getAlexaRank(weburl)
tempurl=getDomainUrl(weburl)
'Baca data di http://client.alexa.com/common/css/scramble.css
alexacss=http://client.alexa.com/common/css/scramble.css
strAlexaCss=GetHttpPage(alexacss)
'respons.tulis strAlexaCss
'respons.akhir
alexarankqueryurl=http://www.alexa.com/data/details/traffic_details/&tempurl
strAlexaContent=GetHttpPage(alexarankqueryurl)
rankcontent=getBody(strAlexaContent,Layanan Informasi.-->,<!-- google_ad_section_end(nama=default) -->,false,false)
'Dapatkan kelas rentang
strspan=GetArray(peringkatkonten,<span class=,,false,false)
'response.tulis konten peringkat&<br>
'response.tulis strspan&<br>
'respons.akhir
Jika strspan<>$False$ Lalu
aspan=split(strspan,$Array$)
Untuk i=0 Ke UBound(aspan)
'respons.tulis .&aspan(i)
'Tentukan apakah aspan(i), kelas span, ada di alexacss. Jika ada, Anda perlu menghapus span dan data dalam span tersebut.
Jika InStr(strAlexaCss,.&aspan(i))>=1 Kemudian
'respons.tulis aspan(i)&<br>
'respons.akhir
'Menunjukkan bahwa atribut tersebut tidak ada dan perlu diganti.
rankcontent=ScriptHtml(rankcontent,span,2,aspan(i))
Kalau tidak
rankcontent=ScriptHtml(rankcontent,span,1,aspan(i))
Berakhir jika
Berikutnya
'Ganti tag span di sebelah kanan yang telah dihapus di atas.
rankcontent=Ganti(peringkatkonten,</span>,)
Akhiri Jika
Jika rankcontent=$False$ Lalu
rankcontent=Tidak Ada Data
Berakhir jika
getAlexaRank=Ganti(peringkatkonten,,,)
Fungsi Akhir
url=permintaan.querystring(url)
%>
<nama formulir=metode alexaform=dapatkan>
URL masukan:<tipe masukan= nama=nilai url=<%=url%> ukuran=40> <tipe masukan=kirim nilai=kueri>
</bentuk>
<%
Jika url<> Lalu
respon.write Peringkat ALEXA situs web Anda adalah:
respon.flush
peringkat=dapatkanAlexaRank(url)
respon.tulis peringkat
Berakhir jika
%>