Attribute VB_Name = "_bitAndByte"
'-------------------------------------------------------------------------------
'File         : bitArray
'               Copyright mpl by ERB software
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/byteArray
'Environment  : VBA 2007 +
'Version      : 1.0
'Author       : Stefan Erb (ERS)
'History      : 29.04.2014 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit

Public Enum baValueType
    baBitPosition = 1       'Der Array-Value beinhaltet die Bitpositionen von allen gesetzten Bit. Bei nicht gesezten Bits ist der Value false (also -1)
    baBit = 2               'Gibt das Bit an der entsprechenden Position zurück. 0 oder 1
    baValue = 3             'Gibt den Wert des Bits zurück: 2^Bitposition
End Enum

Public Enum baBitCode
    baDefault = 0           'Bei Ziffern wird der BCD, bei allen anderen der ASCII verwendet
    baBCD4 = 1              'Im BCD-Code werden die Ziffern 0 bis 9 in vier Bits codiert. Dabei können die Zahlen von 0000 bis 1001 entstehen. Der BCD-Code wird auch als 8-4-2-1-Code bezeichnet.
                            'Wenn der Paramenter keine Nummer ist, wird der Fehler C_BITCODE_CAST_ERROR geworfen
    baASCII = 2             'Der American Standard Code for Information Interchange codiert alle Zeichen inklusive der englischen Sonderzeichen in sieben Bits. Insgesamt können mit dem ASCII-Code 128 ( \textstyle 2^7 ) verschiedene Zeichen codiert werden
End Enum

Public Const C_BITCODE_CAST_ERROR = vbObjectError + 6000

'/**
' * Zerlegt eine Nummer ihn ihre Bits.
' * @example 1) Gib das Bitmuster zurück. Key = Bitposition, Value = Bit
' *         print_r bitArray(5)
' *         <Variant()>  (
' *             [0] => <Integer> 1
' *             [1] => <Integer> 0
' *             [2] => <Integer> 1
' *         )
' * @example 2) Gib die Werte zurück, mit denen bei Bitvergleichen gerehncet werden soll
' *             Key = Bitposition, Value = 2 ^ Bitposition, wenn der Bit gesetzt ist. Ansonsten 0
' *         print_r bitArray(5, baValue)
' *         <Variant()>  (
' *             [0] => <Long> 1
' *             [1] => <Boolean> False
' *             [2] => <Long> 4
' *         )
' * @example 3) Gib einfach ein Array aus, der die besetzten Bitpositionen zurückgint
' *             Key = Laufnummer, Value = Bitposition bei welcher det Bit 0 ist
' *         print_r bitArray(5, baBitPosition, True)
' *         <Variant()>  (
' *             [0] => <Long> 0
' *             [1] => <Long> 2
' *         )
' *
' * @param  Long        Die Nummer, welche 'zerlegt' werden soll
' * @param  baValueType Art des Inhalt des Array.
' * @param  Boolean     Flag, ob alle 0er-Bit ausgefiltert werden sollen
' * @return Array(Variant)
' */
Public Function bitArray( _
        ByVal iNumber, _
        Optional ByVal iValueType As baValueType = baBit, _
        Optional ByVal iFilteredOut As Boolean = False _
) As Variant()
    Dim pos      As Long:    pos = 0     'Index
    Dim k           As Long:    k = 0    'Array-Index
    Dim value       As Variant
    Dim bit         As Boolean
    Dim retArray()  As Variant
    Dim bitPos      As Variant
    
    Do While (2 ^ pos) <= iNumber
        'Der Value ermitteln, der in den Array abgefüllt wird
        bit = CBool(iNumber And 2 ^ pos)
        value = IIf(bit, CLng(2 ^ pos), False)
        bitPos = IIf(bit, pos, False)
        
        'Prüfen, ob nur die geseztzen Bites ausgegeben werden sollen
        If iFilteredOut And bit Then
            ReDim Preserve retArray(k)
            retArray(k) = Choose(iValueType, bitPos, Abs(bit), value)
            k = k + 1
        ElseIf Not iFilteredOut Then
            ReDim Preserve retArray(pos)
            retArray(pos) = Choose(iValueType, bitPos, Abs(bit), value)
        End If
        pos = pos + 1
    Loop
    bitArray = retArray
End Function

'/**
' * Gibt für einen Char das Byte aus
' *
' * @example 1) Byte einer Zahl. Zahlen sind tandart nach BCD-Codierung
' *         print_r getByte(9)
' *         <String> '1001'
' * @example 2) Dito, aber nach ASCII-Codierung
' *         print_r getByte(9, baASCII)
' *         <String> '10011100'
' * @example 3) String, Standart nach Ascii
' *         print_r getByte("A")
' *         <String> '10000010'
' * @example 4) Null, Standart nach Ascii
' *         print_r getByte(Null, baBCD)
' *         <String> '00000000'
' * @example 5) Null nach BCD
' *         print_r getByte(Null)
' *         <String> '0000'
' *
' * @requiered  bitArray()
' *
' * @param  String*1    Charakter, der gewandelt werden soll. Null wird als 0 gewertet
' * @param  baBitCode   Die Codierung.
' * @retuen String      Bitmuster
' */
Public Function char2byte(ByVal iChar As Variant, Optional iBitCode As baBitCode = baDefault) As String
    'Wenn der Input mehr als ein Zeichen ist, Fehler werfen
    If Len(Nz(iChar)) > 1 Then Err.Raise C_BITCODE_CAST_ERROR, "getByte", "Input is to large. Only one Character is alloud"
    'Leere Strings in NULL wandeln
    If Len(Nz(iChar)) = 0 Then iChar = Null
    'NULL und "" nur als BCD behandeln, wenn dies explizit ausgegeben wurde
    If IsNull(iChar) And iBitCode = baDefault Then iBitCode = baASCII
    
    'Prüfen ob der BCD COde angewendet werden kann. Nur wenn der Input eine Ziffer ist und der Codee Default oder BCD ist
    If IsNumeric(Nz(iChar)) And (iBitCode = baDefault Or iBitCode = baBCD4) Then
        Dim numVal As Integer: numVal = CInt(Nz(iChar, 0))
        char2byte = Join(bitArray(numVal), "")
        char2byte = char2byte & String(4 - Len(char2byte), "0")
    'Wenn der Input keine Zahl ist und BCD angewählt wirde, ein Error werfen
    ElseIf iBitCode = baBCD4 Then
        Err.Raise C_BITCODE_CAST_ERROR, "getByte", "Inputcharakter is not a number"
    'Die ASCII-Formatierung anwenden
    Else
        Dim ascVal As Integer: ascVal = IIf(IsNull(iChar), 0, Asc(Nz(iChar, " ")))
        char2byte = Join(bitArray(ascVal), "")
        char2byte = char2byte & String(8 - Len(char2byte), "0")
    End If
End Function

'/**
' * Umkehrfunktion zu getByte: Gibt aus einem Byte-Code wieder das Zeichen zurück
' *
' * @example 1) Byte einer Zahl. Zahlen sind tandart nach BCD-Codierung
' *         print_r getChar("1001")
' *         <Integer> 9
' * @example 2) Dito, aber nach ASCII-Codierung
' *         print_r getChar("10011100")
' *         <String> '9'
' * @example 3) String, Standart nach Ascii
' *         print_r getChar("10000010")
' *         <String> 'A'
' * @example 4) Null, Standart nach Ascii. Es kommt die Rückgabe von chr(NULL) zurück
' *         print_r getChar("00000000")
' *         <String> '\u0000'
' * @example 5) Null nach BCD. Ist nciht mehr von 0 unterscheidbar
' *         print_r getChar("0000")
' *         <Integer> 0
' *
' * @param  String  Byte-Code
' * @return Varaint Das Zeichen. Bei Ascii-Zeichen nach der Regel von chr()
' */
Public Function byte2char(ByVal iByte As String) As Variant
    'Überprüfen ob es sich um ein ASCII oder BCD handelt
    Dim bitCode As baBitCode:   bitCode = Switch(Len(iByte) = 8, baASCII, Len(iByte) = 4, baBCD4, True, baDefault)
    'Falls es keinen von beiden ist, ein Fehler werfen
    If bitCode = baDefault Then Err.Raise C_BITCODE_CAST_ERROR, "getChar", "Input is not a byte in type ASCII oder BCD"
    
    'Die Zahl hochrechnen
    Dim numVal As Integer: numVal = 0
    Dim i As Integer: For i = 0 To Len(iByte) - 1
        If Mid(iByte, i + 1, 1) = 1 Then numVal = numVal + 2 ^ i
    Next i
    
    'und gemäss Code umwandeln
    Select Case bitCode
        Case baASCII:   byte2char = Chr(numVal)
        Case baBCD4:    byte2char = numVal
    End Select
End Function