none
Replacing CAPICOM in VBA & VBScript RRS feed

  • Question

  • No idea whether this is the correct forum category, because my query spans a number of areas. Please also understand that I am not a professional developer.

    About 12 years ago I had a licensing scheme in Excel VBA that protected certain ActiveX controls when the final workbook was sent to customers by using a license key.  The license was generated from an ASP using FrontPage 2003 and VBScript.  The whole process has worked perfectly since it was written, and the code was trivial:

    CAPICOM - License Generation (VBScript)

    '* Create the Microsoft CAPICOM EncryptedData object

          Set objCrypto = CreateObject("CAPICOM.EncryptedData")

    '* Use the Microsoft CAPICOM interface to encrypt the data

          objCrypto.Content = strLicenseText

          objCrypto.Algorithm = CAPICOM_ENCRYPTION_ALGORITHM_AES

          Call objCrypto.SetSecret(strPassword, CAPICOM_SECRET_PASSWORD)

          strLicenseKey = objCrypto.Encrypt(CAPICOM_ENCODE_BASE64)

    CAPICOM – License Check (VBA)

        Dim objCrypto As New EncryptedData      ' Microsoft CAPICOM Interface

        Call objCrypto.SetSecret(strPassword)

        objCrypto.Algorithm = CAPICOM_ENCRYPTION_ALGORITHM_AES

        Call objCrypto.Decrypt(strCryptText)

        strPlainText = CStr(objCrypto.Content)

    the whole technique only took about half a day to develop and test.

    Now Microsoft have not only deprecated the CAPICOM SDK, but now removed its download link so I can no longer send the workbook to customers with the macro and ActiveX controls I want the customers to still be able to use as I have a "Reference" to the "CAPICOM v2.1 Type Library" in the workbook.  All the alternatives to replace this functionality looked extremely painful, so I first decided on:

    • Win32 CryptoAPI for the VBA

    I was able to write a decode function, but my first problem was that it would not decode the CAPICOM generated license and so I then wrote an encryption test function and then found that it could decode a license generated using the same mechanism.  This code in summary does the following:

    VBA - WIN32 API Code Overview

    Encrypt:

    1) Create "CryptAcquireContext" (Provider: MS_ENH_RSA_AES_PROV, Provider Type: PROV_RSA_AES)
    2) Obtain a SHA1 hashing handle (AlgId: CALG_SHA1)
    3) Hash the provided Password (Key)
    4) Derive a Block Cypher Key (AlgId = CALG_AES_256, dwflags=0)
    5) Encrypt the data
    6) BASE64 encode the encrypted text "CryptBinaryToString"

    Decrypt:

    1) Create "CryptAcquireContext" (Provider: MS_ENH_RSA_AES_PROV, Provider Type: PROV_RSA_AES)
    2) Obtain a SHA1 hashing handle (AlgId: CALG_SHA1)
    3) Hash the provided Password (Key)
    4) Derive a Block Cypher Key (AlgId = CALG_AES_256, dwflags=0)
    5) Convert BASE64 to text "CryptStringToBinary"
    6) Decrypt the data

    as I could not decode the CAPICOM data I decided to bite the bullet and investigate VB.NET to replace the VBScript.  So I repeated the development of the code and test harnesses and found that again I could only decode licenses that I'd generated using the same mechanism.  After loads of reading I started to worry about:

    • Padding
    • Initialisation Vector
    • Encryption Mode

    these were things that only seemed to be exposed explicitly in the .NET APIs. I did find one article pertained to the fact that Ciphertext is NOT text & shouldn't be assigned to a VB "String", and so I then tried to convert all the Win32 Crypto API code to use Byte arrays.

    http://www.di-mgt.com.au/properpassword.html#importantnotes

    This was not successful as when I was trying to call "CryptEncrypt" I was either getting errors "Type Mismatch", or I was unable to get a return buffer size from the method with byte arrays, the code using a "String" for pbData is below and does encrypt the data:

    Private Declare Function CryptEncrypt Lib "advapi32.dll" _ (ByVal hKey As Long, _ ByVal hHash As Long, _ ByVal Final As Long, _ ByVal dwFlags As Long, _ ByVal pbData As String, _ ByRef pdwDataLen As Long, _ ByVal dwBufLen As Long) As Long

    ..

    ..


    '* Set the length to the amount of data in the plain text buffer

        lngBufferLen = Len(strPlainText)

    '* Now determine the size of the encryption buffer from the plain text data

       If (Not CBool(CryptEncrypt(lngKeyHandle, 0, 1, 0, vbNullString, lngBufferLen, lngBufferLen))) Then
            If (blnDebug) Then
                lngErrorCode = Err.LastDllError
                strErrorMessage = LastDLLErrorText(lngErrorCode)
                Call MsgBox("Error during CryptEncrypt " & CStr(lngErrorCode) & " - " & strErrorMessage)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
       End If

    '* Pad a string with the required number of spaces to accomodate the returned binary data and then
    '* merge the plain text into the correct size buffer left aligned

        strCryptBinary = Space(lngBufferLen)
        LSet strCryptBinary = strPlainText

    '* Now encrypt the data

        lngActualUsed = Len(strPlainText)

        If (Not CBool(CryptEncrypt(lngKeyHandle, 0, 1, 0, strCryptBinary, lngActualUsed, lngBufferLen))) Then
            If (blnDebug) Then
                lngErrorCode = Err.LastDllError
                strErrorMessage = LastDLLErrorText(lngErrorCode)
                Call MsgBox("Error during CryptEncrypt " & CStr(lngErrorCode) & " - " & strErrorMessage)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        Else
            strCryptText = strCryptBinary
        End If

    using the following with byte arrays just doesn't work and fails with error "234 - More data is available", presumably because the method no longer recognises the "NULL" needed by "pbData" to return the buffer length without throwing an error:

    Private Declare Function CryptEncrypt Lib "advapi32.dll" _
                             (ByVal hKey As Long, _
                              ByVal hHash As Long, _
                              ByVal Final As Long, _
                              ByVal dwFlags As Long, _
                              ByRef pbData() As Byte, _
                              ByRef pdwDataLen As Long, _
                              ByVal dwBufLen As Long) As Long
    ..
    ..
    ..
    ..
    
    '* Set the length to the amount of data in the plain text buffer
    
        lngBufferLen = Len(strPlainText)
        ReDim bytCryptBinary(0)
        bytCryptBinary(0) = CByte(0)
    
    '* Now determine the size of the encryption buffer from the plain text data
    
       If (Not CBool(CryptEncrypt(lngKeyHandle, 0, 1, 0, bytCryptBinary, lngBufferLen, 1))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText(lngErrorCode)
            strErrorMessage = "Error during CryptEncrypt " & CStr(lngErrorCode) & " - " & strErrorMessage
            If (blnDebug) Then
                Call MsgBox(strErrorMessage)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
       End If
    
    '* Convert the plain text string to a byte array and allocate the correct amount of space for the encrypted
    '* data return from the encryption algorithm
    
        bytCryptBinary = StringToByteArray(strPlainText)
        ReDim Preserve bytCryptBinary(lngBufferLen - 1)
    
    '* Now encrypt the data
    
        lngActualUsed = Len(strPlainText)
    
        If (Not CBool(CryptEncrypt(lngKeyHandle, 0, 1, 0, bytCryptBinary, lngActualUsed, lngBufferLen))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText(lngErrorCode)
            strErrorMessage = "Error during CryptEncrypt " & CStr(lngErrorCode) & " - " & strErrorMessage
            If (blnDebug) Then
                Call MsgBox(strErrorMessage)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If


    so after three weeks of research I am still no further forward with finding a consistent method to replace CAPICOM and I'm being exposed to the real underlying issues associated with cryptography which is what the CAPICOM API so neatly hid from the user.

    I am now completely stuck so does anyone know exactly what steps need to be followed to allow a license generation using VB.NET to work with a VBA Win32 Crypto API decryption using AES 256, which is what I had originally?  Clearly without an identical set of base data including padding and an identical initialisation vector I'm not going to get the same results. The Win32 API CryptEncrypt page notes:

    • If the key is a block cipher key, the data is padded to a multiple of the block size of the cipher. If the data length equals the block size of the cipher, one additional block of padding is appended to the data. To find the block size of a cipher, use CryptGetKeyParam to get the KP_BLOCKLEN value of the key.

    but doesn't indicate what padding method to use; the VB.NET code exposes a whole load more properties and is as follows:

    objSHA1 = SHA1.Create() bytKey = Encoding.UTF8.GetBytes(strPassword) bytSHA1 = objSHA1.ComputeHash(bytKey) objCrypto = Aes.Create() objKeySizes = objCrypto.LegalBlockSizes For Each objKeySize In objKeySizes intMaxBlockSize = objKeySize.MaxSize Next objKeySizes = objCrypto.LegalKeySizes For Each objKeySize In objKeySizes intMaxKeySize = objKeySize.MaxSize Next objCrypto.BlockSize = intMaxBlockSize objCrypto.KeySize = intMaxKeySize ReDim Preserve bytSHA1((intMaxKeySize \ BYTESIZE) - 1) objCrypto.Key = bytSHA1

    bytIV = Encoding.UTF8.GetBytes("") ReDim Preserve bytIV((intMaxBlockSize \ BYTESIZE) - 1) objCrypto.IV = bytIV objCrypto.Mode = CipherMode.CBC objCrypto.Padding = PaddingMode.PKCS7 '* Convert the Plain text to a byte array bytPlainText = Encoding.UTF8.GetBytes(strPlainText) objEncryptor = objCrypto.CreateEncryptor(objCrypto.Key, objCrypto.IV) objCryptoStream = New CryptoStream(objMemoryStream, objEncryptor, CryptoStreamMode.Write) objCryptoStream.Write(bytPlainText, 0, bytPlainText.Length) objCryptoStream.FlushFinalBlock() strCryptText = Convert.ToBase64String(objMemoryStream.ToArray)

    at the moment if I try to decode a license in VBA using the Win32 API I receive an error "NTE_BAD_DATA=0x8009005 - Bad Data".  Looking at CryptDecrypt I see:

    The data to be decrypted is not valid. For example, when a block cipher is used and the Final flag is FALSE, the value specified by pdwDataLen must be a multiple of the block size. This error can also be returned when the padding is found to be not valid.

    any suggestions/solutions to this problem will be gratefully received

    Monday, August 1, 2016 4:42 PM

All replies

  • Hi Dave Ardron,

    First of all you had mentioned a huge description in the post. you are trying dealing with many technologies like asp, frontpage, Vb script, VBA. and you had also posted a many code snippets.

    but here you had mentioned that the code was developed before 12 years ago. so which Version of Excel you are using?

    Till Office 2003 the support is ended.

    the other thing I want to tell you that I know you have a very serious issue with that and you are trying to find a solution for that. but this much explanation confusing me that what is the real issue. which point should I consider which are the extra information and so on.

    the first thing I want to tell you that if you did not developed this code by your own then contact the person who developed this code.

    if you had developed this code then please give me the only problem that you are facing in VBA. because this forum only handle the issue regarding Excel object model.

    so that I can try to look in to that and if there is any solution available for the problem I can try to provide you.

    Regards

    Deepak

    ,

    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, August 2, 2016 4:25 AM
    Moderator
  • Hi Deepak,

    Many thanks for taking the time to post.  In answer to your questions:

    • The code was originally developed on Excel 2003, but has happily ported with no change all the way to what the company is now running namely Excel 2013 (32 bit)
    • Main issue that I face is that an encryption using VB.NET will not decrypt with VBA v7 using Win32 Crypto API
    • I'm afraid all the code snippets above I wrote whilst testing so apologies if they are not very pretty

    I was concerned about which forum to use, but I could not find a forum for Cryptography, which is essentially what this enquiry is about, so if you know of a better forum which would make more sense then I'm certainly happy to be educated.

    Issues I seem to be facing are VBA interfaces to the Win32 Crypto API, particularly with respect to parameter passing and returns.  In line with the URL warning in the original post from "DI Management" not to use "String" for ciphertext I'd started trying to convert the code to use Byte Arrays, but I'm having issues where Excel is now crashing, and I don't understand why.

    I have resolved the issue pertaining to "Type Mismatch" by defining multiple aliases to "CryptEncrypt" with different parameter definitions, which seems pretty cludgey, but necessary to bypass VBA type checking:

    Private Declare Function CryptEncryptBufLen Lib "advapi32.dll" Alias "CryptEncrypt" _
                             (ByVal hKey As Long, _
                              ByVal hHash As Long, _
                              ByVal Final As Long, _
                              ByVal dwFlags As Long, _
                              ByVal pbData As String, _
                              ByRef pdwDataLen As Long, _
                              ByVal dwBufLen As Long) As Long
    
    Private Declare Function CryptEncrypt Lib "advapi32.dll" _
                             (ByVal hKey As Long, _
                              ByVal hHash As Long, _
                              ByVal Final As Long, _
                              ByVal dwFlags As Long, _
                              ByRef pbData() As Byte, _
                              ByRef pdwDataLen As Long, _
                              ByVal dwBufLen As Long) As Long

    Hope this provides necessary clarification

    Tuesday, August 2, 2016 10:53 AM
  • Hi Dave Ardron,

    as you mentioned above that encryption is done using VB.Net so here I suggest you that you use VB.Net to decrypt the code and not use the VBA.

    here  below I have find some documentation related to it.

    Encrypting and Decrypting Strings in Visual Basic

    How to encrypt and decrypt a file by using Visual Basic .NET or Visual Basic 2005

    but in that I find that you are using different dll then them.

    so again I contacted to VB.Net team for further guidance of them.

    they had suggested me to Redirect you to VB.Net Forum.

    so if you think that the solution in VB.Net can solve your issue then I recommend you to Raise this issue on that forum and update the status of this thread regarding that.

    Following is the link for Vb.Net Forum.

    MSDN VB.NET

    Regards

    Deepak 


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, August 3, 2016 2:54 AM
    Moderator
  • Hi Deepak,

    Since the issue relates directly to having a decryption algorithm within the Excel workbook to unlock the ActiveX controls I have no way of using VB.NET unless I convert the whole of the project with Visual Studio Tools for Office (VSTO).  Now since the code contained in the workbook is contained in 33 modules, 7 forms modules and 10 class modules with over 100,000 lines of VBA there is simply no way that a conversion on that scale is going to take place.  This leaves me trying to match the algorithms (which should be identical) between VB.NET and the Win32 Crypto API.

    What does stick in my throat here is the statement on the "Alternatives to Using CAPICOM" where it states:

    Important  None of the alternatives to CAPICOM offer a solution for scripts; therefore, you must write your own ActiveX control. For more information, see ActiveX Controls.

    The amazing thing here is that CAPICOM was a COM object which has been withdrawn, so a solution did exist which developers were encouraged to embrace and now they are being told to write the equivalent module themselves!  Not sure what the point of Microsoft introducing APIs is if they withdraw them at random - OK, rant now over.

    I had already found and read all the references you quoted above, but as I am finding out to my cost everything in cryptography is very subtle indeed and small changes completely change the output as one would expect.  It is now becoming obvious that the devil is in the detail.  One thing I would say is that MSDN is truly horrible when it comes to explaining this Win32 Crypto API suite.

    I have finally learned the hard way that passing parameters between a VB variant and C++ is very involved due to the complex way in which some of the VB language capabilities are constructed.  The subtleties in mapping the various VB types to C++ calls and how VB actually worked I found on the truly excellent "Byte Comb" web site at URL:

    http://bytecomb.com/

    After much further reading I have modified the Win32 Crypto API code algorithm as follows:

    Encrypt

    1) Create "CryptAcquireContext"  (Provider: MS_ENH_RSA_AES_PROV, Provider Type: PROV_RSA_AES)
    2) Obtain a SHA1 hashing handle "CryptCreateHash"  (AlgId: CALG_SHA1)
    3) Hash the provided Passphrase "CryptHashData" (Key)
    4) Set Cipher Mode "CryptSetKeyParam" to CRYPT_MODE_CBC
    5) Set Padding Mode "CryptSetKeyParam" to PKCS5_PADDING
    6) Set Initialisation Vector "CryptSetKeyParam" using "KP_IV" with common value
    7) Derive a Block Cypher Key "CryptDeriveKey" (AlgId = CALG_AES_256, dwflags=0)
    8) Encrypt the data "CryptEncrypt"
    9) BASE64 encode the encrypted text "CryptBinaryToString"

    Decrypt

    1) Convert BASE64 to ciphertext "CryptStringToBinary"
    2) Create "CryptAcquireContext"  (Provider: MS_ENH_RSA_AES_PROV, Provider Type: PROV_RSA_AES)
    3) Obtain a SHA1 hashing handle "CryptCreateHash"  (AlgId: CALG_SHA1)
    4) Hash the provided Passphrase "CryptHashData" (Key)
    5) Set Cipher Mode "CryptSetKeyParam" to CRYPT_MODE_CBC
    6) Set Padding Mode "CryptSetKeyParam" to PKCS5_PADDING
    7) Set Initialisation Vector "CryptSetKeyParam" using "KP_IV" with common value
    8) Derive a Block Cypher Key "CryptDeriveKey" (AlgId = CALG_AES_256, dwflags=0)
    9) Decrypt the data "CryptDecrypt"

    but still I cannot match the VB.NET & VBA code output from both API implementations, so something must be different.  I do notice that the Win32 Crypto APIs only allow PKCS#5 padding, but the VB.NET algorithm only has PKCS#7 padding.

    From Wikipedia:

    https://en.wikipedia.org/wiki/Padding_(cryptography)#PKCS7

    it notes:

    PKCS#5 padding is identical to PKCS#7 padding, except that it has only been defined for block ciphers that use a 64-bit (8 byte) block size. In practice the two can be used interchangeably

    now I am trying to use AES256, so I'm not sure whether this is the root of the problem at the moment.

    Friday, August 5, 2016 9:39 AM
  • Hi Dave Ardron,

    in your earlier post you had mentioned that Encryption is done using VB.Net. because of that I mentioned that it is better if you  choose to encrypt it.

    again you have mentioned that you are trying to use VB and C++.

    and you are trying to use AE256.

    currently I am not having any MSFT Documentation regarding AE256.

    I will try to discuss this issue in our team meeting and if possible then I will escalate this issue to senior Engineers to give you some suggestions.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, August 8, 2016 7:03 AM
    Moderator
  • Hi Deepkak,

    The encryption will be coded in VB.NET within ASP.NET as I no longer have a solution for the old Frontpage/VBScript which I used initially to generate the licenses since there is no longer a COM wrapper available to allow VBScript to function, and I'm not intending to try writing one.

    The Excel 2013 application will decrypt the license using VBA v7 using the Win32 Crypto API assuming that I can get the VN.NET and VBA code to generate the same license from the two different API methods.  However, as you correctly state above I am attempting to use AES256 since that was the encryption mode used before with CAPICOM and complies with our corporate standards.

    Should you require I can send you the complete test harness code from each of my methods

    Regards

    Dave

    Monday, August 8, 2016 9:43 AM
  • VB.NET Test harness code

    NB! All comments have been removed

    Option Strict On
    
    Imports System.IO
    Imports System.Globalization
    Imports System.Exception
    Imports System.Text
    Imports System.Security.Cryptography
    Module CryptoAEStest
    
        Sub Main()
    
            Const PASSPHRASE = "P@5sphra53"
    
            Dim strPassphrase As String
            Dim strPlainText As String
            Dim strCryptText As String
            Dim strErrorMessage As String
    
            strPassphrase = PASSPHRASE
            strPlainText = "Test User#30/09/2017#User_License_File@"
            strCryptText = ""
            strErrorMessage = ""
    
            If (Not DotNetEncryptData(strPassphrase, strPlainText, strCryptText, strErrorMessage, False)) Then
                Call MsgBox(strErrorMessage, vbCritical, "Encryption failed")
                Exit Sub
            End If
    
            Console.WriteLine("Encryption Process: " & vbCrLf)
            Console.WriteLine("Original License - " & strPlainText)
            Console.WriteLine("Encrypted License - " & strCryptText)
            Console.WriteLine(vbCrLf)
    
            If (Not DotNetDecryptData(strPassphrase, strCryptText, strPlainText, strErrorMessage, False)) Then
                Call MsgBox(strErrorMessage, vbCritical, "Encryption failed")
                Exit Sub
            End If
    
            Console.WriteLine("Decryption Process: " & vbCrLf)
            Console.WriteLine("Decrypted License - " & strPlainText)
    
        End Sub
        Private Function DotNetEncryptData(ByVal strPassphrase As String,
                                           ByVal strPlainText As String,
                                           ByRef strCryptText As String,
                                           ByRef strErrorMessage As String,
                                           Optional ByVal blnDebug As Boolean = False) As Boolean
    
            Const BYTESIZE As Integer = 8                   ' Byte Size
            Const IVSECRET = "mY5ecRet!"                    ' Initialisation Value Secret
    
            Dim objException As Exception                   ' Code exception
    
            Dim objCSP As SymmetricAlgorithm = Nothing      ' Symmetric Encryption Algorithm
            Dim objSHA1 As SHA1 = Nothing                   ' SHA1 Hashing Algorithm
            Dim objEncryptor As ICryptoTransform            ' AES Encryptor 
            Dim objMemoryStream As New MemoryStream         ' Memory Stream for the encryption
            Dim objCryptoStream As CryptoStream             ' Encryption stream
            Dim bytPassphrase As Byte()                     ' Encryption Key
            Dim bytSHA1 As Byte()                           ' SHA1 Passphrase Hash (Key)
            Dim lngSHA1 As Long                             ' Length of the SHA-1 Hash
            Dim strAlgIdIV As String                        ' Algorithm Initialisation Vector
            Dim bytAlgIdIV As Byte()                        ' Initialisation Vector
    
            Dim bytPlainText As Byte()                      ' Plain text converted to bytes
            Dim bytCryptText As Byte()                      ' Encrypted text in bytes for debugging
            Dim lngCryptText As Long                        ' Length of BASE64 encrypted text
    
            Dim objKeySizes As KeySizes()                   ' Valid key & block sizes
            Dim objKeySize As KeySizes                      ' Symmetric Algorithm Block or Key Size
            Dim intMaxKeySize As Integer                    ' Maximum Symmetrix Algorithm Key Size
            Dim intMaxBlockSize As Integer                  ' Maximum Symmetrix Algorithm Block Size
    
            strCryptText = strPlainText
            DotNetEncryptData = False
    
            Try
    
                objSHA1 = SHA1.Create()
    
                bytPassphrase = Encoding.UTF8.GetBytes(strPassphrase)
                bytSHA1 = objSHA1.ComputeHash(bytPassphrase)
                lngSHA1 = UBound(bytSHA1) + 1
    
                objCSP = SymmetricAlgorithm.Create("Aes")
                'objCSP = SymmetricAlgorithm.Create("Rijndael")
                'objCSP = SymmetricAlgorithm.Create("TripleDES")
    
                objKeySizes = objCSP.LegalBlockSizes
                For Each objKeySize In objKeySizes
                    intMaxBlockSize = objKeySize.MaxSize
                Next
    
                objKeySizes = objCSP.LegalKeySizes
                For Each objKeySize In objKeySizes
                    intMaxKeySize = objKeySize.MaxSize
                Next
    
                objCSP.BlockSize = intMaxBlockSize
                objCSP.KeySize = intMaxKeySize
    
                ReDim Preserve bytSHA1((intMaxKeySize \ BYTESIZE) - 1)
                objCSP.Key = bytSHA1
    
                strAlgIdIV = IVSECRET
                bytAlgIdIV = Encoding.UTF8.GetBytes(strAlgIdIV)
    
                ReDim Preserve bytAlgIdIV((intMaxBlockSize \ BYTESIZE) - 1)
    
                objCSP.IV = bytAlgIdIV
    
                objCSP.Mode = CipherMode.CBC            ' Described in RFC 5652
                objCSP.Padding = PaddingMode.PKCS7      ' Described in RFC 2315
    
                bytPlainText = Encoding.UTF8.GetBytes(strPlainText)
    
                objEncryptor = objCSP.CreateEncryptor(objCSP.Key, objCSP.IV)
    
                objCryptoStream = New CryptoStream(objMemoryStream, objEncryptor, CryptoStreamMode.Write)
    
                objCryptoStream.Write(bytPlainText, 0, bytPlainText.Length)
                objCryptoStream.FlushFinalBlock()
    
                bytCryptText = objMemoryStream.ToArray
                strCryptText = Convert.ToBase64String(bytCryptText)
                lngCryptText = Len(strCryptText)
                DotNetEncryptData = True
            Catch objException
    
                strErrorMessage = objException.Message()
                If (blnDebug) Then
                    Call MsgBox(strErrorMessage, vbCritical, "Encryption Error")
                End If
                DotNetEncryptData = False
            End Try
    
        End Function
        Private Function DotNetDecryptData(ByVal strPassphrase As String,
                                           ByVal strCryptText As String,
                                           ByRef strPlainText As String,
                                           ByRef strErrorMessage As String,
                                           Optional ByVal blnDebug As Boolean = False) As Boolean
    
            Const BYTESIZE As Integer = 8                   ' Byte Size
            Const IVSECRET = "mY5ecRet!"                    ' Initialisation Value Secret
    
            Dim objException As Exception                   ' Code exception
    
            Dim objCSP As SymmetricAlgorithm = Nothing      ' Symmetric Encryption Algorithm
            Dim objSHA1 As SHA1 = Nothing                   ' SHA1 Hashing Algorithm
            Dim objDecryptor As ICryptoTransform            ' AES Decryptor 
            Dim objMemoryStream As New MemoryStream         ' Memory Stream for the encryption
            Dim objCryptoStream As CryptoStream             ' Encryption stream
            Dim bytPassphrase As Byte()                     ' Encryption passphrase
            Dim bytSHA1 As Byte()                           ' SHA1 Password Hash (key)
            Dim strAlgIdIV As String                        ' Algorithm Initialisation Vector
            Dim bytAlgIdIV As Byte()                        ' Initialisation Vector
    
            Dim bytCryptText As Byte()                      ' Encrypted text converted to bytes
    
            Dim objKeySizes As KeySizes()                   ' Valid key & block sizes
            Dim objKeySize As KeySizes                      ' Symmetric Algorithm Block or Key Size
            Dim intMaxKeySize As Integer                    ' Maximum Symmetrix Algorithm Key Size
            Dim intMaxBlockSize As Integer                  ' Maximum Symmetrix Algorithm Block Size
    
            strPlainText = strCryptText
            strErrorMessage = ""
            DotNetDecryptData = False
    
            Try
    
                objSHA1 = SHA1.Create()
    
                bytPassphrase = Encoding.UTF8.GetBytes(strPassphrase)
                bytSHA1 = objSHA1.ComputeHash(bytPassphrase)
    
                objCSP = SymmetricAlgorithm.Create("Aes")
                'objCSP = SymmetricAlgorithm.Create("Rijndael")
                'objCSP = SymmetricAlgorithm.Create("TripleDES")
    
                objKeySizes = objCSP.LegalBlockSizes
                For Each objKeySize In objKeySizes
                    intMaxBlockSize = objKeySize.MaxSize
                Next
    
                objKeySizes = objCSP.LegalKeySizes
                For Each objKeySize In objKeySizes
                    intMaxKeySize = objKeySize.MaxSize
                Next
    
                objCSP.BlockSize = intMaxBlockSize
                objCSP.KeySize = intMaxKeySize
    
                ReDim Preserve bytSHA1((intMaxKeySize \ BYTESIZE) - 1)
                objCSP.Key = bytSHA1
    
                strAlgIdIV = IVSECRET
                bytAlgIdIV = Encoding.UTF8.GetBytes(strAlgIdIV)
    
                ReDim Preserve bytAlgIdIV((intMaxBlockSize \ BYTESIZE) - 1)
    
                objCSP.IV = bytAlgIdIV
    
                objCSP.Mode = CipherMode.CBC            ' Described in RFC 5652
                objCSP.Padding = PaddingMode.PKCS7      ' Described in RFC 2315
    
                bytCryptText = Convert.FromBase64String(strCryptText)
    
                objDecryptor = objCSP.CreateDecryptor(objCSP.Key, objCSP.IV)
    
                objCryptoStream = New CryptoStream(objMemoryStream, objDecryptor, CryptoStreamMode.Write)
    
                objCryptoStream.Write(bytCryptText, 0, bytCryptText.Length)
                objCryptoStream.FlushFinalBlock()
    
                strPlainText = Encoding.UTF8.GetString(objMemoryStream.ToArray)
                DotNetDecryptData = True
            Catch objException
    
                strErrorMessage = objException.Message()
                If (blnDebug) Then
                    Call MsgBox(strErrorMessage, vbCritical, "Decryption Error")
                End If
                DotNetDecryptData = False
            End Try
    
        End Function
    
    End Module
    

    Win32 Crypto API Test Harness from VBA

    NB! All comments have been removed

    Option Explicit                             ' Enforce explicit declarations
    
    Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
                             (ByRef phProv As Long, _
                              ByVal pszContainer As String, _
                              ByVal pszProvider As String, _
                              ByVal dwProvType As Long, _
                              ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptReleaseContext Lib "advapi32.dll" _
                             (ByVal hProv As Long, _
                              ByVal dwFlags As Long) As Long
    
    
    Private Declare Function CryptCreateHash Lib "advapi32.dll" _
                             (ByVal hProv As Long, _
                              ByVal algID As Long, _
                              ByVal hKey As Long, _
                              ByVal dwFlags As Long, _
                              ByRef phHash As Long) As Long
    
    
    Private Declare Function CryptDestroyHash Lib "advapi32.dll" _
                             (ByVal hHash As Long) As Long
    
    
    Private Declare Function CryptHashData Lib "advapi32.dll" _
                             (ByVal hHash As Long, _
                              ByRef pbData As Byte, _
                              ByVal dwDataLen As Long, _
                              ByVal dwFlags As Long) As Long
    
    
    Private Declare Function CryptDeriveKey Lib "advapi32.dll" _
                             (ByVal hProv As Long, _
                              ByVal algID As Long, _
                              ByVal hBaseData As Long, _
                              ByVal dwFlags As Long, _
                              ByRef phKey As Long) As Long
    
    
    Private Declare Function CryptDestroyKey Lib "advapi32.dll" _
                             (ByVal hKey As Long) As Long
    
    
    Private Declare Function CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringA" _
                             (ByRef pbBinary As Byte, _
                              ByVal cbBinary As Long, _
                              ByVal dwFlags As Long, _
                              ByVal pszString As String, _
                              ByRef pcchString As Long) As Long
    
    
    Private Declare Function CryptStringToBinary Lib "Crypt32.dll" Alias "CryptStringToBinaryA" _
                             (ByVal pszString As String, _
                              ByVal cchString As Long, _
                              ByVal dwFlags As Long, _
                              ByRef pbBinary As Byte, _
                              ByRef pcbBinary As Long, _
                              ByRef pdwSkip As Long, _
                              ByRef pdwFlags As Long) As Long
    
    
    Private Declare Function CryptSetCipherMode Lib "advapi32.dll" Alias "CryptSetKeyParam" _
                            (ByVal hKey As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Long, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptSetPaddingMode Lib "advapi32.dll" Alias "CryptSetKeyParam" _
                            (ByVal hKey As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Long, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptSetInitVector Lib "advapi32.dll" Alias "CryptSetKeyParam" _
                            (ByVal hKey As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Byte, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptSetKeyParam Lib "advapi32.dll" _
                            (ByRef hKey As Long, _
                             ByVal dwParam As Long, _
                             ByVal pbData As String, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptEncrypt Lib "advapi32.dll" _
                            (ByVal hKey As Long, _
                             ByVal hHash As Long, _
                             ByVal Final As Long, _
                             ByVal dwFlags As Long, _
                             ByRef pbData As Byte, _
                             ByRef pdwDataLen As Long, _
                             ByVal dwBufLen As Long) As Long
    
    Private Declare Function CryptDecrypt Lib "advapi32.dll" _
                            (ByVal hKey As Long, _
                             ByVal hHash As Long, _
                             ByVal Final As Long, _
                             ByVal dwFlags As Long, _
                             ByRef pbData As Byte, _
                             ByRef pdwDataLen As Long) As Long
    
    Private Declare Function CryptGetHashParam Lib "advapi32.dll" _
                            (ByVal hHash As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Long, _
                             ByRef pdwDataLen As Long, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptGetHashValue Lib "advapi32.dll" Alias "CryptGetHashParam" _
                            (ByVal hHash As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Byte, _
                             ByRef pdwDataLen As Long, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptGetKeyParam Lib "advapi32.dll" _
                            (ByVal hKey As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Long, _
                             ByRef pdwDataLen As Long, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function CryptGetInitVector Lib "advapi32.dll" Alias "CryptGetKeyParam" _
                            (ByVal hKey As Long, _
                             ByVal dwParam As Long, _
                             ByRef pbData As Byte, _
                             ByRef pdwDataLen As Long, _
                             ByVal dwFlags As Long) As Long
    
    Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" _
                            (ByVal dwFlags As Long, _
                             ByRef lpSource As Any, _
                             ByVal dwMessageId As Long, _
                             ByVal dwLanguageId As Long, _
                             ByVal lpBuffer As String, _
                             ByVal nSize As Long, _
                             ByRef Arguments As Long) As Long
    
    Const MS_ENH_RSA_AES_PROV = "Microsoft Enhanced RSA and AES Cryptographic Provider"
    Const PROV_RSA_AES = 24
    Const CRYPT_NEWKEYSET = 8
    Const NTE_BAD_KEYSET = &H80090016
    
    Const ALG_CLASS_HASH = 32768
    Const ALG_TYPE_ANY = 0
    Const ALG_SID_SHA = 4
    Const CALG_SHA1 = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
    
    Const ALG_CLASS_DATA_ENCRYPT = 24576
    Const ALG_TYPE_BLOCK = 1536
    Const ALG_SID_AES = 17
    
    Const CALG_AES_128 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_128)
    Const CALG_AES_192 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_192)
    Const CALG_AES_256 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_256)
    Const CALG_AES = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES)
    
    Const CRYPT_NO_SALT = &H10
    
    Const KP_MODE As Long = &H4
    Const KP_PADDING As Long = &H3
    Const KP_IV As Long = &H1
    Const KP_BLOCKLEN As Long = &H8
    Const CRYPT_MODE_CBC = 1
    Const PKCS5_PADDING As Long = 1
    
    Const CRYPT_STRING_BASE64 As Long = &H1     ' Base64, without headers
    
    Sub CryptoAEStest()
    
        Const PASSPHRASE = "P@5sphra53"
    
        Dim strPassphrase As String
        Dim strPlainText As String
        Dim strCryptText As String
        Dim strErrorMessage As String
    
    '* Win32 API Method
    
        strPassphrase = PASSPHRASE
        strPlainText = "Test User#30/09/2017#User_License_File@"
        strCryptText = ""
        strErrorMessage = ""
    
        If (Not Win32APIEncryptData(strPassphrase, strPlainText, strCryptText, strErrorMessage, False)) Then
            Debug.Print "Encryption failed - "; strErrorMessage
            Call MsgBox(strErrorMessage, vbCritical, "Encryption failed")
            Exit Sub
        End If
    
        Debug.Print ("Win32 Crypto API Encryption Process: " & vbCrLf)
        Debug.Print ("Original License - " & strPlainText)
        Debug.Print ("Encrypted License - " & strCryptText)
        Debug.Print (vbCrLf)
    
        If (Not Win32APIDecryptData(strPassphrase, strCryptText, strPlainText, strErrorMessage, False)) Then
            Debug.Print "Decryption failed - "; strErrorMessage
        End If
    
        Debug.Print ("Win32 Crypto API Decryption Process: " & vbCrLf)
        Debug.Print ("Encrypted License - " & strCryptText)
        Debug.Print ("Decrypted License - " & strPlainText)
        Debug.Print (vbCrLf)
    
        strCryptText = "UucFs5OWbHUpvA7Qlcj2qcE3+zQgLOA/qoOgSxwpKoX+DEwMHpLPT4fmXrj13dUW"
    
        If (Not Win32APIDecryptData(strPassphrase, strCryptText, strPlainText, strErrorMessage, False)) Then
            Debug.Print (".NET License Decryption (will fail): " & vbCrLf)
            Debug.Print ("Encrypted License - " & strCryptText)
            Debug.Print "Decryption failed - "; strErrorMessage
            Debug.Print (vbCrLf)
        Else
            Debug.Print (".NET License Decryption: " & vbCrLf)
            Debug.Print ("Encrypted License - " & strCryptText)
            Debug.Print ("Decrypted License - " & strPlainText)
            Debug.Print (vbCrLf)
        End If
    
    End Sub
    
    Private Function Win32APIEncryptData(ByVal strPassphrase As String, _
                                         ByVal strPlainText As String, _
                                         ByRef strCryptText As String, _
                                         ByRef strErrorMessage As String, _
                                         Optional ByVal blnDebug As Boolean = False) As Boolean
    
        Const LONGBYTES = 4
        Const IVSECRET = "mY5ecRet!"
    
        Dim bytPassphrase() As Byte
        Dim lngPassphraseLen As Long
    
        Dim lngProviderHandle As Long
        Dim strProvider As String
        Dim strKeyContainer As String
        Dim lngProviderType As Long
        Dim lngFlags As Long
    
        Dim lngAlgId As Long
        Dim lngHashHandle As Long
        Dim lngKeyHandle As Long
        Dim lngUnused As Long
        Dim lngErrorCode As Long
        Dim lngBufferLen As Long
        Dim lngActualUsed As Long
        Dim strCryptBinary As String
        Dim bytCryptBinary() As Byte
        Dim lngCipherMode As Long
        Dim lngPaddingMode As Long
        Dim lngBlockLength As Long
        Dim strAlgIV As String
        Dim bytAlgIV() As Byte
        Dim lngNumberOfBytes As Long
    
        Win32APIEncryptData = True
        strCryptText = ""
    
        lngProviderHandle = 0
        lngHashHandle = 0
        lngKeyHandle = 0
    
        strKeyContainer = vbNullString
        strProvider = MS_ENH_RSA_AES_PROV
        lngProviderType = PROV_RSA_AES
        lngFlags = 0
    
        If (Not CBool(CryptAcquireContext(lngProviderHandle, strKeyContainer, strProvider, lngProviderType, lngFlags))) Then
    
            If (Err.Number = NTE_BAD_KEYSET) Then
                lngFlags = CRYPT_NEWKEYSET
                If (Not CBool(CryptAcquireContext(lngProviderHandle, strKeyContainer, strProvider, lngProviderType, lngFlags))) Then
                    lngErrorCode = Err.LastDllError
                    strErrorMessage = LastDLLErrorText("Error during CryptAcquireContext", lngErrorCode)
                    If (blnDebug) Then
                        Call MsgBox(strErrorMessage, vbCritical)
                    End If
                    strCryptText = strPlainText
                    Win32APIEncryptData = False
                    Exit Function
                End If
            Else
                lngErrorCode = Err.LastDllError
                strErrorMessage = LastDLLErrorText("Error during CryptAcquireContext", lngErrorCode)
                If (blnDebug) Then
                    Call MsgBox(strErrorMessage, vbCritical)
                End If
                strCryptText = strPlainText
                Win32APIEncryptData = False
                Exit Function
            End If
        End If
    
        lngAlgId = CALG_SHA1
        lngFlags = 0
        lngUnused = 0
    
        If (Not CBool(CryptCreateHash(lngProviderHandle, lngAlgId, lngUnused, lngFlags, lngHashHandle))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptCreateHash", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngFlags = 0
        bytPassphrase = StringToByteArray(strPassphrase)
        lngPassphraseLen = UBound(bytPassphrase) + 1
    
        If (Not CBool(CryptHashData(lngHashHandle, bytPassphrase(0), lngPassphraseLen, lngFlags))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptHashData", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngAlgId = CALG_AES_256
        lngFlags = 0
    
        If (Not CBool(CryptDeriveKey(lngProviderHandle, lngAlgId, lngHashHandle, lngFlags, lngKeyHandle))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptDeriveKey", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngCipherMode = CRYPT_MODE_CBC
    
        If (Not CBool(CryptSetCipherMode(lngKeyHandle, KP_MODE, lngCipherMode, 0))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptSetKeyParam KP_MODE", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngPaddingMode = PKCS5_PADDING
    
        If (Not CBool(CryptSetPaddingMode(lngKeyHandle, KP_PADDING, lngPaddingMode, 0))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptSetKeyParam KP_PADDING", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngNumberOfBytes = LONGBYTES
        If (Not CBool(CryptGetKeyParam(lngKeyHandle, KP_BLOCKLEN, lngBlockLength, lngNumberOfBytes, 0&))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptGetKeyParam KP_BLOCKLEN", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        strAlgIV = IVSECRET
        bytAlgIV = StringToByteArray(strAlgIV)
    
        lngNumberOfBytes = (lngBlockLength \ 8) - 1
        ReDim Preserve bytAlgIV(lngNumberOfBytes)
    
        If (Not CBool(CryptSetInitVector(lngKeyHandle, KP_IV, bytAlgIV(0), 0))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptSetKeyParam KP_IV", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngBufferLen = Len(strPlainText)
        ReDim bytCryptBinary(0)
        bytCryptBinary(0) = CByte(0)
    
       If (Not CBool(CryptEncrypt(lngKeyHandle, 0, 1, 0, ByVal 0&, lngBufferLen, lngBufferLen))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptEncrypt", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
       End If
    
        bytCryptBinary = StringToByteArray(strPlainText)
        ReDim Preserve bytCryptBinary(lngBufferLen - 1)
    
        lngActualUsed = Len(strPlainText)
    
        If (Not CBool(CryptEncrypt(lngKeyHandle, 0, 1, 0, bytCryptBinary(0), lngActualUsed, lngBufferLen))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptEncrypt", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngBufferLen = lngActualUsed
    
        If (Not CBool(CryptBinaryToString(bytCryptBinary(0), lngBufferLen, _
                                          CRYPT_STRING_BASE64, vbNullString, lngActualUsed))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptBinaryToString", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        strCryptText = Space(lngActualUsed)
    
        If (Not CBool(CryptBinaryToString(bytCryptBinary(0), lngBufferLen, _
                                          CRYPT_STRING_BASE64, strCryptText, lngActualUsed))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptBinaryToString", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIEncryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        strCryptText = Left(strCryptText, lngActualUsed - 1)
    
        Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
    
        If (Err.Number <> 0) Then
            Win32APIEncryptData = False
            Call Err.Clear
        End If
    
    End Function
    
    Private Function Win32APIDecryptData(ByVal strPassphrase As String, _
                                         ByVal strCryptText As String, _
                                         ByRef strPlainText As String, _
                                         ByRef strErrorMessage As String, _
                                         Optional ByVal blnDebug As Boolean = False) As Boolean
    
        Const LONGBYTES = 4
        Const IVSECRET = "mY5ecRet!"
    
        Dim bytPassphrase() As Byte
        Dim lngPassphraseLen As Long
    
        Dim lngProviderHandle As Long
        Dim strProvider As String
        Dim strKeyContainer As String
        Dim lngProviderType As Long
        Dim lngFlags As Long
    
        Dim lngAlgId As Long
        Dim lngHashHandle As Long
        Dim lngKeyHandle As Long
        Dim lngUnused As Long
        Dim lngErrorCode As Long
        Dim lngBufferLen As Long
        Dim lngActualUsed As Long
        Dim strCryptBinary As String
        Dim bytCryptBinary() As Byte
        Dim lngCipherMode As Long
        Dim lngPaddingMode As Long
        Dim lngBlockLength As Long
        Dim strAlgIV As String
        Dim bytAlgIV() As Byte
        Dim lngNumberOfBytes As Long
    
        Win32APIDecryptData = True
        strPlainText = ""
    
    
        If (Not CBool(CryptStringToBinary(strCryptText, Len(strCryptText), _
                                          CRYPT_STRING_BASE64, ByVal 0&, lngBufferLen, _
                                          0&, 0&))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptStringToBinary", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strPlainText = strCryptText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        ReDim bytCryptBinary(lngBufferLen - 1)
    
        If (Not CBool(CryptStringToBinary(strCryptText, Len(strCryptText), _
                                          CRYPT_STRING_BASE64, bytCryptBinary(0), lngBufferLen, _
                                          0&, 0&))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptStringToBinary", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strPlainText = strCryptText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngProviderHandle = 0
        lngHashHandle = 0
        lngKeyHandle = 0
    
        strKeyContainer = vbNullString
        strProvider = MS_ENH_RSA_AES_PROV
        lngProviderType = PROV_RSA_AES
        lngFlags = 0
    
        If (Not CBool(CryptAcquireContext(lngProviderHandle, strKeyContainer, strProvider, lngProviderType, lngFlags))) Then
    
            If (Err.Number = NTE_BAD_KEYSET) Then
                lngFlags = CRYPT_NEWKEYSET
                If (Not CBool(CryptAcquireContext(lngProviderHandle, strKeyContainer, strProvider, lngProviderType, lngFlags))) Then
                    lngErrorCode = Err.LastDllError
                    strErrorMessage = LastDLLErrorText("Error during CryptAcquireContext", lngErrorCode)
                    If (blnDebug) Then
                        Call MsgBox(strErrorMessage, vbCritical)
                    End If
                    strPlainText = strCryptText
                    Win32APIDecryptData = False
                    Exit Function
                End If
            Else
                lngErrorCode = Err.LastDllError
                strErrorMessage = LastDLLErrorText("Error during CryptAcquireContext", lngErrorCode)
                If (blnDebug) Then
                    Call MsgBox(strErrorMessage, vbCritical)
                End If
                strPlainText = strCryptText
                Win32APIDecryptData = False
                Exit Function
            End If
        End If
    
        lngAlgId = CALG_SHA1
        lngFlags = 0
        lngUnused = 0
    
        If (Not CBool(CryptCreateHash(lngProviderHandle, lngAlgId, lngUnused, lngFlags, lngHashHandle))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptCreateHash", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strPlainText = strCryptText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngFlags = 0
        bytPassphrase = StringToByteArray(strPassphrase)
        lngPassphraseLen = UBound(bytPassphrase) + 1
    
        If (Not CBool(CryptHashData(lngHashHandle, bytPassphrase(0), lngPassphraseLen, lngFlags))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptHashData", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strPlainText = strCryptText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        If (blnDebug) Then
            If (Not DisplayHashParameters(lngHashHandle, strErrorMessage)) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
        End If
    
        lngAlgId = CALG_AES_256
        lngFlags = 0
    
        If (Not CBool(CryptDeriveKey(lngProviderHandle, lngAlgId, lngHashHandle, lngFlags, lngKeyHandle))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptDeriveKey", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strPlainText = strCryptText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngCipherMode = CRYPT_MODE_CBC
    
        If (Not CBool(CryptSetCipherMode(lngKeyHandle, KP_MODE, lngCipherMode, 0))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptSetKeyParam KP_MODE", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngPaddingMode = PKCS5_PADDING
    
        If (Not CBool(CryptSetPaddingMode(lngKeyHandle, KP_PADDING, lngPaddingMode, 0))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptSetKeyParam KP_PADDING", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        lngNumberOfBytes = LONGBYTES
        If (Not CBool(CryptGetKeyParam(lngKeyHandle, KP_BLOCKLEN, lngBlockLength, lngNumberOfBytes, 0&))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptGetKeyParam KP_BLOCKLEN", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        strAlgIV = IVSECRET
        bytAlgIV = StringToByteArray(strAlgIV)
    
        lngNumberOfBytes = (lngBlockLength \ 8) - 1
        ReDim Preserve bytAlgIV(lngNumberOfBytes)
    
        If (Not CBool(CryptSetInitVector(lngKeyHandle, KP_IV, bytAlgIV(0), 0))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptSetKeyParam KP_IV", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strCryptText = strPlainText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        End If
    
        If (blnDebug) Then
            If (Not DisplayKeyParameters(lngKeyHandle, strErrorMessage)) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
        End If
    
        lngBufferLen = UBound(bytCryptBinary) + 1
    
        If (Not CBool(CryptDecrypt(lngKeyHandle, 0, 1, 0, bytCryptBinary(0), lngBufferLen))) Then
            lngErrorCode = Err.LastDllError
            strErrorMessage = LastDLLErrorText("Error during CryptDecrypt", lngErrorCode)
            If (blnDebug) Then
                Call MsgBox(strErrorMessage, vbCritical)
            End If
            strPlainText = strCryptText
            Win32APIDecryptData = False
            Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
            Exit Function
        Else
            strPlainText = Left(ByteArrayToString(bytCryptBinary), lngBufferLen)
        End If
    
        Call ReleaseCryptoHandles(lngKeyHandle, lngHashHandle, lngProviderHandle, blnDebug)
    
    End Function
    
    Private Sub ReleaseCryptoHandles(ByRef lngKeyHandle As Long, _
                                     ByRef lngHashHandle As Long, _
                                     ByRef lngProviderHandle As Long, _
                                     Optional ByVal blnDebug As Boolean = False)
    
        Dim lngErrorCode As Long
        Dim strErrorMessage As String
    
        If (lngKeyHandle > 0) Then
            If (Not CBool(CryptDestroyKey(lngKeyHandle))) Then
                If (blnDebug) Then
                    lngErrorCode = Err.LastDllError
                    strErrorMessage = LastDLLErrorText("Error during CryptDestroyKey", lngErrorCode)
                    Call MsgBox(strErrorMessage)
                End If
            End If
            lngKeyHandle = 0
        End If
    
        If (lngHashHandle > 0) Then
            If (Not CBool(CryptDestroyHash(lngHashHandle))) Then
                If (blnDebug) Then
                    lngErrorCode = Err.LastDllError
                    strErrorMessage = LastDLLErrorText("Error during CryptDestroyHash", lngErrorCode)
                    Call MsgBox(strErrorMessage)
                End If
            End If
            lngHashHandle = 0
        End If
    
        If (lngProviderHandle > 0) Then
            If (Not CBool(CryptReleaseContext(lngProviderHandle, 0&))) Then
                If (blnDebug) Then
                    lngErrorCode = Err.LastDllError
                    strErrorMessage = LastDLLErrorText("Error during CryptReleaseContext", lngErrorCode)
                    Call MsgBox(strErrorMessage)
                End If
            End If
            lngProviderHandle = 0
        End If
    
    End Sub
    
    Private Function LastDLLErrorText(ByVal strCaption As String, _
                                      ByVal lngErrorCode As Long) As String
    
        Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
    
        Dim strErrorMessage As String * 1024
        Dim lngErrorReturn As Long
        Dim lngMessageLength As Long
        Dim lngUnused As Long
    
        lngMessageLength = 1024
        lngUnused = 0
    
        lngErrorReturn = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, lngUnused, _
                                       lngErrorCode, lngUnused, strErrorMessage, _
                                       lngMessageLength, lngUnused)
    
        If (lngErrorReturn > 0) Then
            If (lngErrorCode > 0) Then
                LastDLLErrorText = strCaption & " " & CStr(lngErrorCode) & _
                                   " - " & Left(strErrorMessage, lngErrorReturn)
            Else
                LastDLLErrorText = strCaption & " 0x" & Hex(lngErrorCode) & _
                                   " - " & Left(strErrorMessage, lngErrorReturn)
            End If
        Else
            LastDLLErrorText = "Error (" & CStr(lngErrorCode) & ") not defined"
        End If
    
    End Function
    
    Function StringToByteArray(ByVal strSource As String) As Byte()
    
        StringToByteArray = StrConv(strSource, vbFromUnicode)
    
    End Function
    
    Function ByteArrayToString(ByRef bytData() As Byte) As String
    
        ByteArrayToString = StrConv(bytData, vbUnicode)
    
    End Function
    

    VB.NET Results:

    Encryption Process:
    
    Original License - Test User#30/09/2017#User_License_File@
    Encrypted License - UucFs5OWbHUpvA7Qlcj2qcE3+zQgLOA/qoOgSxwpKoX+DEwMHpLPT4fmXrj13dUW
    
    
    Decryption Process:
    
    Decrypted License - Test User#30/09/2017#User_License_File@


    VBA Results:

    Win32 Crypto API Encryption Process: 
    
    Original License - Test User#30/09/2017#User_License_File@
    Encrypted License - 1UanzJSnIIfaKLWah6f89svW9cavAvaY5IqN1hTIYyvOK+cHQJVT0mVfDoypvH29
    
    
    
    Win32 Crypto API Decryption Process: 
    
    Encrypted License - 1UanzJSnIIfaKLWah6f89svW9cavAvaY5IqN1hTIYyvOK+cHQJVT0mVfDoypvH29
    
    Decrypted License - Test User#30/09/2017#User_License_File@
    
    
    .NET License Decryption (will fail): 
    
    Encrypted License - UucFs5OWbHUpvA7Qlcj2qcE3+zQgLOA/qoOgSxwpKoX+DEwMHpLPT4fmXrj13dUW
    Decryption failed - Error during CryptDecrypt 0x80090005 - Bad Data.
    
    


    Summary

    As can be seen from the above it is possible to encrypt/decrypt using the same API set, VB.NET or Win32 Crypto API, but NOT between different API sets.

    I am at a loss as to why this will not work and I've compared:

    • SHA1 Hash Bytes
    • Initialisation Vector Bytes
    • Plain Text Bytes

    SHA1 Hash is 160 bytes and therefore needs padding to the key length of 256 bytes (additional 12 bytes) using zeros.  According to CryptDeriveKey:

    • CRYPT_CREATE_SALT - If this flag is NOT set, then the key is given a salt value of zero

    and this is also what is happening in the VB.NET code.  As mentioned earlier the padding mode differs between the Win32 Crypto API code and the VB.Net code; being PKCS#5 in the Win32 Crypto API and PKCS#7 in the VB.NET code as these are the only like padding modes available for the different APIs.  The Initialisation Vector is set and expanded with zero padding in both implementations but according to:

    https://en.wikipedia.org/wiki/Padding_(cryptography)

    PKCS#5 padding is identical to PKCS#7 padding, except that it has only been defined for block ciphers that use a 64-bit (8 byte) block size. In practice the two can be used interchangeably

    So the $64,000 question is why are the different APIs not producing the same BASE64 encrypted string? I am assuming of course that both these API sets were designed to exchange information across platform and should therefore be able to produce the same encrypted results from the same input data.

    Monday, August 8, 2016 5:52 PM
  • There is an error in the above VBA which happened as I was trying to reduce the upload size.  The AES constants should be:

    Const ALG_CLASS_DATA_ENCRYPT = 24576
    Const ALG_TYPE_BLOCK = 1536
    Const ALG_SID_AES = 17
    Const ALG_SID_AES_256 = 16
    Const CALG_AES_256 = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES_256)
    Const CALG_AES = (ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK Or ALG_SID_AES)
    

    Monday, August 8, 2016 6:00 PM
  • Hi Dave Ardron,

    Thanks for updating the status of the thread and provide some more details regarding your issue.

    I am going to escalate this issue to Senior Engineers.

    after this reply I am going to escalate this issue to them so after this they will contact you and give you an appropriate suggestion regarding your issue.

    generally it takes some more time to get a response from them.

    so please have patients till they contact you to give you suggestion.

    Thanks for your understanding.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Tuesday, August 9, 2016 1:30 AM
    Moderator
  • Hello Guys, Is there any solution for the problem?

    I also looking for a way to generate the same encrypted string from VB a VB.NET and have bad results, they are different for the same passphrase and key.

    I have tested 3DES algorithm on both sides and no luck...

    Friday, April 28, 2017 11:31 AM
  • Hi Peter Pavlik,

    if you are trying to automate some features in Excel then I suggest you to create a new thread.

    because this thread is old now.

    if you create a new thread then there is better chances to get more replies and solutions by community members.

    if your issue is only related with VB.Net then try to post your question on VB.Net forum.

    when you create a new thread , please try to provide all necessary details regarding your issue and code that you had tried.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, May 1, 2017 1:30 AM
    Moderator