Attribute VB_Name = "basMain"
Option Explicit

' $Id: basMain.bas $
'****************************************************************************
' Copyright (C) 2009 DI Management Services Pty Limited, All Rights Reserved.
'****************************************************************************
' Distribution: You can freely use this code in your own applications, but
' you may not reproduce or publish this code on any web site, online service,
' or distribute as source on any media without express permission.
' Terms: Use at your own risk. Provided "as is" with no warranties.
' Contact: <www.di-mgt.com.au> <www.cryptosys.net>
'****************************************************************************
' This file last updated:
'   $Date: 2009-06-21 01:46Z $
'****************************************************************************

' A VB6 conversion of the core functions the VB.NET project CrSysAPIDemo
' Requires the module ``basCryptoSys.bas'' to be included in the project.
' Points to note:
' * Integer variables in VB.NET need to be changed to Long in VB6
' * Functions that output to a string need to have the output string pre-dimensioned first; else GPF!
' * There are some convenient functions in basCryptoSys that return strings directly.


Sub Main()
    ' NOTE: We use the words salt, nonce and IV interchangeably
    Dim strSaltHex As String
    Dim strPassword As String
    Dim nCount As Long
    Dim strPlain As String
    Dim strCipherHex As String
    
    ' USER INPUT:
    strPassword = "password"
    strPlain = "Hello world"
    nCount = 2048
    
    Debug.Print "ENCRYPTION USER INPUT:"
    Debug.Print "PWD='" & strPassword & "'"
    Debug.Print "CNT=" & nCount
    Debug.Print "PT ='" & strPlain & "'"
    
    ' ENCRYPT...
    Debug.Print "DEBUGGING..."
    strSaltHex = SetNonceHex
    Debug.Print "IV =" & strSaltHex
    strCipherHex = EncryptWithPassword(strPassword, strSaltHex, nCount, strPlain)
    Debug.Print "OUTPUT:"
    Debug.Print "CT =" & strCipherHex
    Debug.Print
    
    ' DECRYPT...
    Debug.Print "DECRYPTION USER INPUT:"
    Debug.Print "PWD='" & strPassword & "'"
    Debug.Print "CNT=" & nCount
    Debug.Print "IV =" & strSaltHex
    Debug.Print "CT =" & strCipherHex
    
    Debug.Print "DEBUGGING..."
    strPlain = DecryptWithPassword(strPassword, strSaltHex, nCount, strCipherHex)
    Debug.Print "OUTPUT:"
    If strPlain = strCipherHex Then
        MsgBox ("Decryption error")
        Debug.Print "PT =" & "<Decryption error>"
    Else
        Debug.Print "PT ='" & strPlain & "'"
    End If
    
End Sub

Public Function SetNonceHex() As String
    ' Generate a random nonce the same size as the AES-128 block (128 bits)
    '''Return Rng.NonceHex(Aes128.BlockSize)
    SetNonceHex = rngNonceHex(API_BLK_AES_BYTES)
End Function

Public Function EncryptWithPassword(ByVal strPassword As String, ByVal strSaltHex As String, ByVal nCount As Long, ByVal strPlain As String) As String
    ' Encrypts `ordinary' text given password, etc. and returns hex-encoded ciphertext
    Dim strKeyHex As String
    Dim strInputHex As String
    Dim strCipherHex As String
    Dim nRet As Long
    Dim nOutChars As Long
    Dim strPaddedHex As String

    ' 1. Form a 128-bit key from the password + salt + count
    '''strKeyHex = Pbe.Kdf2(Aes128.BlockSize, strPassword, strSaltHex, nCount)
    
    ' We know that a hex string is exactly 2 times the length in bytes
    strKeyHex = String(API_BLK_AES_BYTES * 2, " ")
    nRet = PBE_Kdf2Hex(strKeyHex, Len(strKeyHex), API_BLK_AES_BYTES, strPassword, strSaltHex, CLng(nCount), 0)
    If nRet <> 0 Then
        Debug.Print "ERROR: PBE_Kdf2Hex returns " & nRet
        Exit Function
    End If
    Debug.Print "KEY=" & strKeyHex
    
    ' 2. Encode the plaintext input in hex format
    '''strInputHex = Cnv.ToHex(strPlain)
    
    strInputHex = cnvHexStrFromString(strPlain)
    Debug.Print "PT =" & strInputHex
    
    ' 3. Pad the plaintext to an exact multiple of the encryption block size
    '''strInputHex = Aes128.Pad(strInputHex)
    
    nOutChars = PAD_HexBlock("", 0, strInputHex, API_BLK_AES_BYTES, 0)
    strPaddedHex = String(nOutChars, " ")
    nRet = PAD_HexBlock(strPaddedHex, Len(strPaddedHex), strInputHex, API_BLK_AES_BYTES, 0)
    Debug.Print "PAD=" & strPaddedHex
    
    ' 4. Encrypt this padded input using the key and the IV
    ' (we use the same value for the IV as we used for the salt above)
    '''strCipherHex = Aes128.ENCRYPT(strInputHex, strKeyHex, Mode.CBC, strSaltHex)
    
    strCipherHex = String(Len(strPaddedHex), " ")
    nRet = AES128_HexMode(strCipherHex, strPaddedHex, strKeyHex, ENCRYPT, "CBC", strSaltHex)
    Debug.Print "CT =" & strCipherHex
    
    ' Return the ciphertext in hex format
    '''Return strCipherHex
    EncryptWithPassword = strCipherHex
    
End Function

Public Function DecryptWithPassword(ByVal strPassword As String, ByVal strSaltHex As String, ByVal nCount As Long, ByVal strCipherHex As String) As String
    ' Decrypts strCipherHex. Returns plaintext as an `ordinary' text string.
    ' If fails, returns original hex-encoded ciphertext to indicate an error
    ' (this is because an empty string is a valid result).
    Dim strKeyHex As String
    Dim strPaddedHex As String
    Dim strPlainHex As String
    Dim strPlain As String
    Dim nOutChars As Long
    Dim nRet As Long

    ' 1. Form a 128-bit key from the password + salt + count
    '''strKeyHex = Pbe.Kdf2(Aes128.BlockSize, strPassword, strSaltHex, nCount)

    ' We know that a hex string is exactly 2 times the length in bytes
    strKeyHex = String(API_BLK_AES_BYTES * 2, " ")
    nRet = PBE_Kdf2Hex(strKeyHex, Len(strKeyHex), API_BLK_AES_BYTES, strPassword, strSaltHex, CLng(nCount), 0)
    If nRet <> 0 Then
        Debug.Print "ERROR: PBE_Kdf2Hex returns " & nRet
        Exit Function
    End If
    Debug.Print "KEY=" & strKeyHex
    
    ' 2. Decrypt the ciphertext to get padded plaintext (IV = salt)
    '''strPaddedHex = Aes128.DECRYPT(strCipherHex, strKeyHex, Mode.CBC, strSaltHex)
    strPaddedHex = String(Len(strCipherHex), " ")
    nRet = AES128_HexMode(strPaddedHex, strCipherHex, strKeyHex, DECRYPT, "CBC", strSaltHex)
    Debug.Print "PAD=" & strPaddedHex
    
    ' No need to query for length because we know the output will be shorter than input
    ' so make sure output is as long as the input
    strPlainHex = String(Len(strPaddedHex), " ")
    nOutChars = PAD_UnpadHex(strPlainHex, Len(strPaddedHex), strPaddedHex, API_BLK_AES_BYTES, 0)
    Debug.Print "Unpadded length is " & nOutChars & " characters"
    
    ' 3. Check for error (i.e. an empty string)
    '''If strPaddedHex.Length = 0 Then
        '''Return strCipherHex
    '''End If
    
    ' Check for error
    If (nOutChars < 0) Then
        ' Return unchanged input to indicate error
        DecryptWithPassword = strCipherHex
        Exit Function
    End If
    
    ' 4. Unpad to retrieve the plaintext
    '''strPlainHex = Aes128.Unpad(strPaddedHex)

    strPlainHex = Left$(strPlainHex, nOutChars)
    Debug.Print "PT =" & strPlainHex
    
    ' 5. Check for error (this time strPlain *equal* to strPaddedHex)
    '''If strPlainHex.Length = strPaddedHex.Length Then
        '''Return strCipherHex
    '''End If
    ' (Not applicable in VB6)
    
    ' 6. Encode the hex-encoded text into normal text
    '''strPlain = Cnv.StringFromHex(strPlainHex)
    
    strPlain = cnvStringFromHexStr(strPlainHex)

    ' Return the plaintext
    '''Return strPlain
    DecryptWithPassword = strPlain
    
End Function