Binaryworld - Encrypt/Decrypt file using Microsoft Crypto APIs (With User specific c ... [ VB -> Cryptography ]

In our previous article Working with Crypto API to encrypt/decrypt text we saw that how to use Microsoft Crypto apis to encrypt/decrypt the data using userdefined secret password. In this code we will see how to encrypt file content eventhough password is not specified. Yes it is possible to derive a current user specific cryptographic key which is only valid for current user. This cryptographic key can be exported and imported for encryption purpose. You can store this key in file or registry so you can use it for encryption/decryption. There are few steps to export user specific cryptographic key to key BLOB (Key BLOB is storage out side of CSP).

Steps for Generating/Exporting user specific Cryptographic key

Create a random session key using CryptGenKey
Get a handle to the key exchange key using CryptGetUserKey and with AT_KEYEXCHANGE option.
Determine the size of the key BLOB and allocate memory. Call CryptExportKey with pbData=NULL to determine the size of key BLOB
Export the key into a simple key BLOB by calling CryptExportKey again with pbData parameter.
Save key BLOB on the disk file or registry so you can use it later to encrypt/decrypt data. In our example its stored in encrypted file it self at the beginning of the file.
Destroy the key exchange key handle by calling CryptDestroyKey.

Step-By-Step Example

- Create a standard exe project
- Add class module and rename it to clsCryptFile
- Add 3 textbox controls, one command button, one picture box and two option button controls on the form1
- Add the following code in form1

Note : Try to run the demo with blank password to encrypt the data. This option will store cryptographic key in the file which is valid only for the user who encrypted the data so if a file encrypted by me with blank password can not be decrypted by different user eventhough cryptographic key is stored in file itself. Read MSDN Documentation for more information

Form1.frm

Click here to copy the following block

Option Explicit

Private WithEvents cCrypt As clsCryptFile

Private Sub ShowProgress(ByVal sngPercent As Single)
  Dim strCaption As String
  Dim intX    As Integer
  Dim intY    As Integer
  Dim intWidth  As Integer
  Dim intHeight As Integer
  Dim intPercent As Integer

  With Picture1
    .ForeColor = &H800000
    .BackColor = &HFFFFFF
  End With

  intPercent = Int(100 * sngPercent + 0.5)

  strCaption = Format$(intPercent) & "%"
  intWidth = Picture1.TextWidth(strCaption)
  intHeight = Picture1.TextHeight(strCaption)

  intX = (Picture1.Width - intWidth) / 2
  intY = (Picture1.Height - intHeight) / 2

  '  Picture1.DrawMode = 13
  '  Picture1.Line (intX, intY)-Step(intWidth, intHeight), Picture1.BackColor, BF

  With Picture1
    .CurrentX = intX
    .CurrentY = intY
  End With
  Picture1.Print strCaption

  Picture1.DrawMode = 10
  Picture1.Line (0, 0)-(Picture1.ScaleWidth * sngPercent, Picture1.ScaleHeight), Picture1.ForeColor, BF
  Picture1.Refresh
End Sub

Private Sub cCrypt_Crypted()
  Picture1.Visible = False
End Sub

Private Sub cCrypt_Crypting(ByVal CryptBytes As Long, ByVal FileBytes As Long)
  Call ShowProgress(Round(CryptBytes / FileBytes, 2))
  If Option1.Value = True Then
    Me.Caption = "Encryption " & Round(CryptBytes / FileBytes, 2) * 100 & " % Completed"
  Else
    Me.Caption = "Decryption " & Round(CryptBytes / FileBytes, 2) * 100 & " % Completed"
  End If
End Sub

Private Sub Command1_Click()
  If Text1.Text = "" Then
    MsgBox "Please secify the source file to encrypt/decrypt", vbCritical, Me.Caption
    Exit Sub
  End If
  If Dir(Text1.Text) = "" Then
    MsgBox "Input File does not exsist", vbCritical, Me.Caption
    Exit Sub
  End If

  If Text1.Text = Text2.Text Then
    MsgBox "Source file and Destination fil both are same. Please choose different path for output file", vbCritical, Me.Caption
    Exit Sub
  End If
  If Text2.Text = "" Then
    MsgBox "Please specify output file name", vbCritical, Me.Caption
    Exit Sub
  End If

  If Dir(Text2.Text) <> "" Then
    If MsgBox("Output file already exist. Do you want to overwrite it?" _
        , vbYesNo + vbExclamation, Me.Caption) = vbNo Then
      Exit Sub
    End If
    Kill Text2.Text
  End If

  Picture1.Visible = True
  Picture1.Cls

  With cCrypt
    .InFile = Text1.Text
    .OutFile = Text2.Text
    .Password = Text3.Text
    If Option1.Value Then
      If .Encrypt Then
        MsgBox "Encrypted successfully", vbInformation, Me.Caption
      Else
        MsgBox "Error in Encrypt", vbCritical, Me.Caption
      End If
    Else
      If .Decrypt Then
        MsgBox "Decrypted successfully", vbInformation, Me.Caption
      Else
        MsgBox "Error in Decrypt", vbCritical, Me.Caption
      End If
    End If
  End With
End Sub

Private Sub Form_Load()
  Set cCrypt = New clsCryptFile
  Picture1.AutoRedraw = True
  Picture1.ScaleMode = vbPixels

  Text1.Text = App.Path & "\" & "demo.txt"
  Text2.Text = App.Path & "\" & "demo_enc.txt"
  Option1.Value = True
  Command1.Caption = "Encrypt File"
End Sub

Private Sub Option1_Click()
  Command1.Caption = "Encrypt File"
End Sub

Private Sub Option2_Click(Index As Integer)
  Command1.Caption = "Decrypt File"
End Sub

- Add the following code in class module

clsCrypFile.cls

Click here to copy the following block

Option Explicit

'// ALG_ID crackers
'#define GET_ALG_CLASS(x)        (x & (7 << 13))
'#define GET_ALG_TYPE(x)         (x & (15 << 9))
'#define GET_ALG_SID(x)         (x & (511))

'// Algorithm classes
Private Const ALG_CLASS_ANY = 0  ' (0)
Private Const ALG_CLASS_SIGNATURE = 8192  ' (1 << 13)
Private Const ALG_CLASS_MSG_ENCRYPT = 16384  ' (2 << 13)
Private Const ALG_CLASS_DATA_ENCRYPT = 24576  ' (3 << 13)
Private Const ALG_CLASS_HASH = 32768  ' (4 << 13)
Private Const ALG_CLASS_KEY_EXCHANGE = 40960  ' (5 << 13)

'// Algorithm types
Private Const ALG_TYPE_ANY = 0  ' (0)
Private Const ALG_TYPE_DSS = 512  ' (1 << 9)
Private Const ALG_TYPE_RSA = 1024  ' (2 << 9)
Private Const ALG_TYPE_BLOCK = 1536  ' (3 << 9)
Private Const ALG_TYPE_STREAM = 2048  ' (4 << 9)

'// Generic sub-ids
Private Const ALG_SID_ANY = 0  ' (0)

'// Some RSA sub-ids
Private Const ALG_SID_RSA_ANY = 0
Private Const ALG_SID_RSA_PKCS = 1
Private Const ALG_SID_RSA_MSATWORK = 2
Private Const ALG_SID_RSA_ENTRUST = 3
Private Const ALG_SID_RSA_PGP = 4

'// Some DSS sub-ids
'//
Private Const ALG_SID_DSS_ANY = 0
Private Const ALG_SID_DSS_PKCS = 1
Private Const ALG_SID_DSS_DMS = 2

'// Block cipher sub ids
'// DES sub_ids
Private Const ALG_SID_DES = 1
Private Const ALG_SID_3DES = 3
Private Const ALG_SID_DESX = 4
Private Const ALG_SID_IDEA = 5
Private Const ALG_SID_CAST = 6
Private Const ALG_SID_SAFERSK64 = 7
Private Const ALD_SID_SAFERSK128 = 8

'// KP_MODE
Private Const CRYPT_MODE_CBCI = 6  '// ANSI CBC Interleaved
Private Const CRYPT_MODE_CFBP = 7  '// ANSI CFB Pipelined
Private Const CRYPT_MODE_OFBP = 8  '// ANSI OFB Pipelined
Private Const CRYPT_MODE_CBCOFM = 9  '// ANSI CBC + OF Masking
Private Const CRYPT_MODE_CBCOFMI = 10  '// ANSI CBC + OFM Interleaved

'// RC2 sub-ids
Private Const ALG_SID_RC2 = 2

'// Stream cipher sub-ids
Private Const ALG_SID_RC4 = 1
Private Const ALG_SID_SEAL = 2

'// Hash sub ids
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA = 4
Private Const ALG_SID_MAC = 5
Private Const ALG_SID_RIPEMD = 6
Private Const ALG_SID_RIPEMD160 = 7
Private Const ALG_SID_SSL3SHAMD5 = 8

'// Our silly example sub-id
Private Const ALG_SID_EXAMPLE = 80

'// algorithm identifier definitions
Private Const CALG_MD2 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_MAC = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MAC)
Private Const CALG_RSA_SIGN = (ALG_CLASS_SIGNATURE Or ALG_TYPE_RSA Or ALG_SID_RSA_ANY)
Private Const CALG_DSS_SIGN = (ALG_CLASS_SIGNATURE Or ALG_TYPE_DSS Or ALG_SID_DSS_ANY)
Private Const CALG_RSA_KEYX = (ALG_CLASS_KEY_EXCHANGE Or ALG_TYPE_RSA Or ALG_SID_RSA_ANY)
Private Const CALG_DES = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_DES)
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 CALG_SEAL = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM Or ALG_SID_SEAL)

'// dwFlags definitions for CryptAquireContext
Private Const CRYPT_VERIFYCONTEXT = &HF0000000
Private Const CRYPT_NEWKEYSET = &H8
Private Const CRYPT_DELETEKEYSET = &H10

'// dwFlag definitions for CryptGenKey
Private Const CRYPT_EXPORTABLE = &H1
Private Const CRYPT_USER_PROTECTED = &H2
Private Const CRYPT_CREATE_SALT = &H4
Private Const CRYPT_UPDATE_KEY = &H8

'// exported key blob definitions
Private Const SIMPLEBLOB = &H1
Private Const PUBLICKEYBLOB = &H6
Private Const PRIVATEKEYBLOB = &H7

Private Const AT_KEYEXCHANGE = 1
Private Const AT_SIGNATURE = 2

Private Const CRYPT_USERDATA = 1

'// dwParam
Private Const KP_IV = 1  '// Initialization vector
Private Const KP_SALT = 2  '// Salt value
Private Const KP_PADDING = 3  '// Padding values
Private Const KP_MODE = 4  '// Mode of the cipher
Private Const KP_MODE_BITS = 5  '// Number of bits to feedback
Private Const KP_PERMISSIONS = 6  '// Key permissions DWORD
Private Const KP_ALGID = 7  '// Key algorithm
Private Const KP_BLOCKLEN = 8  '// Block size of the cipher

'// KP_PADDING
Private Const PKCS5_PADDING = 1  '// PKCS 5 (sec 6.2) padding method

'// KP_MODE
Private Const CRYPT_MODE_CBC = 1  '// Cipher block chaining
Private Const CRYPT_MODE_ECB = 2  '// Electronic code book
Private Const CRYPT_MODE_OFB = 3  '// Output feedback mode
Private Const CRYPT_MODE_CFB = 4  '// Cipher feedback mode
Private Const CRYPT_MODE_CTS = 5  '// Ciphertext stealing mode

'// KP_PERMISSIONS
Private Const CRYPT_ENCRYPT = &H1  '// Allow encryption
Private Const CRYPT_DECRYPT = &H2  '// Allow decryption
Private Const CRYPT_EXPORT = &H4  '// Allow key to be exported
Private Const CRYPT_READ = &H8  '// Allow parameters to be read
Private Const CRYPT_WRITE = &H10  '// Allow parameters to be set
Private Const CRYPT_MAC = &H20  '// Allow MACs to be used with key

Private Const HP_ALGID = &H1  '// Hash algorithm
Private Const HP_HASHVAL = &H2  '// Hash value
Private Const HP_HASHSIZE = &H4  '// Hash value size

'#define CRYPT_FAILED      FALSE
'#define CRYPT_SUCCEED      TRUE

'#define RCRYPT_SUCCEEDED(rt)   ((rt) == CRYPT_SUCCEED)
'#define RCRYPT_FAILED(rt)    ((rt) == CRYPT_FAILED)

'//
'// CryptGetProvParam
'//
Private Const PP_ENUMALGS = 1
Private Const PP_ENUMCONTAINERS = 2
Private Const PP_IMPTYPE = 3
Private Const PP_NAME = 4
Private Const PP_VERSION = 5
Private Const PP_CONTAINER = 6

Private Const CRYPT_FIRST = 1
Private Const CRYPT_NEXT = 2

Private Const CRYPT_IMPL_HARDWARE = 1
Private Const CRYPT_IMPL_SOFTWARE = 2
Private Const CRYPT_IMPL_MIXED = 3
Private Const CRYPT_IMPL_UNKNOWN = 4

'//
'// CryptSetProvParam
'//
Private Const PP_CLIENT_HWND = 1

Private Const PROV_RSA_FULL = 1
Private Const PROV_RSA_SIG = 2
Private Const PROV_DSS = 3
Private Const PROV_FORTEZZA = 4
Private Const PROV_MS_EXCHANGE = 5
Private Const PROV_SSL = 6

'//
'//STT defined Providers
'//
Private Const PROV_STT_MER = 7
Private Const PROV_STT_ACQ = 8
Private Const PROV_STT_BRND = 9
Private Const PROV_STT_ROOT = 10
Private Const PROV_STT_ISS = 11

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const OPEN_EXISTING = 3
Private Const CREATE_ALWAYS = 2

Private Declare Function CreateFile Lib "KERNEL32" Alias "CreateFileA" ( _
    ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Private Declare Function GetFileSize Lib "KERNEL32" ( _
    ByVal hFile As Long, _
    lpFileSizeHigh As Long) As Long

Private Declare Function ReadFile Lib "KERNEL32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    lpOverlapped As Long) As Long

Private Declare Function WriteFile Lib "KERNEL32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "KERNEL32" ( _
    ByVal hObject As Long) As Long

Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" ( _
    phProv As Long, _
    ByVal pszContainer As String, _
    ByVal pszProvider As String, _
    ByVal dwProvType As Long, _
    ByVal dwFlags As Long) As Long

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

Private Declare Function CryptGetUserKey Lib "advapi32.dll" ( _
    ByVal hProv As Long, _
    ByVal dwKeySpec As Long, _
    phUserKey As Long) As Long

Private Declare Function CryptExportKey Lib "advapi32.dll" ( _
    ByVal hKey As Long, _
    ByVal hExpKey As Long, _
    ByVal dwBlobType As Long, _
    ByVal dwFlags As Long, _
    pbData As Any, _
    pdwDataLen As Long) As Long

Private Declare Function CryptDestroyKey Lib "advapi32.dll" ( _
    ByVal hKey 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 cbData 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 CryptEncrypt Lib "advapi32.dll" ( _
    ByVal hKey As Long, _
    ByVal hHash As Long, _
    ByVal Final As Long, _
    ByVal dwFlags As Long, _
    pbData As Any, _
    pcbData As Long, _
    ByVal cbBuffer 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, _
    pbData As Any, _
    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 CryptDestroyHash Lib "advapi32.dll" ( _
    ByVal hHash As Long) As Long

Private Declare Function CryptImportKey Lib "advapi32.dll" ( _
    ByVal hProv As Long, _
    pbData As Any, _
    ByVal dwDataLen As Long, _
    ByVal hPubKey As Long, _
    ByVal dwFlags As Long, _
    phKey As Long) As Long

'//Progress event of encryption/decryption
Public Event Crypting(ByVal CryptBytes As Long, ByVal FileBytes As Long)

'//Raised when encryption or decryption is done
Public Event Crypted()

Private m_strInFile   As String
Private m_strOutFile  As String
Private m_strPassword As String

Private Const ENCRYPT_BLOCK_SIZE = 2
Private Const ENCRYPT_ALGORITHM = CALG_RC4
'//////////////////////////////////////////////////////////////////

Private Function EncryptFile(ByVal strFileIn As String, _
               ByVal strFileOut As String, _
               Optional ByVal strPassword As String = "") As Boolean
  Dim hProv      As Long
  Dim hKey      As Long
  Dim hXchgKey    As Long
  Dim dwKeyBlobLen  As Long
  Dim pbKeyBlob()   As Byte
  Dim hHash      As Long
  Dim dwBlockLen   As Long
  Dim dwBufferLen   As Long
  Dim pbBuffer()   As Byte
  Dim dwByte     As Long
  Dim dwWriten    As Long
  Dim lngEOF     As Long
  Dim hIn       As Long
  Dim hOut      As Long
  Dim lngFileSize   As Long
  Dim lngEncryptSize As Long

  EncryptFile = False

  If Dir(strFileIn) = "" Then GoTo done:
  hIn = CreateFile(strFileIn, _
      GENERIC_READ, _
      FILE_SHARE_READ, _
      ByVal 0, _
      OPEN_EXISTING, _
      FILE_ATTRIBUTE_NORMAL, _
      ByVal 0)

  If Dir(strFileOut) <> "" Then GoTo done:
  hOut = CreateFile(strFileOut, _
      GENERIC_WRITE, _
      FILE_SHARE_READ, _
      ByVal 0, _
      CREATE_ALWAYS, _
      FILE_ATTRIBUTE_NORMAL, _
      ByVal 0)

  If Not CBool(CryptAcquireContext(hProv, _
      ByVal vbNullString, _
      ByVal vbNullString, _
      PROV_RSA_FULL, 0)) Then

    If Not CBool(CryptAcquireContext(hProv, _
        ByVal vbNullString, _
        ByVal vbNullString, _
        PROV_RSA_FULL, _
        CRYPT_NEWKEYSET)) Then
      MsgBox "CryptAcquireContext Error!"
      GoTo done:
    End If
  End If

  '//If password is not specified then generate user public/private keys
  '//for exisiting user and store its length and actual key to the beginning of the file
  '//This key can be used only by current user only nobody else can use it to decrypt the file

  If strPassword = "" Then
    '//Create a random session key.
    If Not CBool(CryptGenKey(hProv, ENCRYPT_ALGORITHM, CRYPT_EXPORTABLE, hKey)) Then
      MsgBox "CryptGenKey Error!"
      GoTo done:
    End If

    '// Get a handle to the key exchange key.
    If Not CBool(CryptGetUserKey(hProv, AT_KEYEXCHANGE, hXchgKey)) Then
      MsgBox "CryptGetUserKey Error!"
      GoTo done:
    End If

    '// Determine the size of the key BLOB and allocate memory.
    If Not CBool(CryptExportKey(hKey, hXchgKey, SIMPLEBLOB, 0, ByVal 0, dwKeyBlobLen)) Then
      MsgBox "CryptExportKey Error!"
      GoTo done:
    End If

    If dwKeyBlobLen = 0 Then
      MsgBox "CryptExportKey Error!"
      GoTo done:
    Else
      ReDim pbKeyBlob(dwKeyBlobLen - 1)
    End If

    '//Export the key into a simple key BLOB.
    If Not CBool(CryptExportKey(hKey, hXchgKey, SIMPLEBLOB, 0, pbKeyBlob(0), dwKeyBlobLen)) Then
      MsgBox "CryptExportKey Error!"
      GoTo done:
    End If

    '//Destroy the key exchange key handle.
    Call CryptDestroyKey(hXchgKey)
    hXchgKey = 0

    '//Write length of cryptographic key (first 4 bytes in the file)
    Call WriteFile(hOut, dwKeyBlobLen, Len(dwKeyBlobLen), dwWriten, ByVal 0)

    '//Write cryptographic key
    Call WriteFile(hOut, pbKeyBlob(0), dwKeyBlobLen, dwWriten, ByVal 0)
  Else
    '//Create a hash object
    If Not CBool(CryptCreateHash(hProv, CALG_MD5, 0, 0, hHash)) Then
      MsgBox "CryptCreateHash Error!"
      GoTo done:
    End If

    '//Get handle to the Hash of the password text
    If Not CBool(CryptHashData(hHash, strPassword, Len(strPassword), 0)) Then
      MsgBox "CryptHashData Error!"
      GoTo done:
    End If

    '//Create a session key from the hash object
    If Not CBool(CryptDeriveKey(hProv, ENCRYPT_ALGORITHM, hHash, 0, hKey)) Then
      MsgBox "CryptDeriveKey Error!"
      GoTo done:
    End If

    '//Destroy Hash object
    Call CryptDestroyHash(hHash)
    hHash = 0
  End If

  lngFileSize = GetFileSize(hIn, ByVal 0)

  dwBlockLen = 1000 - 1000 Mod ENCRYPT_BLOCK_SIZE

  If ENCRYPT_BLOCK_SIZE > 1 Then
    dwBufferLen = dwBlockLen + ENCRYPT_BLOCK_SIZE
  Else
    dwBufferLen = dwBlockLen + 1
  End If

  ReDim pbBuffer(dwBufferLen - 1)

  '//Write encrypted blocks to the file
  Do
    Call ReadFile(hIn, pbBuffer(0), dwBufferLen, dwByte, ByVal 0)
    If dwByte < dwBufferLen Then lngEOF = 1
    ' Encrypt
    If Not CBool(CryptEncrypt(hKey, 0, lngEOF, 0, pbBuffer(0), dwByte, dwBufferLen)) Then
      MsgBox "CryptEncrypt Error!"
      GoTo done:
    End If
    Call WriteFile(hOut, pbBuffer(0), dwByte, dwWriten, ByVal 0)
    lngEncryptSize = lngEncryptSize + dwByte
    RaiseEvent Crypting(lngEncryptSize, lngFileSize)
  Loop While Not CBool(lngEOF)

  EncryptFile = True
done:
  Call CloseHandle(hIn)
  Call CloseHandle(hOut)
  Call CryptDestroyKey(hKey)
  Call CryptDestroyKey(hXchgKey)
  Call CryptDestroyHash(hHash)
  Call CryptReleaseContext(hProv, 0)

  RaiseEvent Crypted
End Function

Private Function DecryptFile(ByVal strFileIn As String, _
               ByVal strFileOut As String, _
               Optional ByVal strPassword As String = "") As Boolean
  Dim hProv      As Long
  Dim hKey      As Long
  Dim hXchgKey    As Long
  Dim dwKeyBlobLen  As Long
  Dim pbKeyBlob()   As Byte
  Dim hHash      As Long
  Dim dwBlockLen   As Long
  Dim dwBufferLen   As Long
  Dim pbBuffer()   As Byte
  Dim dwByte     As Long
  Dim dwWriten    As Long
  Dim lngEOF     As Long
  Dim hIn       As Long
  Dim hOut      As Long
  Dim lngFileSize   As Long
  Dim lngEncryptSize As Long

  DecryptFile = False

  If Dir(strFileIn) = "" Then GoTo done:
  hIn = CreateFile(strFileIn, _
      GENERIC_READ, _
      FILE_SHARE_READ, _
      ByVal 0, _
      OPEN_EXISTING, _
      FILE_ATTRIBUTE_NORMAL, _
      ByVal 0)

  If Dir(strFileOut) <> "" Then GoTo done:
  hOut = CreateFile(strFileOut, _
      GENERIC_WRITE, _
      FILE_SHARE_READ, _
      ByVal 0, _
      CREATE_ALWAYS, _
      FILE_ATTRIBUTE_NORMAL, _
      ByVal 0)

  If Not CBool(CryptAcquireContext(hProv, _
      ByVal vbNullString, _
      ByVal vbNullString, _
      PROV_RSA_FULL, 0)) Then
    MsgBox "CryptAcquireContext Error!"
    GoTo done:
  End If

  '//If password is not specified then try to read user public/private keys
  '//for exisiting user. First read key length and then actual key from the beginning of the file

  '//This key is only valid if current user had encrypted the file its invalid for everybody else
  If strPassword = "" Then
    '//Read key length (first 4 bytes in the file)
    Call ReadFile(hIn, dwKeyBlobLen, Len(dwKeyBlobLen), dwByte, ByVal 0)
    ReDim pbKeyBlob(dwKeyBlobLen - 1)
    '//Read key
    Call ReadFile(hIn, pbKeyBlob(0), dwKeyBlobLen, dwByte, ByVal 0)
    '//Now transfer cryptographic key to key BLOB
    If Not CBool(CryptImportKey(hProv, pbKeyBlob(0), dwKeyBlobLen, 0, 0, hKey)) Then
      MsgBox "CryptImportKey Error!"
      GoTo done:
    End If
  Else
    '//Create a hash object
    If Not CBool(CryptCreateHash(hProv, CALG_MD5, 0, 0, hHash)) Then
      MsgBox "CryptCreateHash Error!"
      GoTo done:
    End If

    '//Get handle to the Hash of the password text
    If Not CBool(CryptHashData(hHash, strPassword, Len(strPassword), 0)) Then
      MsgBox "CryptHashData Error!"
      GoTo done:
    End If

    '//Create a session key from the hash object
    If Not CBool(CryptDeriveKey(hProv, ENCRYPT_ALGORITHM, hHash, 0, hKey)) Then
      MsgBox "CryptDeriveKey Error!"
      GoTo done:
    End If

    '//Destroy Hash object
    Call CryptDestroyHash(hHash)
    hHash = 0
  End If

  lngFileSize = GetFileSize(hIn, ByVal 0)

  dwBlockLen = 1000 - 1000 Mod ENCRYPT_BLOCK_SIZE

  If ENCRYPT_BLOCK_SIZE > 1 Then
    dwBufferLen = dwBlockLen + ENCRYPT_BLOCK_SIZE
  Else
    dwBufferLen = dwBlockLen + 1
  End If

  ReDim pbBuffer(dwBufferLen - 1)

  '//Decrypt and Write content to the output file
  Do
    Call ReadFile(hIn, pbBuffer(0), dwBufferLen, dwByte, ByVal 0)

    If dwByte < dwBufferLen Then lngEOF = 1
    ' Decrypt
    If Not CBool(CryptDecrypt(hKey, 0, lngEOF, 0, pbBuffer(0), dwByte)) Then
      MsgBox "CryptDecrypt Error!"
      GoTo done:
    End If

    Call WriteFile(hOut, pbBuffer(0), dwByte, dwWriten, ByVal 0)

    lngEncryptSize = lngEncryptSize + dwByte
    RaiseEvent Crypting(lngEncryptSize, lngFileSize)
  Loop While Not CBool(lngEOF)

  DecryptFile = True
done:

  '//Cleanup
  Call CloseHandle(hIn)
  Call CloseHandle(hOut)
  Call CryptDestroyKey(hKey)
  Call CryptDestroyHash(hHash)
  Call CryptReleaseContext(hProv, 0)

  RaiseEvent Crypted
End Function

Public Function Decrypt() As Boolean
  Decrypt = DecryptFile(m_strInFile, m_strOutFile, m_strPassword)
End Function

Public Function Encrypt() As Boolean
  Encrypt = EncryptFile(m_strInFile, m_strOutFile, m_strPassword)
End Function

Public Property Get InFile() As String
  InFile = m_strInFile
End Property

Public Property Let InFile(ByVal vNewValue As String)
  m_strInFile = vNewValue
End Property

Public Property Get OutFile() As String
  OutFile = m_strOutFile
End Property

Public Property Let OutFile(ByVal vNewValue As String)
  m_strOutFile = vNewValue
End Property

Public Property Get Password() As String
  Password = m_strPassword
End Property

Public Property Let Password(ByVal vNewValue As String)
  m_strPassword = vNewValue
End Property