[VB6/VBA] Simple AES 256-bit password protected encryption

Simple AES 256-bit password protected encryption

A single mdAesCtr.bas module contains an implementation of a simple to use openssl compatible AES 256-bit encryption/decryption in Counter (CTR) mode, using CNG API functions available in Win7 and later.

Sample usage

Just copy/paste mdAesCtr.bas from Source code section below to your project and will be able to strongly encrypt a user-supplied text with a custom password by calling AesEncryptString like this

encrypted = AesEncryptString(userText, password)

To decrypt the original text use AesDecryptString function with the same password like this

origText = AesDecryptString(encrypted, password)

These functions use sane defaults for salt and cipher strength that you don't have to worry about. These also encode/expect the string in encrypted in base-64 format so it can be persisted/mailed/transported as a simple string.

Advanced usage

Both string functions above use AesCryptArray worker function to encrypt/decrypt UTF-8 byte-arrays of the original strings. You can directly call AesCryptArray if you need to process binary data or need to customize AES salt and/or AES key length (strength) parameters.

Function AesCryptArray also allows calculating detached HMAC-SHA256 on the input/output data ("detached" means hashes has to be stored separately, supports both encrypt-then-MAC and MAC-then-encrypt) when used like this

AesCryptArray baEncr, ToUtf8Array("pass"), Hmac:=baHmacEncr

(See More samples section below)

Stream usage

When contents to be encrypted does not fit in (32-bit) memory you can expose private pvCryptoAesCtrInit/Terminate/Crypt functions so these can be used to implement read/process/write loop on paged original content.

Implementation

This implementation used to be based on WinZip AES-encrypted archives as implemented in ZipArchive project but now is compatible with openssl enc command when using aes-256-ctr cipher.

Source code

Code:

---

'--- https://gist.github.com/wqweto/42a6c1de16cc87e9bab2ac9f3c9d8510
'--- already too long to fit in 25000 characters post limit

---

More samples

Code:

---

Option Explicit

Private Sub TestEncrypt()
    Dim sPass      As String
    Dim sText      As String
    Dim sEncr      As String
   
    sPass = "password123"
    sText = "this is a test"
    sEncr = AesEncryptString(sText, sPass)
    Debug.Assert sText = AesDecryptString(sEncr, sPass)
   
    Debug.Print "Result (Base64): " & sEncr
    Debug.Print "Raw byte-array:  " & StrConv(FromBase64Array(sEncr), vbUnicode)
    Debug.Print "Decrypted:      " & AesDecryptString(sEncr, sPass)
End Sub
   
Private Sub TestHmac()
    Dim baEncr()    As Byte
    Dim baHmacEncr(0 To 31) As Byte
    Dim baHmacDecr(0 To 31) As Byte
   
    baEncr = ToUtf8Array("test message")
    baHmacEncr(0) = 0          '--- 0 -> generate hash before encrypting
    AesCryptArray baEncr, ToUtf8Array("pass"), Hmac:=baHmacEncr
    baHmacDecr(0) = 1          '--- 1 -> decrypt and generate hash after that
    AesCryptArray baEncr, ToUtf8Array("pass"), Hmac:=baHmacDecr
    Debug.Assert InStrB(1, baHmacDecr, baHmacEncr) = 1
   
    Debug.Print "baHmacDecr: " & StrConv(baHmacDecr, vbUnicode)
    Debug.Print "baHmacEncr: " & StrConv(baHmacEncr, vbUnicode)
End Sub

---

cheers,
</wqw>

It's incredible that no other DLLs and LIBs are used. Only one class can compress files!

Hello,
This looks very intimidating -- which makes it amazing! However, I am having trouble testing it out in a 64-bit system; it keeps presenting a type mismatch error. Would it be possible to post a 64-bit version?
Thanks so much!

It works ok in VB6 on x64 here.

Thanks for sharing, but not working for me here. I have attached the test project.

It is throwing a runtime error -214... etc Then it says [0] The operation completed successfully.

AesEncryptString

Could be I have done something wrong :)

Look forward to your feedback.
cheers

Your project works ok here. Windows 10 version 1803

Which OS are you testing this on?

cheers,
</wqw>

Thanks for checking it out so quickly.

I am developing on Windows 7 32bit only because a few other items I have here need that environment to compile. I do have a Win 7 x64 here which I will try also a bit later today and let you know.

@Krammig: Yes, there was a problem w/ Windows 7 support but now mdAesCtr.bas above is fixed (turned out there is no support for BCRYPT_HASH_REUSABLE_FLAG flag on Windows 7).

FYI, here is a diff of the changes, along with err handling fixes.

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

@Krammig: Yes, there was a problem w/ Windows 7 support but now mdAesEcb.bas above is fixed (turned out there is no support for BCRYPT_HASH_REUSABLE_FLAG flag on Windows 7).

FYI, here is a diff of the changes, along with err handling fixes.

cheers,
</wqw>

---

Thanks for that,

Cheers

how to encode a Binary file(or decode) ,can you give me a example？，please,
thank you.

Try using AesCryptArray function like this

baData = ReadBinaryFile("c:\path\to\input.file")
AesCryptArray baData, ToUtf8Array("pass")
WriteBinaryFile "c:\path\to\encrypted.file", baData

cheers,
</wqw>

please，A file that USES a command “openssl enc -aes-128-cbc -in plain.txt -out encrypt.txt -iv 313233343536 -K 313233343536 -p -salt”
how decrypt?
(Can't English)

Try reading this code: https://docs.microsoft.com/en-us/win...-data-with-cng

cheers,
</wqw>

thank you！
I'm not a programmer，is vb6 fans, This link example is C++。
Where are the vb6 examples？

Quote:

---

Originally Posted by ln_0

thank you！
I'm not a programmer，is vb6 fans, This link example is C++。
Where are the vb6 examples？

---

Since there are no VB6 examples nowadays we just use whatever C/C++ examples we can find. Can you find a real programmer to do this job for you?

Or you can use "openssl enc -aes-128-cbc -in encrypt.txt -iv 313233343536 -K 313233343536 -d -out decrypted.txt" to decrypt. (Use -d parameter to decrypt).

cheers,
</wqw>

ok，Thanks for your advice

Hi,

This is brilliant with so little code. I can encrypt and decrypt entirely in VB but my problem is that I need to decrypt an encryption which was done in java. This requires a salt and a secret key. I can see where the salt is set but not the secret key. Can you tell me how I can set the secret key for decryption which was used for the encryption.

Thanks

Rob

Quote:

---

Originally Posted by IWASHERE

Hi,

This is brilliant with so little code. I can encrypt and decrypt entirely in VB but my problem is that I need to decrypt an encryption which was done in java. This requires a salt and a secret key. I can see where the salt is set but not the secret key. Can you tell me how I can set the secret key for decryption which was used for the encryption.

Thanks

Rob

---

This is hardly going to match Java implementation. It is currently matching 1-to-1 the WinZip AES encryption scheme where the module was actually extracted from. Unfortunately it deviates a bit from most "standard" AES-in-Counter-Mode implementations in the wild which vex me now. I'll probably delete this thread althogether in the future and reimplement a compatible enough scheme.

You might find sample BCrypt API usage helpful though to be able to re-implemented Java's implementation. The code after '-- generate RFC 2898 based derived key comment is dealing with the "secret key". You can try skipping the key derivation from the password text and directly use your byte-array for specific custom key to initialize AES.

cheers,
</wqw>

Hi everyone,

Hope you are all well.

I was wondering if someone could help, i am struggling with something. By the way this code is pretty awesome! thank you

In the code there is this line

Debug.Print FromUtf8Array(FromBase64Array(sEncr))

I want to be able to store some text in the format that this outputs, however i need to be able to decrypt that string back into its original form later.

i m seriously struggling to figure out how to do this.

So for example.

Using the above code example you get the following outputs

rYuhuCOvpPncA2tEGeg=
????#????kD?
this is a test

i would like to encrypt the original string and store the second line, then when a user enters their password their original text is restored, in this case "this is a test"

can this be achieved?

Many thanks,

What you marked above is the raw byte-array dumped to Immediate Window with Debug.Print FromUtf8Array(FromBase64Array(sEncr)).

Place this pair of AesEncrypt/DecryptByteArray byte-array encrypting functions in a separate module

Code:

---

Option Explicit

Public Function AesEncryptByteArray(sText As String, sPassword As String) As Byte()
    Dim baData()        As Byte
    Dim sError          As String
   
    baData = ToUtf8Array(sText)
    If Not AesCryptArray(baData, ToUtf8Array(sPassword), Error:=sError) Then
        Err.Raise vbObjectError, , sError
    End If
    AesEncryptByteArray = baData
End Function
 
Public Function AesDecryptByteArray(baData() As Byte, sPassword As String) As String
    Dim sError          As String
   
    If Not AesCryptArray(baData, ToUtf8Array(sPassword), Error:=sError) Then
        Err.Raise vbObjectError, , sError
    End If
    AesDecryptByteArray = FromUtf8Array(baData)
End Function

Private Sub Form_Load()
    Dim sPass      As String
    Dim sText      As String
    Dim baEncr()    As Byte
   
    sPass = "password123"
    sText = "this is a test"
    baEncr = AesEncryptByteArray(sText, sPass)
    Debug.Print baEncr
    Debug.Print AesDecryptByteArray(baEncr, sPass)
End Sub

---

These are using the same AesCryptArray function underneath but skip base-64 encoding and return raw byte-arrays.

cheers,
</wqw>

Hi wqweto,

You my friend are a NINJA.

I have not programmed in over 10 years and am struggling with some basic things. i am re learning much of what i have forgotten but it will take some tie i guess.

I am trying to update some of the applications i wrote years ago but am struggling with something.

What i am to do is:

1) Allow the user to specify some text and a password
2) Encrypt and write that encrypted text into a text file
3) Later the user should be able to Specify the password and retrieve that text from the file decrypted

I can write the encrypted test to a file, but when i try to retrieve it, it fails

Write value to file

Code:

---

Private Sub Command1_Click()
 Dim sPass      As String
    Dim sText      As String
    Dim baEncr()    As Byte
   
    baEncr = AesEncryptByteArray("Encrypt me", "Password123")
   
    Open "C:\users\abc\Desktop\a.txt" For Output As #1
        Print #1, baEncr
        Close #1
End Sub

---

Read from file

Code:

---

Private Sub Command2_Click()
    Dim LineText As Byte
    Dim LT As String
    Com1.ShowOpen
   
    Open Com1.FileName For Input As #2
        Do Until EOF(2) ' Repeat until end of file...
            Line Input #2, LT ' Read a line from the file.
            Debug.Print LT
            LineText = AesEncryptByteArray(LT, "Password123")
            Debug.Print AesDecryptByteArray(LT, "Password123")
        Loop
  Close #2
End Sub

---

Appreciate all your help bud, sorry if this is basic, i am trying to relearn everything after many years away from it all.

Any ideas what i am doing wrong?

Thanks,

Code:

---

Open "C:\users\abc\Desktop\a.txt" For Output As #1
        Print #1, baEncr
        Close #1

---

You are saving a byte array using file IO meant for textual data.
Open the file in binary mode and use the Put statement

The same goes for reading the file, you are using text based file IO

Thank you Arnoutdv and everyone,

I have it working now, i was going crazy trying to figure out why i kept on getting a type mismatch error, then it occured to me, when i defined my variable, i did not define it as an array

ie i had

dim LineText as byte
instead on
Dim LineText() as byte

its now working.

You guys are awesome!!!

Thank you again.

Quote:

---

Originally Posted by wqweto

Simple AES 256-bit password protected encryption

A single mdAesCtr.bas module contains an implementation of a simple to use AES 256-bit encryption/decryption in CTR mode, using API functions (CNG) available in Win7 and later.

Sample usage

Just copy/paste mdAesCtr.bas from Source code section below to your project and will be able to strongly encrypt a user-supplied text with a custom password by calling AesEncryptString like this

encrypted = AesEncryptString(userText, password)

To decrypt the original text use AesDecryptString function with the same password like this

origText = AesDecryptString(encrypted, password)

These functions use sane defaults for salt and cypher strength that you don't have to worry about. These also encode/expect the string in encrypted in base-64 format so it can be persisted/mailed/transported as a simple string.

Advanced usage

Both string functions above use AesCryptArray worker function to encrypt/decrypt UTF-8 byte-arrays of the original strings. You can directly call AesCryptArray if you need to process binary data or need to customize AES salt and/or AES key length (strength) parameters.

Function AesCryptArray also allows calculating out-of-band HMAC-SHA1 hashes on the input/output binary data (OOB means hashes has to be stored separately) when used like this

AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacEncr

(See More samples section below)

Stream usage

When contents to be encrypted does not fit in (32-bit) memory you can expose private pvCryptoAesInit/Terminate/Crypt functions so these can be used to implement read/process/write loop on paged original content.

Implementation

This implementation is based on WinZip AES-encrypted archives as implemented in ZipArchive project.

Source code

thinBasic Code:

'--- mdAesCtr.bas
Option Explicit
DefObj A-Z
 
#Const ImplUseShared = False
 
'=========================================================================
' API
'=========================================================================
 
'--- for CNG
Private Const MS_PRIMITIVE_PROVIDER         As String = "Microsoft Primitive Provider"
Private Const BCRYPT_CHAIN_MODE_ECB         As String = "ChainingModeECB"
Private Const BCRYPT_ALG_HANDLE_HMAC_FLAG   As Long = 8
 
'--- for CryptStringToBinary
Private Const CRYPT_STRING_BASE64           As Long = 1
'--- for WideCharToMultiByte
Private Const CP_UTF8                       As Long = 65001
'--- for FormatMessage
Private Const FORMAT_MESSAGE_FROM_SYSTEM    As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function BCryptOpenAlgorithmProvider Lib "bcrypt" (phAlgorithm As Long, ByVal pszAlgId As Long, ByVal pszImplementation As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptCloseAlgorithmProvider Lib "bcrypt" (ByVal hAlgorithm As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptGetProperty Lib "bcrypt" (ByVal hObject As Long, ByVal pszProperty As Long, pbOutput As Any, ByVal cbOutput As Long, cbResult As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptSetProperty Lib "bcrypt" (ByVal hObject As Long, ByVal pszProperty As Long, ByVal pbInput As Long, ByVal cbInput As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptGenerateSymmetricKey Lib "bcrypt" (ByVal hAlgorithm As Long, phKey As Long, pbKeyObject As Any, ByVal cbKeyObject As Long, pbSecret As Any, ByVal cbSecret As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDestroyKey Lib "bcrypt" (ByVal hKey As Long) As Long
Private Declare Function BCryptEncrypt Lib "bcrypt" (ByVal hKey As Long, pbInput As Any, ByVal cbInput As Long, ByVal pPaddingInfo As Long, ByVal pbIV As Long, ByVal cbIV As Long, pbOutput As Any, ByVal cbOutput As Long, pcbResult As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDeriveKeyPBKDF2 Lib "bcrypt" (ByVal pPrf As Long, pbPassword As Any, ByVal cbPassword As Long, pbSalt As Any, ByVal cbSalt As Long, ByVal cIterations As Long, ByVal dwDummy As Long, pbDerivedKey As Any, ByVal cbDerivedKey As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptCreateHash Lib "bcrypt" (ByVal hAlgorithm As Long, phHash As Long, ByVal pbHashObject As Long, ByVal cbHashObject As Long, pbSecret As Any, ByVal cbSecret As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptDestroyHash Lib "bcrypt" (ByVal hHash As Long) As Long
Private Declare Function BCryptHashData Lib "bcrypt" (ByVal hHash As Long, pbInput As Any, ByVal cbInput As Long, ByVal dwFlags As Long) As Long
Private Declare Function BCryptFinishHash Lib "bcrypt" (ByVal hHash As Long, pbOutput As Any, ByVal cbOutput As Long, ByVal dwFlags As Long) As Long
#If Not ImplUseShared Then
    Private Declare Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
    Private Declare Function CryptBinaryToString Lib "crypt32" Alias "CryptBinaryToStringW" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, pcchString As Long) As Long
    Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
    Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
    Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Args As Any) As Long
#End If
 
'=========================================================================
' Constants and member variables
'=========================================================================
 
Private Const ERR_UNSUPPORTED_ENCR  As String = "Unsupported encryption"
Private Const AES_BLOCK_SIZE        As Long = 16
Private Const AES_KEYLEN            As Long = 32                    '-- 32 -> AES-256, 24 -> AES-196, 16 -> AES-128
Private Const AES_SALT              As String = "SaltVb6CryptoAes"  '-- at least 16 chars
 
Private Type UcsZipCryptoType
    hPbkdf2Alg          As Long
    hHmacAlg            As Long
    hHmacHash           As Long
    HmacHashLen         As Long
    hAesAlg             As Long
    hAesKey             As Long
    AesKeyObjData()     As Byte
    AesKeyObjLen        As Long
    Nonce(0 To 1)       As Long
    EncrData()          As Byte
    EncrPos             As Long
    LastError           As String
End Type
 
'=========================================================================
' Functions
'=========================================================================
 
Public Function AesEncryptString(sText As String, sPassword As String) As String
    Dim baData()        As Byte
    Dim sError          As String
    
    baData = ToUtf8Array(sText)
    If Not AesCryptArray(baData, ToUtf8Array(sPassword), Error:=sError) Then
        Err.Raise vbObjectError, , sError
    End If
    AesEncryptString = ToBase64Array(baData)
End Function
 
Public Function AesDecryptString(sEncr As String, sPassword As String) As String
    Dim baData()        As Byte
    Dim sError          As String
    
    baData = FromBase64Array(sEncr)
    If Not AesCryptArray(baData, ToUtf8Array(sPassword), Error:=sError) Then
        Err.Raise vbObjectError, , sError
    End If
    AesDecryptString = FromUtf8Array(baData)
End Function
 
Public Function AesCryptArray( _
            baData() As Byte, _
            baPass() As Byte, _
            Optional Salt As String, _
            Optional ByVal KeyLen As Long, _
            Optional Error As String, _
            Optional HmacSha1 As Variant) As Boolean
    Const VT_BYREF      As Long = &H4000
    Dim uCtx            As UcsZipCryptoType
    Dim vErr            As Variant
    Dim bHashBefore     As Boolean
    Dim bHashAfter      As Boolean
    Dim baTemp()        As Byte
    Dim lPtr            As Long
    
    On Error GoTo EH
    If Not IsMissing(HmacSha1) Then
        bHashBefore = (HmacSha1(0) <= 0)
        bHashAfter = (HmacSha1(0) > 0)
    End If
    If LenB(Salt) > 0 Then
        baTemp = ToUtf8Array(Salt)
    Else
        baTemp = ToUtf8Array(AES_SALT)
    End If
    If KeyLen <= 0 Then
        KeyLen = AES_KEYLEN
    End If
    If Not pvCryptoAesInit(uCtx, baPass, baTemp, KeyLen, 0) Then
        Error = uCtx.LastError
        GoTo QH
    End If
    If Not pvCryptoAesCrypt(uCtx, baData, Size:=UBound(baData) + 1, HashBefore:=bHashBefore, HashAfter:=bHashAfter) Then
        Error = uCtx.LastError
        GoTo QH
    End If
    If Not IsMissing(HmacSha1) Then
        baTemp = pvCryptoAesGetFinalHash(uCtx, UBound(HmacSha1) + 1)
        lPtr = Peek((VarPtr(HmacSha1) Xor &H80000000) + 8 Xor &H80000000)
        If (Peek(VarPtr(HmacSha1)) And VT_BYREF) <> 0 Then
            lPtr = Peek(lPtr)
        End If
        lPtr = Peek((lPtr Xor &H80000000) + 12 Xor &H80000000)
        Call CopyMemory(ByVal lPtr, baTemp(0), UBound(baTemp) + 1)
    End If
    '--- success
    AesCryptArray = True
QH:
    pvCryptoAesTerminate uCtx
    Exit Function
EH:
    vErr = Array(Err.Number, Err.Source, Err.Description)
    pvCryptoAesTerminate uCtx
    Err.Raise vErr(0), vErr(1), vErr(2)
End Function
 
'= private ===============================================================
 
Private Function pvCryptoAesInit(uCrypto As UcsZipCryptoType, baPass() As Byte, baSalt() As Byte, ByVal lKeyLen As Long, nPassVer As Integer) As Boolean
    Dim baDerivedKey()  As Byte
    Dim lDummy          As Long '--- discarded
    Dim hResult         As Long
    Dim sApiSource      As String
    
    '--- init member vars
    uCrypto.Nonce(0) = 0
    uCrypto.Nonce(1) = 0
    uCrypto.EncrData = vbNullString
    uCrypto.EncrPos = 0
    '--- generate RFC 2898 based derived key
    On Error GoTo EH_Unsupported '--- CNG API missing on XP
    hResult = BCryptOpenAlgorithmProvider(uCrypto.hPbkdf2Alg, StrPtr("SHA1"), StrPtr(MS_PRIMITIVE_PROVIDER), BCRYPT_ALG_HANDLE_HMAC_FLAG)
    If hResult <> 0 Then
        sApiSource = "BCryptOpenAlgorithmProvider(SHA1)"
        GoTo QH
    End If
    On Error GoTo 0
    ReDim baDerivedKey(0 To 2 * lKeyLen + 1) As Byte
    On Error GoTo EH_Unsupported '--- PBKDF2 API missing on Vista
    hResult = BCryptDeriveKeyPBKDF2(uCrypto.hPbkdf2Alg, baPass(0), UBound(baPass) + 1, baSalt(0), UBound(baSalt) + 1, 1000, 0, baDerivedKey(0), UBound(baDerivedKey) + 1, 0)
    If hResult <> 0 Then
        sApiSource = "BCryptDeriveKeyPBKDF2"
        GoTo QH
    End If
    On Error GoTo 0
    '--- extract Password Verification Value from last 2 bytes of derived key
    Call CopyMemory(nPassVer, baDerivedKey(2 * lKeyLen), 2)
    '--- init AES w/ ECB from first half of derived key
    hResult = BCryptOpenAlgorithmProvider(uCrypto.hAesAlg, StrPtr("AES"), StrPtr(MS_PRIMITIVE_PROVIDER), 0)
    If hResult <> 0 Then
        sApiSource = "BCryptOpenAlgorithmProvider(AES)"
        GoTo QH
    End If
    hResult = BCryptGetProperty(uCrypto.hAesAlg, StrPtr("ObjectLength"), uCrypto.AesKeyObjLen, 4, lDummy, 0)
    If hResult <> 0 Then
        sApiSource = "BCryptGetProperty(ObjectLength)"
        GoTo QH
    End If
    hResult = BCryptSetProperty(uCrypto.hAesAlg, StrPtr("ChainingMode"), StrPtr(BCRYPT_CHAIN_MODE_ECB), LenB(BCRYPT_CHAIN_MODE_ECB), 0)
    If hResult <> 0 Then
        sApiSource = "BCryptSetProperty(ChainingMode)"
        GoTo QH
    End If
    ReDim uCrypto.AesKeyObjData(0 To uCrypto.AesKeyObjLen - 1) As Byte
    hResult = BCryptGenerateSymmetricKey(uCrypto.hAesAlg, uCrypto.hAesKey, uCrypto.AesKeyObjData(0), uCrypto.AesKeyObjLen, baDerivedKey(0), lKeyLen, 0)
    If hResult <> 0 Then
        sApiSource = "BCryptGenerateSymmetricKey"
        GoTo QH
    End If
    '-- init HMAC from second half of derived key
    hResult = BCryptOpenAlgorithmProvider(uCrypto.hHmacAlg, StrPtr("SHA1"), StrPtr(MS_PRIMITIVE_PROVIDER), BCRYPT_ALG_HANDLE_HMAC_FLAG)
    If hResult <> 0 Then
        sApiSource = "BCryptOpenAlgorithmProvider(SHA1)"
        GoTo QH
    End If
    hResult = BCryptGetProperty(uCrypto.hHmacAlg, StrPtr("HashDigestLength"), uCrypto.HmacHashLen, 4, lDummy, 0)
    If hResult <> 0 Then
        sApiSource = "BCryptGetProperty(HashDigestLength)"
        GoTo QH
    End If
    hResult = BCryptCreateHash(uCrypto.hHmacAlg, uCrypto.hHmacHash, 0, 0, baDerivedKey(lKeyLen), lKeyLen, 0)
    If hResult <> 0 Then
        sApiSource = "BCryptCreateHash"
        GoTo QH
    End If
    '--- success
    pvCryptoAesInit = True
    Exit Function
QH:
    If Err.LastDllError <> 0 Then
        uCrypto.LastError = GetSystemMessage(Err.LastDllError)
    Else
        uCrypto.LastError = "[" & Hex(hResult) & "] Error in " & sApiSource
    End If
    Exit Function
EH_Unsupported:
    uCrypto.LastError = ERR_UNSUPPORTED_ENCR
End Function
 
Private Sub pvCryptoAesTerminate(uCrypto As UcsZipCryptoType)
    If uCrypto.hPbkdf2Alg <> 0 Then
        Call BCryptCloseAlgorithmProvider(uCrypto.hPbkdf2Alg, 0)
        uCrypto.hPbkdf2Alg = 0
    End If
    If uCrypto.hHmacHash <> 0 Then
        Call BCryptDestroyHash(uCrypto.hHmacHash)
        uCrypto.hHmacHash = 0
    End If
    If uCrypto.hHmacAlg <> 0 Then
        Call BCryptCloseAlgorithmProvider(uCrypto.hHmacAlg, 0)
        uCrypto.hHmacAlg = 0
    End If
    If uCrypto.hAesKey <> 0 Then
        Call BCryptDestroyKey(uCrypto.hAesKey)
        uCrypto.hAesKey = 0
    End If
    If uCrypto.hAesAlg <> 0 Then
        Call BCryptCloseAlgorithmProvider(uCrypto.hAesAlg, 0)
        uCrypto.hAesAlg = 0
    End If
End Sub
 
Private Function pvCryptoAesCrypt( _
            uCrypto As UcsZipCryptoType, _
            baData() As Byte, _
            Optional ByVal Offset As Long, _
            Optional ByVal Size As Long, _
            Optional ByVal HashBefore As Boolean, _
            Optional ByVal HashAfter As Boolean) As Boolean
    Dim lIdx            As Long
    Dim lJdx            As Long
    Dim lPadSize        As Long
    Dim hResult         As Long
    Dim sApiSource      As String
    
    If Size < 0 Then
        Size = UBound(baData) + 1 - Offset
    End If
    If HashBefore Then
        hResult = BCryptHashData(uCrypto.hHmacHash, baData(Offset), Size, 0)
        If hResult <> 0 Then
            sApiSource = "BCryptHashData"
            GoTo QH
        End If
    End If
    With uCrypto
        '--- reuse EncrData from prev call until next AES_BLOCK_SIZE boundary
        For lIdx = Offset To Offset + Size - 1
            If (.EncrPos And (AES_BLOCK_SIZE - 1)) = 0 Then
                Exit For
            End If
            baData(lIdx) = baData(lIdx) Xor .EncrData(.EncrPos)
            .EncrPos = .EncrPos + 1
        Next
        If lIdx < Offset + Size Then
            '--- pad remaining input size to AES_BLOCK_SIZE
            lPadSize = (Offset + Size - lIdx + AES_BLOCK_SIZE - 1) And -AES_BLOCK_SIZE
            If UBound(.EncrData) + 1 < lPadSize Then
                ReDim .EncrData(0 To lPadSize - 1) As Byte
            End If
            '--- encrypt incremental nonces in EncrData
            For lJdx = 0 To lPadSize - 1 Step 16
                If .Nonce(0) <> -1 Then
                    .Nonce(0) = (.Nonce(0) Xor &H80000000) + 1 Xor &H80000000
                Else
                    .Nonce(0) = 0
                    .Nonce(1) = (.Nonce(1) Xor &H80000000) + 1 Xor &H80000000
                End If
                Call CopyMemory(.EncrData(lJdx), .Nonce(0), 8)
            Next
            hResult = BCryptEncrypt(.hAesKey, .EncrData(0), lPadSize, 0, 0, 0, .EncrData(0), lPadSize, lJdx, 0)
            If hResult <> 0 Then
                sApiSource = "BCryptEncrypt"
                GoTo QH
            End If
            '--- xor remaining input and leave anything extra of EncrData for reuse
            For .EncrPos = 0 To Offset + Size - lIdx - 1
                baData(lIdx) = baData(lIdx) Xor .EncrData(.EncrPos)
                lIdx = lIdx + 1
            Next
        End If
    End With
    If HashAfter Then
        hResult = BCryptHashData(uCrypto.hHmacHash, baData(Offset), Size, 0)
        If hResult <> 0 Then
            sApiSource = "BCryptHashData"
            GoTo QH
        End If
    End If
    '--- success
    pvCryptoAesCrypt = True
    Exit Function
QH:
    If Err.LastDllError <> 0 Then
        uCrypto.LastError = GetSystemMessage(Err.LastDllError)
    Else
        uCrypto.LastError = "[" & Hex(hResult) & "] Error in " & sApiSource
    End If
End Function
 
Private Function pvCryptoAesGetFinalHash(uCrypto As UcsZipCryptoType, ByVal lSize As Long) As Byte()
    Dim baResult()      As Byte
    
    ReDim baResult(0 To uCrypto.HmacHashLen - 1) As Byte
    Call BCryptFinishHash(uCrypto.hHmacHash, baResult(0), uCrypto.HmacHashLen, 0)
    ReDim Preserve baResult(0 To lSize - 1) As Byte
    pvCryptoAesGetFinalHash = baResult
End Function
 
'= shared ================================================================
 
#If Not ImplUseShared Then
Public Function ToBase64Array(baData() As Byte) As String
    Dim lSize           As Long
    
    If UBound(baData) >= 0 Then
        ToBase64Array = String$(2 * UBound(baData) + 6, 0)
        lSize = Len(ToBase64Array) + 1
        Call CryptBinaryToString(VarPtr(baData(0)), UBound(baData) + 1, CRYPT_STRING_BASE64, StrPtr(ToBase64Array), lSize)
        ToBase64Array = Left$(ToBase64Array, lSize)
    End If
End Function
 
Public Function FromBase64Array(sText As String) As Byte()
    Dim lSize           As Long
    Dim baOutput()      As Byte
    
    lSize = Len(sText) + 1
    ReDim baOutput(0 To lSize - 1) As Byte
    Call CryptStringToBinary(StrPtr(sText), Len(sText), CRYPT_STRING_BASE64, VarPtr(baOutput(0)), lSize, 0, 0)
    If lSize > 0 Then
        ReDim Preserve baOutput(0 To lSize - 1) As Byte
        FromBase64Array = baOutput
    Else
        FromBase64Array = vbNullString
    End If
End Function
 
Public Function ToUtf8Array(sText As String) As Byte()
    Dim baRetVal()      As Byte
    Dim lSize           As Long
    
    lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), ByVal 0, 0, 0, 0)
    If lSize > 0 Then
        ReDim baRetVal(0 To lSize - 1) As Byte
        Call WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), baRetVal(0), lSize, 0, 0)
    Else
        baRetVal = vbNullString
    End If
    ToUtf8Array = baRetVal
End Function
 
Public Function FromUtf8Array(baText() As Byte) As String
    Dim lSize           As Long
    
    If UBound(baText) >= 0 Then
        FromUtf8Array = String$(2 * UBound(baText), 0)
        lSize = MultiByteToWideChar(CP_UTF8, 0, baText(0), UBound(baText) + 1, StrPtr(FromUtf8Array), Len(FromUtf8Array))
        FromUtf8Array = Left$(FromUtf8Array, lSize)
    End If
End Function
 
Public Function GetSystemMessage(ByVal lLastDllError As Long) As String
    Dim lSize            As Long
   
    GetSystemMessage = Space$(2000)
    lSize = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, lLastDllError, 0&, GetSystemMessage, Len(GetSystemMessage), 0&)
    If lSize > 2 Then
        If Mid$(GetSystemMessage, lSize - 1, 2) = vbCrLf Then
            lSize = lSize - 2
        End If
    End If
    GetSystemMessage = "[" & lLastDllError & "] " & Left$(GetSystemMessage, lSize)
End Function
 
Private Function Peek(ByVal lPtr As Long) As Long
    Call CopyMemory(Peek, ByVal lPtr, 4)
End Function
#End If

More samples

thinBasic Code:

Private Sub TestEncrypt()
    Dim sPass       As String
    Dim sText       As String
    Dim sEncr       As String
    
    sPass = "password123"
    sText = "this is a test"
    sEncr = AesEncryptString(sText, sPass)
    Debug.Assert sText = AesDecryptString(sEncr, sPass)
    
    Debug.Print sEncr
    Debug.Print FromUtf8Array(FromBase64Array(sEncr))
    Debug.Print AesDecryptString(sEncr, sPass)
End Sub
    
Private Sub TestHmac()
    Dim baEncr()    As Byte
    Dim baHmacEncr(0 To 19) As Byte
    Dim baHmacDecr(0 To 19) As Byte
    
    baEncr = ToUtf8Array("test message")
    baHmacEncr(0) = 0           '--- 0 -> generate hash before encrypting
    AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacEncr
    baHmacDecr(0) = 1           '--- 1 -> decrypt and generate hash after that
    AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacDecr
    Debug.Assert StrConv(baHmacDecr, vbUnicode) = StrConv(baHmacEncr, vbUnicode)
    
    Debug.Print ToBase64Array(baHmacDecr)
    Debug.Print ToBase64Array(baHmacEncr)
End Sub

cheers,
</wqw>

---

Many thanks for this cool class.
First I noted that the returned encrypted string has line feed (LF &H10) character at the end of it, I fixed that by (I am not sure if this the right way or not!) subtracting 2 of lSize variable

Code:

---

ToBase64Array = Left$(ToBase64Array, lSize - 2) 'Original code was ToBase64Array = Left$(ToBase64Array, lSize)

---

Second and most important for me is that the returend string is not equal to what a PHP code is returning, here is the code:

Code:

---

<!DOCTYPE html>
<html>
<body>

<?php

echo '6NH7/w==    This is the VB generated one <br>';
$encrypted = openssl_encrypt('1234', 'AES-256-CTR', 'password123', false, 'SaltVb6CryptoAes');
echo $encrypted;
echo '<br>';
echo openssl_decrypt($encrypted, 'AES-256-CTR', 'password123', false, 'SaltVb6CryptoAes');

?>


</body>
</html>

---

You can test the above PHP code here :
https://www.w3schools.com/Php/phptry...ryphp_compiler

The VB6 code :

Code:

---

    Private Sub TestEncrypt()
        Dim sPass      As String
        Dim sText      As String
        Dim sEncr      As String
       
        sPass = "password123"
        sText = "1234"
        sEncr = AesEncryptString(sText, sPass)       
        Debug.Print sEncr       
        Debug.Print AesDecryptString(sEncr, sPass)
    End Sub

---

I do appreciate if you can tell what's wrong!

Yes, this is a problem with this code and it's currently not compatible with openssl's implementation in both key derivation (expanding the password to 32 bytes keys) and probably the counter mode (this is using WinZip's construction).

I'll have to come up with a completely new submission based on this signature in PHP sources when time permits, so that this would allow passing the key as byte-array and more modes too (like GCM, CCM, OCB)

cheers,
</wqw>

The last revision is openssl compatible equivalent to using this from command-line to encrypt

Code:

---

c:> openssl enc -aes-256-ctr -pbkdf2 -md sha512 -pass pass:{sPassword} -in {sText}.file -a

---

. . . and this to decrypt

Code:

---

c:> openssl enc -d -aes-256-ctr -pbkdf2 -md sha512 -pass pass:{sPassword} -in {sEncr}.file -a

---

I'm not sure about equivalent php implementation but before calling openssl_encrypt you'll probably have to prepare key/IV using pbkdf2 for key derivation based on the password and some random 8 bytes salt.

cheers,
</wqw>

Here is the equivalent php implementation with compatible arguments for the pbkdf2 key derivation

Code:

---

<?php
const CIPHER = "AES-256-CTR";
const KEYLEN = 32;
const IVLEN = 16;
const KDF_SALTLEN = 8;
const KDF_ITER = 10000;
const KDF_HASH = "SHA512";
const OPENSSL_MAGIC = "Salted__";
const OPENSSL_MAGICLEN = 8;

function AesEncryptString($text, $password)
{
    $salt = openssl_random_pseudo_bytes(KDF_SALTLEN);
    $derived = openssl_pbkdf2($password, $salt, KEYLEN + IVLEN, KDF_ITER, KDF_HASH);
    $encr = openssl_encrypt($text, CIPHER, substr($derived, 0, KEYLEN), OPENSSL_RAW_DATA, substr($derived, KEYLEN, IVLEN));
    return base64_encode(OPENSSL_MAGIC . $salt . $encr);
}

function AesDecryptString($encr, $password)
{
    $encr = base64_decode($encr);
    $salt = "";
    if (substr($encr, 0, OPENSSL_MAGICLEN) == OPENSSL_MAGIC) {
        $salt = substr($encr, OPENSSL_MAGICLEN, KDF_SALTLEN);
        $encr = substr($encr, OPENSSL_MAGICLEN + KDF_SALTLEN);
    }
    $derived = openssl_pbkdf2($password, $salt, KEYLEN + IVLEN, KDF_ITER, KDF_HASH);
    return openssl_decrypt($encr, CIPHER, substr($derived, 0, KEYLEN), OPENSSL_RAW_DATA, substr($derived, KEYLEN, IVLEN));
}

$encr = AesEncryptString("this is a PHP test това е проба", "password123");
echo $encr . "\n";
echo AesDecryptString($encr, "password123") . "\n";
?>

---

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

Here is the equivalent php implementation with compatible arguments for the pbkdf2 key derivation

Code:

---

<?php
const CIPHER = "AES-256-CTR";
const KEYLEN = 32;
const IVLEN = 16;
const KDF_SALTLEN = 8;
const KDF_ITER = 10000;
const KDF_HASH = "SHA512";
const OPENSSL_MAGIC = "Salted__";
const OPENSSL_MAGICLEN = 8;

function AesEncryptString($text, $password)
{
    $salt = openssl_random_pseudo_bytes(KDF_SALTLEN);
    $derived = openssl_pbkdf2($password, $salt, KEYLEN + IVLEN, KDF_ITER, KDF_HASH);
    $encr = openssl_encrypt($text, CIPHER, substr($derived, 0, KEYLEN), OPENSSL_RAW_DATA, substr($derived, KEYLEN, IVLEN));
    return base64_encode(OPENSSL_MAGIC . $salt . $encr);
}

function AesDecryptString($encr, $password)
{
    $encr = base64_decode($encr);
    if (substr($encr, 0, OPENSSL_MAGICLEN) == OPENSSL_MAGIC) {
        $salt = substr($encr, OPENSSL_MAGICLEN, KDF_SALTLEN);
        $encr = substr($encr, OPENSSL_MAGICLEN + KDF_SALTLEN);
    }
    $derived = openssl_pbkdf2($password, $salt, KEYLEN + IVLEN, KDF_ITER, KDF_HASH);
    return openssl_decrypt($encr, CIPHER, substr($derived, 0, KEYLEN), OPENSSL_RAW_DATA, substr($derived, KEYLEN, IVLEN));
}

$encr = AesEncryptString("this is a PHP test това е проба", "password123");
echo $encr . "\n";
echo AesDecryptString($encr, "password123") . "\n";
?>

---

cheers,
</wqw>

---

Thank you very much.
I do appreciate your help.

Here is an XP compatible implementation of AesEncrypt/DecryptString functions: mdAesCbc.bas implements AES-256 in CBC mode and PBKDF2 w/ SHA-512 using only legacy wincrypto API functions.

cheers,
</wqw>

Thanks.

Also, I guess it is SAFE (by safe here I mean URL compatible) to pass decrypted data as parameters, right?

Sorry!

Updated the PHP code a bit!

I am using only AesDecryptString function on my server, so I get an error that $salt is not defined, also for some reason "\n" is not working so I replaced it with the HTML equivalent.

Code:

---

<?php
const CIPHER = "AES-256-CTR";
const KEYLEN = 32;
const IVLEN = 16;
const KDF_SALTLEN = 8;
const KDF_ITER = 10000;
const KDF_HASH = "SHA512";
const OPENSSL_MAGIC = "Salted__";
const OPENSSL_MAGICLEN = 8;

function AesEncryptString($text, $password)
{
    $salt = openssl_random_pseudo_bytes(KDF_SALTLEN);
    $derived = openssl_pbkdf2($password, $salt, KEYLEN + IVLEN, KDF_ITER, KDF_HASH);
    $encr = openssl_encrypt($text, CIPHER, substr($derived, 0, KEYLEN), OPENSSL_RAW_DATA, substr($derived, KEYLEN, IVLEN));
    return base64_encode(OPENSSL_MAGIC . $salt . $encr);
}

function AesDecryptString($encr, $password)
{
    $encr = base64_decode($encr);
    if (substr($encr, 0, OPENSSL_MAGICLEN) == OPENSSL_MAGIC) {
        $salt = substr($encr, OPENSSL_MAGICLEN, KDF_SALTLEN);
        $encr = substr($encr, OPENSSL_MAGICLEN + KDF_SALTLEN);
    }
    if(!isset($salt)){
        $salt = openssl_random_pseudo_bytes(KDF_SALTLEN);
    }
    $derived = openssl_pbkdf2($password, $salt, KEYLEN + IVLEN, KDF_ITER, KDF_HASH);
    return openssl_decrypt($encr, CIPHER, substr($derived, 0, KEYLEN), OPENSSL_RAW_DATA, substr($derived, KEYLEN, IVLEN));
}

$encr = AesEncryptString("this is a PHP test това е проба", "password123");
echo $encr . '<br>';
echo AesDecryptString($encr, "password123") . '<br>';
?>

---

Yes, that would happen if $encr is invalid (i.e. does not contain the openssl prefix) so in this case in VB6 version the $salt is just an empty byte-array.

Not sure how to initialize it to an array with no elements in php but empty string seems to do the job (tweaked my post above).

cheers,
</wqw>

Thanks a lot.
I do appreciate your efforts.

I implement the encryption using your module in my commercial application and it works ok till the update for a client with Windows 7 where he reported he can not log in the system!

I found that the library is failing with Windows 7, though when I debugged the problem it raises an error at :

Code:

---

    If Not AesCryptArray(baData, ToUtf8Array(sPassword), baSalt, Error:=sError) Then
        Err.Raise vbObjectError, , sError
    End If

---

And to my surprise, the error is:
[0] completed successfully

Any clue?

This bug mysteriously resurfaced apparently, combined with poor error handling.

All fixed now!

Diff of changes is here.

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

This bug mysteriously resurfaced apparently, combined with poor error handling.

All fixed now!

Diff of changes is here.

cheers,
</wqw>

---

Many thanks.
It works ok now.

One more thing you may want to check or enlighten me if I am not aware of it:

The generated encrypted string sometimes contains unsafe characters which don't work if I pass it as URL parameters for a PHP script to parse it!
I overcome it using the following:

Code:

---

    Dim baSalt(0 To KDF_SALTLEN - 1) As Byte
   
    '/ + ^§ []{} .. etc which are not URL compatible
    Randomize Timer
    baSalt(0) = Int(Rnd(1) * 25) + 65: baSalt(1) = Int(Rnd(1) * 25) + 97: baSalt(2) = Int(Rnd(1) * 25) + 65: baSalt(3) = Int(Rnd(1) * 25) + 97: baSalt(4) = Int(Rnd(1) * 25) + 65: baSalt(5) = Int(Rnd(1) * 25) + 97: baSalt(6) = Int(Rnd(1) * 25) + 65

---

instead of the original code:

Code:

---

    Dim baSalt(0 To KDF_SALTLEN - 1) As Byte
    Call RtlGenRandom(baSalt(0), KDF_SALTLEN)

---

I am not sure if this is the right way but at least it works for me!

AesEncryptString returns a base64 encoded result, the same way base64_encode encodes the result in the PHP code above and the same way final -a parameter to openssl.exe encodes the output in base64.

What you want to use in your URLs would be base64url -- a slight modification to base64 which allows base64 encoded result to be used without additional URLs escape.

Here is an explanation of the difference beteen base64 and base64url.

For simple base64->base64url conversion you need two replacements on the encoded string: + to - (dash) and / to _ (underscore).

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

AesEncryptString returns a base64 encoded result, the same way base64_encode encodes the result in the PHP code above and the same way final -a parameter to openssl.exe encodes the output in base64.

What you want to use in your URLs would be base64url -- a slight modification to base64 which allows base64 encoded result to be used without additional URLs escape.

Here is an explanation of the difference beteen base64 and base64url.

For simple base64->base64url conversion you need two replacements on the encoded string: + to - (dash) and / to _ (underscore).

cheers,
</wqw>

---

Thanks again, that was helpful and informative :)