PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197

PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
[VB6] Simple AES 256-bit password protected encryption-VBForums
Results 1 to 9 of 9

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

  1. #1

    Thread Starter
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    718

    [VB6] Simple AES 256-bit password protected encryption

    Simple AES 256-bit password protected encryption

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

    Sample usage

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

    encrypted = AesEncryptString(userText, password)

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

    origText = AesDecryptString(encrypted, password)

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

    Advanced usage

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

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

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

    (See More samples section below)

    Stream usage

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

    Implementation

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

    Source code

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

    More samples

    thinBasic Code:
    1. Private Sub TestEncrypt()
    2.     Dim sPass       As String
    3.     Dim sText       As String
    4.     Dim sEncr       As String
    5.    
    6.     sPass = "password123"
    7.     sText = "this is a test"
    8.     sEncr = AesEncryptString(sText, sPass)
    9.     Debug.Assert sText = AesDecryptString(sEncr, sPass)
    10.    
    11.     Debug.Print sEncr
    12.     Debug.Print FromUtf8Array(FromBase64Array(sEncr))
    13.     Debug.Print AesDecryptString(sEncr, sPass)
    14. End Sub
    15.    
    16. Private Sub TestHmac()
    17.     Dim baEncr()    As Byte
    18.     Dim baHmacEncr(0 To 19) As Byte
    19.     Dim baHmacDecr(0 To 19) As Byte
    20.    
    21.     baEncr = ToUtf8Array("test message")
    22.     baHmacEncr(0) = 0           '--- 0 -> generate hash before encrypting
    23.     AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacEncr
    24.     baHmacDecr(0) = 1           '--- 1 -> decrypt and generate hash after that
    25.     AesCryptArray baEncr, ToUtf8Array("pass"), HmacSha1:=baHmacDecr
    26.     Debug.Assert StrConv(baHmacDecr, vbUnicode) = StrConv(baHmacEncr, vbUnicode)
    27.    
    28.     Debug.Print ToBase64Array(baHmacDecr)
    29.     Debug.Print ToBase64Array(baHmacEncr)
    30. End Sub
    cheers,
    </wqw>
    Last edited by wqweto; Sep 17th, 2018 at 01:22 AM. Reason: Bump baHmacEncr/Decr size to 20

  2. #2
    Lively Member
    Join Date
    May 2016
    Location
    China
    Posts
    96

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

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

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

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

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

  4. #4

    Thread Starter
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    718

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

    It works ok in VB6 on x64 here.

  5. #5
    Junior Member
    Join Date
    Apr 2011
    Posts
    22

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

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

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

    AesEncryptString

    Could be I have done something wrong

    Look forward to your feedback.
    cheers
    Attached Files Attached Files

  6. #6

    Thread Starter
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    718

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

    Your project works ok here. Windows 10 version 1803

    Which OS are you testing this on?

    cheers,
    </wqw>

  7. #7
    Junior Member
    Join Date
    Apr 2011
    Posts
    22

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

    Thanks for checking it out so quickly.

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

  8. #8

    Thread Starter
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    718

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

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

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

    cheers,
    </wqw>

  9. #9
    Junior Member
    Join Date
    Apr 2011
    Posts
    22

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

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

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

    cheers,
    </wqw>

    Thanks for that,

    Cheers

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width