FF Lesezeichen auslesen

    • VB6

      FF Lesezeichen auslesen

      Viellt. kann das ja jmd gebrauchen. (Leicht zu .NET umwandelbar)

      Quellcode

      1. Option Explicit
      2. 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
      5. Private Sub Form_Load()
      6. Text1.Text = FirefoxBM
      7. End Sub
      9. Private Function FirefoxBM() As String
      10. Dim fPath As String
      11. Dim sPath As String
      12. Dim sLen As Long
      13. Dim fData As String
      14. Dim sFiles As String
      15. Dim sFile As String
      16. Dim oSplit() As String
      18. On Error GoTo fail:
      20. fPath = Environ$("APPDATA") & "\Mozilla\Firefox\profiles.ini"
      21. sPath = Space(&HFF)
      22. sLen = GetPrivateProfileString("Profile0", "Path", vbNullString, sPath, &HFF, fPath)
      23. sPath = Left$(fPath, Len(fPath) - 12) & Left$(sPath, sLen) & "\bookmarkbackups\"
      25. sPath = Replace(sPath, "/", "\")
      26. If DirExists(sPath) = False Then GoTo fail
      28. sFiles = Dir(sPath & "*.json")
      30. While Len(sFiles) > 0
      31. sFile = sFiles
      32. sFiles = Dir
      33. Wend
      35. Dim F As Integer
      36. F = FreeFile
      38. Open sPath & sFile For Binary As #F
      39. fData = String(LOF(F), vbNullChar)
      40. Get #F, , fData
      41. Close #F
      43. oSplit = Split(fData, Chr(34) & "uri" & Chr(34) & ":" & Chr(34))
      45. For sLen = 0 To UBound(oSplit)
      46. fData = Left(oSplit(sLen), InStr(oSplit(sLen), """") - 1) & vbNewLine
      47. If InStr(fData, "http") > 0 Then FirefoxBM = FirefoxBM & fData
      48. Next sLen
      51. Exit Function
      52. fail:
      53. FirefoxBM = "Error"
      54. End Function
      57. Private Function DirExists(ByVal DirectoryName As String) As Boolean
      58. On Error Resume Next
      59. DirExists = CBool(GetAttr(DirectoryName) And vbDirectory)
      60. On Error GoTo 0
      61. End Function


      funktioniert mit momentan neuester FF version
      Für ein Mindestmaß an Rechtschreibung, Interpunktion und Majuskeln!