Manche Leute halten den Crawler für einen Schatz, andere verkaufen TND für Geld. Vielleicht ist das Folgende etwas lahm.
Der folgende Schritt verfügt nicht über die Funktion zum Schreiben in die Bibliothek. Bitte vervollständigen Sie ihn bei Bedarf selbst. Kopieren Sie den Code und führen Sie ihn direkt aus, um den Effekt zu sehen
Dim URL,List_PageCode,Array_ArticleID,i,ArticleID
Dimmen Sie Content_PageCode,Content_TempCode
Blenden Sie Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName aus
Dim ArticleTitle, ArticleAuthor, ArticleFrom, ArticleContent
URL = http://www.webasp.net/article/class/1.htm
List_PageCode = getHTTPPage(URL)
List_PageCode = RegExpText(List_PageCode, print</th></tr>,</table><table border=0 cellpadding=5,0)
List_PageCode = RegExpText(List_PageCode,<td align=left><a href='../,'><img border=0 src='../images/authortype0.gif',1)'Holen Sie sich die Artikel des aktuellen Listenseite Links, getrennt durch
Array_ArticleID = Split(List_PageCode,,)'Erstellen Sie ein Array zum Speichern von Artikel-IDs
Für i=0 bis Ubound(Array_ArticleID)-1
ArticleID = Array_ArticleID(i)'Artikel-ID
Content_PageCode = getHTTPPage(http://www.webasp.net/article/&ArticleID) 'Den Inhalt der Artikelseite abrufen
'==========Rufen Sie die Artikelkategorie und die zugehörigen ID-Parameter ab, um zu beginnen========================
Content_TempCode = RegExpText(Content_PageCode,<a href=/article/>Technisches Tutorial</a> >> ,>> Inhalt</td>,0)
Content_CategoryID = RegExpText(Content_PageCode,<a href='../class,/'>,1)
BorderID = Split(Content_CategoryID,,)(0)' Kategorie-ID
ClassID = Split(Content_CategoryID,,)(1)'Unterklassen-ID
'==========Überprüfen Sie, ob die Hauptkategorie existiertStart================
'Wenn es nicht existiert, speichern Sie es in der Datenbank
'==========Überprüfen Sie, ob die Hauptkategorie existiertEnd================
'Response.Write(BorderID & , & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'Kategoriename
ClassName = Split(Content_CategoryName,,)(1)'Unterklassenname
'==========Überprüfen Sie, ob die Unterklasse existiertStart================
'Wenn es nicht existiert, speichern Sie es in der Datenbank
'==========Überprüfen Sie, ob eine Unterklasse existiert end================
'==========Das Abrufen der Artikelklassifizierung und der zugehörigen ID-Parameter endet========================
'==========Holen Sie sich den Titel und den Inhalt des Artikels und beginnen Sie============================ =
ArticleTitle = RegExpText(Content_PageCode,<tr><td align=center bgcolor=#DEE2F5><strong>,</strong></td></tr>,0)
ArticleAuthor = RegExpText(Content_PageCode,<tr><td><span class=blue>Author:</span>,</td></tr>,0)
ArticleFrom = RegExpText(Content_PageCode,<tr><td><span class=blue>Quelle:</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> </table>,0)
'==========Holen Sie sich den Titel und den Inhalt des Artikels end=============================
Response.Write(ArticleTitle& <br /><br />)
Response.Flush()
Nächste
Im Anhang ein paar Funktionen:
Funktion getHTTPPage(url)
IF(IsObjInstalled(Microsoft.XMLHTTP) = False)THEN
Response.Write <br><br>Der Server unterstützt die Microsoft.XMLHTTP-Komponente nicht
Fehler.Klar
Antwort.Ende
ENDE WENN
Bei Fehler Weiter fortsetzen
Verdunkeln Sie http
SET http=Server.CreateObject(Msxml2.XMLHTTP)
Http.open GET,url,False
Http.send()
IF(Http.readystate<>4)DANN
Exit-Funktion
ENDE WENN
getHTTPPage=BytesToBSTR(Http.responseBody,GB2312)
SET http=NOTHING
WENN(Fehlernummer<>0)DANN
Response.Write <br><br>Fehler beim Abrufen des Dateiinhalts
'Antwort.Ende
Fehler.Klar
ENDE WENN
Funktion beenden
Funktion BytesToBstr(CodeBody,CodeSet)
Dimmen Sie objStream
SET objStream = Server.CreateObject(adodb.stream)
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write CodeBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeSet
BytesToBstr = objStream.ReadText
objStream.Close
SET objStream = NICHTS
Funktion beenden
'=============================================
'Funktion: Prüfen, ob die Komponente installiert wurde
'Rückgabewert: True ---- Bereits installiert
' Falsch ---- nicht installiert
'=============================================
Funktion IsObjInstalled(objName)
Bei Fehler Weiter fortsetzen
IsObjInstalled = False
Fehler = 0
Dim testObj
SET testObj = Server.CreateObject(objName)
IF(0 = Err)THEN IsObjInstalled = True
SET testObj = NICHTS
Fehler = 0
Funktion beenden
Funktion RegExpText(strng,strStart,strEnd,n)
Dimmen Sie regEx,Match,Matches,RetStr
SET regEx = Neuer RegExp
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = True
regEx.Global = True
SET Matches = regEx.Execute(strng)
Für jedes Spiel in Spielen
WENN(n=1)DANN
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
ANDERS
RetStr = RetStr & regEx.Replace(Match.Value,$1)
ENDE WENN
Nächste
RegExpText = RetStr
SETze regEx=NOTHING
Funktion beenden