This is an old revision of the document!
Zwei Funktionen im Umgang mit Bits. bitArray() zerlegt ein Zahl in ihre Bit-Teile. Ist also das Rekusive zu 1+2+4+8+…
Und mit getByte kann man die Bit-Darstellung einers Zeichens ermitteln
'------------------------------------------------------------------------------- '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 baBCD = 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 getByte(ByVal iChar As Variant, Optional iBitCode As baBitCode = baDefault) As String '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 = baBCD) Then Dim numVal As Integer: numVal = CInt(Nz(iChar)) getByte = Join(bitArray(numVal), "") getByte = getByte & String(4 - Len(getByte), "0") 'Wenn der Input keine Zahl ist und BCD angewählt wirde, ein Error werfen ElseIf iBitCode = baBCD 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, " "))) getByte = Join(bitArray(ascVal), "") getByte = getByte & String(8 - Len(getByte), "0") End If End Function