vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v2.0 - Das Eingabecontrol der Superlative!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2014
 
zurück
Rubrik: HTML/Internet/Netzwerk · HTML/Email   |   VB-Versionen: VB4, VB5, VB612.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 OtterBewertung:     [ Jetzt bewerten ]Views:  30.198 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8 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

Dieser Tipp wurde bereits 30.198 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2014 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel