Attribute VB_Name = "basByteUtils"
Option Explicit
Option Base 0

' basByteUtils: Misc byte utilities in VB

' Version 3.2. Posted on <www.di-mgt.com.au>  August 2001
' Revision history at end of file

'************************* COPYRIGHT NOTICE*************************
' This code was originally written in Visual Basic by David Ireland
' and is copyright (c) 2001 D.I. Management Services Pty Limited.
' All rights reserved.

' You may use this code in your applications provided this
' copyright notice is left intact.

' 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*************************

' Contents:
' . bu_HexStr2Bytes: Converts string with hex values into array of bytes
' . bu_HexStr2Words: Converts string with hex values into array of Longs
' . bu_Words2HexStr: Converts array of Longs to a hex string (Added 11/5/01)
' . bu_String2Bytes: Converts string directly into array of bytes
' . bu_Bytes2String: Converts array of bytes into a string of acsii chars
' . bu_String2Words: Converts string of ascii chars into an array of Longs*
' . bu_Str2Hex: Converts string of ascii chars to string in hex format
' . bu_Hex2Str: Converts string in hex format to string of ascii chars*
' . bu_IsValidHex: Checks if string contains only valid hex digits*
' . bu_XorBytes: XOR's two arrays of bytes
' . bu_CopyBytes: Copies bytes from one array to another
' . bu_LoadByteArray: Copies a list of values into array of bytes
' * = added XX August 2001

Public Function bu_Bytes2HexStr(aBytes() As Byte, nBytes As Long) As String
    bu_Bytes2HexStr = bu_Str2Hex(bu_Bytes2String(aBytes, nBytes))
End Function


Public Function bu_HexStr2Bytes(sHex As String, aBytes() As Byte) As Integer
' Converts string <sHex> with hex values into array of bytes
' Returns # of bytes converted
' Assumes array is large enough
' E.g. "fedcba98" will be converted into {&HFE, &HDC, &HBA, &H98}
    Dim i As Integer
    Dim nBytes As Integer

    If Not bu_IsValidHex(sHex) Then    ' Validation added Aug 2001
        Exit Function
    End If

    nBytes = Len(sHex) \ 2
    For i = 0 To nBytes - 1
        aBytes(i) = CByte("&H" & Mid(sHex, i * 2 + 1, 2))
    Next

    bu_HexStr2Bytes = nBytes

End Function

Public Function bu_HexStr2Words(sHex As String, aWords() As Long) As Integer
' Converts string <sHex> with hex values into array of words (long ints)
' Returns # of words converted
' Assumes array is large enough
' E.g. "fedcba9876543210" will be converted into {&HFEDCBA98, &H76543210}
    Const ncLEN As Integer = 8
    Dim i As Integer
    Dim nWords As Integer

    If Not bu_IsValidHex(sHex) Then    ' Validation added Aug 2001
        Exit Function
    End If

    nWords = Len(sHex) \ ncLEN
    For i = 0 To nWords - 1
        aWords(i) = CLng("&H" & Mid(sHex, i * ncLEN + 1, ncLEN))
    Next

    bu_HexStr2Words = nWords

End Function

' New function added in Version 3, 11 May 2001.
Public Function bu_Words2HexStr(aWords() As Long, nWords As Long) As String
' Converts array of words (long ints), nWords long, into a string
' E.g. {&HFEDCBA98, &H76543210} will be converted to "FEDCBA9876543210"
    Const ncLEN As Integer = 8
    Dim i As Integer
    Dim sHex As String

    bu_Words2HexStr = ""
    For i = 0 To nWords - 1
        sHex = Hex(aWords(i))
        sHex = String(ncLEN - Len(sHex), "0") & sHex
        bu_Words2HexStr = bu_Words2HexStr & sHex
    Next

End Function

Public Function bu_String2Bytes(str As String, aBytes() As Byte) As Integer
' Converts string <str> directly into array of bytes
' String may contain any characters between &H00 and &HFF
' Returns # of bytes converted
' Assumes array is large enough
' E.g. "abc" will be converted to (&H61, &H62, &H63) i.e. (97, 98, 99)
    Dim i As Integer
    Dim nBytes As Integer

    nBytes = Len(str)
    For i = 0 To nBytes - 1
        aBytes(i) = Asc(Mid(str, i + 1, 1))
    Next

    bu_String2Bytes = nBytes

End Function

Public Function bu_Bytes2String(aBytes() As Byte, nBytes As Long) As String
' Converts array of bytes, nBytes long, into a string
' E.g. (&H61, &H62, &H63) will be converted to "abc"
    Dim i As Integer
    Dim str As String

    For i = 0 To nBytes - 1
        str = str & Chr(aBytes(i))
    Next

    bu_Bytes2String = str

End Function

Public Function bu_String2Words(str As String, aWords() As Long) As Long
' Converts string of ascii chars into an array of 32-bit words
' E.g. "abcdefgh" will be converted to {&H61626364, &H65666768}
    Dim sTemp As String
    sTemp = bu_Str2Hex(str)
    bu_String2Words = bu_HexStr2Words(sTemp, aWords)
End Function

Public Function bu_Str2Hex(str As String) As String
' Converts string <str> of ascii chars to string in hex byte format
' E.g. "abc" will be converted to "616263"
    Dim byt As Byte
    Dim i As Integer
    Dim n As Integer
    Dim sHex As String
    sHex = ""

    n = Len(str)
    For i = 1 To n
        byt = CByte(Asc(Mid(str, i, 1)))
        If Len(Hex(byt)) = 1 Then
            sHex = sHex & "0" & Hex(byt)
        Else
            sHex = sHex & Hex(byt)
        End If
    Next
    bu_Str2Hex = sHex

End Function

Public Function bu_Hex2Str(sHex As String) As String
' Version 3.1: New function added August 2001
' Converts string <sHex> in hex format to string of ascii chars
' E.g. "6162632E" will be converted to "abc."
    Dim i As Integer
    Dim nBytes As Integer

    bu_Hex2Str = ""
    If Not bu_IsValidHex(sHex) Then
        Exit Function
    End If
    nBytes = Len(sHex) \ 2
    For i = 0 To nBytes - 1
        bu_Hex2Str = bu_Hex2Str & Chr(CByte("&H" & Mid(sHex, i * 2 + 1, 2)))
    Next

End Function

Public Function bu_IsValidHex(strToCheck As String)
' Vesrion 3.1: New function added August 2001
' Returns True if strToCheck only contains valid hexadecimal digits
    Const scHEXDIGITS As String = "0123456789ABCDEFabcdef"
    ' NB Include both uc and lc just in case Binary Compare mode
    Dim i As Integer
    Dim nLen As Long

    bu_IsValidHex = True
    nLen = Len(strToCheck)
    For i = 1 To nLen
        If InStr(scHEXDIGITS, Mid(strToCheck, i, 1)) = 0 Then
            bu_IsValidHex = False
            Exit For
        End If
    Next
End Function

Public Function bu_XorBytes(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 Function

Public Function bu_CopyBytes(aDest() As Byte, aSrc() As Byte, nBytes As Long)
' Copies nBytes from array aSrc() into aDest()
' Assumes aDest is large enough.
    Dim i As Long
    For i = 0 To nBytes - 1
        aDest(i) = aSrc(i)
    Next
End Function

Public Function bu_LoadByteArray(aBytes() As Byte, ParamArray List() As Variant) As Integer
' Copies a list of values <List> into array of bytes <aBytes>.
' Returns number of bytes read.
' Checks length of array first.
' E.g. bu_LoadByteArray(aBytes, &HFE, &HDC, &HBA, &H98) will return 4 and set
' aBytes(0) = &HFE, aBytes(1) = &HDC, aBytes(2) = &HBA, aBytes(3) = &H98
    Dim nLen As Integer, i As Integer

    nLen = UBound(List())      ' NB Zero-base, so one less than real length
    If UBound(aBytes()) < nLen Then
        nLen = UBound(aBytes())
    End If

    For i = 0 To nLen
        aBytes(i) = CByte(List(i))
    Next

    bu_LoadByteArray = nLen + 1

End Function

' Version 3: ShiftLeft and ShiftRight functions improved.
' Thanks to Doug J Ward for these.
' Identical functions are also used as private functions in basRadix64
Public Function bu_ShiftLeft(ByVal bytValue As Byte, intShift As Integer) As Byte
    If intShift > 0 And intShift < 8 Then
        bu_ShiftLeft = bytValue * (2 ^ intShift) Mod 256
    ElseIf intShift = 0 Then
        bu_ShiftLeft = bytValue
    Else
        bu_ShiftLeft = 0
    End If
End Function

Public Function bu_ShiftRight(ByVal bytValue As Byte, intShift As Integer) As Byte
    If intShift > 0 And intShift < 8 Then
        bu_ShiftRight = bytValue \ (2 ^ intShift)
    ElseIf intShift = 0 Then
        bu_ShiftRight = bytValue
    Else
        bu_ShiftRight = 0
    End If
End Function

Public Function bu_PadHexString(strData As String, nblocklen As Long) As String
' Pad hex data string to next multiple of nBlockLen bytes as per RFC 2630
    Dim nLen As Long
    Dim sPad As String
    Dim nPad As Integer
    Dim sHex As String
    Dim i As Integer
    nLen = Len(strData) \ 2
    nPad = ((nLen \ nblocklen) + 1) * nblocklen - nLen
    nPad = nPad And &HFF
    sHex = IIf(nPad < 16, "0" & Hex(nPad), Hex(nPad))
    sPad = ""
    ' Pad with # of pads (1-n)
    For i = 1 To nPad
        sPad = sPad & sHex
    Next
    bu_PadHexString = strData & sPad

End Function

Public Function bu_UnpadHexString(strData As String, nblocklen As Long) As String
' Strip RFC 2630-style padding from hex string
    Dim nLen As Long
    Dim nPad As Long
    nLen = Len(strData)
    ' Get # of padding bytes from last char hex pair
    nPad = Int("&H" & (Right(strData, 2)))
    If nPad > nblocklen Then nPad = 0    ' In case invalid
    bu_UnpadHexString = Left(strData, nLen - nPad * 2)
End Function

'***************************************************
' REVISION HISTORY
' Version 3.2. Published September 2001
' - Added Pad and UnpadHexString functions
' Version 3.1. Published August 2001
' - Added bu_Hex2Str function. Editorial revisions.
' Version 3.0. Published 11 May 2001.
' Added ShiftLeft and ShiftRight functions - thanks to Doug J Ward.
' Also added bu_Words2HexStr function.
' Version 2.1. Editorial revisions, 28 November 2000
' Version 2. Published 16 November 2000
' Changed name of function bu_Str2Bytes() to bu_HexStr2Bytes()
' and bu_Str2Words() to bu_HexStr2Words()
' Added new functions:
' bu_XorBytes, bu_CopyBytes, bu_Bytes2String, bu_String2Bytes
' Version 1. First posted by DI Management Services in October 2000
'***************************************************