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