====== [VBA] bitArray(), char2byte() und byte2char()======
//Drei Funktionen im Umgang mit Bits.//
{{:vba:cast:bitandbyte.bas|Download bitAndBytes.bas Version 1.0}}
- bitArray() zerlegt ein Zahl in ihre Bit-Teile. Ist also das Rekusive zu 1+2+4+8+...
- Mit char2byte() kann man die Bit-Darstellung eines Zeichens ermitteln
- Und mit byte2char() das byte wieder in ein Zeichen.
=====Public Defintions=====
====Enum byValueType====
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
====Enum byBitCode====
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
====Konstanten====
Public Const C_BITCODE_CAST_ERROR = vbObjectError + 6000
=====bitArray()=====
====Definition====
Public Function bitArray( _
ByVal iNumber, _
Optional ByVal iValueType As baValueType = baBit, _
Optional ByVal iFilteredOut As Boolean = False _
) As Variant()
***iNumber** Die Nummer, welche 'zerlegt' werden soll
***iValueType** Art des Inhalt des Array.
***iFilteredOut** Flag, ob alle 0er-Bit ausgefiltert werden sollen
====Beispiele====
'example 1) Gib das Bitmuster zurück. Key = Bitposition, Value = Bit
print_r bitArray(5)
(
[0] => 1
[1] => 0
[2] => 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)
(
[0] => 1
[1] => False
[2] => 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)
(
[0] => 0
[1] => 2
)
=====char2byte()=====
====Definition====
Public Function char2byte(
ByVal iChar As Variant,
Optional iBitCode As baBitCode = baDefault
) As String
***iChar** Charakter, der gewandelt werden soll. Null wird als 0 gewertet
***iBitCode** Die Codierung. baAscii oder ba BCD
====Beispiele====
'example 1) Byte einer Zahl. Zahlen sind tandart nach BCD-Codierung
print_r getByte(9)
'1001'
'example 2) Dito, aber nach ASCII-Codierung
print_r getByte(9, baASCII)
'10011100'
'example 3) String, Standart nach Ascii
print_r getByte("A")
'10000010'
'example 4) Null, Standart nach Ascii
print_r getByte(Null, baBCD)
'00000000'
'example 5) Null nach BCD
print_r getByte(Null)
'0000'
=====byte2char()=====
====Definition====
Public Function byte2char(ByVal iByte As String) As Variant
***iByte** Byte, das in ein Charakter gewandelt werden soll
====Beispiele====
'example 1) Byte einer Zahl. Zahlen sind tandart nach BCD-Codierung
print_r getChar("1001")
9
'example 2) Dito, aber nach ASCII-Codierung
print_r getChar("10011100")
'9'
'example 3) String, Standart nach Ascii
print_r getChar("10000010")
'A'
'example 4) Null, Standart nach Ascii. Es kommt die Rückgabe von chr(NULL) zurück
print_r getChar("00000000")
'\u0000'
'example 5) Null nach BCD. Ist nciht mehr von 0 unterscheidbar
print_r getChar("0000")
0
=====Codes=====
====Code bitArray()====
'/**
' * Zerlegt eine Nummer ihn ihre Bits.
' *
' * @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
====Code char2byte====
'/**
' * Gibt für einen Char das Byte aus
' * @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
====Code byte2char==
'/**
' * Umkehrfunktion zu getByte: Gibt aus einem Byte-Code wieder das Zeichen zurück
' *
' *
' * @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, baNA)
'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