dcsimg
Results 1 to 2 of 2
  1. #1

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

    [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. Private Const BCRYPT_HASH_REUSABLE_FLAG     As Long = &H20
    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 lResult         As Long '--- discarded
    156.    
    157.     '--- init member vars
    158.     uCrypto.Nonce(0) = 0
    159.     uCrypto.Nonce(1) = 0
    160.     uCrypto.EncrData = vbNullString
    161.     uCrypto.EncrPos = 0
    162.     '--- generate RFC 2898 based derived key
    163.     On Error GoTo EH_Unsupported '--- CNG API missing on XP
    164.     If BCryptOpenAlgorithmProvider(uCrypto.hPbkdf2Alg, StrPtr("SHA1"), StrPtr(MS_PRIMITIVE_PROVIDER), BCRYPT_ALG_HANDLE_HMAC_FLAG) <> 0 Then
    165.         GoTo QH
    166.     End If
    167.     On Error GoTo 0
    168.     ReDim baDerivedKey(0 To 2 * lKeyLen + 1) As Byte
    169.     On Error GoTo EH_Unsupported '--- PBKDF2 API missing on Vista
    170.     If BCryptDeriveKeyPBKDF2(uCrypto.hPbkdf2Alg, baPass(0), UBound(baPass) + 1, baSalt(0), UBound(baSalt) + 1, 1000, 0, baDerivedKey(0), UBound(baDerivedKey) + 1, 0) <> 0 Then
    171.         GoTo QH
    172.     End If
    173.     On Error GoTo 0
    174.     '--- extract Password Verification Value from last 2 bytes of derived key
    175.     Call CopyMemory(nPassVer, baDerivedKey(2 * lKeyLen), 2)
    176.     '--- init AES w/ ECB from first half of derived key
    177.     If BCryptOpenAlgorithmProvider(uCrypto.hAesAlg, StrPtr("AES"), StrPtr(MS_PRIMITIVE_PROVIDER), 0) <> 0 Then
    178.         GoTo QH
    179.     End If
    180.     If BCryptGetProperty(uCrypto.hAesAlg, StrPtr("ObjectLength"), uCrypto.AesKeyObjLen, 4, lResult, 0) <> 0 Then
    181.         GoTo QH
    182.     End If
    183.     If BCryptSetProperty(uCrypto.hAesAlg, StrPtr("ChainingMode"), StrPtr(BCRYPT_CHAIN_MODE_ECB), LenB(BCRYPT_CHAIN_MODE_ECB), 0) <> 0 Then
    184.         GoTo QH
    185.     End If
    186.     ReDim uCrypto.AesKeyObjData(0 To uCrypto.AesKeyObjLen - 1) As Byte
    187.     If BCryptGenerateSymmetricKey(uCrypto.hAesAlg, uCrypto.hAesKey, uCrypto.AesKeyObjData(0), uCrypto.AesKeyObjLen, baDerivedKey(0), lKeyLen, 0) <> 0 Then
    188.         GoTo QH
    189.     End If
    190.     '-- init HMAC from second half of derived key
    191.     If BCryptOpenAlgorithmProvider(uCrypto.hHmacAlg, StrPtr("SHA1"), StrPtr(MS_PRIMITIVE_PROVIDER), BCRYPT_ALG_HANDLE_HMAC_FLAG) <> 0 Then
    192.         GoTo QH
    193.     End If
    194.     If BCryptGetProperty(uCrypto.hHmacAlg, StrPtr("HashDigestLength"), uCrypto.HmacHashLen, 4, lResult, 0) <> 0 Then
    195.         GoTo QH
    196.     End If
    197.     If BCryptCreateHash(uCrypto.hHmacAlg, uCrypto.hHmacHash, 0, 0, baDerivedKey(lKeyLen), lKeyLen, BCRYPT_HASH_REUSABLE_FLAG) <> 0 Then
    198.         GoTo QH
    199.     End If
    200.     '--- success
    201.     pvCryptoAesInit = True
    202.     Exit Function
    203. QH:
    204.     uCrypto.LastError = GetSystemMessage(Err.LastDllError)
    205.     Exit Function
    206. EH_Unsupported:
    207.     uCrypto.LastError = ERR_UNSUPPORTED_ENCR
    208. End Function
    209.  
    210. Private Sub pvCryptoAesTerminate(uCrypto As UcsZipCryptoType)
    211.     If uCrypto.hPbkdf2Alg <> 0 Then
    212.         Call BCryptCloseAlgorithmProvider(uCrypto.hPbkdf2Alg, 0)
    213.         uCrypto.hPbkdf2Alg = 0
    214.     End If
    215.     If uCrypto.hHmacHash <> 0 Then
    216.         Call BCryptDestroyHash(uCrypto.hHmacHash)
    217.         uCrypto.hHmacHash = 0
    218.     End If
    219.     If uCrypto.hHmacAlg <> 0 Then
    220.         Call BCryptCloseAlgorithmProvider(uCrypto.hHmacAlg, 0)
    221.         uCrypto.hHmacAlg = 0
    222.     End If
    223.     If uCrypto.hAesKey <> 0 Then
    224.         Call BCryptDestroyKey(uCrypto.hAesKey)
    225.         uCrypto.hAesKey = 0
    226.     End If
    227.     If uCrypto.hAesAlg <> 0 Then
    228.         Call BCryptCloseAlgorithmProvider(uCrypto.hAesAlg, 0)
    229.         uCrypto.hAesAlg = 0
    230.     End If
    231. End Sub
    232.  
    233. Private Function pvCryptoAesCrypt( _
    234.             uCrypto As UcsZipCryptoType, _
    235.             baData() As Byte, _
    236.             Optional ByVal Offset As Long, _
    237.             Optional ByVal Size As Long, _
    238.             Optional ByVal HashBefore As Boolean, _
    239.             Optional ByVal HashAfter As Boolean) As Boolean
    240.     Dim lIdx            As Long
    241.     Dim lJdx            As Long
    242.     Dim lPadSize        As Long
    243.    
    244.     If Size < 0 Then
    245.         Size = UBound(baData) + 1 - Offset
    246.     End If
    247.     If HashBefore Then
    248.         If BCryptHashData(uCrypto.hHmacHash, baData(Offset), Size, 0) <> 0 Then
    249.             GoTo QH
    250.         End If
    251.     End If
    252.     With uCrypto
    253.         '--- reuse EncrData from prev call until next AES_BLOCK_SIZE boundary
    254.         For lIdx = Offset To Offset + Size - 1
    255.             If (.EncrPos And (AES_BLOCK_SIZE - 1)) = 0 Then
    256.                 Exit For
    257.             End If
    258.             baData(lIdx) = baData(lIdx) Xor .EncrData(.EncrPos)
    259.             .EncrPos = .EncrPos + 1
    260.         Next
    261.         If lIdx < Offset + Size Then
    262.             '--- pad remaining input size to AES_BLOCK_SIZE
    263.             lPadSize = (Offset + Size - lIdx + AES_BLOCK_SIZE - 1) And -AES_BLOCK_SIZE
    264.             If UBound(.EncrData) + 1 < lPadSize Then
    265.                 ReDim .EncrData(0 To lPadSize - 1) As Byte
    266.             End If
    267.             '--- encrypt incremental nonces in EncrData
    268.             For lJdx = 0 To lPadSize - 1 Step 16
    269.                 If .Nonce(0) <> -1 Then
    270.                     .Nonce(0) = (.Nonce(0) Xor &H80000000) + 1 Xor &H80000000
    271.                 Else
    272.                     .Nonce(0) = 0
    273.                     .Nonce(1) = (.Nonce(1) Xor &H80000000) + 1 Xor &H80000000
    274.                 End If
    275.                 Call CopyMemory(.EncrData(lJdx), .Nonce(0), 8)
    276.             Next
    277.             If BCryptEncrypt(.hAesKey, .EncrData(0), lPadSize, 0, 0, 0, .EncrData(0), lPadSize, lJdx, 0) <> 0 Then
    278.                 GoTo QH
    279.             End If
    280.             '--- xor remaining input and leave anything extra of EncrData for reuse
    281.             For .EncrPos = 0 To Offset + Size - lIdx - 1
    282.                 baData(lIdx) = baData(lIdx) Xor .EncrData(.EncrPos)
    283.                 lIdx = lIdx + 1
    284.             Next
    285.         End If
    286.     End With
    287.     If HashAfter Then
    288.         If BCryptHashData(uCrypto.hHmacHash, baData(Offset), Size, 0) <> 0 Then
    289.             GoTo QH
    290.         End If
    291.     End If
    292.     '--- success
    293.     pvCryptoAesCrypt = True
    294.     Exit Function
    295. QH:
    296.     uCrypto.LastError = GetSystemMessage(Err.LastDllError)
    297. End Function
    298.  
    299. Private Function pvCryptoAesGetFinalHash(uCrypto As UcsZipCryptoType, ByVal lSize As Long) As Byte()
    300.     Dim baResult()      As Byte
    301.    
    302.     ReDim baResult(0 To uCrypto.HmacHashLen - 1) As Byte
    303.     Call BCryptFinishHash(uCrypto.hHmacHash, baResult(0), uCrypto.HmacHashLen, 0)
    304.     ReDim Preserve baResult(0 To lSize - 1) As Byte
    305.     pvCryptoAesGetFinalHash = baResult
    306. End Function
    307.  
    308. '= shared ================================================================
    309.  
    310. #If Not ImplUseShared Then
    311. Public Function ToBase64Array(baData() As Byte) As String
    312.     Dim lSize           As Long
    313.    
    314.     If UBound(baData) >= 0 Then
    315.         ToBase64Array = String$(2 * UBound(baData) + 6, 0)
    316.         lSize = Len(ToBase64Array) + 1
    317.         Call CryptBinaryToString(VarPtr(baData(0)), UBound(baData) + 1, CRYPT_STRING_BASE64, StrPtr(ToBase64Array), lSize)
    318.         ToBase64Array = Left$(ToBase64Array, lSize)
    319.     End If
    320. End Function
    321.  
    322. Public Function FromBase64Array(sText As String) As Byte()
    323.     Dim lSize           As Long
    324.     Dim baOutput()      As Byte
    325.    
    326.     lSize = Len(sText) + 1
    327.     ReDim baOutput(0 To lSize - 1) As Byte
    328.     Call CryptStringToBinary(StrPtr(sText), Len(sText), CRYPT_STRING_BASE64, VarPtr(baOutput(0)), lSize, 0, 0)
    329.     If lSize > 0 Then
    330.         ReDim Preserve baOutput(0 To lSize - 1) As Byte
    331.         FromBase64Array = baOutput
    332.     Else
    333.         FromBase64Array = vbNullString
    334.     End If
    335. End Function
    336.  
    337. Public Function ToUtf8Array(sText As String) As Byte()
    338.     Dim baRetVal()      As Byte
    339.     Dim lSize           As Long
    340.    
    341.     lSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), ByVal 0, 0, 0, 0)
    342.     If lSize > 0 Then
    343.         ReDim baRetVal(0 To lSize - 1) As Byte
    344.         Call WideCharToMultiByte(CP_UTF8, 0, StrPtr(sText), Len(sText), baRetVal(0), lSize, 0, 0)
    345.     Else
    346.         baRetVal = vbNullString
    347.     End If
    348.     ToUtf8Array = baRetVal
    349. End Function
    350.  
    351. Public Function FromUtf8Array(baText() As Byte) As String
    352.     Dim lSize           As Long
    353.    
    354.     If UBound(baText) >= 0 Then
    355.         FromUtf8Array = String$(2 * UBound(baText), 0)
    356.         lSize = MultiByteToWideChar(CP_UTF8, 0, baText(0), UBound(baText) + 1, StrPtr(FromUtf8Array), Len(FromUtf8Array))
    357.         FromUtf8Array = Left$(FromUtf8Array, lSize)
    358.     End If
    359. End Function
    360.  
    361. Public Function GetSystemMessage(ByVal lLastDllError As Long) As String
    362.     Dim lSize            As Long
    363.    
    364.     GetSystemMessage = Space$(2000)
    365.     lSize = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, lLastDllError, 0&, GetSystemMessage, Len(GetSystemMessage), 0&)
    366.     If lSize > 2 Then
    367.         If Mid$(GetSystemMessage, lSize - 1, 2) = vbCrLf Then
    368.             lSize = lSize - 2
    369.         End If
    370.     End If
    371.     GetSystemMessage = "[" & lLastDllError & "] " & Left$(GetSystemMessage, lSize)
    372. End Function
    373.  
    374. Private Function Peek(ByVal lPtr As Long) As Long
    375.     Call CopyMemory(Peek, ByVal lPtr, 4)
    376. End Function
    377. #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; May 2nd, 2018 at 06:12 AM. Reason: Bump baHmacEncr/Decr size to 20

  2. #2
    Member
    Join Date
    May 2016
    Location
    China
    Posts
    62

    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

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