Binaryworld - Working with Crypto API to encrypt/decrypt text ... [ VB -> Cryptography ]

This article uses the CRYPTOAPI sample application to demonstrate how to decrypt or encrypt data.

For more information check MSDN article

MSDN Article : The Cryptography API, or How to Keep a Secret

Here is the basic steps to encrypt/decrypt data using Crypto APIs

[Step-1] Initiating the Cryptography Service Provider (CSP): CryptAcquireContext, CryptReleaseContext
The CryptAcquireContext function is used to obtain a handle to a particular key container within a particular CSP. This returned handle can then be used to make calls to the selected CSP.

At the end of encryption/decryption you can call the CryptReleaseContext function to release the handle returned from a call to CryptAcquireContext.

[Step-2] Hashing Data: CryptCreateHash, CryptHashData, CryptGetHashParam, and CryptDestroyHash
"hashing" or "hash," refers to the method or algorithm used to derive a numeric value from a piece of data. In our case we will derive a numeric value (Hash) from our password which will be used to encrypt/decrypt the data and then this Hash value will be used to generate session key which we will see in the next step.

To get hash value from Password first create a hash object using CryptCreateHash then you can call CryptHashData to get hash value derived from your password.

[Step-3] Generating Keys: CryptDeriveKey, CryptGenKey, CryptDestroyKey
These three functions are the ones used to generate handles to keys:

The CryptDeriveKey function is used to generate a key from a specified password.
The CryptGenKey function is used to generate a key from random generated data.
The CryptDestroyKey function is used to release the handle to the key object.

[Step-4] Encrypting and Decrypting Data: CryptEncrypt, CryptDecrypt
In this step you prepare Buffer for Plain text or Cipher text (Encrypted text) for CryptEncrypt/CryptDecrypt call and then you can call CryptEncrypt for encryption or CryptDecrypt for decryption.

[Step-5] Cleanup : CryptDestroyKey, CryptDestroyHash, CryptReleaseContext
Once you are done with encryption/decryption you have to do cleanup of resources taken by Crypto Apis. Cleanup requires the following steps
- Destroy session key using CryptDestroyKey
- Destroy key exchange key handle using CryptDestroyKey
- Destroy hash object using CryptDestroyHash
- Release Context provider handle using CryptReleaseContext

Step-By-Step Example

- Create a standard exe project
- Add three textbox controls and one command button control on the form1. Set Multine=True for Text1 and Text2
- Add the following code in form1

Click here to copy the following block

Private Const CRYPT_NEWKEYSET = &H8

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
    phProv As Long, pszContainer As String, pszProvider As String, _
    ByVal dwProvType 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, phHash As Long) As Long

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 CryptDeriveKey Lib "advapi32.dll" ( _
    ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, _
    phKey As Long) As Long

Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash 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 String, _
    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 String, _
    pdwDataLen As Long) As Long

Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, _
    ByVal dwFlags As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

'constants for Cryptography API functions
Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_DATA_ENCRYPT = 24576
Private Const ALG_CLASS_HASH = 32768

Private Const ALG_TYPE_ANY = 0
Private Const ALG_TYPE_BLOCK = 1536
Private Const ALG_TYPE_STREAM = 2048

Private Const ALG_SID_RC2 = 2

Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_MD5 = 3
Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2)
Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)

Private Const ENCRYPT_ALGORITHM = CALG_RC4
Private Const ENCRYPT_BLOCK_SIZE = 1

Private Const CRYPT_EXPORTABLE = 1

Public Function DoCryptoEncrypt(sPassword As String, PlainText As String) As String

  Dim lHHash As Long
  Dim lHkey As Long
  Dim lResult As Long
  Dim lHExchgKey As Long
  Dim lHCryptprov As Long

  Dim sContainer As String
  Dim lCryptLength As Long
  Dim lCryptBufLen As Long
  Dim sCryptBuffer As String

  On Error GoTo EncryptError

  Dim sOutputBuffer As String

  Dim sProvider

  'Get handle to the default CSP
  sProvider = MS_DEF_PROV & vbNullChar

  If Len(PlainText) = 0 Then
    DoCryptoEncrypt = ""
    Exit Function
  End If

  sOutputBuffer = ""

  If Not CBool(CryptAcquireContext(lHCryptprov, ByVal _
      sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
    ' If there is no default key container then create one
    ' using Flags field
    If GetLastError = 0 Then
      If Not CBool(CryptAcquireContext(lHCryptprov, 0&, ByVal sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
        sOutputBuffer = PlainText
        GoTo Finished
      End If
    End If
  End If

  'Create a hash object
  If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, _
      0, lHHash)) Then
    MsgBox ("Error " & CStr(GetLastError) & _
        " during CryptCreateHash!")
    GoTo Finished
  End If

  'Hash in the password text
  If Not CBool(CryptHashData(lHHash, sPassword, _
      Len(sPassword), 0)) Then
    MsgBox ("Error " & CStr(GetLastError) & _
        " during CryptHashData!")
    GoTo Finished
  End If

  'Create a session key from the hash object.
  If Not CBool(CryptDeriveKey(lHCryptprov, _
      ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
    MsgBox ("Error " & CStr(GetLastError) & _
        " during CryptDeriveKey!")
    GoTo Finished
  End If

  'Destroy the hash object.
  CryptDestroyHash (lHHash)
  lHHash = 0

  'Create a buffer for the CryptEncrypt function
  lCryptLength = Len(PlainText)
  lCryptBufLen = lCryptLength * 2
  sCryptBuffer = String(lCryptBufLen, vbNullChar)
  LSet sCryptBuffer = PlainText

  'Encrypt the text data
  If Not CBool(CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, _
      lCryptLength, lCryptBufLen)) Then
    MsgBox ("bytes required:" & CStr(lCryptLength))
    MsgBox ("Error " & CStr(GetLastError) & _
        " during CryptEncrypt!")
  End If

  sOutputBuffer = Mid$(sCryptBuffer, 1, lCryptLength)

Finished:
  'Outa here
  DoCryptoEncrypt = sOutputBuffer

  'Destroy session key.
  If (lHkey) Then lResult = CryptDestroyKey(lHkey)

  'Destroy key exchange key handle
  If lHExchgKey Then CryptDestroyKey (lHExchgKey)

  'Destroy hash object
  If lHHash Then CryptDestroyHash (lHHash)

  'Release Context provider handle
  If lHCryptprov Then lResult = _
      CryptReleaseContext(lHCryptprov, 0)

  Exit Function

EncryptError:

  MsgBox ("Encrypt Error: " & Error$)

  GoTo Finished

End Function

Public Function DoCryptoDecrypt(sPassword As String, CryptText As String) As String

  Dim lHExchgKey As Long
  Dim lHCryptprov As Long
  Dim lHHash As Long
  Dim lHkey As Long
  Dim lResult As Long

  Dim sContainer As String
  Dim sProvider As String

  Dim sCryptBuffer As String
  Dim lCryptBufLen As Long
  Dim lCryptPoint As Long

  Dim lPasswordPoint As Long
  Dim lPasswordCount As Long

  Dim sOutputBuffer As String

  On Error GoTo DecryptError

  If Len(CryptText) = 0 Then
    DoCryptoDecrypt = ""
    Exit Function
  End If
  'Clear the Output buffer
  sOutputBuffer = ""

  'Get handle to the default CSP.
  sContainer = vbNullChar
  sProvider = vbNullChar
  sProvider = MS_DEF_PROV & vbNullChar
  If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
    If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
      'MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext! ")"
      sOutputBuffer = CryptText
      GoTo Finished
    End If
  End If

  'Create a hash object
  If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash! ")
    GoTo Finished
  End If

  'Hash in the password text
  If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
    GoTo Finished
  End If

  'Create a session key from the hash object
  If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
    MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
    GoTo Finished
  End If

  'Destroy the hash object.
  CryptDestroyHash (lHHash)
  lHHash = 0

  'Prepare sCryptBuffer for CryptDecrypt
  lCryptBufLen = Len(CryptText) * 2
  sCryptBuffer = String(lCryptBufLen, vbNullChar)
  LSet sCryptBuffer = CryptText

  'Decrypt data
  If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen)) Then
    MsgBox ("bytes required:" & CStr(lCryptBufLen))
    MsgBox ("Error " & CStr(GetLastError) & " during CryptDecrypt!")
    GoTo Finished
  End If

  'Setup output buffer with just decrypted data
  sOutputBuffer = Mid$(sCryptBuffer, 1, lCryptBufLen / 2)

Finished:
  'Outa here
  DoCryptoDecrypt = sOutputBuffer

  'Destroy session key
  If (lHkey) Then lResult = CryptDestroyKey(lHkey)

  'Destroy key exchange key handle
  If lHExchgKey Then CryptDestroyKey (lHExchgKey)

  'Destroy hash object
  If lHHash Then CryptDestroyHash (lHHash)

  'Release Context provider handle
  If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)

  Exit Function

DecryptError:
  MsgBox ("Decrypt Error: " & Error$)
  GoTo Finished
End Function

Private Sub Command1_Click()
  Dim MyEncryptedMsg As String
  Dim MyKey As String
  Dim MyClearTextMsg As String
  Dim MyClearTextMsgBackAgain As String

  MyKey = Text3

  If Command1.Caption = "Encrypt Message" Then
    '//Encrypt
    MyClearTextMsg = Text1
    MyEncryptedMsg = DoCryptoEncrypt(MyKey, MyClearTextMsg)
    Command1.Caption = "Decrypt Message"
    Text2 = MyEncryptedMsg
  Else
    '//Decrypt
    MyEncryptedMsg = Text2
    MyClearTextMsgBackAgain = DoCryptoDecrypt(MyKey, MyEncryptedMsg)
    Command1.Caption = "Encrypt Message"
    Text2 = MyClearTextMsgBackAgain
  End If
End Sub

Private Sub Form_Load()
  '//Some text which we want to encrypt
  Text1 = "Our mission time is 9.00 PM" & vbCrLf & _
      "Mission Code : ROYALBLUE-1" & vbCrLf & _
      "Main Gate Password : 22789001"

  Text3 = "MYSECRETPASS123"  '//This is secrete key which will be used to encrypt/decrypt our message
  Command1.Caption = "Encrypt Message"
End Sub