1Imports System
2Imports System.Text
3Imports System.Runtime.InteropServices
4Imports System.ComponentModel
5Imports Microsoft.VisualBasic
6
7Public Module RdpEncrypt
8
9    Public Class DPAPI
10        <DllImport("crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
11        Private Shared Function CryptProtectData( _
12            ByRef pPlainText As DATA_BLOB, _
13            ByVal szDescription As String, _
14            ByRef pEntropy As DATA_BLOB, _
15            ByVal pReserved As IntPtr, _
16            ByRef pPrompt As CRYPTPROTECT_PROMPTSTRUCT, _
17            ByVal dwFlags As Integer, _
18            ByRef pCipherText As DATA_BLOB _
19        ) As Boolean
20        End Function
21
22        <DllImport("crypt32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
23        Private Shared Function CryptUnprotectData( _
24            ByRef pCipherText As DATA_BLOB, _
25            ByRef pszDescription As String, _
26            ByRef pEntropy As DATA_BLOB, _
27            ByVal pReserved As IntPtr, _
28            ByRef pPrompt As CRYPTPROTECT_PROMPTSTRUCT, _
29            ByVal dwFlags As Integer, _
30            ByRef pPlainText As DATA_BLOB _
31        ) As Boolean
32        End Function
33
34        <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
35        Friend Structure DATA_BLOB
36            Public cbData As Integer
37            Public pbData As IntPtr
38        End Structure
39
40        <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
41        Friend Structure CRYPTPROTECT_PROMPTSTRUCT
42            Public cbSize As Integer
43            Public dwPromptFlags As Integer
44            Public hwndApp As IntPtr
45            Public szPrompt As String
46        End Structure
47
48        Private Const CRYPTPROTECT_UI_FORBIDDEN As Integer = 1
49        Private Const CRYPTPROTECT_LOCAL_MACHINE As Integer = 4
50
51        Private Shared Sub InitPrompt _
52        ( _
53            ByRef ps As CRYPTPROTECT_PROMPTSTRUCT _
54        )
55            ps.cbSize = Marshal.SizeOf(GetType(CRYPTPROTECT_PROMPTSTRUCT))
56            ps.dwPromptFlags = 0
57            ps.hwndApp = IntPtr.Zero
58            ps.szPrompt = Nothing
59        End Sub
60
61        Private Shared Sub InitBLOB _
62        ( _
63            ByVal data As Byte(), _
64            ByRef blob As DATA_BLOB _
65        )
66            ' Use empty array for null parameter.
67            If data Is Nothing Then
68                data = New Byte(0) {}
69            End If
70
71            ' Allocate memory for the BLOB data.
72            blob.pbData = Marshal.AllocHGlobal(data.Length)
73
74            ' Make sure that memory allocation was successful.
75            If blob.pbData.Equals(IntPtr.Zero) Then
76                Throw New Exception( _
77                        "Unable to allocate data buffer for BLOB structure.")
78            End If
79
80            ' Specify number of bytes in the BLOB.
81            blob.cbData = data.Length
82            Marshal.Copy(data, 0, blob.pbData, data.Length)
83        End Sub
84
85        Public Enum KeyType
86            UserKey = 1
87            MachineKey
88        End Enum
89
90        Private Shared defaultKeyType As KeyType = KeyType.UserKey
91
92        Public Shared Function Encrypt _
93        ( _
94            ByVal keyType As KeyType, _
95            ByVal plainText As String, _
96            ByVal entropy As String, _
97            ByVal description As String _
98        ) As String
99            If plainText Is Nothing Then
100                plainText = String.Empty
101            End If
102            If entropy Is Nothing Then
103                entropy = String.Empty
104            End If
105
106            Dim result As Byte()
107            Dim encrypted As String = ""
108            Dim i As Integer
109            result = Encrypt(keyType, _
110                             Encoding.Unicode.GetBytes(plainText), _
111                             Encoding.Unicode.GetBytes(entropy), _
112                             description)
113            For i = 0 To result.Length - 1
114                encrypted = encrypted & Convert.ToString(result(i), 16).PadLeft(2, "0").ToUpper()
115            Next
116            Return encrypted.ToString()
117        End Function
118
119        Public Shared Function Encrypt _
120        ( _
121            ByVal keyType As KeyType, _
122            ByVal plainTextBytes As Byte(), _
123            ByVal entropyBytes As Byte(), _
124            ByVal description As String _
125        ) As Byte()
126            If plainTextBytes Is Nothing Then
127                plainTextBytes = New Byte(0) {}
128            End If
129
130            If entropyBytes Is Nothing Then
131                entropyBytes = New Byte(0) {}
132            End If
133
134            If description Is Nothing Then
135                description = String.Empty
136            End If
137
138            Dim plainTextBlob As DATA_BLOB = New DATA_BLOB
139            Dim cipherTextBlob As DATA_BLOB = New DATA_BLOB
140            Dim entropyBlob As DATA_BLOB = New DATA_BLOB
141
142            Dim prompt As  _
143                    CRYPTPROTECT_PROMPTSTRUCT = New CRYPTPROTECT_PROMPTSTRUCT
144            InitPrompt(prompt)
145
146            Try
147                Try
148                    InitBLOB(plainTextBytes, plainTextBlob)
149                Catch ex As Exception
150                    Throw New Exception("Cannot initialize plaintext BLOB.", ex)
151                End Try
152
153                Try
154                    InitBLOB(entropyBytes, entropyBlob)
155                Catch ex As Exception
156                    Throw New Exception("Cannot initialize entropy BLOB.", ex)
157                End Try
158
159                Dim flags As Integer = CRYPTPROTECT_UI_FORBIDDEN
160
161                If keyType = keyType.MachineKey Then
162                    flags = flags Or (CRYPTPROTECT_LOCAL_MACHINE)
163                End If
164
165                Dim success As Boolean = CryptProtectData( _
166                                                plainTextBlob, _
167                                                description, _
168                                                entropyBlob, _
169                                                IntPtr.Zero, _
170                                                prompt, _
171                                                flags, _
172                                                cipherTextBlob)
173
174                If Not success Then
175                    Dim errCode As Integer = Marshal.GetLastWin32Error()
176
177                    Throw New Exception("CryptProtectData failed.", _
178                                    New Win32Exception(errCode))
179                End If
180
181                Dim cipherTextBytes(cipherTextBlob.cbData) As Byte
182
183                Marshal.Copy(cipherTextBlob.pbData, cipherTextBytes, 0, _
184                                cipherTextBlob.cbData)
185
186                Return cipherTextBytes
187            Catch ex As Exception
188                Throw New Exception("DPAPI was unable to encrypt data.", ex)
189            Finally
190                If Not (plainTextBlob.pbData.Equals(IntPtr.Zero)) Then
191                    Marshal.FreeHGlobal(plainTextBlob.pbData)
192                End If
193
194                If Not (cipherTextBlob.pbData.Equals(IntPtr.Zero)) Then
195                    Marshal.FreeHGlobal(cipherTextBlob.pbData)
196                End If
197
198                If Not (entropyBlob.pbData.Equals(IntPtr.Zero)) Then
199                    Marshal.FreeHGlobal(entropyBlob.pbData)
200                End If
201            End Try
202        End Function
203
204    End Class
205
206    Sub Main(ByVal args As String())
207        Try
208            Dim text As String = args(0)
209            Dim encrypted As String
210
211            encrypted = DPAPI.Encrypt(DPAPI.KeyType.MachineKey, text, Nothing, "psw")
212
213            Console.WriteLine("{0}" & Chr(13) & Chr(10), encrypted)
214
215        Catch ex As Exception
216            While Not (ex Is Nothing)
217                Console.WriteLine(ex.Message)
218                ex = ex.InnerException
219            End While
220        End Try
221    End Sub
222
223End Module
224
225