Page 2 of 2 FirstFirst 12
Results 41 to 66 of 66

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

  1. #41
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    This is a really wonderful thread! I unfortunately discovered it far too late. Otherwise I could have saved myself many days of work. Although I have not yet contributed anything myself, I would like to express my heartfelt thanks to all who contribute here!

  2. #42
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    Quote Originally Posted by wqweto View Post
    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>
    Unfortunately, it only works for me with strings of less than 16 characters. I have tested it under Windows XP with VB6 and it always gives a runtime error and the message "[234] There is more data available" when I want to encrypt strings with more than 15 characters. Has anyone ever tested this with more than 15 characters? The CTR code, on the other hand, works with strings of any length.

    Edit: Very strange! The exception is not fired with every string, but only with some. The following string gives the error: "testtesttesttest" with password "12345678901234567890123456789012" whereas "testtesttesttestt" does not give an error. I think there is still a bug to fix ;-)
    Attached Images Attached Images  
    Last edited by volkeru; Feb 3rd, 2022 at 05:54 PM.

  3. #43
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    I'll give myself the answer: The problem arises from the CryptEncrypt function. The number of bytes to be encoded specified in pdwDataLen can be identical to the buffer size dwBufLen. And that is obviously a problem. Here an excerpt from the documentation of the function:

    If the buffer allocated for pbData is not large enough to hold the encrypted data, GetLastError returns ERROR_MORE_DATA and stores the required buffer size, in bytes, in the DWORD value pointed to by pdwDataLen.
    With a number of 16 bytes to encode and a buffer length of 16 bytes, pdwDataLen returns the number of 32 bytes required. Therefore, the error ERROR_MORE_DATA is returned.

    However, if I change line

    Code:
        lPadSize = (lSize + AES_BLOCK_SIZE - 1) And -AES_BLOCK_SIZE
    in the code to

    Code:
        lPadSize = (lSize + AES_BLOCK_SIZE) And -AES_BLOCK_SIZE
    the error no longer occurs. This is because a buffer of 32 bytes is then reserved for a data length of 16 bytes, etc. I have now tested 4096 encryptions and decryptions with random strings from 1 to 4096 bytes in length and everything worked fine.
    Last edited by volkeru; Feb 3rd, 2022 at 09:45 PM.

  4. #44

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

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

    @volkeru: Your analysis is correct. Thanks for that!

    PKCS #7 padding for plaintext of size multiple of AES_BLOCK_SIZE (16) is not 0 but 16 i.e. this is the most inefficient case where tha last 16 bytes are padded with 15, 15, 15, 15, .... so the complete AES block is wasted.

    Fixed in latest commit, here is the diff.

    Edit: Another fix for empty string handling in both encrypt and decrypt.

    cheers,
    </wqw>

  5. #45
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    @wqweto: Thank you so much for the fast answer and the modification to the code! And thank you very much for sharing your work!

  6. #46
    New Member
    Join Date
    Feb 2022
    Posts
    1

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

    I'm trying to create a SHA256 object from MS Access VBA, and it won't work. See the attached code sample for details. I'm running Access 2016 on a Windows machine with .NET 4.8. I believe I've tried everything obvious. Any suggestions would be much appreciated.

    Code:
    Public Function Base64_HMACSHA256(ByVal sTextToHash As String, ByVal sSharedSecretKey As String) As String
        Dim asc As Object, enc As Object
        Dim TextToHash() As Byte
        Dim SharedSecretKey() As Byte
        Set asc = CreateObject("System.Text.UTF8Encoding")
        'Set enc = CreateObject("System.Security.Cryptography.HMACSHA256") 'THIS SUCCESSFULLY CREATES THE OBJECT
        'Set enc = CreateObject("System.Security.Cryptography.SHA256") 'IHF 02/03/22 'CAN'T CREATE OBJECT
        'Set enc = CreateObject("System.Security.Cryptography.SHA256CryptoServiceProvider") 'IHF 02/03/22 'CAN'T CREATE OBJECT
        'Set enc = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider") 'CAN'T CREATE OBJECT
        TextToHash = asc.Getbytes_4(sTextToHash)
        SharedSecretKey = asc.Getbytes_4(sSharedSecretKey)    
        enc.Key = SharedSecretKey 
        Dim bytes() As Byte
        bytes = enc.ComputeHash_2((TextToHash))
        Base64_HMACSHA256 = EncodeBase64(bytes)
        Set asc = Nothing
        Set enc = Nothing
    End Function

  7. #47
    New Member
    Join Date
    Feb 2022
    Posts
    2

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

    Hi,

    first of all: great forum. Thanks for the living the spirit of sharing and supporting.

    I tried the latest code-version of mdAesCbc.bas in my excel and in general it worked! That's already great! .

    Unfortunately i need encoding string in excel and let these decode in another system / software. That software uses AES256, CBC, IV = 0000000000000000, no salt (as it seems). The results are matching with these from several AES-encyption / decryption websites.

    1. Can i anyhow specifiy the IV itself to make the results of encryption here match with the external software and making these two "work" together?

    2. Can the salt be set to 0 / "" without problems?

    Thank you in advance,

    regards

    zerbes

  8. #48

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

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

    1. You have to specify both key and IV in principle. Here a password is used to “generate” both key and IV. The “generation” uses a random salt on the password too and the salt is output in final result too (along with ciphertext obviously).

    This is done in a compatible way so that the receiving party can use openssl.exe to decrypt the message provided that they know the password only.

    2. You need salt only for some password being used. You don’t need salt nor password when you want to specify both key and IV for the AES in CBC mode to use.

  9. #49
    New Member
    Join Date
    Feb 2022
    Posts
    2

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

    Hi,

    thanks for your support. The receiving party can't use any binaries to decrypt my encrypted strings, i can just use the application-layer with a provided class and methods. Let me note the results here:

    external system:

    AES256-key: C&F)J@NcRfUjXn2r5u7x!A%D*G-KaPdS
    Plain-String: www.vbforums.com
    IV: 0000000000000000
    Salt used: no

    results in encrypted string: bTaRHvRreoUIVuqQt7/BZ4Ez5YGh61nx66EzSJK5fgk=

    Same result is received using the values on several websites.

    The Excel returns encrypted string: Result (Base64): U2FsdGVkX18aB5L57pS8944M9OlMeCe6XLrJAvN0YsM=
    and this string can't neither be decrypted using a website nor the implementation on the external system. The Message seen when trying refers anyhow to "bad padding".

    I have a general understanding of how the encryption works, still i am not seeing what i need to adjust to make the VBA create encrypted strings that can be decrypted by the external system using a specifyable IV and without salt.
    Last edited by zerbes; Feb 8th, 2022 at 09:20 AM.

  10. #50
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    I'm using wqweto's mdAesCbc.bas to encrypt my data end decrypt them with the PHP script from labmany. That works great!

    One of my users now has the software running on Linux with wine and found that it does not work there. On wine, mdAesCbc.bas also generates encrypted data blocks, but these can no longer be decrypted with the PHP script. They always result in an empty string there. Apparently the advapi32.dll on linux wine is not compatible with the one under Windows. Does anyone know more about this? It would be interesting to know what the cause is and whether it can be fixed somehow...

    Many greetings, Volker

  11. #51
    Angel of Code Niya's Avatar
    Join Date
    Nov 2011
    Posts
    8,598

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

    Quote Originally Posted by volkeru View Post
    I'm using wqweto's mdAesCbc.bas to encrypt my data end decrypt them with the PHP script from labmany. That works great!

    One of my users now has the software running on Linux with wine and found that it does not work there. On wine, mdAesCbc.bas also generates encrypted data blocks, but these can no longer be decrypted with the PHP script. They always result in an empty string there. Apparently the advapi32.dll on linux wine is not compatible with the one under Windows. Does anyone know more about this? It would be interesting to know what the cause is and whether it can be fixed somehow...

    Many greetings, Volker
    Sounds more like a Wine problem. This might be something the Wine devs would want to know about but I will leave it to the crypto experts to determine if that is indeed the case.
    Treeview with NodeAdded/NodesRemoved events | BlinkLabel control | Calculate Permutations | Object Enums | ComboBox with centered items | .Net Internals article(not mine) | Wizard Control | Understanding Multi-Threading | Simple file compression | Demon Arena

    Copy/move files using Windows Shell | I'm not wanted

    C++ programmers will dismiss you as a cretinous simpleton for your inability to keep track of pointers chained 6 levels deep and Java programmers will pillory you for buying into the evils of Microsoft. Meanwhile C# programmers will get paid just a little bit more than you for writing exactly the same code and VB6 programmers will continue to whitter on about "footprints". - FunkyDexter

    There's just no reason to use garbage like InputBox. - jmcilhinney

    The threads I start are Niya and Olaf free zones. No arguing about the benefits of VB6 over .NET here please. Happiness must reign. - yereverluvinuncleber

  12. #52

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

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

    Quote Originally Posted by zerbes View Post
    Hi,

    thanks for your support. The receiving party can't use any binaries to decrypt my encrypted strings, i can just use the application-layer with a provided class and methods. Let me note the results here:

    external system:

    AES256-key: C&F)J@NcRfUjXn2r5u7x!A%D*G-KaPdS
    Plain-String: www.vbforums.com
    IV: 0000000000000000
    Salt used: no

    results in encrypted string: bTaRHvRreoUIVuqQt7/BZ4Ez5YGh61nx66EzSJK5fgk=

    Same result is received using the values on several websites.

    The Excel returns encrypted string: Result (Base64): U2FsdGVkX18aB5L57pS8944M9OlMeCe6XLrJAvN0YsM=
    and this string can't neither be decrypted using a website nor the implementation on the external system. The Message seen when trying refers anyhow to "bad padding".

    I have a general understanding of how the encryption works, still i am not seeing what i need to adjust to make the VBA create encrypted strings that can be decrypted by the external system using a specifyable IV and without salt.
    I just tweaked the mdAesCbc.bas above to accept byte-arrays for second parameter which is treated directly as the AES256-CBC key and IV (no PBKDF2 derivation and no salt is stored/used).

    For instance this code

    Code:
        Dim baKey()     As Byte
        Dim sText       As String
        Dim sEncr       As String
        
        baKey = StrConv("C&F)J@NcRfUjXn2r5u7x!A%D*G-KaPdS", vbFromUnicode)
        sText = "www.vbforums.com"
        sEncr = AesEncryptString(sText, baKey)
        Debug.Print sEncr
    . . . produces +hYo90qObfy5tAy0HjtioXnc2o3P1JMgBLyzXDHoRbM= while this code

    Code:
        Dim baKey()     As Byte
        Dim sText       As String
        Dim sEncr       As String
        
        baKey = StrConv("C&F)J@NcRfUjXn2r5u7x!A%D*G-KaPdS0000000000000000", vbFromUnicode)
        sText = "www.vbforums.com"
        sEncr = AesEncryptString(sText, baKey)
        Debug.Print sEncr
    . . . produces bTaRHvRreoUIVuqQt7/BZ4Ez5YGh61nx66EzSJK5fgk= so the IV is optional and can be passed in the same byte-array immediately after the 32-byte key.

    The module is VBA/TB compatible now incl. x64 support.

    cheers,
    </wqw>

  13. #53
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    Quote Originally Posted by Niya View Post
    Sounds more like a Wine problem. This might be something the Wine devs would want to know about but I will leave it to the crypto experts to determine if that is indeed the case.
    The problem has been reported repeatedly in various places since autumn '21. It seemed to work before, but then it was apparently "engineered out of order". It doesn't seem to interest the wine developers. Unfortunately, there has not been a single reaction so far. I have now also checked again, but I don't expect any reaction either: https://forum.winehq.org/viewtopic.php?f=8&t=35667
    Last edited by volkeru; Feb 13th, 2022 at 09:24 AM.

  14. #54

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

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

    Quote Originally Posted by volkeru View Post
    The problem has been reported repeatedly in various places since autumn '21. It seemed to work before, but then it was apparently "engineered out of order". It doesn't seem to interest the wine developers. Unfortunately, there has not been a single reaction so far. I have now also checked again, but I don't expect any reaction either: https://forum.winehq.org/viewtopic.php?f=8&t=35667
    It's not that it doesn't interest the Wine developers to fix this but the fixme warning cited in the bug report make no sense and it's not apparent how to dig into the root cause of the problem.

    Take a look yourself which GNUTLS cipher is designated 23: https://cs.github.com/gnutls/gnutls?q=GNUTLS_CIPHER+23

    CHACHA20 is not supported by Crypto API so it's not needed for AES -- the problem is elsewhere, the fixme messages are false lead.

    At this point only a small C application (a single main function) which clearly produces invalid result under Wine can convince anyone to debug the problem IMO.

    cheers,
    </wqw>

  15. #55
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    Quote Originally Posted by wqweto View Post
    It's not that it doesn't interest the Wine developers to fix this but the fixme warning cited in the bug report make no sense and it's not apparent how to dig into the root cause of the problem.
    Well, the fixme warning is the only one issued in relation to the encryption problem with wine. If you deactivate the encryption, this message also disappears. The non-functioning of the VST plug-ins is certainly also related to the faulty encryption.

    Quote Originally Posted by wqweto View Post
    Take a look yourself which GNUTLS cipher is designated 23: https://cs.github.com/gnutls/gnutls?q=GNUTLS_CIPHER+23
    Okay, you're right. AES256-CBC should be number 5, not 23, but why does the message about algorithm 23 disappear if you deactivate encryption 5? That's strange!

    Quote Originally Posted by wqweto View Post
    the fixme messages are false lead.
    Yeah, that's what I also think now.

    Quote Originally Posted by wqweto View Post
    At this point only a small C application (a single main function) which clearly produces invalid result under Wine can convince anyone to debug the problem IMO.
    On the other hand, we have provided more than enough information so that anyone can easily reproduce the problem within a few minutes. Actually, no C procedure is required for this. It is enough to encrypt something with AES256-CBC using wine and then decrypt it with Windows - or vice versa. My software is designed for Windows and not for wine. That's why my engagement in this matter is quite limited.

    Cheers, Volker

  16. #56
    New Member
    Join Date
    Feb 2022
    Posts
    8

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

    I have now solved the problem with the incompatible AES256-CBC encryption under wine with a workaround: Since the AES256-CTR encryption in wine is compatible with the encryption on Windows (and thus also PHP), I now always encrypt with CTR by default and only use a fallback to CBC for old Windows versions that do not yet support CTR. Of course, the PHP script has to be adapted correspondingly so that it supports both encryptions. Not a particularly nice or clean solution, but it works.

  17. #57
    New Member
    Join Date
    Feb 2022
    Posts
    1

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

    Hi wqweto, Thanks for your very helpful contribution. I am working on a VB6 project and need your help, do you have a version for ECB mode and PKCS5Padding padding method? I have a specification for communicating with a device with AES algorithm, ECB mode, PKCS5Padding padding method. Thanks a lot.

  18. #58

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

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

    You cannot use PKCS#5 padding with AES as it only supports 8 bytes of padding (AES uses 16 bytes blocks) - What is the difference between PKCS#5 padding and PKCS#7 padding

    Using ECB mode outside of other cryptographic constructs (e.g. CTR/GCM modes) is a very bad idea - The ECB Penguin.

    If you *have* to deal with such bullsh*t you can try tweaking mdAesCbc.bas source by replacing CRYPT_MODE_CBC constant with this one

    Private Const CRYPT_MODE_ECB As Long = 2

    . . . everywhere in the module's source code and hope your original assignment was meant to use PKCS#7 in first place.

    Edit: JFYI, in latest revision of mdAesCbc.bas module there is a new optional CipherMode parameter to AesChunkedInit function which optionally accepts CRYPT_MODE_ECB const as declared above (when not specified defaults to CRYPT_MODE_CBC to keep current behavior).

    cheers,
    </wqw>

  19. #59
    Member
    Join Date
    Jan 2020
    Location
    India
    Posts
    38

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

    unsupported encryption throw runtime error
    -2147221504

  20. #60

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

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

    Quote Originally Posted by hinditutorpoint View Post
    unsupported encryption throw runtime error
    -2147221504
    FYI, it says “win7 and later” in the first sentence of OP so this is normal runtime error to get on XP.

  21. #61
    Member
    Join Date
    Nov 2019
    Posts
    33

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

    @Wqweto; Can you share the binary read and write codes: ReadBinaryFile and WriteBinaryFile?

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

  22. #62

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

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

    Here you go

    Code:
    '--- mdBinaryFile.bas
    Option Explicit
    
    #Const HasPtrSafe = (VBA7 <> 0) Or (TWINBASIC <> 0)
    
    #If HasPtrSafe Then
    Private Declare PtrSafe Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    #Else
    Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    #End If
    
    Public Function ReadBinaryFile(sFile As String) As Byte()
        Dim baBuffer()      As Byte
        Dim nFile           As Integer
    
        On Error GoTo EH
        baBuffer = vbNullString
        nFile = FreeFile
        Open sFile For Binary Access Read Shared As nFile
        If LOF(nFile) > 0 Then
            ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
            Get nFile, , baBuffer
        End If
        Close nFile
        ReadBinaryFile = baBuffer
    EH:
    End Function
    
    Public Sub WriteBinaryFile(sFile As String, baBuffer() As Byte)
        Dim nFile           As Integer
        
        Call DeleteFile(sFile)
        nFile = FreeFile
        Open sFile For Binary Access Write Shared As nFile
        If UBound(baBuffer) >= 0 Then
            Put nFile, , baBuffer
        End If
        Close nFile
    End Sub
    Can be used like this

    Code:
    Private Sub TestBinary()
        Const IN_FILE As String = "D:\TEMP\aaa.txt"
        Dim baData() As Byte
        
        baData = ReadBinaryFile(IN_FILE)
        AesCryptArray baData, ToUtf8Array("pass")
        WriteBinaryFile IN_FILE & ".encrypted", baData
        
        baData = ReadBinaryFile(IN_FILE & ".encrypted")
        AesCryptArray baData, ToUtf8Array("pass")
        WriteBinaryFile IN_FILE & ".decrypted", baData
    End Sub
    Btw, just updated the the mdAesCtr.bas with some small fixes.

    cheers,
    </wqw>

  23. #63
    New Member
    Join Date
    Jan 2017
    Posts
    3

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

    Hi wqweto
    thanks for the excellent work and for sharing the code
    cheers
    Tiz

  24. #64
    Lively Member
    Join Date
    Feb 2006
    Posts
    92

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

    Quote Originally Posted by labmany View Post
    Updated the PHP code a bit!
    Code:
    <?php
    
    function AesEncryptString($text, $password)
    {...}
    
    function AesDecryptString($encr, $password)
    {......}
    
    ?>
    Thanks wqweto, as usual, for excelent code.
    Can php code be use to create stored procedure for AES 256 Encryption and Decryption in MS SQL Server 2008? Can someone share?
    Last edited by cliv; Oct 17th, 2023 at 02:17 AM.

  25. #65

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

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

    Quote Originally Posted by cliv View Post
    Thanks wqweto, as usual, for excelent code.
    Can php code be use to create stored procedure for AES 256 Encryption and Decryption in MS SQL Server 2008? Can someone share?
    Unfortunately MSSQL does not support creating/importing symmetric keys with prepared values for keys and IVs. It uses some weird scheme with KEY_SOURCE strings which is probably PBKDF2 based but not documented.

    In recent SQL 2022 there are BACKUP/RESTORE ASYMMETRIC KEY statements but it's not clear what the format of these backup files is and I'm not sure whether using .pfx containers is a possibility here.

    Edit: On second glance, there is no backup/restore for *symmetric* keys needed for AES so even these new statements (in .pfx format) cannot help.

    cheers,
    </wqw>

  26. #66
    Lively Member
    Join Date
    Feb 2006
    Posts
    92

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

    Quote Originally Posted by wqweto View Post
    Unfortunately MSSQL does not support creating/importing symmetric keys with prepared values for keys and IVs. It uses some weird scheme with KEY_SOURCE strings which is probably PBKDF2 based but not documented.
    In recent SQL 2022 there are BACKUP/RESTORE ASYMMETRIC KEY statements but it's not clear what the format of these backup files is and I'm not sure whether using .pfx containers is a possibility here.

    cheers,
    </wqw>
    Thanks for the clarification

Page 2 of 2 FirstFirst 12

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