Rubrik: HTML/Internet/Netzwerk · HTML/Email | VB-Versionen: VB4, VB5, VB6 | 12.01.02 |
Alle URL-Links einer HTML-Seite auslesen Mit diesem Code lassen sich die URL-Links eines HTML-Seitenquelltextes auslesen und in einem Array speichern. | ||
Autor: Dieter Otter | Bewertung: | Views: 40.500 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Die nachfolgende Funktion ermittelt alle URL-Linkadressen eines HTML-Seitenquelltextes und gibt diese als String-Array zurück.
Private Function HTML_GetAllURLs( _ ByVal sHTMLText As String) As Variant ' Alle URL-Adressen im übergebenen HTML-Text suchen ' und als Array zurückgeben Dim sPos As Long Dim ePos As Long Dim hPos As Integer Dim nCount As Long Dim sTemp As String Dim sLink As String Dim sURL() As String nCount = 0 If sHTMLText <> "" Then ' an erster Position begonnen sPos = 1 Do ' nach einleitendem Link-Tag suchen "<a" sPos = InStr(sPos, LCase$(sHTMLText), "<a ") If sPos > 0 Then ' <a - Tag gefunden, jetzt End-Tag suchen ePos = InStr(sPos, sHTMLText, ">") If ePos > 0 Then ' End-Tag gefunden ' jetzt alles zwischen sPos und ePos filtern sTemp = Mid$(sHTMLText, sPos, ePos - sPos) If InStr(Mid$(sTemp, 2), "<") = 0 Then ' nur wenn < nicht nochmals vorhanden ist sTemp = Mid$(sTemp, 4) ' jetzt nach dem Schlüsselwort "HREF" suchen hPos = InStr(LCase$(sTemp), "href=") If hPos > 0 Then ' gefunden... jetzt die Link-Adresse auslesen sLink = Mid$(sTemp, hPos + 5) ' Prüfen, ob "-Zeichen vorhanden, ' wenn ja - "ausschneiden" If Left$(sLink, 1) = Chr$(34) Then sLink = Mid$(sLink, 2) sLink = strLeft(sLink, Chr$(34)) Else sLink = strLeft(sLink, " ") End If If Right$(sLink, 1) = Chr$(34) Then _ sLink = Left$(sLink, Len(sLink) - 1) ' Link in URL-Array speichern ReDim Preserve sURL(nCount) sURL(nCount) = sLink nCount = nCount + 1 ' Weitersuche ab "ePos" sPos = ePos - 1 End If End If End If sPos = sPos + 1 Else Exit Do End If Loop End If HTML_GetAllURLs = sURL End Function
' Hilfsfunktion Public Function strLeft(ByVal sString As String, _ ByVal vDelimiter As Variant) As String Dim lPos As Long If VarType(vDelimiter) = vbString Then ' String bis zum ersten Vorkommen eines Zeichens ' zurückgeben lPos = InStr(sString, vDelimiter) If lPos = 0 Then lPos = Len(sString) Else lPos = Val(vDelimiter) End If strLeft = Left(sString, lPos) End Function
Beispiel:
Sie haben auf der Form ein WebBrowser-Steuerelement und eine Internetseite geladen. Per Knopfdruck sollen nun alle Linkadressen der Internetseite in einer ListBox angezeigt werden.Private Sub Command1_Click() Dim sHTMLText As String Dim sURL As Variant Dim I As Integer ' zunächst Seitenquelltext ermitteln With WebBrowser1.Document sHTMLText = .documentElement.outerHTML End With ' jetzt URLs ermitteln sURL = HTML_GetAllURLs(sHTMLText) ' URLs vorhanden? If IsArray(sURL) Then ' ListBox mit den URLs füllen List1.Clear For I = 0 To UBound(sURL) List1.AddItem sURL(I) Next I End If End Sub