Beberapa orang menganggap crawler sebagai harta karun. Sejauh ini, beberapa orang menjual TND demi uang. Saya sangat memuji orang-orang ini apa adanya! Mungkin hal-hal di bawah ini agak timpang.
Yang di bawah ini tidak memiliki fungsi menulis ke perpustakaan. Kami telah mencapai langkah ini. Fungsi memasuki perpustakaan sangat sederhana. Silakan selesaikan sendiri jika perlu. Salin kodenya dan jalankan langsung untuk melihat efeknya
Redupkan Url,List_PageCode,Array_ArticleID,i,ArticleID
Redupkan Content_PageCode,Content_TempCode
Redupkan Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Redupkan Judul Artikel,Penulis Artikel,ArtikelDari,Isi Artikel
Url = http://www.webasp.net/article/class/1.htm
List_PageCode = getHTTPPage(Url)
List_PageCode = RegExpText(List_PageCode, cetak</th></tr>,</table><tabel border=0 cellpadding=5,0)
List_PageCode = RegExpText(List_PageCode,<td align=left><a href='../,'><img border=0 src='../images/authortype0.gif',1)'Dapatkan artikel terkini daftar halaman Tautan, dipisahkan oleh
Array_ArticleID = Split(List_PageCode,,)'Buat array untuk menyimpan ID artikel
Untuk i=0 Ke Ubound(Array_ArticleID)-1
ArticleID = Array_ArticleID(i)'ID Artikel
Content_PageCode = getHTTPPage(http://www.webasp.net/article/&ArticleID) 'Dapatkan konten halaman artikel
'==========Dapatkan kategori artikel dan parameter ID terkait untuk memulai=========
Content_TempCode = RegExpText(Content_PageCode,<a href=/article/>Tutorial Teknis</a> >> ,>> Konten</td>,0)
Content_CategoryID = RegExpText(Content_PageCode,<a href='../class,/'>,1)
BorderID = Split(Content_CategoryID,,)(0)' ID Kategori
ClassID = Split(Content_CategoryID,,)(1)'ID Subkelas
'==========Periksa apakah kategori utama adaMulai=
'Jika tidak ada, simpan di database
'==========Periksa apakah kategori utama adaEnd=
'Respon.Tulis(BorderID & , & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'Nama kategori
ClassName = Split(Content_CategoryName,,)(1)'Nama subkelas
'==========Periksa apakah subkelasnya adaMulai=
'Jika tidak ada, simpan di database
'==========Periksa apakah subkelas ada akhir=
'==========Pengakhiran klasifikasi artikel dan parameter ID terkait=========
'==========Dapatkan judul dan isi artikel dan mulai============== =
Judul Artikel = RegExpText(Content_PageCode,<tr><td align=center bgcolor=#DEE2F5><strong>,</strong></td></tr>,0)
ArticleAuthor = RegExpText(Content_PageCode,<tr><td><span class=blue>Penulis:</span>,</td></tr>,0)
ArticleFrom = RegExpText(Content_PageCode,<tr><td><span class=blue>Sumber:</span>,</td></tr>,0)
ArticleContent = RegExpText(Content_PageCode,<tr><td class=content style=WORD-WRAP: break-word id=zoom>,</td></tr>&VBCrlf& </table>&VBCrlf& </td></tr> </tabel>,0)
'==========Dapatkan judul artikel dan isi akhir===============
Respon.Tulis(Judul Artikel& <br /><br />)
Respon.Flush()
Berikutnya
Terlampir adalah beberapa fungsi:
Fungsi getHTTPHalaman(url)
JIKA(IsObjInstalled(Microsoft.XMLHTTP) = Salah) MAKA
Response.Write <br><br>Server tidak mendukung komponen Microsoft.XMLHTTP
Err. Jelas
Respon.Akhir
AKHIR JIKA
Pada Kesalahan Lanjutkan Berikutnya
Redupkan http
SET http=Server.CreateObject(Msxml2.XMLHTTP)
Http.buka GET,url,False
Http.kirim()
JIKA(Http.readystate<>4) MAKA
Fungsi Keluar
AKHIR JIKA
getHTTPPage=BytesToBSTR(Http.responseBody,GB2312)
SETEL http=TIDAK ADA
IF(Err.number<>0)THEN
Response.Write <br><br>Kesalahan saat mengambil konten file
'Respon. Selesai
Err. Jelas
AKHIR JIKA
Fungsi Akhir
Fungsi BytesToBstr(CodeBody,CodeSet)
Redupkan objStream
SET objStream = Server.CreateObject(adodb.stream)
objStream.Jenis = 1
objStream.Mode =3
objStream.Buka
objStream.Tulis CodeBody
objStream.Posisi = 0
objStream.Jenis = 2
objStream.Charset = Kumpulan Kode
BytesToBstr = objStream.ReadText
objStream.Tutup
SET objStream = TIDAK ADA
Fungsi Akhir
' ====
'Fungsi : Mengecek apakah komponen sudah terpasang
'Nilai pengembalian: Benar ---- Sudah diinstal
' Salah ---- tidak diinstal
' ====
Fungsi IsObjInstalled(objName)
Pada Kesalahan Lanjutkan Berikutnya
IsObjInstalled = Salah
Salah = 0
Tes redupObj
SET testObj = Server.CreateObject(objName)
JIKA(0 = Err)MAKA IsObjInstalled = Benar
SET testObj = TIDAK ADA
Salah = 0
Fungsi Akhir
Fungsi RegExpText(strng,strStart,strEnd,n)
Redupkan regEx, Cocokkan, Cocok, RetStr
SET regEx = RegExp Baru
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = Benar
regEx.Global = Benar
SET Kecocokan = regEx.Execute(strng)
Untuk Setiap Pertandingan dalam Pertandingan
JIKA(n=1)MAKA
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
KALAU TIDAK
RetStr = RetStr & regEx.Replace(Match.Value,$1)
AKHIR JIKA
Berikutnya
RegExpText = RetStr
SET regEx=TIDAK ADA
Fungsi Akhir