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