Drei Funktionen im Umgang mit Bits.
Download bitAndBytes.bas Version 1.0
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
Public Function bitArray( _ ByVal iNumber, _ Optional ByVal iValueType As baValueType = baBit, _ Optional ByVal iFilteredOut As Boolean = False _ ) As Variant()
'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 )
Public Function char2byte( ByVal iChar As Variant, Optional iBitCode As baBitCode = baDefault ) As String
'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'
Public Function byte2char(ByVal iByte As String) As Variant
'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
'/** ' * 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
'/** ' * 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
'/** ' * 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