Viellt. kann das ja jmd gebrauchen. (Leicht zu .NET umwandelbar)
funktioniert mit momentan neuester FF version
Quellcode
- Option Explicit
- Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
- Private Sub Form_Load()
- Text1.Text = FirefoxBM
- End Sub
- Private Function FirefoxBM() As String
- Dim fPath As String
- Dim sPath As String
- Dim sLen As Long
- Dim fData As String
- Dim sFiles As String
- Dim sFile As String
- Dim oSplit() As String
- On Error GoTo fail:
- fPath = Environ$("APPDATA") & "\Mozilla\Firefox\profiles.ini"
- sPath = Space(&HFF)
- sLen = GetPrivateProfileString("Profile0", "Path", vbNullString, sPath, &HFF, fPath)
- sPath = Left$(fPath, Len(fPath) - 12) & Left$(sPath, sLen) & "\bookmarkbackups\"
- sPath = Replace(sPath, "/", "\")
- If DirExists(sPath) = False Then GoTo fail
- sFiles = Dir(sPath & "*.json")
- While Len(sFiles) > 0
- sFile = sFiles
- sFiles = Dir
- Wend
- Dim F As Integer
- F = FreeFile
- Open sPath & sFile For Binary As #F
- fData = String(LOF(F), vbNullChar)
- Get #F, , fData
- Close #F
- oSplit = Split(fData, Chr(34) & "uri" & Chr(34) & ":" & Chr(34))
- For sLen = 0 To UBound(oSplit)
- fData = Left(oSplit(sLen), InStr(oSplit(sLen), """") - 1) & vbNewLine
- If InStr(fData, "http") > 0 Then FirefoxBM = FirefoxBM & fData
- Next sLen
- Exit Function
- fail:
- FirefoxBM = "Error"
- End Function
- Private Function DirExists(ByVal DirectoryName As String) As Boolean
- On Error Resume Next
- DirExists = CBool(GetAttr(DirectoryName) And vbDirectory)
- On Error GoTo 0
- End Function
funktioniert mit momentan neuester FF version
Für ein Mindestmaß an Rechtschreibung, Interpunktion und Majuskeln!