|
| |
Suche Visual-Basic Code| Re: Schleife? | |  | Autor:  Dieter (Moderator) | | Datum: 26.01.02 13:42 |
| Hallo Reiner,
ist logisch, dass das eine Endlos-Schleife ist, denn es wird niemals die Bedingung sURLListe(iTemp) erfüllt!
iTemp zeigt ja immer auf den letzten URL-Eintrag.
Versuch's mal damit:
<code><font color=#000099>Private</font> <font color=#000099>Function</font> _
URL_Aufloesen(url <font color=#000099>As</font> <font _
color=#000099>String</font>) <font color=#000099>As</font> <font _
color=#000099>String</font>
<font color=#000099>Dim</font> sHTMLText <font color=#000099>As</font> <font _
color=#000099>String</font>
<font color=#000099>Dim</font> sURL <font color=#000099>As</font> <font _
color=#000099>String</font>
<font color=#000099>Dim</font> sTemp <font color=#000099>As</font> <font _
color=#000099>String</font>
<font color=#000099>Dim</font> sDatei <font color=#000099>As</font> <font _
color=#000099>String</font>
<font color=#000099>Dim</font> ePos, sPos, hPos <font color=#000099>As</font> _
<font color=#000099>Long</font>
<font color=#000099>Dim</font> sURLListe() <font color=#000099>As</font> _
<font color=#000099>String</font>
<font color=#000099>Dim</font> nCount, iTemp <font color=#000099>As</font> _
<font color=#000099>Long</font>
<font color=#000099>Dim</font> I <font color=#000099>As</font> <font _
color=#000099>Integer</font>
<font color=#000099>Dim</font> sDomaine <font color=#000099>As</font> <font _
color=#000099>String</font>
<font color=#000099>Dim</font> zaehler <font color=#000099>As</font> <font _
color=#000099>Integer</font>
<font color=#000099>Dim</font> bWahr <font color=#000099>As</font> <font _
color=#000099>Boolean</font>
sDomaine = url
nCount = 0
<font color=#000099>ReDim</font> Preserve sURLListe(nCount)
sURLListe(nCount) = sDomaine
nCount = nCount + 1
<font color=green>' For I = 0 To UBound(sURLListe)</font>
I = 0
iTemp = 0
<font color=#000099>While</font> I < nCount
<font color=#000099>If</font> I = 0 <font color=#000099>Then</font>
sURL = sURLListe(I)
sDatei = ""
<font color=#000099>Else</font>
hPos = 8
hPos = InStr(hPos, LCase(sURLListe(I)), "/")
<font color=#000099>If</font> hPos > 0 <font color=#000099>Then</font>
<font color=green>' ePos = End_Pos(hPos, LCase(sURLListe(I)))</font>
<font color=#000099>Do</font>
ePos = hPos
hPos = InStr(hPos + 1, LCase(sURLListe(I)), "/")
<font color=#000099>Loop</font> <font color=#000099>While</font> hPos > _
0
sURL = Mid(sURLListe(I), 1, ePos - 1)
sDatei = Mid(sURLListe(I), ePos) '+ 1)
<font color=#000099>Else</font>
sURL = sURLListe(I)
sDatei = ""
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=green>' Ist URL vorhanden???</font>
<font color=#000099>If</font> sURL <> "" <font color=#000099>Then</font>
sHTMLText = OpenURL(sURL & sDatei)
<font color=green>' Ist HTML-Quelltext vorhanden???</font>
<font color=#000099>If</font> sHTMLText <> "" <font _
color=#000099>Then</font>
<font color=green>' rtf1.Text = sHTMLText</font>
<font color=green>' Anfangsposition setzen auf 1</font>
sPos = 1
<font color=green>' Schleife zum auslesen von TAG's</font>
<font color=#000099>Do</font>
<font color=green>' Erstes Vorkommen von " 0 Then</font>
<font color=green>' Letztes Zeichen des TAG's ">" suchen</font>
ePos = InStr(sPos + 1, LCase(sHTMLText), ">")
<font color=green>' Ist ">"-Zeichen vorhanden???</font>
<font color=#000099>If</font> ePos > 0 <font color=#000099>Then</font>
sTemp = Mid(sHTMLText, sPos, ePos - sPos)
<font color=green>' Bis "href=" abtrennen</font>
hPos = InStr(sTemp, "href=")
<font color=green>' "href=" gefunden???</font>
<font color=#000099>If</font> hPos > 0 <font _
color=#000099>Then</font>
sTemp = Mid(sTemp, hPos + 5, Len(sTemp))
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=green>' "-Zeichen in Space umwandeln</font>
sTemp = Replace(sTemp, Chr$(34), " ")
<font color=green>' Wenn erste Zeichen Space dann Löschen</font>
sTemp = LTrim(sTemp)
<font color=green>' Überprüfen, ob absolute oder relative
' Adresse</font>
<font color=#000099>If</font> InStr(sTemp, "http://") <font _
color=#000099>Then</font>
<font color=green>' Funktion URL_Absolut aufrufen</font>
sTemp = URL_Absolut(sTemp)
<font color=#000099>Else</font>
<font color=green>' Funktion URL_Relativ aufrufen</font>
sTemp = URL_Relativ(sTemp, sURL)
<font color=#000099>End</font> <font color=#000099>If</font>
rtf1.SelText = sTemp & vbCrLf
<font color=#000099>If</font> sTemp <> "" <font _
color=#000099>Then</font>
bWahr = <font color=#000099>True</font>
<font color=#000099>For</font> zaehler = 0 <font _
color=#000099>To</font> <font color=#000099>UBound</font>( _
sURLListe)
<font color=#000099>If</font> sURLListe(zaehler) = sTemp <font _
color=#000099>Then</font>
bWahr = <font color=#000099>False</font>: <font _
color=#000099>Exit</font> <font color=#000099>For</font>
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=#000099>Next</font> zaehler
<font color=#000099>If</font> bWahr = <font _
color=#000099>True</font> <font color=#000099>Then</font>
<font color=#000099>ReDim</font> Preserve sURLListe(nCount)
sURLListe(nCount) = sTemp
iTemp = nCount
nCount = nCount + 1
<font color=#000099>End</font> <font color=#000099>If</font>
sPos = ePos + 1
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=#000099>Loop</font> <font color=#000099>While</font> ePos > _
0 <font color=#000099>And</font> sPos > 0
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=#000099>End</font> <font color=#000099>If</font>
<font color=green>' Next I</font>
I = I + 1
<font color=#000099>Wend</font>
<font color=#000099>End</font> <font color=#000099>Function</font></code>Cu
Dieter | |
 | 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 |
 |
|
TOP! Unser Nr. 1 
Neu! sevDataGrid 3.0
Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Weitere InfosTipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) Access-Tools Vol.1 
Über 400 MByte Inhalt
Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB
Nur 24,95 EURWeitere Infos
|
| |
|
Copyright ©2000-2025 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
|
|
Sie sind aktuell nicht angemeldet.
