Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: html Quelltext auslesen
Autor: saxa
Datum: 21.06.04 10:23
Bitte schön: Private Sub Form_Load() Label1.Caption = "keine Seite" Label2.Caption = "keine Seite" End Sub Private Sub Command1_Click() ' Seite laden Label1.Caption = "Loading..." WebBrowser1.Navigate Text1.Text End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim sHTMLText As String Dim sURL As Variant Dim I As Integer ' Prüfen, ob Seite vollständig geladen ist If (pDisp Is WebBrowser1.Object) Then Label1.Caption = "Dokument komplett geladen." Else Debug.Print "Loading..." End If If Label1.Caption = "Dokument komplett geladen." Then ' 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 For I = 0 To UBound(sURL) 'If InStr(sURL(I), "pages.ebay.de") Then If sURL(I) = "http://pages.ebay.de/" Then MsgBox sURL(I) WebBrowser2.Navigate sURL(I) 'Else 'MsgBox "browser1 nichts gefunden" End If Next I End If End If End Sub Private Sub WebBrowser2_DocumentComplete(ByVal pDisp As Object, URL As Variant) Dim strHTMLText As String Dim strURL As Variant Dim I As Integer ' Prüfen, ob Seite vollständig geladen ist If (pDisp Is WebBrowser2.Object) Then Label2.Caption = "Dokument komplett geladen." Else Debug.Print "Loading..." End If If Label2.Caption = "Dokument komplett geladen." Then ' zunächst Seitenquelltext ermitteln With WebBrowser2.Document strHTMLText = .documentElement.outerHTML End With ' jetzt URLs ermitteln strURL = HTML_GetAllURLs(strHTMLText) ' URLs vorhanden? If IsArray(strURL) Then For I = 0 To UBound(strURL) If InStr(strURL(I), "www.ebay.de") Then MsgBox strURL(I) Else MsgBox "www.ebay.de nicht vorhanden" End If Next I End If End If End Sub 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

html Quelltext auslesen	702	saxa	20.06.04 20:04
Re: html Quelltext auslesen	427	Dieter	20.06.04 23:08
Re: html Quelltext auslesen	425	saxa	21.06.04 09:24
Re: html Quelltext auslesen	397	Dieter	21.06.04 10:15
Re: html Quelltext auslesen	465	saxa	21.06.04 10:23
Re: html Quelltext auslesen	410	devnull	22.06.04 09:36
Re: html Quelltext auslesen	478	saxa	22.06.04 21:03

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen