in meinem Windows\Favoriten-Verzeichnis habe ich hunderte von Favoriten. Wer kann mir sagen, wie man mit Visual Basic 6 die URL dieser Favoriten abfragen kann. Anzeigen kann ich mir in einer normalen File-Liste die Adressen. Die haben da die Endung .url
Vielen Dank im voraus für Deine Hilfe
Hallo Markus,
kleiner Tip: Schiebe Dir doch die Datei einfach mal
in den Iditor, wenn Du sowas rauskriegen
willst. Mit Probieren wird vieles sofort
ersichtlich, denn die Lösung ist ja nun
wirklich einfach:
Option Explicit
Option Base 1
’ [email protected], 9.Juni 2000
Private Function OpenInputTextFile(FileName As String) As Integer
Dim oFileID As Integer
oFileID = FreeFile
On Error GoTo OpenInputError
Close oFileID 'Datei vorsorglich schließen
Open FileName For Input As oFileID
OpenInputTextFile = oFileID
Exit Function
OpenInputError:
OpenInputTextFile = 0
End Function 'OpenTextFile()
Private Function ReadLine(rFileID As Integer, rLineStr As String) As Boolean
Dim ch As String * 1
Dim EoL As Boolean
ReadLine = True
rLineStr = „“
EoL = False
On Error GoTo ReadLineError
If Not EOF(rFileID) Then
Do
ch = Input(1, rFileID)
’ Chr(10)=vbLf, Chr(13)=vbCr
’ Zugeschnitten auf DOS-Zeilenenden mit vbCr&vbLf!
If Not ((ch = vbCr Or ch = vbLf)) Then
rLineStr = rLineStr & ch
’ Zeichen für Zeichen einlesen
’ (Zeilenende-Zeichen werden ignoriert)
Else
If ch = vbLf Then EoL = True
’ Erst bei vbLf ist die DOS-Zeile zu Ende!
End If 'Not vbCr/vbLf
Loop Until EoL Or EOF(rFileID)
End If 'Not EOF(rFileID)
On Error GoTo 0
Exit Function
ReadLineError:
ReadLine = False
End Function ’ ReadLine()
Private Function GetURL(Favorit As String, Optional Complete As Boolean) As String
Dim FileID As Integer
Dim Line As String
Dim p As Integer
GetURL = „“
FileID = OpenInputTextFile(Favorit)
Do
If Not ReadLine(FileID, Line) Then
MsgBox „Fehler beim Lesen der Datei!“ & vbLf & vbLf & Favorit, vbOKOnly + vbCritical, „Error“
Exit Function
Else
p = InStr(1, Line, „URL=“, vbBinaryCompare)
If p > 0 Then
Line = Mid(Line, p + 4)
If Not Complete Then
p = InStr(1, Line, „?“, vbBinaryCompare)
If p = 0 Then p = 32000
Line = Left(Line, p - 1)
End If 'Not Complete
GetURL = Line
Exit Function
End If 'p > 0
End If 'Not ReadLine(FileID, Line)
Loop Until EOF(FileID)
End Function 'GetURL()
Public Function Test()
Const DatFavorit = „C:\WINNT\Profiles\htw8200\Favoriten\Radiostationsführer.url“
MsgBox GetURL(DatFavorit, True) & vbLf & vbLf & _
GetURL(DatFavorit, False), vbOKOnly + vbInformation, „Die URL ist:“
End Function 'Test()
Ach Mist,
der WerWeissWas-Server lutscht die Leerzeichen alle weg.
Nun ist der Code etwas unstrukturiert. Ich hoffe, Du
kannst ihn trotzdem lesen, sonst schicke ich ihn Dir
nochmal.
Kristian