Attribute VB_Name = "basBlowfishByteFns"
Option Explicit
Option Base 0

' basBlowfishByteFns: Wrapper functions to call Blowfish algorithms

' Version 6. November 2003. Added this module with new Byte functions
' Blowfish in Visual Basic first published October 2000.
'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2000-3 D.I. Management Services Pty Limited,
' all rights reserved.

' You are free to use this code as part of your own applications
' provided you keep this copyright notice intact and acknowledge
' its authorship with the words:

'   "Contains cryptography software by David Ireland of
'   DI Management Services Pty Ltd <www.di-mgt.com.au>."

' If you use it as part of a web site, please include a link
' to our site in the form
' <A HREF="http://www.di-mgt.com.au/crypto.html">Cryptography
' Software Code</a>

' This code may only be used as part of an application. It may
' not be reproduced or distributed separately by any means without
' the express written permission of the author.

' David Ireland and DI Management Services Pty Limited make no
' representations concerning either the merchantability of this
' software or the suitability of this software for any particular
' purpose. It is provided "as is" without express or implied
' warranty of any kind.

' Please forward comments or bug reports to <code@di-mgt.com.au>.
' The latest version of this source code can be downloaded from
' www.di-mgt.com.au/crypto.html.
'****************** END OF COPYRIGHT NOTICE*************************

' The functions in this module are:
' blf_BytesRaw(abData, bEncrypt): En/Deciphers bytes abData without padding
' blf_BytesEnc(abData): Pads and enciphers byte array abData with current key
' blf_BytesDec(abData): Deciphers byte array abData with current key and unpads
' PadBytes(abData): Pads byte array to next multiple of 8 bytes
' UnpadBytes(abData): Removes padding after decryption
' blf_BytesEncRawCBC(abData, abInitV): Encrypts abData in CBC mode
' blf_BytesEncCBC(abData, abInitV): Pads and encrypts abData in CBC mode
' blf_BytesDecRawCBC(abData, abInitV): Decrypts abData in CBC mode
' blf_BytesDecCBC(abData, abInitV): Decrypts abData in CBC mode and unpads

' To set current key, call blf_KeyInit(aKey())
'   where aKey() is the key as an array of Bytes

' NB The functions in this module deal with data of any length, but
' if you only want to deal with an 8-byte block, use
' blf_EncryptBytes() and blf_DecryptBytes() in module basBlowfish

' Use faster API call to copy bytes
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (ByVal lpDestination As Any, ByVal lpSource As Any, ByVal Length As Long)

Public Function blf_BytesRaw(abData() As Byte, bEncrypt As Boolean) As Variant
' New function added version 6.
' Encrypts or decrypts byte array abData without padding using to current key.
' Similar to blf_BytesEnc and blf_BytesDec, but does not add padding
' and ignores trailing odd bytes.
' ECB mode - each block is en/decrypted independently
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim j As Long
    Dim abOutput() As Byte
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    
    ' Calc number of 8-byte blocks (ignore odd trailing bytes)
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' Work through in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Get the next block of 8 bytes
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&

        ' En/Decrypt the block according to flag
        If bEncrypt Then
            Call blf_EncryptBytes(abBlock())
        Else
            Call blf_DecryptBytes(abBlock())
        End If
        
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&
        
        iIndex = iIndex + 8
    Next
    
    blf_BytesRaw = abOutput
    
End Function

Public Function blf_BytesEnc(abData() As Byte) As Variant
' Encrypts byte array abData after adding PKCS#5/RFC2630/RFC3370 padding
' NB always adds padding - use blf_BytesRaw() if you don't want padding
' ECB mode
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = PadBytes(abData)
    abOutput = blf_BytesRaw(abOutput, True)
    
    blf_BytesEnc = abOutput
End Function

Public Function blf_BytesDec(abData() As Byte) As Variant
' Decrypts byte array abData assuming PKCS#5/RFC2630/RFC3370 padding and ECB mode
' NB always removes valid padding - use blf_BytesRaw() if you don't want padding
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = blf_BytesRaw(abData, False)
    abOutput = UnpadBytes(abOutput)
    
    blf_BytesDec = abOutput
End Function

Public Function PadBytes(abData() As Byte) As Variant
' Pad data bytes to next multiple of 8 bytes as per PKCS#5/RFC2630/RFC3370
    Dim nLen As Long
    Dim nPad As Integer
    Dim abPadded() As Byte
    Dim i As Long
    
    'Set up error handler for empty array
    On Error GoTo ArrayIsEmpty

    nLen = UBound(abData) - LBound(abData) + 1
    nPad = ((nLen \ 8) + 1) * 8 - nLen
    
    ReDim abPadded(nLen + nPad - 1)  ' Pad with # of pads (1-8)
    If nLen > 0 Then
        CopyMemory VarPtr(abPadded(0)), VarPtr(abData(0)), nLen
    End If
    For i = nLen To nLen + nPad - 1
        abPadded(i) = CByte(nPad)
    Next
    
ArrayIsEmpty:
    PadBytes = abPadded

End Function

Public Function UnpadBytes(abData() As Byte) As Variant
' Strip PKCS#5/RFC2630/RFC3370-style padding
    Dim nLen As Long
    Dim nPad As Long
    Dim abUnpadded() As Byte
    Dim i As Long
    
    'Set up error handler for empty array
    On Error GoTo ArrayIsEmpty
    
    nLen = UBound(abData) - LBound(abData) + 1
    If nLen = 0 Then GoTo ArrayIsEmpty
    ' Get # of padding bytes from last char
    nPad = abData(nLen - 1)
    If nPad > 8 Then nPad = 0   ' In case invalid
    If nLen - nPad > 0 Then
        ReDim abUnpadded(nLen - nPad - 1)
        CopyMemory VarPtr(abUnpadded(0)), VarPtr(abData(0)), nLen - nPad
    End If

ArrayIsEmpty:
    UnpadBytes = abUnpadded
    
End Function

Public Function TestPadBytes()
    Dim abData() As Byte
    
    abData = StrConv("abc", vbFromUnicode)
    abData = PadBytes(abData)
    Stop
    abData = UnpadBytes(abData)
    Stop
    
End Function

Private Sub bXorBytes(aByt1() As Byte, aByt2() As Byte, nBytes As Long)
' XOR's bytes in array aByt1 with array aByt2
' Returns results in aByt1
' i.e. aByt1() = aByt1() XOR aByt2()
    Dim i As Long
    For i = 0 To nBytes - 1
        aByt1(i) = aByt1(i) Xor aByt2(i)
    Next
End Sub

Public Function blf_BytesEncRawCBC(abData() As Byte, abInitV() As Byte) As Variant
' Encrypts byte array <abData> in CBC mode
' using byte array <abInitV> as initialisation vector.
' Returns ciphertext as variant array of bytes.
' Requires key and boxes to be already set up.
' New in Version 6.
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    Dim abReg(7) As Byte    ' Feedback register
    Dim abOutput() As Byte
    
    ' Initialisation vector should be a 8-byte array
    ' so ReDim just to make sure
    ' This will add zero bytes if too short or chop off any extra
    ReDim Preserve abInitV(7)
    
    ' Calc number of 8-byte blocks
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ' Dimension output
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' C_0 = IV
    CopyMemory VarPtr(abReg(0)), VarPtr(abInitV(0)), 8&
    
    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Fetch next block from input
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&
        
        
        ' XOR with feedback register = Pi XOR C_i-1
        Call bXorBytes(abBlock, abReg, 8)
        
        ' Encrypt the block Ci = Ek(Pi XOR C_i-1)
        Call blf_EncryptBytes(abBlock())
        
        
        ' Store in feedback register Reg = Ci
        CopyMemory VarPtr(abReg(0)), VarPtr(abBlock(0)), 8&
        
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&

        iIndex = iIndex + 8
    Next
    
    blf_BytesEncRawCBC = abOutput
    
End Function

Public Function blf_BytesDecRawCBC(abData() As Byte, abInitV() As Byte) As Variant
' Decrypts byte array <abData> in CBC mode
' using byte array <abInitV> as initialisation vector.
' Returns plaintext as variant array of bytes.
' Requires key and boxes to be already set up.
' New in Version 6.
'    Dim strIn As String
'    Dim strOut As String
    
    Dim nLen As Long
    Dim nBlocks As Long
    Dim iBlock As Long
    Dim abBlock(7) As Byte
    Dim iIndex As Long
    Dim abReg(7) As Byte    ' Feedback register
    Dim abStore(7) As Byte
    Dim abOutput() As Byte
    
    ' Initialisation vector should be a 8-byte array
    ' so ReDim just to make sure
    ' This will add zero bytes if too short or chop off any extra
    ReDim Preserve abInitV(7)
    
    ' Calc number of 8-byte blocks
    nLen = UBound(abData) - LBound(abData) + 1
    nBlocks = nLen \ 8
    
    ' Dimension output
    ReDim abOutput(nBlocks * 8 - 1)
    
    ' C_0 = IV
    CopyMemory VarPtr(abReg(0)), VarPtr(abInitV(0)), 8&
    
    ' Work through string in blocks of 8 bytes
    iIndex = 0
    For iBlock = 1 To nBlocks
        ' Fetch next block from input
        CopyMemory VarPtr(abBlock(0)), VarPtr(abData(iIndex)), 8&
        
      
        ' Save C_i-1
        CopyMemory VarPtr(abStore(0)), VarPtr(abBlock(0)), 8&
        
        ' Decrypt the block Dk(Ci)
        Call blf_DecryptBytes(abBlock())
        
        ' XOR with feedback register = C_i-1 XOR Dk(Ci)
        Call bXorBytes(abBlock, abReg, 8)
        
        
        ' Store in feedback register Reg = C_i-1
        CopyMemory VarPtr(abReg(0)), VarPtr(abStore(0)), 8&
                
        ' Copy to output string
        CopyMemory VarPtr(abOutput(iIndex)), VarPtr(abBlock(0)), 8&

        iIndex = iIndex + 8
    Next
    
    blf_BytesDecRawCBC = abOutput
    
End Function

Public Function blf_BytesEncCBC(abData() As Byte, abInitV() As Byte) As Variant
' Encrypts byte array abData after adding PKCS#5/RFC2630/RFC3370 padding
' NB always adds padding - use blf_BytesEncRawCBC() if you don't want padding
' CBC mode
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = PadBytes(abData)
    abOutput = blf_BytesEncRawCBC(abOutput, abInitV)
    
    blf_BytesEncCBC = abOutput
End Function

Public Function blf_BytesDecCBC(abData() As Byte, abInitV() As Byte) As Variant
' Decrypts byte array abData assuming PKCS#5/RFC2630/RFC3370 padding and CBC mode
' NB always removes valid padding - use blf_BytesDecRawCBC() if you don't want padding
' Returns encrypted byte array as a variant.
' Requires key and boxes to be already set up.
' New in Version 6.

    Dim abOutput() As Byte
    
    abOutput = blf_BytesDecRawCBC(abData, abInitV)
    abOutput = UnpadBytes(abOutput)
    
    blf_BytesDecCBC = abOutput
End Function