Page 1 of 2 12 LastLast
Results 1 to 40 of 66

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

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    [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>
    Last edited by wqweto; Jan 28th, 2022 at 05:54 AM. Reason: VBA compatibility

  2. #2
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    197

    Re: [VB6] Simple AES 256-bit password protected encryption

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

  3. #3
    New Member
    Join Date
    Aug 2018
    Posts
    1

    Re: [VB6] Simple AES 256-bit password protected encryption

    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!

  4. #4

  5. #5
    Member
    Join Date
    Apr 2011
    Posts
    47

    Re: [VB6] Simple AES 256-bit password protected encryption

    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
    Attached Files Attached Files

  6. #6

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    Your project works ok here. Windows 10 version 1803

    Which OS are you testing this on?

    cheers,
    </wqw>

  7. #7
    Member
    Join Date
    Apr 2011
    Posts
    47

    Re: [VB6] Simple AES 256-bit password protected encryption

    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.

  8. #8

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    @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>

  9. #9
    Member
    Join Date
    Apr 2011
    Posts
    47

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by wqweto View Post
    @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

  10. #10
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] Simple AES 256-bit password protected encryption

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

  11. #11

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  12. #12
    New Member
    Join Date
    May 2020
    Posts
    7

    Re: [VB6] Simple AES 256-bit password protected encryption

    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)

  13. #13

  14. #14
    New Member
    Join Date
    May 2020
    Posts
    7

    Re: [VB6] Simple AES 256-bit password protected encryption

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

  15. #15

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by ln_0 View Post
    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>

  16. #16
    New Member
    Join Date
    May 2020
    Posts
    7

    Re: [VB6] Simple AES 256-bit password protected encryption

    ok,Thanks for your advice

  17. #17
    New Member
    Join Date
    Jul 2020
    Posts
    1

    Re: [VB6] Simple AES 256-bit password protected encryption

    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

  18. #18

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by IWASHERE View Post
    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>

  19. #19
    New Member
    Join Date
    Nov 2019
    Posts
    5

    Re: [VB6] Simple AES 256-bit password protected encryption

    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,
    Last edited by BuntyK; Jul 8th, 2021 at 07:29 AM.

  20. #20

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  21. #21
    New Member
    Join Date
    Nov 2019
    Posts
    5

    Re: [VB6] Simple AES 256-bit password protected encryption

    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,

  22. #22
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,857

    Re: [VB6] Simple AES 256-bit password protected encryption

    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

  23. #23
    New Member
    Join Date
    Nov 2019
    Posts
    5

    Re: [VB6] Simple AES 256-bit password protected encryption

    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.

  24. #24
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by wqweto View Post
    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:
    1. '--- mdAesCtr.bas
    2. Option Explicit
    3. DefObj A-Z
    4.  
    5. #Const ImplUseShared = False
    6.  
    7. '=========================================================================
    8. ' API
    9. '=========================================================================
    10.  
    11. '--- for CNG
    12. Private Const MS_PRIMITIVE_PROVIDER         As String = "Microsoft Primitive Provider"
    13. Private Const BCRYPT_CHAIN_MODE_ECB         As String = "ChainingModeECB"
    14. Private Const BCRYPT_ALG_HANDLE_HMAC_FLAG   As Long = 8
    15.  
    16. '--- for CryptStringToBinary
    17. Private Const CRYPT_STRING_BASE64           As Long = 1
    18. '--- for WideCharToMultiByte
    19. Private Const CP_UTF8                       As Long = 65001
    20. '--- for FormatMessage
    21. Private Const FORMAT_MESSAGE_FROM_SYSTEM    As Long = &H1000
    22. Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
    23.  
    24. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    25. Private Declare Function BCryptOpenAlgorithmProvider Lib "bcrypt" (phAlgorithm As Long, ByVal pszAlgId As Long, ByVal pszImplementation As Long, ByVal dwFlags As Long) As Long
    26. Private Declare Function BCryptCloseAlgorithmProvider Lib "bcrypt" (ByVal hAlgorithm As Long, ByVal dwFlags As Long) As Long
    27. 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
    28. 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
    29. 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
    30. Private Declare Function BCryptDestroyKey Lib "bcrypt" (ByVal hKey As Long) As Long
    31. 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
    32. 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
    33. 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
    34. Private Declare Function BCryptDestroyHash Lib "bcrypt" (ByVal hHash As Long) As Long
    35. Private Declare Function BCryptHashData Lib "bcrypt" (ByVal hHash As Long, pbInput As Any, ByVal cbInput As Long, ByVal dwFlags As Long) As Long
    36. Private Declare Function BCryptFinishHash Lib "bcrypt" (ByVal hHash As Long, pbOutput As Any, ByVal cbOutput As Long, ByVal dwFlags As Long) As Long
    37. #If Not ImplUseShared Then
    38.     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
    39.     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
    40.     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
    41.     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
    42.     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
    43. #End If
    44.  
    45. '=========================================================================
    46. ' Constants and member variables
    47. '=========================================================================
    48.  
    49. Private Const ERR_UNSUPPORTED_ENCR  As String = "Unsupported encryption"
    50. Private Const AES_BLOCK_SIZE        As Long = 16
    51. Private Const AES_KEYLEN            As Long = 32                    '-- 32 -> AES-256, 24 -> AES-196, 16 -> AES-128
    52. Private Const AES_SALT              As String = "SaltVb6CryptoAes"  '-- at least 16 chars
    53.  
    54. Private Type UcsZipCryptoType
    55.     hPbkdf2Alg          As Long
    56.     hHmacAlg            As Long
    57.     hHmacHash           As Long
    58.     HmacHashLen         As Long
    59.     hAesAlg             As Long
    60.     hAesKey             As Long
    61.     AesKeyObjData()     As Byte
    62.     AesKeyObjLen        As Long
    63.     Nonce(0 To 1)       As Long
    64.     EncrData()          As Byte
    65.     EncrPos             As Long
    66.     LastError           As String
    67. End Type
    68.  
    69. '=========================================================================
    70. ' Functions
    71. '=========================================================================
    72.  
    73. Public Function AesEncryptString(sText As String, sPassword As String) As String
    74.     Dim baData()        As Byte
    75.     Dim sError          As String
    76.    
    77.     baData = ToUtf8Array(sText)
    78.     If Not AesCryptArray(baData, ToUtf8Array(sPassword), Error:=sError) Then
    79.         Err.Raise vbObjectError, , sError
    80.     End If
    81.     AesEncryptString = ToBase64Array(baData)
    82. End Function
    83.  
    84. Public Function AesDecryptString(sEncr As String, sPassword As String) As String
    85.     Dim baData()        As Byte
    86.     Dim sError          As String
    87.    
    88.     baData = FromBase64Array(sEncr)
    89.     If Not AesCryptArray(baData, ToUtf8Array(sPassword), Error:=sError) Then
    90.         Err.Raise vbObjectError, , sError
    91.     End If
    92.     AesDecryptString = FromUtf8Array(baData)
    93. End Function
    94.  
    95. Public Function AesCryptArray( _
    96.             baData() As Byte, _
    97.             baPass() As Byte, _
    98.             Optional Salt As String, _
    99.             Optional ByVal KeyLen As Long, _
    100.             Optional Error As String, _
    101.             Optional HmacSha1 As Variant) As Boolean
    102.     Const VT_BYREF      As Long = &H4000
    103.     Dim uCtx            As UcsZipCryptoType
    104.     Dim vErr            As Variant
    105.     Dim bHashBefore     As Boolean
    106.     Dim bHashAfter      As Boolean
    107.     Dim baTemp()        As Byte
    108.     Dim lPtr            As Long
    109.    
    110.     On Error GoTo EH
    111.     If Not IsMissing(HmacSha1) Then
    112.         bHashBefore = (HmacSha1(0) <= 0)
    113.         bHashAfter = (HmacSha1(0) > 0)
    114.     End If
    115.     If LenB(Salt) > 0 Then
    116.         baTemp = ToUtf8Array(Salt)
    117.     Else
    118.         baTemp = ToUtf8Array(AES_SALT)
    119.     End If
    120.     If KeyLen <= 0 Then
    121.         KeyLen = AES_KEYLEN
    122.     End If
    123.     If Not pvCryptoAesInit(uCtx, baPass, baTemp, KeyLen, 0) Then
    124.         Error = uCtx.LastError
    125.         GoTo QH
    126.     End If
    127.     If Not pvCryptoAesCrypt(uCtx, baData, Size:=UBound(baData) + 1, HashBefore:=bHashBefore, HashAfter:=bHashAfter) Then
    128.         Error = uCtx.LastError
    129.         GoTo QH
    130.     End If
    131.     If Not IsMissing(HmacSha1) Then
    132.         baTemp = pvCryptoAesGetFinalHash(uCtx, UBound(HmacSha1) + 1)
    133.         lPtr = Peek((VarPtr(HmacSha1) Xor &H80000000) + 8 Xor &H80000000)
    134.         If (Peek(VarPtr(HmacSha1)) And VT_BYREF) <> 0 Then
    135.             lPtr = Peek(lPtr)
    136.         End If
    137.         lPtr = Peek((lPtr Xor &H80000000) + 12 Xor &H80000000)
    138.         Call CopyMemory(ByVal lPtr, baTemp(0), UBound(baTemp) + 1)
    139.     End If
    140.     '--- success
    141.     AesCryptArray = True
    142. QH:
    143.     pvCryptoAesTerminate uCtx
    144.     Exit Function
    145. EH:
    146.     vErr = Array(Err.Number, Err.Source, Err.Description)
    147.     pvCryptoAesTerminate uCtx
    148.     Err.Raise vErr(0), vErr(1), vErr(2)
    149. End Function
    150.  
    151. '= private ===============================================================
    152.  
    153. Private Function pvCryptoAesInit(uCrypto As UcsZipCryptoType, baPass() As Byte, baSalt() As Byte, ByVal lKeyLen As Long, nPassVer As Integer) As Boolean
    154.     Dim baDerivedKey()  As Byte
    155.     Dim lDummy          As Long '--- discarded
    156.     Dim hResult         As Long
    157.     Dim sApiSource      As String
    158.    
    159.     '--- init member vars
    160.     uCrypto.Nonce(0) = 0
    161.     uCrypto.Nonce(1) = 0
    162.     uCrypto.EncrData = vbNullString
    163.     uCrypto.EncrPos = 0
    164.     '--- generate RFC 2898 based derived key
    165.     On Error GoTo EH_Unsupported '--- CNG API missing on XP
    166.     hResult = BCryptOpenAlgorithmProvider(uCrypto.hPbkdf2Alg, StrPtr("SHA1"), StrPtr(MS_PRIMITIVE_PROVIDER), BCRYPT_ALG_HANDLE_HMAC_FLAG)
    167.     If hResult <> 0 Then
    168.         sApiSource = "BCryptOpenAlgorithmProvider(SHA1)"
    169.         GoTo QH
    170.     End If
    171.     On Error GoTo 0
    172.     ReDim baDerivedKey(0 To 2 * lKeyLen + 1) As Byte
    173.     On Error GoTo EH_Unsupported '--- PBKDF2 API missing on Vista
    174.     hResult = BCryptDeriveKeyPBKDF2(uCrypto.hPbkdf2Alg, baPass(0), UBound(baPass) + 1, baSalt(0), UBound(baSalt) + 1, 1000, 0, baDerivedKey(0), UBound(baDerivedKey) + 1, 0)
    175.     If hResult <> 0 Then
    176.         sApiSource = "BCryptDeriveKeyPBKDF2"
    177.         GoTo QH
    178.     End If
    179.     On Error GoTo 0
    180.     '--- extract Password Verification Value from last 2 bytes of derived key
    181.     Call CopyMemory(nPassVer, baDerivedKey(2 * lKeyLen), 2)
    182.     '--- init AES w/ ECB from first half of derived key
    183.     hResult = BCryptOpenAlgorithmProvider(uCrypto.hAesAlg, StrPtr("AES"), StrPtr(MS_PRIMITIVE_PROVIDER), 0)
    184.     If hResult <> 0 Then
    185.         sApiSource = "BCryptOpenAlgorithmProvider(AES)"
    186.         GoTo QH
    187.     End If
    188.     hResult = BCryptGetProperty(uCrypto.hAesAlg, StrPtr("ObjectLength"), uCrypto.AesKeyObjLen, 4, lDummy, 0)
    189.     If hResult <> 0 Then
    190.         sApiSource = "BCryptGetProperty(ObjectLength)"
    191.         GoTo QH
    192.     End If
    193.     hResult = BCryptSetProperty(uCrypto.hAesAlg, StrPtr("ChainingMode"), StrPtr(BCRYPT_CHAIN_MODE_ECB), LenB(BCRYPT_CHAIN_MODE_ECB), 0)
    194.     If hResult <> 0 Then
    195.         sApiSource = "BCryptSetProperty(ChainingMode)"
    196.         GoTo QH
    197.     End If
    198.     ReDim uCrypto.AesKeyObjData(0 To uCrypto.AesKeyObjLen - 1) As Byte
    199.     hResult = BCryptGenerateSymmetricKey(uCrypto.hAesAlg, uCrypto.hAesKey, uCrypto.AesKeyObjData(0), uCrypto.AesKeyObjLen, baDerivedKey(0), lKeyLen, 0)
    200.     If hResult <> 0 Then
    201.         sApiSource = "BCryptGenerateSymmetricKey"
    202.         GoTo QH
    203.     End If
    204.     '-- init HMAC from second half of derived key
    205.     hResult = BCryptOpenAlgorithmProvider(uCrypto.hHmacAlg, StrPtr("SHA1"), StrPtr(MS_PRIMITIVE_PROVIDER), BCRYPT_ALG_HANDLE_HMAC_FLAG)
    206.     If hResult <> 0 Then
    207.         sApiSource = "BCryptOpenAlgorithmProvider(SHA1)"
    208.         GoTo QH
    209.     End If
    210.     hResult = BCryptGetProperty(uCrypto.hHmacAlg, StrPtr("HashDigestLength"), uCrypto.HmacHashLen, 4, lDummy, 0)
    211.     If hResult <> 0 Then
    212.         sApiSource = "BCryptGetProperty(HashDigestLength)"
    213.         GoTo QH
    214.     End If
    215.     hResult = BCryptCreateHash(uCrypto.hHmacAlg, uCrypto.hHmacHash, 0, 0, baDerivedKey(lKeyLen), lKeyLen, 0)
    216.     If hResult <> 0 Then
    217.         sApiSource = "BCryptCreateHash"
    218.         GoTo QH
    219.     End If
    220.     '--- success
    221.     pvCryptoAesInit = True
    222.     Exit Function
    223. QH:
    224.     If Err.LastDllError <> 0 Then
    225.         uCrypto.LastError = GetSystemMessage(Err.LastDllError)
    226.     Else
    227.         uCrypto.LastError = "[" & Hex(hResult) & "] Error in " & sApiSource
    228.     End If
    229.     Exit Function
    230. EH_Unsupported:
    231.     uCrypto.LastError = ERR_UNSUPPORTED_ENCR
    232. End Function
    233.  
    234. Private Sub pvCryptoAesTerminate(uCrypto As UcsZipCryptoType)
    235.     If uCrypto.hPbkdf2Alg <> 0 Then
    236.         Call BCryptCloseAlgorithmProvider(uCrypto.hPbkdf2Alg, 0)
    237.         uCrypto.hPbkdf2Alg = 0
    238.     End If
    239.     If uCrypto.hHmacHash <> 0 Then
    240.         Call BCryptDestroyHash(uCrypto.hHmacHash)
    241.         uCrypto.hHmacHash = 0
    242.     End If
    243.     If uCrypto.hHmacAlg <> 0 Then
    244.         Call BCryptCloseAlgorithmProvider(uCrypto.hHmacAlg, 0)
    245.         uCrypto.hHmacAlg = 0
    246.     End If
    247.     If uCrypto.hAesKey <> 0 Then
    248.         Call BCryptDestroyKey(uCrypto.hAesKey)
    249.         uCrypto.hAesKey = 0
    250.     End If
    251.     If uCrypto.hAesAlg <> 0 Then
    252.         Call BCryptCloseAlgorithmProvider(uCrypto.hAesAlg, 0)
    253.         uCrypto.hAesAlg = 0
    254.     End If
    255. End Sub
    256.  
    257. Private Function pvCryptoAesCrypt( _
    258.             uCrypto As UcsZipCryptoType, _
    259.             baData() As Byte, _
    260.             Optional ByVal Offset As Long, _
    261.             Optional ByVal Size As Long, _
    262.             Optional ByVal HashBefore As Boolean, _
    263.             Optional ByVal HashAfter As Boolean) As Boolean
    264.     Dim lIdx            As Long
    265.     Dim lJdx            As Long
    266.     Dim lPadSize        As Long
    267.     Dim hResult         As Long
    268.     Dim sApiSource      As String
    269.    
    270.     If Size < 0 Then
    271.         Size = UBound(baData) + 1 - Offset
    272.     End If
    273.     If HashBefore Then
    274.         hResult = BCryptHashData(uCrypto.hHmacHash, baData(Offset), Size, 0)
    275.         If hResult <> 0 Then
    276.             sApiSource = "BCryptHashData"
    277.             GoTo QH
    278.         End If
    279.     End If
    280.     With uCrypto
    281.         '--- reuse EncrData from prev call until next AES_BLOCK_SIZE boundary
    282.         For lIdx = Offset To Offset + Size - 1
    283.             If (.EncrPos And (AES_BLOCK_SIZE - 1)) = 0 Then
    284.                 Exit For
    285.             End If
    286.             baData(lIdx) = baData(lIdx) Xor .EncrData(.EncrPos)
    287.             .EncrPos = .EncrPos + 1
    288.         Next
    289.         If lIdx < Offset + Size Then
    290.             '--- pad remaining input size to AES_BLOCK_SIZE
    291.             lPadSize = (Offset + Size - lIdx + AES_BLOCK_SIZE - 1) And -AES_BLOCK_SIZE
    292.             If UBound(.EncrData) + 1 < lPadSize Then
    293.                 ReDim .EncrData(0 To lPadSize - 1) As Byte
    294.             End If
    295.             '--- encrypt incremental nonces in EncrData
    296.             For lJdx = 0 To lPadSize - 1 Step 16
    297.                 If .Nonce(0) <> -1 Then
    298.                     .Nonce(0) = (.Nonce(0) Xor &H80000000) + 1 Xor &H80000000
    299.                 Else
    300.                     .Nonce(0) = 0
    301.                     .Nonce(1) = (.Nonce(1) Xor &H80000000) + 1 Xor &H80000000
    302.                 End If
    303.                 Call CopyMemory(.EncrData(lJdx), .Nonce(0), 8)
    304.             Next
    305.             hResult = BCryptEncrypt(.hAesKey, .EncrData(0), lPadSize, 0, 0, 0, .EncrData(0), lPadSize, lJdx, 0)
    306.             If hResult <> 0 Then
    307.                 sApiSource = "BCryptEncrypt"
    308.                 GoTo QH
    309.             End If
    310.             '--- xor remaining input and leave anything extra of EncrData for reuse
    311.             For .EncrPos = 0 To Offset + Size - lIdx - 1
    312.                 baData(lIdx) = baData(lIdx) Xor .EncrData(.EncrPos)
    313.                 lIdx = lIdx + 1
    314.             Next
    315.         End If
    316.     End With
    317.     If HashAfter Then
    318.         hResult = BCryptHashData(uCrypto.hHmacHash, baData(Offset), Size, 0)
    319.         If hResult <> 0 Then
    320.             sApiSource = "BCryptHashData"
    321.             GoTo QH
    322.         End If
    323.     End If
    324.     '--- success
    325.     pvCryptoAesCrypt = True
    326.     Exit Function
    327. QH:
    328.     If Err.LastDllError <> 0 Then
    329.         uCrypto.LastError = GetSystemMessage(Err.LastDllError)
    330.     Else
    331.         uCrypto.LastError = "[" & Hex(hResult) & "] Error in " & sApiSource
    332.     End If
    333. End Function
    334.  
    335. Private Function pvCryptoAesGetFinalHash(uCrypto As UcsZipCryptoType, ByVal lSize As Long) As Byte()
    336.     Dim baResult()      As Byte
    337.    
    338.     ReDim baResult(0 To uCrypto.HmacHashLen - 1) As Byte
    339.     Call BCryptFinishHash(uCrypto.hHmacHash, baResult(0), uCrypto.HmacHashLen, 0)
    340.     ReDim Preserve baResult(0 To lSize - 1) As Byte
    341.     pvCryptoAesGetFinalHash = baResult
    342. End Function
    343.  
    344. '= shared ================================================================
    345.  
    346. #If Not ImplUseShared Then
    347. Public Function ToBase64Array(baData() As Byte) As String
    348.     Dim lSize           As Long
    349.    
    350.     If UBound(baData) >= 0 Then
    351.         ToBase64Array = String$(2 * UBound(baData) + 6, 0)
    352.         lSize = Len(ToBase64Array) + 1
    353.         Call CryptBinaryToString(VarPtr(baData(0)), UBound(baData) + 1, CRYPT_STRING_BASE64, StrPtr(ToBase64Array), lSize)
    354.         ToBase64Array = Left$(ToBase64Array, lSize)
    355.     End If
    356. End Function
    357.  
    358. Public Function FromBase64Array(sText As String) As Byte()
    359.     Dim lSize           As Long
    360.     Dim baOutput()      As Byte
    361.    
    362.     lSize = Len(sText) + 1
    363.     ReDim baOutput(0 To lSize - 1) As Byte
    364.     Call CryptStringToBinary(StrPtr(sText), Len(sText), CRYPT_STRING_BASE64, VarPtr(baOutput(0)), lSize, 0, 0)
    365.     If lSize > 0 Then
    366.         ReDim Preserve baOutput(0 To lSize - 1) As Byte
    367.         FromBase64Array = baOutput
    368.     Else
    369.         FromBase64Array = vbNullString
    370.     End If
    371. End Function
    372.  
    373. Public Function ToUtf8Array(sText As String) As Byte()
    374.     Dim baRetVal()      As Byte
    375.     Dim lSize           As Long
    376.    
    377.     lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), ByVal 0, 0, 0, 0)
    378.     If lSize > 0 Then
    379.         ReDim baRetVal(0 To lSize - 1) As Byte
    380.         Call WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), baRetVal(0), lSize, 0, 0)
    381.     Else
    382.         baRetVal = vbNullString
    383.     End If
    384.     ToUtf8Array = baRetVal
    385. End Function
    386.  
    387. Public Function FromUtf8Array(baText() As Byte) As String
    388.     Dim lSize           As Long
    389.    
    390.     If UBound(baText) >= 0 Then
    391.         FromUtf8Array = String$(2 * UBound(baText), 0)
    392.         lSize = MultiByteToWideChar(CP_UTF8, 0, baText(0), UBound(baText) + 1, StrPtr(FromUtf8Array), Len(FromUtf8Array))
    393.         FromUtf8Array = Left$(FromUtf8Array, lSize)
    394.     End If
    395. End Function
    396.  
    397. Public Function GetSystemMessage(ByVal lLastDllError As Long) As String
    398.     Dim lSize            As Long
    399.    
    400.     GetSystemMessage = Space$(2000)
    401.     lSize = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, lLastDllError, 0&, GetSystemMessage, Len(GetSystemMessage), 0&)
    402.     If lSize > 2 Then
    403.         If Mid$(GetSystemMessage, lSize - 1, 2) = vbCrLf Then
    404.             lSize = lSize - 2
    405.         End If
    406.     End If
    407.     GetSystemMessage = "[" & lLastDllError & "] " & Left$(GetSystemMessage, lSize)
    408. End Function
    409.  
    410. Private Function Peek(ByVal lPtr As Long) As Long
    411.     Call CopyMemory(Peek, ByVal lPtr, 4)
    412. End Function
    413. #End If

    More samples

    thinBasic Code:
    1. Private Sub TestEncrypt()
    2.     Dim sPass       As String
    3.     Dim sText       As String
    4.     Dim sEncr       As String
    5.    
    6.     sPass = "password123"
    7.     sText = "this is a test"
    8.     sEncr = AesEncryptString(sText, sPass)
    9.     Debug.Assert sText = AesDecryptString(sEncr, sPass)
    10.    
    11.     Debug.Print sEncr
    12.     Debug.Print FromUtf8Array(FromBase64Array(sEncr))
    13.     Debug.Print AesDecryptString(sEncr, sPass)
    14. End Sub
    15.    
    16. Private Sub TestHmac()
    17.     Dim baEncr()    As Byte
    18.     Dim baHmacEncr(0 To 19) As Byte
    19.     Dim baHmacDecr(0 To 19) As Byte
    20.    
    21.     baEncr = ToUtf8Array("test message")
    22.     baHmacEncr(0) = 0           '--- 0 -> generate hash before encrypting
    23.     AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacEncr
    24.     baHmacDecr(0) = 1           '--- 1 -> decrypt and generate hash after that
    25.     AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacDecr
    26.     Debug.Assert StrConv(baHmacDecr, vbUnicode) = StrConv(baHmacEncr, vbUnicode)
    27.    
    28.     Debug.Print ToBase64Array(baHmacDecr)
    29.     Debug.Print ToBase64Array(baHmacEncr)
    30. 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!

  25. #25

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  26. #26

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  27. #27

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  28. #28
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by wqweto View Post
    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.

  29. #29

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  30. #30
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Thanks.

    Also, I guess it is SAFE (by safe here I mean URL compatible) to pass decrypted data as parameters, right?
    Last edited by labmany; Dec 11th, 2021 at 01:22 AM.

  31. #31
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Sorry!

  32. #32
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>';
    ?>

  33. #33

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  34. #34
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Thanks a lot.
    I do appreciate your efforts.

  35. #35
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    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?

  36. #36

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

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

    All fixed now!

    Diff of changes is here.

    cheers,
    </wqw>

  37. #37
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by wqweto View Post
    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.

  38. #38
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    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!

  39. #39

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,095

    Re: [VB6] Simple AES 256-bit password protected encryption

    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>

  40. #40
    Addicted Member
    Join Date
    Sep 2015
    Posts
    225

    Re: [VB6] Simple AES 256-bit password protected encryption

    Quote Originally Posted by wqweto View Post
    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

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width