Este código hace tiempo que había quedado pendiente en un hilo del foro por el amigo 79137913 el cual sirve para recuperar contraseñas guardadas en Windows 8 y posteriores, haciendo un breve resúmen en versiones anteriores Internet explorer (IE7) éste almacenaba sus contraseñas en el registro de windows, las cuales utilizando algunas apis de desencriptación se podían obtener todos los datos. Con la llegada de Windows 8 el sistema cambió y comenzaron a guardarlas en Windows Vault, si nos metemos desde el Administrador de credenciales podemos ver todas las contraseñas guardas con sus respectivos Usuarios y Url.
Me dió mucho trabajo poder traducir el código de C, ya que son todas apis indocumentadas y el manejo desde VB y los punteros a las estructuras es un tanto engorroso, pero tras prueba y error pude lograr recuperar las contraseñas.
Tanto I.Explorer como Microsoft Edge guardan las contraseñas en el mismo lugar con el mismo seudónimo (Intenet Explorer) (ya sabemos que ambos son la misma cosa).
El código se puede resumir si se quiere, pero traté de mantener todas las estructuras y enumeraciones para que sea más entendible su funcionamiento o poder usar otras funcionalidades de las credenciales.
(Aclaro esto sólo sirve en Windows 8 y posteriores, si bien las credenciales estaban disponibles en Windows 7, mi internet explorer no almacenaba sus contraseñas en vault, y si estoy equivocado es fácil corregir, sólo hay que verificar la versión de windows y cambiar la estructura según el S.O.).
Option Explicit Private Declare Function VaultOpenVault Lib "vaultcli.dll" (ByRef VaultGuid As GUID, ByVal dwFlags As Long, ByRef VaultHandle As Long) As Long Private Declare Function VaultCloseVault Lib "vaultcli.dll" (ByRef VaultHandle As Long) As Long Private Declare Function VaultEnumerateItems Lib "vaultcli.dll" (ByVal VaultHandle As Long, ByVal dwFlags As Long, ByRef ItemsCount As Long, ByRef Items As Long) As Long Private Declare Function VaultGetItem Lib "vaultcli.dll" (ByVal VaultHandle As Long, pSchemaId As GUID, ByVal pResource As Long, ByVal pIdentity As Long, ByVal pPackageSid As Long, ByVal hwndOwner As Long, ByVal dwFlags As Long, ppItem As Long) As Long Private Declare Function VaultFree Lib "vaultcli.dll" (ByVal ppItem As Long) As Long Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Private Enum VAULT_SCHEMA_ELEMENT_ID ElementId_Illegal = 0 ElementId_Resource = 1 ElementId_Identity = 2 ElementId_Authenticator = 3 ElementId_Tag = 4 ElementId_PackageSid = 5 ElementId_AppStart = &H64 ElementId_AppEnd = &H2710 End Enum Private Enum VAULT_ELEMENT_TYPE ElementType_Boolean = 0 ElementType_Short = 1 ElementType_UnsignedShort = 2 ElementType_Integer = 3 ElementType_UnsignedInteger = 4 ElementType_Double = 5 ElementType_Guid = 6 ElementType_String = 7 ElementType_ByteArray = 8 ElementType_TimeStamp = 9 ElementType_ProtectedArray = 10 ElementType_Attribute = 11 ElementType_Sid = 12 ElementType_Last = 13 ElementType_Undefined = -1 End Enum Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type VAULT_VARIANT veType As VAULT_ELEMENT_TYPE Unknown As Long lpString As Long End Type Private Type VAULT_ITEM_ELEMENT SchemaElementId As VAULT_SCHEMA_ELEMENT_ID Unknown As Long ItemValue As VAULT_VARIANT End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type VAULT_ITEM_W8 SchemaId As GUID pszCredentialFriendlyName As Long pResourceElement As Long ' VAULT_ITEM_ELEMENT pIdentityElement As Long ' VAULT_ITEM_ELEMENT pAuthenticatorElement As Long ' VAULT_ITEM_ELEMENT pPackageSid As Long ' VAULT_ITEM_ELEMENT LastModified As FILETIME dwFlags As Long dwPropertiesCount As Long pPropertyElements As Long ' VAULT_ITEM_ELEMENT End Type Private Type VAULT_ITEM_W7 SchemaId As GUID pszCredentialFriendlyName As Long pResourceElement As Long ' VAULT_ITEM_ELEMENT pIdentityElement As Long ' VAULT_ITEM_ELEMENT pAuthenticatorElement As Long ' VAULT_ITEM_ELEMENT LastModified As FILETIME dwFlags As Long dwPropertiesCount As Long pPropertyElements As Long ' VAULT_ITEM_ELEMENT End Type Const WEB_CREDENTIALS As String = "{4BF4C442-9B8A-41A0-B380-DD4A704DDB28}" Const VAULT_ENUMERATE_ALL_ITEMS = 512 Public Function GetVaultCredentials() As String Dim tGUID As GUID Dim hVault As Long Dim ItemsCount As Long, i As Long Dim Items As Long Dim VI_W8() As VAULT_ITEM_W8 Dim dwError As Long Dim ppCredentials As Long 'VAULT_ITEM_W8 Dim tVIE As VAULT_ITEM_ELEMENT Dim sResult As String Dim tItemVault As VAULT_ITEM_W8 CLSIDFromString StrPtr(WEB_CREDENTIALS), tGUID If VaultOpenVault(tGUID, 0, hVault) <> 0 Then Exit Function Call VaultEnumerateItems(hVault, 0, ItemsCount, Items) ReDim VI_W8(ItemsCount - 1) CopyMemory VI_W8(0), ByVal Items, Len(VI_W8(0)) * ItemsCount For i = 0 To ItemsCount - 1 If VI_W8(i).dwPropertiesCount <> 0 Then dwError = VaultGetItem(hVault, VI_W8(i).SchemaId, VI_W8(i).pResourceElement, VI_W8(i).pIdentityElement, 0&, 0&, 0&, ppCredentials) If dwError = 0 Then sResult = sResult & "Account: " & PtrToString(VI_W8(i).pszCredentialFriendlyName) CopyMemory tVIE, ByVal VI_W8(i).pResourceElement, Len(tVIE) sResult = sResult & " URL: " & PtrToString(tVIE.ItemValue.lpString) CopyMemory tVIE, ByVal VI_W8(i).pIdentityElement, Len(tVIE) sResult = sResult & " User: " & PtrToString(tVIE.ItemValue.lpString) CopyMemory tItemVault, ByVal ppCredentials, Len(tItemVault) CopyMemory tVIE, ByVal tItemVault.pAuthenticatorElement, Len(tVIE) sResult = sResult & " Pass: " & PtrToString(tVIE.ItemValue.lpString) & vbCrLf VaultFree (ppCredentials) ppCredentials = 0 End If End If Next VaultCloseVault (hVault) GetVaultCredentials = sResult End Function Private Function PtrToString(lpwString As Long) As String Dim Buffer() As Byte Dim nLen As Long If lpwString Then nLen = lstrlenW(lpwString) * 2 If nLen Then ReDim Buffer(0 To (nLen - 1)) As Byte CopyMemory Buffer(0), ByVal lpwString, nLen PtrToString = Buffer End If End If End Function Private Sub Form_Load() Text1.Text = GetVaultCredentials End Sub
Broder no puedo imaginar el esfuerzo que haz puesto para lograr esto sin embargo imagino lo feliz que estabas cuando terminaste tu proyecto, gracias por compartir