CryptEncrypt and CryptDecrypt

Use of the CryptEncrypt and CryptDecrypt functions are a challenge for VB programmers. The main problem is that both functions use one buffer for both their input and their output. The unencrypted data is usually a string and the encrypted data is binary. For those of us not familiar with VB, it can be frustrating getting binary data into and out from VB strings, since VB uses Unicode internally and VB tries to make things easy for us. When we want to do something differently from what VB thinks we want to do, we can get confused and frustrated.

So I wrote a VB class that does things a little differently than most or all of the other samples. I use a Byte array for the encrypted and unencrypted data buffer parameters. Doing things that way, the conversions between a String and a Byte Array seems easier.

I forget what sample I started with that resulted in this, but I am nearly certain it was the sample code from one of the MSDN articles shown below. Regardless of what I started with, what I have here is very different.

Option Explicit

Dim m_CryptoContext As Long
Dim m_KeyHandle As Long

Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_TYPE_BLOCK As Long = 1536
Private Const ALG_CLASS_DATA_ENCRYPT As Long = 24576
Private Const ALG_SID_RC2 As Long = 2
Private Const ALG_SID_SHA1 As Long = 4
' Hash algorithms
Private Const CALG_SHA1 As Long = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
' Block ciphers
Private Const CALG_RC2 As Long = ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_RC2

' CryptSetProvParam
Private Const PROV_RSA_FULL As Long = 1
' used when aquiring the provider
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
' Microsoft provider data
Private Const MS_DEFAULT_PROVIDER As String = _
"Microsoft Base Cryptographic Provider v1.0"
' used to specify not to use any salt value while deriving the key
Private Const CRYPT_NO_SALT As Long = &H10

' ---------------------------------------------------------------------------
' Declares
' ---------------------------------------------------------------------------
Private Declare Function CryptHashData Lib "advapi32.dll" _
	(ByVal hHash As Long, ByVal pbData As String, _
	ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" _
	(ByVal hProv As Long, ByVal algid As Long, _
	ByVal hKey As Long, ByVal dwFlags As Long, _
	ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" _
	(ByVal hHash As Long) As Long
Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
	Alias "CryptAcquireContextA" (ByRef phProv As Long, _
	ByVal pszContainer As String, ByVal pszProvider As String, _
	ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" _
	(ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" _
	(ByVal hProv As Long, ByVal algid As Long, _
	ByVal hBaseData As Long, ByVal dwFlags As Long, _
	ByRef phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" _
	(ByVal hKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" _
	(ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, _
	ByVal dwFlags As Long, ByVal pbData As Long, _
	ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, _
	ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, _
	ByVal pbData As Long, pdwDataLen As Long) As Long

Public Function Encrypt(ByVal Unencrypted As String, _
	ByRef Encrypted() As Byte, _
	Optional ByVal Password As String = "") As Boolean
Dim ReturnCode As Long
Dim BufferLength As Long
Dim DataLength As Long
Dim ErrorMessage As String
Dim DllError As Long
If m_CryptoContext = 0 Then
	Encrypt = False
	Exit Function
End If
DataLength = Len(Unencrypted)
' The pointer to the data is set to Null to
' determine the correct buffer size "unambiguously"
ReturnCode = CryptEncrypt(m_KeyHandle, ByVal 0&, ByVal 1&, ByVal 0&, 0, DataLength, 0)
DllError = Err.LastDllError
If CBool(ReturnCode) Then
'	DataLength now has the size required for the output
	BufferLength = DataLength
	DataLength = Len(Unencrypted)
'	copy Unencrypted to Encrypted, since CryptEncrypt
'	uses one buffer for both input and output
	Encrypted = StrConv(Unencrypted, vbFromUnicode) ' convert to ANSI
	ReDim Preserve Encrypted(BufferLength - 1) ' expand to the output size
	ReturnCode = CryptEncrypt(m_KeyHandle, ByVal 0&, ByVal 1&, ByVal 0&, _
	VarPtr(Encrypted(LBound(Encrypted))), DataLength, BufferLength)
	DllError = Err.LastDllError
	If CBool(ReturnCode) Then
		Encrypt = True ' Successful finish
	Else
		ReDim Encrypted(0)
		If GetErrorMessage(DllError, ErrorMessage) Then
			MsgBox "CryptEncrypt error: " & ErrorMessage, vbExclamation Or vbOKOnly
		Else
			MsgBox "Unknown error from CryptEncrypt", vbExclamation Or vbOKOnly
		End If
		Encrypt = False
	End If
Else
	ReDim Encrypted(0)
	If GetErrorMessage(DllError, ErrorMessage) Then
		MsgBox "CryptEncrypt error: " & ErrorMessage, vbExclamation Or vbOKOnly
	Else
		MsgBox "Unknown error from CryptEncrypt", vbExclamation Or vbOKOnly
	End If
	Encrypt = False
End If
End Function

Public Function Decrypt(Encrypted() As Byte, _
		ByRef Unencrypted As String, _
		Optional ByVal Password As String = "") As Boolean
	Dim DataLength As Long
	Dim Buffer() As Byte
	Dim ErrorMessage As String
	Dim ReturnCode As Long
	Dim DllError As Long
If m_CryptoContext = 0 Then
	Exit Function
End If
DataLength = UBound(Encrypted) - LBound(Encrypted) + 1
Buffer = Encrypted ' Copy to buffer so as to not change the parameter
' Buffer has the input and will also have the output
ReturnCode = CryptDecrypt(m_KeyHandle, 0, 1, 0, VarPtr(Buffer(LBound(Buffer))), DataLength)
DllError = Err.LastDllError
If DataLength = 0 Then
	MsgBox "No Decrypted data", vbExclamation Or vbOKOnly
	Decrypt = False ' Unsuccessful
	Exit Function
End If
If CBool(ReturnCode) Then
	ReDim Preserve Buffer(DataLength - 1) ' reduce to string size
	Unencrypted = StrConv(Buffer, vbUnicode) ' convert to Unicode
	Decrypt = True ' Successful
Else
	If GetErrorMessage(DllError, ErrorMessage) Then
		MsgBox "CryptDecrypt error: " & ErrorMessage, vbExclamation Or vbOKOnly
	Else
		MsgBox "Unknown error from CryptDecrypt", vbExclamation Or vbOKOnly
	End If
	Decrypt = False ' Unsuccessful
End If
End Function

Public Function AcquireContext() As Boolean
	Dim Provider As String
	Dim ErrorMessage As String
	Dim ReturnCode As Long
	Dim DllError As Long
On Error Resume Next
Provider = MS_DEFAULT_PROVIDER & vbNullChar
ReturnCode = CryptAcquireContext(m_CryptoContext, ByVal vbNullString, _
	ByVal Provider, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
DllError = Err.LastDllError
If CBool(ReturnCode) Then
	AcquireContext = True
	Exit Function
End If
If GetErrorMessage(DllError, ErrorMessage) Then
	MsgBox "CryptAcquireContext error: " & ErrorMessage, vbExclamation Or vbOKOnly
Else
	MsgBox "Unknown error from CryptAcquireContext", vbExclamation Or vbOKOnly
End If
m_CryptoContext = 0
AcquireContext = False
End Function

Public Sub ReleaseContext()
CryptReleaseContext m_CryptoContext, ByVal 0&
m_CryptoContext = 0
End Sub

Private Function ShowEncrypted(Encrypted() As Byte) As String
	Dim Message As String
	Dim i As Integer
For i = LBound(Encrypted) To UBound(Encrypted)
	Message = Message + " " + Hex(Encrypted(i))
Next
ShowEncrypted = Message
End Function

Public Function ResetPassword() As Boolean
ResetPassword = CBool(CryptDestroyKey(m_KeyHandle))
End Function

Public Function SetPassword(ByVal Password As String) As Boolean
	Dim ErrorMessage As String
	Dim HashHandle As Long ' Hash handle
	Dim ReturnCode As Long
	Dim DllError As Long
	Dim HashType As Long
	Dim AlgorithmType As Long
HashType = CALG_SHA1
AlgorithmType = CALG_RC2
On Error Resume Next
' Initiate hashing
ReturnCode = CryptCreateHash(m_CryptoContext, HashType, ByVal 0&, ByVal 0&, HashHandle)
DllError = Err.LastDllError
If Not CBool(ReturnCode) Then
	If GetErrorMessage(DllError, ErrorMessage) Then
		MsgBox "CryptCreateHash error: " & ErrorMessage, vbExclamation Or vbOKOnly
	Else
		MsgBox "Unknown error from CryptCreateHash", vbExclamation Or vbOKOnly
	End If
	m_KeyHandle = 0
	SetPassword = False
	Exit Function
End If
If HashHandle = 0 Then
	MsgBox "Hash handle is zero", vbExclamation Or vbOKOnly
	m_KeyHandle = 0
	SetPassword = False
	Exit Function
End If
' Add the password to the hash
ReturnCode = CryptHashData(HashHandle, Password, Len(Password), ByVal 0&)
DllError = Err.LastDllError
If Not CBool(ReturnCode) Then
	If GetErrorMessage(DllError, ErrorMessage) Then
		MsgBox "CryptHashData error: " & ErrorMessage, vbExclamation Or vbOKOnly
	Else
		MsgBox "Unknown error from CryptHashData", vbExclamation Or vbOKOnly
	End If
	CryptDestroyHash HashHandle
	m_KeyHandle = 0
	SetPassword = False
	Exit Function
End If
' Generate a cryptographic session key
ReturnCode = CryptDeriveKey(m_CryptoContext, AlgorithmType, HashHandle, ByVal CRYPT_NO_SALT, m_KeyHandle)
DllError = Err.LastDllError
If Not CBool(ReturnCode) Then
	If GetErrorMessage(DllError, ErrorMessage) Then
		MsgBox "CryptDeriveKey error: " & ErrorMessage, vbExclamation Or vbOKOnly
	Else
		MsgBox "Unknown error from CryptDeriveKey", vbExclamation Or vbOKOnly
	End If
	CryptDestroyHash HashHandle
	m_KeyHandle = 0
	SetPassword = False
	Exit Function
End If
If m_KeyHandle = 0 Then
	MsgBox "Key handle is zero", vbExclamation Or vbOKOnly
	CryptDestroyHash HashHandle
	m_KeyHandle = 0
	SetPassword = False
	Exit Function
End If
'
CryptDestroyHash HashHandle
SetPassword = True
End Function

The LogOnOff.ZIP file has a sample project with the class and that uses the class. The project has a single form that works like a logon form. It encrypts a password and stores the encrypted password in the registry.

References

MSDN

• The Cryptography API, or How to Keep a Secret
• How to encrypt a string in Visual Basic 6.0 and how to decrypt the string in Visual Basic .NET
• Technical Article "A Cryptographic Filter Box Class in Visual Basic"; I think it is in the archives somewhere

FreeVBCode

• CryptoAPI Demo Version 1.7
• Encryption using CryptoAPI
• VB COM Wrappers for the CryptoAPI
• CryptoAPI Wrapper
• Encryption Module

Code Toad

• CodeToad - Visual Basic CryptoAPI Demo Version 1.7.

Binaryworld

• Working with Crypto API to encrypt/decrypt text
• Encrypt/Decrypt file using Microsoft Crypto APIs

See my Visual C++ Programmer Stuff page for more C++ stuff.