Attribute VB_Name = "TestAPI"
' $Id: TestAPI.bas $

'****************************** LICENSE ***********************************
' * Copyright (C) 2001-21 David Ireland, DI Management Services Pty Limited.
' * All rights reserved. <www.di-mgt.com.au> <www.cryptosys.net>
' * The code in this module is licensed under the terms of the MIT license.
' * For a copy, see <http://opensource.org/licenses/MIT>
' *   Last updated:
' *   $Date: 2021-09-25 10:01 $
' *   $Version: 6.20.0 $
'****************************************************************************
'
' Some tests using the CryptoSys API VB6/VBA wrapper interface.

Option Explicit
Option Base 0

Public Const MIN_VERSION As Long = 62000

Public Sub DoAllTests()
    Dim n As Long
    Dim isok As Boolean
    
    
    Debug.Print ("INTERROGATE THE CORE DICRYPTOSYS DLL...")
    n = apiVersion()
    Debug.Print "Version=" & n
    If n < MIN_VERSION Then
        MsgBox "Require diCryptoSys v" & MIN_VERSION & " or higher", vbCritical
        Exit Sub
    End If
    Debug.Print "ModuleName=" & apiModuleName()
    
    Call test_cnvBytesLen
    Call test_rngKeyBytes
    Call test_rngKeyHex
    Call test_pbeKdf2
    Call test_pbeKdf2Hex
    Call test_pbeScrypt
    Call test_pbeScryptHex
    Call test_xofBytes
    Call test_cipherStreamHex
    Call test_cipherStreamBytes
    Call test_CipherStreamInit
    Call test_prfBytes
    Call test_hashHexFromBits
    Call test_hashHexFromString
    Call test_padBytesBlock
    Call Test_padHexBlock
    Call test_unpadHex
    Call test_apiErrorLookup
    Call test_ErrorMessages
    Call test_rngNonceHex
    Call test_cipherEncryptBytes
    Call test_cipherEncryptHex
    Call test_cipherFile
    Call test_cipherKeyWrap
    Call test_aeadEncryptWithTag
    Call test_zlibDeflate
    Call test_hashHexFromBytes
    Call test_macHexFromBytes
    Call test_hashHexFromBytes
    Call test_macHexFromBytes
    Call test_Hash_Objects
    Call test_Hash_1Mxa
    Call test_MAC_Init
    Call test_MAC_AddBytes
    Call test_cipherInit_error
    Call test_cipherInit_objects
    Call test_cipherInitHex_objects
    Call test_comprCompress
    Call test_crc
    Call test_cipherStreamFile
    Call test_blfBytesBlock
    Call test_aeadInit
    Call test_wipeBytes
    Call test_apiModuleName
    Call test_apiCompileTime
    
    Debug.Print
    Debug.Print "ALL DONE."
End Sub


Public Sub test_cnvBytesLen()
    Debug.Print "test_cnvBytesLen..."
    Dim ab() As Byte
    Debug.Print cnvBytesLen(ab) ' Expecting 0
    ReDim ab(10)    ' NB actually 11 elements (0..10)
    Debug.Print cnvBytesLen(ab) ' 11
    ab = vbNullString   ' Set to empty array
    Debug.Print cnvBytesLen(ab) ' 0
End Sub


Public Sub test_rngKeyBytes()
    Debug.Print "test_rngKeyBytes..."
    Dim i As Integer
    For i = 1 To 5
        Debug.Print cnvHexStrFromBytes(rngKeyBytes(32))
    Next
End Sub

Public Sub test_rngKeyHex()
    Dim i As Integer
    For i = 1 To 10
        Debug.Print rngKeyHex(16)
    Next
End Sub

Public Sub test_pbeKdf2()
    Dim lpPwd() As Byte
    Dim lpSalt() As Byte
    Dim lpDK() As Byte
    lpPwd = StrConv("password", vbFromUnicode)
    lpSalt = cnvBytesFromHexStr("78 57 8E 5A 5D 63 CB 06")
    lpDK = pbeKdf2(24, lpPwd, lpSalt, 2048, API_HASH_SHA256)
    Debug.Print "DK=" & cnvHexStrFromBytes(lpDK)
    Debug.Print "OK=97B5A91D35AF542324881315C4F849E327C4707D1BC9D322"
End Sub

Public Sub test_pbeKdf2Hex()
    Dim strDerivedKey As String
    strDerivedKey = pbeKdf2Hex(24, "password", "78578E5A5D63CB06", 2048, 0)
    Debug.Print "Derived key = " & strDerivedKey
    Debug.Print "OK =          " & "BFDE6BE94DF7E11DD409BCE20A0255EC327CB936FFE93643"
End Sub

Public Sub test_pbeScrypt()
    Dim lpPwd() As Byte
    Dim lpSalt() As Byte
    Dim lpDK() As Byte
    lpPwd = StrConv("password", vbFromUnicode)
    lpSalt = StrConv("NaCl", vbFromUnicode)
    lpDK = pbeScrypt(64, lpPwd, lpSalt, 1024, 8, 16, 0)
    Debug.Print "DK=" & cnvHexStrFromBytes(lpDK)
    Debug.Print "OK=FDBABE1C9D3472007856E7190D01E9FE7C6AD7CBC8237830E77376634B3731622EAF30D92E22A3886FF109279D9830DAC727AFB94A83EE6D8360CBDFA2CC0640"
    ' INPUT: (N=16, r=1, p=1)
    ' P="", S="" => empty strings => byte arrays of length zero
    ' Set lpPwd and lpSalt to be empty arrays
    lpPwd = vbNullString
    lpSalt = vbNullString
    lpDK = pbeScrypt(64, lpPwd, lpSalt, 16, 1, 1, 0)
    Debug.Print "DK=" & cnvHexStrFromBytes(lpDK)
    Debug.Print "OK=77D6576238657B203B19CA42C18A0497F16B4844E3074AE8DFDFFA3FEDE21442FCD0069DED0948F8326A753A0FC81F17E8D3E0FB2E0D3628CF35E20C38D18906"
End Sub

Public Sub test_pbeScryptHex()
    Dim strDerivedKey As String
    strDerivedKey = pbeScryptHex(64, "pleaseletmein", cnvHexStrFromString("SodiumChloride"), 16384, 8, 1, 0)
    Debug.Print "Derived key = " & strDerivedKey
    Debug.Print "OK =          " & "7023BDCB3AFD7348461C06CD81FD38EBFDA8FBBA904F8E3EA9B543F6545DA1F2D5432955613F0FCF62D49705242A9AF9E61E85DC0D651E40DFCF017B45575887"
End Sub

Public Sub test_xofBytes()
    Dim lpMessage() As Byte
    Dim lpOut() As Byte
    lpMessage = cnvBytesFromHexStr("6ae23f058f0f2264a18cd609acc26dd4dbc00f5c3ee9e13ecaea2bb5a2f0bb6b")
    ' Output 2000 bits
    lpOut = xofBytes(2000 \ 8, lpMessage, API_XOF_SHAKE256)
    Debug.Print "OUT=" & cnvHexStrFromBytes(lpOut)
    Debug.Print "OK =" & "b9b92544fb25cf...f1d35bdff79a"
    
End Sub

Public Sub test_cipherStreamHex()
    Dim strCipher As String
    Dim strPlain As String
    strCipher = cipherStreamHex("0000000000000000000000000000000000000000000000000000000000000000", _
        "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F", _
        "0000000000000000", API_SC_SALSA20)
    Debug.Print "CT=" & strCipher
    Debug.Print "OK=B580F7671C76E5F7441AF87C146D6B513910DC8B4146EF1B3211CF12AF4A4B49"
    ' Decrypt by calling again...
    strPlain = cipherStreamHex(strCipher, _
        "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F", _
        "0000000000000000", API_SC_SALSA20)
    Debug.Print "PT=" & strPlain
    
    strCipher = cipherStreamHex("00000000000000000000", "ef012345", "", API_SC_ARCFOUR)
    Debug.Print "CT=" & strCipher
    Debug.Print "OK=d6a141a7ec3c38dfbd61"
    ' Decrypt by calling again...
    strPlain = cipherStreamHex(strCipher, "ef012345", "", API_SC_ARCFOUR)
    Debug.Print "PT=" & strPlain
End Sub

Public Sub test_cipherStreamBytes()
    Dim lpCipher() As Byte
    Dim lpPlain() As Byte
    Dim lpKey() As Byte
    Dim lpIV() As Byte
    Dim strData As String
    lpKey = cnvBytesFromHexStr("000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f")
    lpIV = cnvBytesFromHexStr("000000000000004a00000000")
    strData = _
    "Ladies and Gentlemen of the class of '99: If I could offer you only one tip for the future, sunscreen would be it."
    lpPlain = StrConv(strData, vbFromUnicode)   ' Encode as bytes
    
    ' Encipher using ChaCha20 with counter=1
    lpCipher = cipherStreamBytes(lpPlain, lpKey, lpIV, API_SC_CHACHA20, 1)
    Debug.Print "CT=" & cnvHexStrFromBytes(lpCipher)
    Debug.Print "OK=6E2E359A2568F98041BA0728DD0D6981E97E7AEC1D4360C20A27AFCCFD9FAE0BF91B65C5524733AB8F593DABCD62B3571639D624E65152AB8F" _
        & "530C359F0861D807CA0DBF500D6A6156A38E088A22B65E52BC514D16CCF806818CE91AB77937365AF90BBF74A35BE6B40B8EEDF2785E42874D"
    ' Now decipher just by calling again. ...
    lpPlain = cipherStreamBytes(lpCipher, lpKey, lpIV, API_SC_CHACHA20, 1)
    Debug.Print "PT=" & StrConv(lpPlain, vbUnicode) ' Decode bytes to string
    
    ' Arcfour test vector
    lpKey = cnvBytesFromHexStr("0123456789abcdef")
    lpPlain = cnvBytesFromHexStr("0123456789abcdef")
    lpIV = vbNullString     ' Empty (null) array
    ' Encipher using Arcfour
    lpCipher = cipherStreamBytes(lpPlain, lpKey, lpIV, API_SC_ARCFOUR)
    Debug.Print "CT=" & cnvHexStrFromBytes(lpCipher)
    Debug.Print "OK=75b7878099e0c596"

End Sub

Public Sub test_cipherStreamFile()
    Dim strFileIn As String
    Dim strFileOut As String
    Dim lpKey() As Byte
    Dim lpIV() As Byte
    Dim nRet As Long
    lpKey = cnvBytesFromHexStr("000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f")
    lpIV = cnvBytesFromHexStr("000000000000004a00000000")
    
    ' Encipher plaintext file
    strFileIn = "sunscreen.txt"
    strFileOut = "sunscreen-chacha.dat"
    nRet = cipherStreamFile(strFileOut, strFileIn, lpKey, lpIV, API_SC_CHACHA20, 1)
    Debug.Print "cipherStreamFile returns " & nRet & " (expecting 0)"

End Sub

Public Sub test_CipherStreamInit()
    ' Ref: `draft-strombergson-chacha-test-vectors-02.txt` TC7: Sequence patterns in key and IV. Rounds: 20
    Dim lpKey() As Byte
    Dim lpIV() As Byte
    Dim lpInput() As Byte
    Dim lpOutput() As Byte
    Dim hContext As Long
    Dim nRet As Long
    Dim nDataLen As Long
    Dim strCorrect As String

    ' Use incremental functions to encrypt a 65-byte input of *zeros* in chunks of 1, 62 and 2 bytes
    Debug.Print "CHACHA20 (INCREMENTAL):"
    strCorrect = "9fadf409c00811d00431d67efbd88fba59218d5d6708b1d685863fabbb0e961eea480fd6fb532bfd494b2151015057423ab60a63fe4f55f7a212e2167ccab931fb"
    
    lpKey = cnvFromHex("00112233445566778899aabbccddeeffffeeddccbbaa99887766554433221100")
    lpIV = cnvFromHex("0f1e2d3c4b5a6978")
    ' Initialize CIPHERSTREAM context
    hContext = cipherStreamInit(lpKey, lpIV, API_SC_CHACHA20)
    Debug.Assert hContext <> 0
    
    ' Part 1: block of 1 byte
    nDataLen = 1
    ReDim lpInput(nDataLen - 1)   ' Set to zero by default
    lpOutput = cipherStreamUpdate(hContext, lpInput)
    Debug.Print cnvHexStrFromBytes(lpOutput)

    ' Part 2: block of 62 bytes
    nDataLen = 62
    ReDim lpInput(nDataLen - 1)   ' Set to zero by default
    lpOutput = cipherStreamUpdate(hContext, lpInput)
    Debug.Print cnvHexStrFromBytes(lpOutput)
    
    ' Part 3: block of 2 bytes
    nDataLen = 2
    ReDim lpInput(nDataLen - 1)   ' Set to zero by default
    lpOutput = cipherStreamUpdate(hContext, lpInput)
    Debug.Print cnvHexStrFromBytes(lpOutput)

    Debug.Print "CORRECT="
    Debug.Print strCorrect

    ' We are done with context
    nRet = cipherStreamFinal(hContext)
    Debug.Print "cipherStreamFinal returns " & nRet & " (expecting 0)"
End Sub

Public Sub test_prfBytes()
    Dim lpPrf() As Byte
    Dim lpMsg() As Byte
    Dim lpKey() As Byte
    lpKey = cnvBytesFromHexStr("404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F")
    lpMsg = cnvBytesFromHexStr("00010203")
    ' NB order of parameters (szCustom <=> nOptions).
    lpPrf = prfBytes(256 \ 8, lpMsg, lpKey, API_KMAC_128, "My Tagged Application")
    Debug.Print "KMAC=" & cnvHexStrFromBytes(lpPrf)
    Debug.Print "OK  =3B1FBA963CD8B0B59E8C1A6D71888B7143651AF8BA0A7070C0979E2811324AA5"
End Sub

Public Sub test_hashHexFromBits()
    Dim strDigest As String
    Dim lpData() As Byte
    
    ' NIST SHAVS CAVS 11.0 "SHA-1 ShortMsg" information
    lpData = cnvBytesFromHexStr("5180")  ' 9-bit bitstring = 0101 0001 1
    strDigest = hashHexFromBits(lpData, 9, API_HASH_SHA1)
    Debug.Print "MD = " & strDigest
    Debug.Print "OK = 0f582fa68b71ecdf1dcfc4946019cf5a18225bd2"
    
    ' SHAVS-SHA3 CAVS 19.0 "SHA3-256 ShortMsg"
    lpData = cnvBytesFromHexStr("2590A0")
    strDigest = hashHexFromBits(lpData, 22, API_HASH_SHA3_256)
    Debug.Print "MD = " & strDigest
    Debug.Print "OK = d5863d4b1ff41551c92a9e08c52177e32376c9bd100c611c607db840096eb22f"

    ' ERROR: too many bits for data byte array
    Debug.Print "Expecting error..."
    strDigest = hashHexFromBits(lpData, 666, API_HASH_SHA3_256)
    Debug.Print "hashHexFromBits(too many bits) returns '" & strDigest & "'"
    Debug.Print errFormatErrorMessage
    
End Sub

Public Sub test_hashHexFromString()
    Dim strMessage As String
    Dim strDigest As String
    strDigest = hashHexFromString("abc", API_HASH_SHA1)
    Debug.Print "SHA-1('abc')=" & strDigest
    Debug.Print "OK = a9993e36 4706816a ba3e2571 7850c26c 9cd0d89d"
    strMessage = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" '(length 448 bits).
    strDigest = hashHexFromString(strMessage, API_HASH_SHA3_256)
    Debug.Print "msg='" & strMessage & "'"
    Debug.Print "SHA3-256(msg)=" & strDigest
    Debug.Print "OK = 41c0dba2a9d62408 49100376a8235e2c 82e1b9998a999e21 db32dd97496d3376"
End Sub

Public Sub test_padBytesBlock()
    Dim lpInput() As Byte
    Dim lpBlock() As Byte
    Dim lpUnpadded() As Byte
    lpInput = cnvBytesFromHexStr("FFFFFFFFFF")
    Debug.Print "Input data =  0x" & cnvHexStrFromBytes(lpInput)
    lpBlock = padBytesBlock(lpInput, 8, 0)
    Debug.Print "Padded data = 0x" & cnvHexStrFromBytes(lpBlock)
    ' Unpad
    lpUnpadded = padUnpadBytes(lpBlock, 8, 0)
    Debug.Print "Unpadded data = 0x" & cnvHexStrFromBytes(lpUnpadded)
    
    ' Special corner case - output is the empty string
    lpBlock = cnvBytesFromHexStr("0808080808080808")
    Debug.Print "Padded data = 0x" & cnvHexStrFromBytes(lpBlock)
    lpUnpadded = padUnpadBytes(lpBlock, 8, 0)
    Debug.Print "Unpadded data = 0x" & cnvHexStrFromBytes(lpUnpadded)
End Sub

Public Sub Test_padHexBlock()
    Dim strInputHex As String
    Dim strOutputHex As String
    strInputHex = "FFFFFF"
    Debug.Print "Hex input  =" & strInputHex
    
    strOutputHex = padHexBlock(strInputHex, 8, 0)
    Debug.Print "Padded data=" & strOutputHex
    Debug.Print "Unpadded   =" & padUnpadHex(strOutputHex, 8, 0)
    
    strOutputHex = padHexBlock(strInputHex, 8, API_PAD_1ZERO)
    Debug.Print "Padded data=" & strOutputHex
    Debug.Print "Unpadded   =" & padUnpadHex(strOutputHex, 8, API_PAD_1ZERO)
    
    strOutputHex = padHexBlock(strInputHex, 8, API_PAD_AX923)
    Debug.Print "Padded data=" & strOutputHex
    Debug.Print "Unpadded   =" & padUnpadHex(strOutputHex, 8, API_PAD_AX923)
    
End Sub

Public Sub test_unpadHex()
    Dim strInputHex As String
    Dim strOutputHex As String
    strInputHex = "FFFFFFFFFF030303"
    Debug.Print "Hex input  =" & strInputHex
    strOutputHex = padUnpadHex(strInputHex, API_BLK_TDEA_BYTES, 0)
    Debug.Print "Unpadded   =" & strOutputHex
    ' Output is empty string
    strInputHex = "0808080808080808"
    Debug.Print "Hex input  =" & strInputHex
    strOutputHex = padUnpadHex(strInputHex, API_BLK_TDEA_BYTES, 0)
    Debug.Print "Unpadded   =" & strOutputHex
    ' Bad input data results in the same data being returned
    strInputHex = "FFFFFFFFFFFFFFFF"    ' Invalid!
    Debug.Print "Hex input  =" & strInputHex
    strOutputHex = padUnpadHex(strInputHex, API_BLK_TDEA_BYTES, 0)
    Debug.Print "Unpadded   =" & strOutputHex
    If Len(strOutputHex) = Len(strInputHex) Then
        Debug.Print "DECRYPTION ERROR (<= expected)"
    End If
End Sub


Public Sub test_apiErrorLookup()
    Dim i As Long
    For i = 0 To 9
        Debug.Print "apiErrorLookup(" & i & ") => "; apiErrorLookup(i)
    Next
End Sub

Public Sub test_rngNonceHex()
    Dim i As Long
    For i = 1 To 5
        Debug.Print rngNonceHex(32)
    Next
End Sub

Public Sub test_cipherEncryptBytes()
    ' [v6.20] Changed "~Bytes2" to "~Bytes"
    Dim key() As Byte
    Dim iv() As Byte
    Dim pt() As Byte
    Dim ct() As Byte
    Dim dt() As Byte
    Dim algstr As String
    
    ' PART 1
    algstr = "Aes128/CBC/OneAndZeroes"
    Debug.Print algstr
    key = cnvBytesFromHexStr("0123456789ABCDEFF0E1D2C3B4A59687")
    iv = cnvBytesFromHexStr("FEDCBA9876543210FEDCBA9876543210")
    ' "Now is the time for all good men to"
    pt = cnvBytesFromHexStr("4E6F77206973207468652074696D6520666F7220616C6C20676F6F64206D656E20746F")
    
    ct = cipherEncryptBytes(pt, key, iv, algstr, 0)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)
    Debug.Print "OK=C3153108A8DD340C0BCB1DFE8D25D2320EE0E66BD2BB4A313FB75C5638E9E1771D4CDA34FBFB7E74B321F9A2CF4EA61B"

    dt = cipherDecryptBytes(ct, key, iv, algstr, 0)
    Debug.Print "dt='" & StrConv(dt, vbUnicode) & "'"
    
    ' PART 2 - Use CTR mode and prefix the IV in the output
    algstr = "Aes128/CTR"
    Debug.Print algstr & " + PREFIX"
    ct = cipherEncryptBytes(pt, key, iv, algstr, API_IV_PREFIX)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)
    dt = cipherDecryptBytes(ct, key, iv, algstr, API_IV_PREFIX)
    Debug.Print "dt='" & StrConv(dt, vbUnicode) & "'"
    
    ' PART 3 - Use ECB mode and pass an empty byte array for the IV
    algstr = "Aes128/ECB"
    Debug.Print algstr
    iv = vbNullString     ' Set IV as empty array
    ct = cipherEncryptBytes(pt, key, iv, algstr, 0)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)
    dt = cipherDecryptBytes(ct, key, iv, algstr, 0)
    Debug.Print "dt='" & StrConv(dt, vbUnicode) & "'"
End Sub

Public Sub test_cipherEncryptHex()
    Dim strKeyHex As String
    Dim strIvHex As String
    Dim strPlainHex As String
    Dim strCipherHex As String
    strKeyHex = "0123456789ABCDEFF0E1D2C3B4A59687"
    strIvHex = "FEDCBA9876543210FEDCBA9876543210"
    strPlainHex = "4E6F77206973207468652074696D6520666F7220616C6C20676F6F64206D656E20746F"
    
    ' Get encrypted output directly in hex
    strCipherHex = cipherEncryptHex(strPlainHex, strKeyHex, strIvHex, "Aes128/CBC/OneAndZeroes", 0)
    Debug.Print strCipherHex
    
    ' Same again with hex using ECB mode with default PKCS#5 padding
    ' To pass a "null" IV in hex, just use the empty string
    strCipherHex = cipherEncryptHex(strPlainHex, strKeyHex, "", "Aes128/ECB", 0)
    Debug.Print strCipherHex
    
    ' Or vbNullString
    strCipherHex = cipherEncryptHex(strPlainHex, strKeyHex, vbNullString, "Aes128/ECB", 0)
    Debug.Print strCipherHex
End Sub

Public Sub test_cipherDecryptHex()
    Dim strKeyHex As String
    Dim strIvHex As String
    Dim strPlainHex As String
    Dim strCipherHex As String
    strKeyHex = "0123456789ABCDEFF0E1D2C3B4A59687"
    strIvHex = "FEDCBA9876543210FEDCBA9876543210"
    strCipherHex = "C3153108A8DD340C0BCB1DFE8D25D2320EE0E66BD2BB4A313FB75C5638E9E1771D4CDA34FBFB7E74B321F9A2CF4EA61B"
    strPlainHex = cipherDecryptHex(strCipherHex, strKeyHex, strIvHex, "Aes128/CBC/OneAndZeroes")
    Debug.Print "PT=" & strPlainHex
    Debug.Print "PT='" & cnvStringFromHexStr(strPlainHex) & "'"
    
    ' PART 2 - CT includes IV prefix
    strCipherHex = "FEDCBA9876543210FEDCBA9876543210C3153108A8DD340C0BCB1DFE8D25D2320EE0E66BD2BB4A313FB75C5638E9E1771D4CDA34FBFB7E74B321F9A2CF4EA61B"
    Debug.Print "IV||CT=" & strCipherHex
    strPlainHex = cipherDecryptHex(strCipherHex, strKeyHex, strIvHex, "Aes128/CBC/OneAndZeroes", API_IV_PREFIX)
    Debug.Print "PT=" & strPlainHex
    Debug.Print "PT='" & cnvStringFromHexStr(strPlainHex) & "'"

End Sub

Public Sub test_cipherFile()
    Dim lpKey() As Byte
    Dim lpIV() As Byte
    Dim nRet As Long
    ' Encrypt using AES-192 in CBC mode with ANSI-X923 padding, prefixing the IV to the output
    lpKey = cnvFromHex("fedcba9876543210fedcba98765432101122334455667788")
    ' Generate a random IV of correct length for AES
    lpIV = rngNonce(API_BLK_AES_BYTES)
    nRet = cipherFileEncrypt("hello.aes192.enc.dat", "hello.txt", lpKey, lpIV, "aes192/CBC/ANSIX923", API_IV_PREFIX)
    Debug.Print "cipherFileEncrypt returns " & nRet & " (expecting 0)"
    Debug.Assert 0 = nRet
    Debug.Print "Encrypted file has length " & FileLen("hello.aes192.enc.dat")
    
    ' Now decrypt
    nRet = cipherFileDecrypt("hello.aes192.chk.txt", "hello.aes192.enc.dat", lpKey, lpIV, "aes192/CBC/ANSIX923", API_IV_PREFIX)
    Debug.Print "cipherFileDecrypt returns " & nRet & " (expecting 0)"
    Debug.Assert 0 = nRet
    Debug.Print "Encrypted file has length " & FileLen("hello.aes192.chk.txt")
    
    ' Repeat using ECB mode and default PKCS#5 padding
    lpIV = vbNullString     ' Set IV to empty array
    nRet = cipherFileEncrypt("hello.aes192.enc.ecb.dat", "hello.txt", lpKey, lpIV, "aes192/ecb")
    Debug.Print "cipherFileEncrypt returns " & nRet & " (expecting 0)"
    Debug.Assert 0 = nRet
    Debug.Print "Encrypted file has length " & FileLen("hello.aes192.enc.ecb.dat")
    
    ' Now decrypt
    nRet = cipherFileDecrypt("hello.aes192.chk1.txt", "hello.aes192.enc.ecb.dat", lpKey, lpIV, "aes192/ecb")
    Debug.Print "cipherFileDecrypt returns " & nRet & " (expecting 0)"
    Debug.Assert 0 = nRet
    Debug.Print "Encrypted file has length " & FileLen("hello.aes192.chk1.txt")

End Sub

Public Sub test_cipherKeyWrap()
    Dim lpKeyData() As Byte
    Dim lpKek() As Byte
    Dim lpWK() As Byte
    Dim lpKD() As Byte
    
    ' Input for AES128-Wrap
    lpKeyData = cnvBytesFromHexStr("8cbedec4 8d063e1b a46be8e3 69a9c398 d8e30ee5 42bc347c 4f30e928 ddd7db49")
    lpKek = cnvBytesFromHexStr("9e84ee99 e6a84b50 c76cd414 a2d2ec05 8af41bfe 4bf3715b f894c8da 1cd445f6")
    ' Wrap the content encyption key
    lpWK = cipherKeyWrap(lpKeyData, lpKek, API_BC_AES256)
    Debug.Print "WK=" & cnvHexStrFromBytes(lpWK)
    Debug.Print "OK=EAFB901F82B98D37F17497063DE3E5EC7246AB57200AE73EDDDDF24AA403DAFA0C5AE151D1746FA4"
    ' Unwrap
    lpKD = cipherKeyUnwrap(lpWK, lpKek, API_BC_AES256)
    Debug.Print "KD=" & cnvHexStrFromBytes(lpKD)
    Debug.Print "OK=" & cnvHexStrFromBytes(lpKeyData)
End Sub

Public Sub test_aeadEncryptWithTag()
    Dim lpKey() As Byte
    Dim lpNonce() As Byte
    Dim lpAAD() As Byte
    Dim lpPT() As Byte
    Dim lpCT() As Byte
    Dim lpDT() As Byte
    
    ' Ref: IEEE P802.1 MACsec 2.4.1 54-byte Packet Encryption Using GCM-AES-128:
    ' Set byte arrays from hex strings
    lpKey = cnvBytesFromHexStr("071b113b 0ca743fe cccf3d05 1f737382")
    lpNonce = cnvBytesFromHexStr("f0761e8d cd3d0001 76d457ed")
    lpAAD = cnvBytesFromHexStr("e20106d7 cd0df076 1e8dcd3d 88e54c2a 76d457ed")
    lpPT = cnvBytesFromHexStr("08000f10 11121314 15161718 191a1b1c 1d1e1f20 21222324 25262728 292a2b2c 2d2e2f30 31323334 0004")
    
    lpCT = aeadEncryptWithTag(lpPT, lpKey, lpNonce, lpAAD, API_AEAD_AES_128_GCM Or API_IV_PREFIX)
    Debug.Print "C: " & cnvHexStrFromBytes(lpCT)
    Debug.Print "OK f0761e8dcd3d000176d457ed13b4c72b389dc5018e72a171dd85a5d3752274d3a019fbcaed09a425cd9b2e1c9b72eee7c9de7d52b3f3d6a5284f4a6d3fe22a5d6c2b960494c3"
    
    lpDT = aeadDecryptWithTag(lpCT, lpKey, lpNonce, lpAAD, API_AEAD_AES_128_GCM Or API_IV_PREFIX)
    Debug.Print "P: " & cnvHexStrFromBytes(lpDT)
    Debug.Print "OK 08000F101112131415161718191A1B1C1D1E1F202122232425262728292A2B2C2D2E2F30313233340004"

End Sub

Public Sub test_zlibDeflate()
    Dim strPlain As String
    Dim lpToCompress() As Byte
    Dim lpCompressed() As Byte
    Dim lpUncompressed() As Byte
    strPlain = "hello, hello, hello. This is a 'hello world' message " & _
        "for the world, repeat, for the world."
    lpToCompress = StrConv(strPlain, vbFromUnicode)
    lpCompressed = zlibDeflate(lpToCompress)
    Debug.Print "OK=        " & "789CCB48CDC9C9D751C840A2F4144232328B15802851411D2CA2509E5F9493A2AE909B5A5C9C989EAA90965FA45092910A11D651284A2D484D2CD14115D6030086D11F4E"
    Debug.Print "COMPRESSED=" & cnvHexStrFromBytes(lpCompressed)
    lpUncompressed = zlibInflate(lpCompressed)
    Debug.Print "'" & StrConv(lpUncompressed, vbUnicode); "'"
    
End Sub

Public Sub test_hashHexFromBytes()
    Dim lpMessage() As Byte
    lpMessage = StrConv("abc", vbFromUnicode)
    Debug.Print "lpMessage=" & cnvHexStrFromBytes(lpMessage)
    
    Debug.Print "OK:" & vbCrLf & "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"
    Debug.Print hashHexFromBytes(lpMessage, API_HASH_SHA256)
    Debug.Print hashHexFromHex("616263", API_HASH_SHA256)
    Debug.Print hashHexFromFile("abc.txt", API_HASH_SHA256)
    Debug.Print cnvHexStrFromBytes(hashBytes(lpMessage, API_HASH_SHA256))
    Debug.Print cnvHexStrFromBytes(hashFile("abc.txt", API_HASH_SHA256))
End Sub

Public Sub test_macHexFromBytes()
    Dim lpMessage() As Byte
    Dim lpKey() As Byte
    lpMessage = StrConv("what do ya want for nothing?", vbFromUnicode)
    lpKey = StrConv("Jefe", vbFromUnicode)
    
    Debug.Print "OK:" & vbCrLf & "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"
    Debug.Print macHexFromBytes(lpMessage, lpKey, API_HMAC_SHA256)
    Debug.Print macHexFromHex(cnvHexStrFromBytes(lpMessage), cnvHexStrFromBytes(lpKey), API_HMAC_SHA256)
    Debug.Print cnvHexStrFromBytes(macBytes(lpMessage, lpKey, API_HMAC_SHA256))
End Sub

Public Sub test_Hash_Objects()
    Dim hContext As Long
    Dim lpDigest() As Byte
    ' Initialize context to use SHA-3-256 (NB HASH_ func)
    hContext = HASH_Init(API_HASH_SHA3_256)
    Debug.Print "HASH_Init returns 0x" & Hex(hContext)
    ' Check for an invalid handle
    If hContext = 0 Then
      MsgBox "Failed to set context"
      Exit Sub
    End If
    ' Add "abc" in parts
    Call hashAddBytes(hContext, cnvBytesFromHexStr("61"))   ' ASCII "a"
    Call hashAddString(hContext, "")    ' Empty string => No effect
    Call hashAddBytes(hContext, cnvBytesFromHexStr(""))    ' Empty byte array => No effect
    Call hashAddString(hContext, "bc")  ' Add a string directly
    ' Get final digest value
    lpDigest = hashFinal(hContext)
    Debug.Print "DIG=" & cnvHexStrFromBytes(lpDigest)
    Debug.Print "OK= " & "3a985da74fe225b2045c172d6bd390bd855f086e3e9d525b46bfe24511431532"
End Sub

Public Sub test_Hash_1Mxa()
' Compute the SHA-3-224 digest of one million repetitions of the character "a"
    Dim hContext As Long
    Dim lpDigest() As Byte
    Dim nRet As Long
    Dim i As Long
    Dim sA1000 As String
    ' Initialize context
    hContext = HASH_Init(API_HASH_SHA3_224)
    If hContext = 0 Then
      MsgBox "Failed to set context"
      Exit Sub
    End If
    ' Create a string of 1000 'a's
    sA1000 = String(1000, "a")
    ' Add 1000 times => one million repetitions of "a"
    For i = 1 To 1000
      nRet = hashAddString(hContext, sA1000)
    Next
    ' Get final digest value
    lpDigest = hashFinal(hContext)
    Debug.Print "DIG=" & cnvHexStrFromBytes(lpDigest)
    Debug.Print "OK= " & "d69335b93325192e516a912e6d19a15cb51c6ed5c15243e7a7fd653c"
End Sub

Public Sub test_MAC_Init()
    Dim hContext As Long
    Dim r As Long
    Dim lpKey() As Byte
    
    lpKey = cnvBytesFromHexStr("0102030405060708090a0b0c0d0e0f10111213141516171819")

    hContext = MAC_Init(lpKey(0), cnvBytesLen(lpKey), API_HMAC_SHA256)
    Debug.Print "MAC_Init returns 0x" & Hex(hContext) & " (expected nonzero)"
    Debug.Print "MAC_CodeLength = " & MAC_CodeLength(hContext)
    r = MAC_Reset(hContext)
    Debug.Print "After reset, MAC_CodeLength returns " & MAC_CodeLength(hContext)
    Debug.Print "apiErrorCode=" & apiErrorCode() & ": " & apiErrorLookup(apiErrorCode())
    
    hContext = MAC_Init(lpKey(0), cnvBytesLen(lpKey), &HFF)  ' Invalid alg code
    Debug.Print "MAC_Init(INVALID) returns 0x" & Hex(hContext)
    Debug.Print "apiErrorCode=" & apiErrorCode() & ": " & apiErrorLookup(apiErrorCode())
    
    ' Wrapper fn
    hContext = macInit(lpKey, API_HMAC_SHA256)
    Debug.Print "macInit returns 0x" & Hex(hContext) & " (expected nonzero)"
    r = MAC_Reset(hContext)
    
End Sub

Public Sub test_MAC_AddBytes()
    ' Test case 4 from RFC 2202 and RFC 4231
    ' key =           0x0102030405060708090a0b0c0d0e0f10111213141516171819
    ' key_len         25
    ' data =          0xcd repeated 50 times
    ' data_len =      50
    Dim hContext As Long
    Dim r As Long
    Dim lpKey() As Byte
    Dim lpMsg10() As Byte
    Dim lpDigest() As Byte
    Dim i As Long
    lpKey = cnvBytesFromHexStr("0102030405060708090a0b0c0d0e0f10111213141516171819")
    lpMsg10 = cnvBytesFromHexStr("cdcdcdcdcdcdcdcdcdcd")    ' 0xcd repeated 10 times
    
    ' HMAC-SHA-1
    hContext = macInit(lpKey, API_HMAC_SHA1)
    Debug.Print "macInit returns 0x" & Hex(hContext) & " (expected nonzero)"
    For i = 1 To 5
        r = macAddBytes(hContext, lpMsg10)
        Debug.Print "macAddBytes returns " & r
    Next
    lpDigest = macFinal(hContext)
    Debug.Print "MAC=" & cnvHexStrFromBytes(lpDigest)
    Debug.Print "OK= " & "4c9007f4026250c6bc8414f9bf50c86c2d7235da"
    
    ' HMAC-SHA-256
    hContext = macInit(lpKey, API_HMAC_SHA256)
    Debug.Print "macInit returns 0x" & Hex(hContext) & " (expected nonzero)"
    For i = 1 To 5
        r = macAddBytes(hContext, lpMsg10)
        'Debug.Print "macAddBytes returns " & r
    Next
    lpDigest = macFinal(hContext)
    Debug.Print "MAC=" & cnvHexStrFromBytes(lpDigest)
    Debug.Print "OK= " & "82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b"
    
    Dim strData As String
    Dim strKey As String
    ' Test case 2 from RFC 2202 and RFC 4231
    strData = "what do ya want for nothing?"
    strKey = "Jefe"
    lpKey = StrConv(strKey, vbFromUnicode)
    hContext = macInit(lpKey, API_HMAC_SHA512)
    ' Split input into parts
    r = macAddString(hContext, "what do ya")
    r = macAddString(hContext, " want for ")
    r = macAddString(hContext, "nothing?")
    lpDigest = macFinal(hContext)
    Debug.Print "MAC=" & cnvHexStrFromBytes(lpDigest)
    Debug.Print "OK =" _
    & "164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea250554" _
    & "9758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737" _
    

End Sub

Public Sub test_cipherInit_error()
    ' Using the "raw" functions
    Dim key() As Byte
    Dim iv() As Byte
    Dim hContext As Long
    
    key = cnvFromHex("0123456789ABCDEFF0E1D2C3B4A59687")
    iv = cnvFromHex("FEDCBA9876543210FEDCBA9876543210")
    
    ' Test errors for cipherInit
    hContext = cipherInit(ENCRYPT, "BADALG", key, iv)
    Debug.Print "cipherInit returns 0x" & Hex(hContext) & " (0 => error)"
    Debug.Assert hContext = 0
    Debug.Print "ErrorCode=" & apiErrorCode() & ": " & apiErrorLookup(apiErrorCode())
    hContext = cipherInit(ENCRYPT, "", key, iv, &HFFFF)
    Debug.Print "cipherInit returns 0x" & Hex(hContext) & " (0 => error)"
    Debug.Assert hContext = 0
    Debug.Print "ErrorCode=" & apiErrorCode() & ": " & apiErrorLookup(apiErrorCode())
    
    hContext = cipherInit(ENCRYPT, "BADALG", cnvBytesFromHexStr("0123456789ABCDEFF0E1D2C3B4A59687"), cnvBytesFromHexStr(""))
    Debug.Print "cipherInit returns 0x" & Hex(hContext) & " (0 => error)"
    Debug.Assert hContext = 0
    Debug.Print "ErrorCode=" & apiErrorCode() & ": " & apiErrorLookup(apiErrorCode())

End Sub

Public Sub test_cipherInit_objects()

    ' Using the wrapper functions
    Dim key() As Byte
    Dim iv() As Byte
    Dim pt() As Byte
    Dim ct() As Byte
    Dim algstr As String
    Dim hContext As Long
    Dim nRet As Long
    
    key = cnvBytesFromHexStr("0123456789ABCDEFF0E1D2C3B4A59687")
    iv = cnvBytesFromHexStr("FEDCBA9876543210FEDCBA9876543210")
    Debug.Print "KY=" & cnvHexStrFromBytes(key)
    Debug.Print "IV=" & cnvHexStrFromBytes(iv)
    
    ' TEST 1 - CBC mode
    algstr = "Aes128/CBC"
    Debug.Print algstr
    ' Initialize context for repeated chunks
    hContext = cipherInit(ENCRYPT, algstr, key, iv)
    Debug.Print "cipherInit returns 0x" & Hex(hContext) & " (expected NON-zero)"
    Debug.Assert hContext <> 0
    
    ' Pass data in chunks of 16 bytes (or multiples of)
    ' Part 1...
    pt = StrConv("Now is the time for all good men", vbFromUnicode)
    Debug.Print "PT=" & cnvHexStrFromBytes(pt)
    ct = cipherUpdate(hContext, pt)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)

    ' Part 2...
    pt = StrConv(" to come to the aid of the party", vbFromUnicode)
    Debug.Print "PT=" & cnvHexStrFromBytes(pt)
    ct = cipherUpdate(hContext, pt)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)
    
    ' We are done
    nRet = CIPHER_Final(hContext)
    Debug.Print "CIPHER_Final returns " & nRet & " (expected 0)"

    ' TEST 2 - ECB mode
    algstr = "Aes128/ecb"
    Debug.Print algstr
    Dim dummy() As Byte
    ' Initialize context for repeated chunks
    hContext = cipherInit(ENCRYPT, algstr, key, dummy)
    Debug.Print "cipherInit returns 0x" & Hex(hContext) & " (expected NON-zero)"
    Debug.Assert hContext <> 0
    
    ' Pass data in chunks of 16 bytes (or multiples of)
    ' Part 1...
    pt = StrConv("Now is the time for all good men", vbFromUnicode)
    Debug.Print "PT=" & cnvHexStrFromBytes(pt)
    ct = cipherUpdate(hContext, pt)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)

    ' Part 2...
    pt = StrConv(" to come to the aid of the party", vbFromUnicode)
    Debug.Print "PT=" & cnvHexStrFromBytes(pt)
    ct = cipherUpdate(hContext, pt)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)
    
    ' We are done
    nRet = CIPHER_Final(hContext)
    Debug.Assert nRet = 0

    ' TEST 3 - CTR mode
    algstr = "Aes128/ctr"
    Debug.Print algstr
    ' Initialize context for repeated chunks
    hContext = cipherInit(ENCRYPT, algstr, key, iv)
    Debug.Print "cipherInit returns 0x" & Hex(hContext) & " (expected NON-zero)"
    Debug.Assert hContext <> 0
    
    ' Pass data in chunks of 16 bytes (or multiples of)
    ' Part 1...
    pt = StrConv("Now is the time for all good men", vbFromUnicode)
    Debug.Print "PT=" & cnvHexStrFromBytes(pt)
    ct = cipherUpdate(hContext, pt)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)

    ' Part 2...
    ' In CTR mode (and OFB and CFB) the last block need not be a multiple
    pt = StrConv(" to come to the aid of", vbFromUnicode)
    Debug.Print "PT=" & cnvHexStrFromBytes(pt)
    ct = cipherUpdate(hContext, pt)
    Debug.Print "CT=" & cnvHexStrFromBytes(ct)
    
    ' We are done
    nRet = CIPHER_Final(hContext)
    Debug.Assert nRet = 0

End Sub


Public Sub test_cipherInitHex_objects()

    ' Using the wrapper functions
    Dim keyhex As String
    Dim ivhex  As String
    Dim pthex As String
    Dim cthex As String
    Dim algstr As String
    Dim hContext As Long
    Dim nRet As Long
    
    keyhex = "0123456789ABCDEFF0E1D2C3B4A59687"
    ivhex = "FEDCBA9876543210FEDCBA9876543210"
    Debug.Print "KY=" & keyhex
    Debug.Print "IV=" & ivhex
    
    ' TEST 1 - CBC mode
    algstr = "Aes128/CBC"
    Debug.Print algstr
    ' Initialize context for repeated chunks
    hContext = cipherInitHex(ENCRYPT, algstr, keyhex, ivhex, 0)
    Debug.Print "cipherInitHex returns 0x" & Hex(hContext) & " (expected NON-zero)"
    Debug.Assert hContext <> 0
    
    ' Pass data in chunks of 16 bytes (or multiples of)
    ' Part 1...
    pthex = cnvHexStrFromString("Now is the time for all good men")
    Debug.Print "PT=" & pthex
    cthex = cipherUpdateHex(hContext, pthex)
    Debug.Print "CT=" & cthex

    ' Part 2...
    pthex = cnvHexStrFromString(" to come to the aid of the party")
    Debug.Print "PT=" & pthex
    cthex = cipherUpdateHex(hContext, pthex)
    Debug.Print "CT=" & cthex
    
    ' We are done
    nRet = cipherFinal(hContext)
    Debug.Print "cipherFinal returns " & nRet & " (expected 0)"

    ' TEST 4 - Decrypt in CTR mode
    algstr = "Aes128/ctr"
    Debug.Print algstr
    Debug.Print "DECRYPTING..."
    ' Initialize context for repeated chunks
    hContext = cipherInitHex(DECRYPT, algstr, keyhex, ivhex, 0)
    Debug.Assert hContext <> 0
    
    ' Pass data in chunks of 16 bytes (or multiples of)
    ' Part 1...
    cthex = "3FAC68CBAE6D774151306E9DB16CE0191C51E91959DA4F082B7CE3498C2D20D7"
    Debug.Print "CT=" & cthex
    ' NB switched pt <=> ct
    pthex = cipherUpdateHex(hContext, cthex)
    Debug.Print "PT=" & pthex
    Debug.Print "'" & cnvStringFromHexStr(pthex) & "'"
    ' Part 2...
    cthex = "8437EC92088FE4C19FB49BDF2BADF7C7FD6FB9A7D52A"
    Debug.Print "CT=" & cthex
    pthex = cipherUpdateHex(hContext, cthex)
    Debug.Print "PT=" & pthex
    Debug.Print "'" & cnvStringFromHexStr(pthex) & "'"
    
    ' We are done
    nRet = cipherFinal(hContext)
    Debug.Assert nRet = 0

End Sub

Public Sub test_comprCompress()
    Dim strPlain As String
    Dim lpToCompress() As Byte
    Dim lpCompressed() As Byte
    Dim lpUncompressed() As Byte
    strPlain = "hello, hello, hello. This is a 'hello world' message " & _
        "for the world, repeat, for the world."
    lpToCompress = StrConv(strPlain, vbFromUnicode)
    
    ' Using default zlib algorithm
    lpCompressed = comprCompress(lpToCompress)
    Debug.Print "COMPRESSED(ZLIB)=" & cnvHexStrFromBytes(lpCompressed)
    ' 789CCB48CDC9C9D751C840A2F4144232328B15802851411D2CA2509E5F9493A2AE909B5A5C9C989EAA90965FA45092910A11D651284A2D484D2CD14115D6030086D11F4E
    lpUncompressed = comprUncompress(lpCompressed)
    Debug.Print "'" & StrConv(lpUncompressed, vbUnicode); "'"

    ' Using Zstandard algorithm
    lpCompressed = comprCompress(lpToCompress, API_COMPR_ZSTD)
    Debug.Print "COMPRESSED(ZSTD)=" & cnvHexStrFromBytes(lpCompressed)
    ' 28B52FFD205A1D0200540368656C6C6F2C202E20546869732069732061202720776F726C6427206D65737361676520666F72207468652C207265706561742C2E0400409E3AB1E1D97E71C508
    lpUncompressed = comprUncompress(lpCompressed, API_COMPR_ZSTD)
    Debug.Print "'" & StrConv(lpUncompressed, vbUnicode); "'"

End Sub

Public Sub test_crc()
    Dim n As Long
    Dim ab() As Byte
    n = crcString("123456789")
    Debug.Print "crcString returns " & Hex(n)  ' CBF43926
    ab = StrConv("123456789", vbFromUnicode)
    n = crcBytes(ab)
    Debug.Print "crcBytes returns " & Hex(n)  ' CBF43926
    n = crcFile("hello.txt")
    Debug.Print "crcFile('hello.txt') returns " & Hex(n)  ' 38E6C41A
   
End Sub

Public Sub test_blfBytesBlock()
    Dim lpPT() As Byte
    Dim lpKey() As Byte
    Dim lpIV() As Byte
    Dim lpCT() As Byte
    Dim lpDT() As Byte
    lpKey = cnvBytesFromHexStr("0123456789ABCDEFF0E1D2C3B4A59687")
    lpIV = cnvBytesFromHexStr("FEDCBA9876543210")
    lpPT = cnvBytesFromHexStr("37363534333231204E6F77206973207468652074696D6520666F722000000000")
    Debug.Print "PT=" & cnvHexStrFromBytes(lpPT)
    lpCT = blfBytesBlock(ENCRYPT, lpPT, lpKey, lpIV, "CBC")
    Debug.Print "CT=" & cnvHexStrFromBytes(lpCT)
    ' 6B77B4D63006DEE605B156E27403979358DEB9E7154616D959F1652BD5FF92CC
    lpDT = blfBytesBlock(DECRYPT, lpCT, lpKey, lpIV, "CBC")
    Debug.Print "DT=" & cnvHexStrFromBytes(lpDT)
    ' 37363534333231204E6F77206973207468652074696D6520666F722000000000
    
End Sub

Public Sub test_aeadInit()
    ' RFC7539 ChaCha20_Poly1305 Sunscreen test - INCREMENTAL MODE:
    Dim lpKey() As Byte
    Dim lpNonce() As Byte
    Dim lpAAD() As Byte
    Dim lpPT() As Byte
    Dim lpCT() As Byte
    Dim lpTag() As Byte
    Dim lpChunk() As Byte
    Dim strPT As String
    Dim strCtHex As String
    
    Dim nRet As Long
    Dim strCTOK As String
    Dim strTagOK As String
    Dim hContext As Long
    Dim nOffset As Long
    Dim nLen As Long
    Dim nLeft As Long
    Dim strSubStr As String
    
    Debug.Print "RFC7539 ChaCha20_Poly1305 Sunscreen test:"
    ' Set byte arrays from hex strings
    lpKey = cnvBytesFromHexStr("808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F")
    lpNonce = cnvBytesFromHexStr("070000004041424344454647")
    lpAAD = cnvBytesFromHexStr("50515253C0C1C2C3C4C5C6C7")
    strPT = "Ladies and Gentlemen of the class of '99: If I could offer you only one tip for the future, sunscreen would be it."

    strTagOK = "1ae10b594f09e26a7e902ecbd0600691"

    ' Do authenticated encryption using AEAD_CHACHA20_POLY1305
    ' 1.1 Initialize with the key and AEAD algorithm
    hContext = aeadInitKey(lpKey, API_AEAD_CHACHA20_POLY1305)
    Debug.Print "aeadInitKey returns 0x" & Hex(hContext) & " (expecting non-zero)"
    Debug.Assert hContext <> 0

    ' 1.2 Set the nonce
    nRet = aeadSetNonce(hContext, lpNonce)
    
    ' 1.3 Add the AAD (simulate adding in two parts)
    nRet = aeadAddAAD(hContext, cnvFromHex("50515253"))
    nRet = aeadAddAAD(hContext, cnvFromHex("C0C1C2C3C4C5C6C7"))
    
    ' 1.4 Start Encrypting
    nRet = aeadStartEncrypt(hContext)
    
    ' 1.5 Update plaintext -> ciphertext (simulate adding in chunks)
    Debug.Print "Adding plaintext in chunks"
    ' We'll store the ciphertext chunks in a hex string because it's simpler
    strCtHex = ""
    nLen = 17
    nLeft = Len(strPT)
    nOffset = 0
    While nLeft > 0
        If nLeft < nLen Then nLen = nLeft
        strSubStr = Mid(strPT, nOffset + 1, nLen)
        Debug.Print "P: '" & strSubStr & "'"
        Debug.Print "P: " & cnvHexStrFromString(strSubStr)
        ' Update another chunk of plaintext
        lpChunk = aeadUpdate(hContext, StrConv(strSubStr, vbFromUnicode))
        Debug.Print "C: " & cnvToHex(lpChunk)
        strCtHex = strCtHex & cnvToHex(lpChunk)
        nOffset = nOffset + nLen
        nLeft = nLeft - nLen
    Wend
    
    ' 1.6 Finish encrypting and output Tag
    lpTag = aeadFinishEncrypt(hContext)

    Debug.Print "T: " & cnvHexStrFromBytes(lpTag)
    Debug.Print "OK:" & strTagOK

    ' DECRYPTING...
    Debug.Print "DECRYPTING..."
    ' 2.1 Use key we initialized with in step 1.1
    ' 2.2 Set Nonce
    nRet = aeadSetNonce(hContext, lpNonce)
    ' 2.3 Add AAD (this time in one go)
    nRet = aeadAddAAD(hContext, lpAAD)
    ' 2.4 Start decrypting using Tag we just made
    nRet = aeadStartDecrypt(hContext, lpTag)
    
    ' 2.5. Update with ciphertext -> plaintext (simulate adding in chunks)
    lpCT = cnvFromHex(strCtHex)
    Debug.Print "Adding ciphertext in chunks"
    nLen = 13
    nLeft = cnvBytesLen(lpCT)
    nOffset = 0
    While nLeft > 0
        If nLeft < nLen Then
            nLen = nLeft
        End If
        ' Update chunk of ciphertext in situ
        Debug.Print "C: " & cnvHexFromBytesMid(lpCT, nOffset, nLen)
        lpChunk = aeadUpdate(hContext, cnvBytesMid(lpCT, nOffset, nLen))
        Debug.Print "P: " & cnvToHex(lpChunk)
        Debug.Print "P: " & StrConv(lpChunk, vbUnicode)
        nOffset = nOffset + nLen
        nLeft = nLeft - nLen
    Wend
    ' Note: treat plaintext output as suspect until authenticated by FinishDecrypt

    ' 2.6 Finish decrypting and check OK|FAIL
    nRet = aeadFinishDecrypt(hContext)
    Debug.Print "aeadFinishDecrypt returns " & nRet & " (0 => OK)"
    
    ' 3. We are done with the key so destroy it
    nRet = aeadDestroy(hContext)
    Debug.Print "aeadDestroy returns " & nRet & " (expecting 0)"

End Sub

Public Sub test_wipeBytes()
    Dim lpData() As Byte
    lpData = cnvFromHex("DEADBEEF")
    Debug.Print "Before wipeBytes='" & cnvToHex(lpData) & "'"
    Call wipeBytes(lpData)
    Debug.Print "After wipeBytes='" & cnvToHex(lpData) & "'"
    
    ' Zeroize a byte array
    Dim strData As String
    strData = "Secret information"
    Debug.Print "Before wipeString='" & strData & "'"
    
    ' Zeroise a string
    Call wipeString(strData)
    ' This just sets each character in the string to a zero value
    Debug.Print cnvHexStrFromString(strData)
    ' To clear the string completely, do the following
    strData = wipeString(strData)
    Debug.Print "After wipeString='" & strData & "'"
       
End Sub

Public Sub test_wipeFile()
    Dim strFileName As String
    Dim nRet As Long
    strFileName = "FileToBeDeleted.txt"
    WriteFileFromString strFileName, "Secret information"
    Debug.Print "Before wipeFile='" & ReadFileIntoString(strFileName) & "'"
    nRet = wipeFile(strFileName)
    Debug.Print "wipeFile returns " & nRet & " (expecting 0)"
    Debug.Assert 0 = nRet
    Debug.Print "After wipeFile='" & ReadFileIntoString(strFileName) & "'"
End Sub

Public Sub test_ErrorMessages()
    Dim nRet As Long
    Dim strDigest As String
    Debug.Print "EXPECTING ERRORS..."
    ' Invalid context handle, error code returned
    nRet = cipherFinal(666)
    Debug.Print errFormatErrorMessage(nRet)
    ' Missing file, empty string returned
    strDigest = hashFile("missing.file", API_HASH_SHA1)
    Debug.Print errFormatErrorMessage()
    ' Unsupported algorithm
    nRet = hashInit(API_HASH_MD2)
    ' Plus a user message
    Debug.Print errFormatErrorMessage(nRet, "OMG! user-supplied message")
End Sub

Public Sub test_apiModuleName()
    Debug.Print "ModuleName= " & apiModuleName()
End Sub

Public Sub test_apiCompileTime()
    Debug.Print "CompileTime=" & apiCompileTime()
    Debug.Print "Licence=" & apiLicenceType()
End Sub

' -----------------
' FILE UTILITIES
' -----------------
Private Function ReadFileIntoString(sFilePath As String) As String
' Reads file (if it exists) into a string.
    Dim strIn As String
    Dim hFile As Integer
    
    ' Check if file exists
    If Len(Dir(sFilePath)) = 0 Then
        Exit Function
    End If
    hFile = FreeFile
    Open sFilePath For Binary Access Read As #hFile
    strIn = Input(LOF(hFile), #hFile)
    Close #hFile
    ReadFileIntoString = strIn
    
End Function

Private Function WriteFileFromString(sFilePath As String, strIn As String) As Boolean
' Creates a file from a string. Clobbers any existing file.
On Error GoTo OnError
    Dim hFile As Integer
    
    If Len(Dir(sFilePath)) > 0 Then
        Kill sFilePath
    End If
    hFile = FreeFile
    Open sFilePath For Binary Access Write As #hFile
    Put #hFile, , strIn
    Close #hFile
    WriteFileFromString = True
Done:
    Exit Function
OnError:
    Resume Done
    
End Function