Encrypting RDP Passwords in VB.NET

2 May

Justin Shepard converted my code to encrypt RPD passwords to VB.NET:

'======SOF
 
Imports System
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports Microsoft.VisualBasic
 
Public Module RdpEncrypt
 
    Public Class DPAPI
&lt;dllimport&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
 
&lt;dllimport&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
 
&lt;structlayout&gt; _
        Friend Structure DATA_BLOB
            Public cbData As Integer
            Public pbData As IntPtr
        End Structure
 
&lt;structlayout&gt; _
        Friend Structure CRYPTPROTECT_PROMPTSTRUCT
            Public cbSize As Integer
            Public dwPromptFlags As Integer
            Public hwndApp As IntPtr
            Public szPrompt As String
        End Structure
 
        Private Const CRYPTPROTECT_UI_FORBIDDEN As Integer = 1
        Private Const CRYPTPROTECT_LOCAL_MACHINE As Integer = 4
 
        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
 
        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
 
        Public Enum KeyType
            UserKey = 1
            MachineKey
        End Enum
 
        Private Shared defaultKeyType As KeyType = KeyType.UserKey
 
        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 result As Byte()
            Dim encrypted As String = ""
            Dim i As Integer
            result = Encrypt(keyType, _
                             Encoding.Unicode.GetBytes(plainText), _
                             Encoding.Unicode.GetBytes(entropy), _
                             description)
            For i = 0 To result.Length - 1
                encrypted = encrypted &amp; Convert.ToString(result(i), 16).PadLeft(2, "0").ToUpper()
            Next
            Return encrypted.ToString()
        End Function
 
        Public Shared Function Encrypt _
        ( _
            ByVal keyType As KeyType, _
            ByVal plainTextBytes As Byte(), _
            ByVal entropyBytes As Byte(), _
            ByVal description As String _
        ) As Byte()
            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
 
            Dim plainTextBlob As DATA_BLOB = New DATA_BLOB
            Dim cipherTextBlob As DATA_BLOB = New DATA_BLOB
            Dim entropyBlob As DATA_BLOB = New DATA_BLOB
 
            Dim prompt As  _
                    CRYPTPROTECT_PROMPTSTRUCT = New CRYPTPROTECT_PROMPTSTRUCT
            InitPrompt(prompt)
 
            Try
                Try
                    InitBLOB(plainTextBytes, plainTextBlob)
                Catch ex As Exception
                    Throw New Exception("Cannot initialize plaintext BLOB.", ex)
                End Try
 
                Try
                    InitBLOB(entropyBytes, entropyBlob)
                Catch ex As Exception
                    Throw New Exception("Cannot initialize entropy BLOB.", ex)
                End Try
 
                Dim flags As Integer = CRYPTPROTECT_UI_FORBIDDEN
 
                If keyType = keyType.MachineKey Then
                    flags = flags Or (CRYPTPROTECT_LOCAL_MACHINE)
                End If
 
                Dim success As Boolean = CryptProtectData( _
                                                plainTextBlob, _
                                                description, _
                                                entropyBlob, _
                                                IntPtr.Zero, _
                                                prompt, _
                                                flags, _
                                                cipherTextBlob)
 
                If Not success Then
                    Dim errCode As Integer = Marshal.GetLastWin32Error()
 
                    Throw New Exception("CryptProtectData failed.", _
                                    New Win32Exception(errCode))
                End If
 
                Dim cipherTextBytes(cipherTextBlob.cbData) As Byte
 
                Marshal.Copy(cipherTextBlob.pbData, cipherTextBytes, 0, _
                                cipherTextBlob.cbData)
 
                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
 
    End Class
 
    Sub Main(ByVal args As String())
        Try
            Dim text As String = args(0)
            Dim encrypted As String
 
            encrypted = DPAPI.Encrypt(DPAPI.KeyType.MachineKey, text, Nothing, "psw")
 
            Console.WriteLine("{0}" &amp; Chr(13) &amp; Chr(10), encrypted)
 
        Catch ex As Exception
            While Not (ex Is Nothing)
                Console.WriteLine(ex.Message)
                ex = ex.InnerException
            End While
        End Try
    End Sub
 
End Module
'======EOF

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

'======SOF

Imports System

Imports System.Text

Imports System.Runtime.InteropServices

Imports System.ComponentModel

Imports Microsoft.VisualBasic

Public Module RdpEncrypt

Public Class DPAPI

<dllimport> _

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

<dllimport> _

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

<structlayout> _

Friend Structure DATA_BLOB

Public cbData As Integer

Public pbData As IntPtr

End Structure

<structlayout> _

Friend Structure CRYPTPROTECT_PROMPTSTRUCT

Public cbSize As Integer

Public dwPromptFlags As Integer

Public hwndApp As IntPtr

Public szPrompt As String

End Structure

Private Const CRYPTPROTECT_UI_FORBIDDEN As Integer = 1

Private Const CRYPTPROTECT_LOCAL_MACHINE As Integer = 4

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

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

Public Enum KeyType

UserKey = 1

MachineKey

End Enum

Private Shared defaultKeyType As KeyType = KeyType.UserKey

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 result As Byte()

Dim encrypted As String = ""

Dim i As Integer

result = Encrypt(keyType, _

Encoding.Unicode.GetBytes(plainText), _

Encoding.Unicode.GetBytes(entropy), _

description)

For i = 0 To result.Length - 1

encrypted = encrypted & Convert.ToString(result(i), 16).PadLeft(2, "0").ToUpper()

Return encrypted.ToString()

End Function

Public Shared Function Encrypt _

( _

ByVal keyType As KeyType, _

ByVal plainTextBytes As Byte(), _

ByVal entropyBytes As Byte(), _

ByVal description As String _

) As Byte()

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

Dim plainTextBlob As DATA_BLOB = New DATA_BLOB

Dim cipherTextBlob As DATA_BLOB = New DATA_BLOB

Dim entropyBlob As DATA_BLOB = New DATA_BLOB

Dim prompt As _

CRYPTPROTECT_PROMPTSTRUCT = New CRYPTPROTECT_PROMPTSTRUCT

InitPrompt(prompt)

Try

InitBLOB(plainTextBytes, plainTextBlob)

Catch ex As Exception

Throw New Exception("Cannot initialize plaintext BLOB.", ex)

End Try

Try

InitBLOB(entropyBytes, entropyBlob)

Catch ex As Exception

Throw New Exception("Cannot initialize entropy BLOB.", ex)

End Try

Dim flags As Integer = CRYPTPROTECT_UI_FORBIDDEN

If keyType = keyType.MachineKey Then

flags = flags Or (CRYPTPROTECT_LOCAL_MACHINE)

End If

Dim success As Boolean = CryptProtectData( _

plainTextBlob, _

description, _

entropyBlob, _

IntPtr.Zero, _

prompt, _

flags, _

cipherTextBlob)

If Not success Then

Dim errCode As Integer = Marshal.GetLastWin32Error()

Throw New Exception("CryptProtectData failed.", _

New Win32Exception(errCode))

End If

Dim cipherTextBytes(cipherTextBlob.cbData) As Byte

Marshal.Copy(cipherTextBlob.pbData, cipherTextBytes, 0, _

cipherTextBlob.cbData)

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

End Class

Sub Main(ByVal args As String())

Try

Dim text As String = args(0)

Dim encrypted As String

encrypted = DPAPI.Encrypt(DPAPI.KeyType.MachineKey, text, Nothing, "psw")

Console.WriteLine("{0}" & Chr(13) & Chr(10), encrypted)

Catch ex As Exception

While Not (ex Is Nothing)

Console.WriteLine(ex.Message)

ex = ex.InnerException

End While

End Try

End Sub

End Module

'======EOF

Please consider donating something (even a small amount is ok) to support this site and my work:

Filed under: Uncategorized

2 Responses for "Encrypting RDP Passwords in VB.NET"

James July 5th, 2010 at 9:32 1
Hi friends, anyone know where I can find the code to decrypt in vb.net? Thanks for your help
Anthony July 5th, 2010 at 14:07 2
Please, I need this function too!!