Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Schleife?
Autor: Reiner
Datum: 26.01.02 13:27
Private Function URL_Aufloesen(url As String) As String Dim sHTMLText As String Dim sURL As String Dim sTemp As String Dim sDatei As String Dim ePos, sPos, hPos As Long Dim sURLListe() As String Dim nCount, iTemp As Long Dim I As Integer Dim sDomaine As String Dim zaehler As Integer Dim bWahr As Boolean sDomaine = url nCount = 0 ReDim Preserve sURLListe(nCount) sURLListe(nCount) = sDomaine nCount = nCount + 1 'For I = 0 To UBound(sURLListe) I = 0 iTemp = 0 While sURLListe(iTemp) <> "" If I = 0 Then sURL = sURLListe(I) sDatei = "" Else hPos = 8 hPos = InStr(hPos, LCase(sURLListe(I)), "/") If hPos > 0 Then 'ePos = End_Pos(hPos, LCase(sURLListe(I))) Do ePos = hPos hPos = InStr(hPos + 1, LCase(sURLListe(I)), "/") Loop While hPos > 0 sURL = Mid(sURLListe(I), 1, ePos - 1) sDatei = Mid(sURLListe(I), ePos) '+ 1) Else sURL = sURLListe(I) sDatei = "" End If End If 'Ist URL vorhanden??? If sURL <> "" Then sHTMLText = OpenURL(sURL & sDatei) 'Ist HTML-Quelltext vorhanden??? If sHTMLText <> "" Then 'rtf1.Text = sHTMLText 'Anfangsposition setzen auf 1 sPos = 1 'Schleife zum auslesen von TAG's Do 'Erstes Vorkommen von " sPos = InStr(sPos, LCase(sHTMLText), " 'Ist Zeichen vorhanden??? If sPos > 0 Then 'Letztes Zeichen des TAG's ">" suchen ePos = InStr(sPos + 1, LCase(sHTMLText), ">") 'Ist ">"-Zeichen vorhanden??? If ePos > 0 Then sTemp = Mid(sHTMLText, sPos, ePos - sPos) 'Bis "href=" abtrennen hPos = InStr(sTemp, "href=") '"href=" gefunden??? If hPos > 0 Then sTemp = Mid(sTemp, hPos + 5, Len(sTemp)) End If '"-Zeichen in Space umwandeln sTemp = Replace(sTemp, Chr$(34), " ") 'Wenn erste Zeichen Space dann Löschen sTemp = LTrim(sTemp) 'Überprüfen, ob absolute oder relative Adresse If InStr(sTemp, "http://") Then 'Funktion URL_Absolut aufrufen sTemp = URL_Absolut(sTemp) Else 'Funktion URL_Relativ aufrufen sTemp = URL_Relativ(sTemp, sURL) End If rtf1.SelText = sTemp & vbCrLf If sTemp <> "" Then For zaehler = 0 To UBound(sURLListe) If sURLListe(zaehler) = sTemp Then bWahr = False Exit For Else bWahr = True End If Next zaehler If bWahr = True Then ReDim Preserve sURLListe(nCount) sURLListe(nCount) = sTemp iTemp = nCount nCount = nCount + 1 End If End If sPos = ePos + 1 End If End If Loop While ePos > 0 And sPos > 0 End If End If 'Next I I = I + 1 Wend End Function

Schleife?	71	Reiner	26.01.02 11:08
Re: Schleife?	298	Dieter	26.01.02 12:45
Re: Schleife?	54	Reiner	26.01.02 13:27
Re: Schleife?	318	Dieter	26.01.02 13:42
Re: Schleife?	49	Reiner	26.01.02 18:48
DoEvents bewirkt Wunder	294	Dieter	26.01.02 19:21

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