Read/Extract & Parse Firefox History

[shirazamod]

I've been looking for a way to get the website history of firefox for a while, but I couldn't find any existing code that did it, so I coded my own.

This function will read the Firefox history for all profiles on the computer and returns a string containing all the URLs, separated by vbNewLine.

Let me know what you think

Private Function ReadFfHistory() As String
Dim fso As FileSystemObject
Dim tmp As String
Dim Fldr As Folder
Dim F As Folder
Dim Strm As TextStream
Dim Parsed As String
Dim Hist As String
 
Dim urlStart As Single
Dim urlEnd As Single
 
Set fso = New FileSystemObject
 
If fso.FolderExists(Environ("appdata") & "\Mozilla\Firefox\Profiles") = False Then
    'cant find firefox profiles
    Exit Function
End If
 
Set Fldr = fso.GetFolder(Environ("appdata") & "\Mozilla\Firefox\Profiles")
 
For Each F In Fldr.SubFolders 'Loop through each profile
    If fso.FileExists(F.Path & "\history.dat") Then
        'Read in history
        Set Strm = fso.GetFile(F.Path & "\history.dat").OpenAsTextStream(ForReading)
        tmp = Strm.ReadAll
        Strm.Close
        tmp = Replace$(tmp, "\" & vbNewLine, vbNullString)
        'Parse history
        Do While InStr(urlEnd + 1, tmp, "=http") <> 0
            urlStart = InStr(urlEnd + 1, tmp, "=http") + 1
            urlEnd = InStr(urlStart, tmp, ")")
            Parsed = Parsed & Mid$(tmp, urlStart, urlEnd - urlStart) & vbNewLine
        Loop
        Hist = Hist & F.Name & ":" & vbNewLine & Parsed & vbNewLine
        Parsed = vbNullString
    End If
    urlEnd = 0
Next
 
Set Strm = Nothing
Set fso = Nothing
 
ReadFfHistory = Hist
End Function