'Attribute VB_Name = "HexInDecAscii_"
Dim aTab&(129, 39) ' AnzahlByte(HexZahl) * 8 + 2; AnzahlDekaden(Ergebnis)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function HexInDecAscii(ByVal xInStrg$)
' Wandelt einen String mit max. 32 relevanten HexZeichen (128 Bit) in einen max. 39 Byte langen DezimalString
' z.B.: "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF" in "340282366920938463463374607431768211455" ODER "AFFE" in "45054"
' Die Funktion verwendet das Array aTab&(129, 39) mit 130 Zeilen und 40 Spalten
' Spalte 0: Anzahl der in der Zeile relevanten DezimalStellen (Ausnahme: Zeile 0, s.u.)
' Spalte 1 ... 40: 39 DezimalZiffern von der niederwertigsten bis zu höchstwertigen Stelle
' Zeile 2 ... 130: Zu jeder 2er Potenz von 2^0 bis 2^127 die Ziffern der entsprechenden DezimalZahl
' z.B. 1 in Zeile 2, 2 in Zeile 3, 4 in Zeile 4, ..., 1024 in Zeile 12, ...
' Bei der Wandlung Hex in Dec wird die Hex-Zahl Bit für Bit geprüft, ob das jeweilige Bit 1 ist und - wenn ja -
' dann die entsprechende Zeile der Tabelle von DezimalZiffern mittels AddBin&(xDst&, xSrc1&, xSrc2&) auf das
' in Zeile 1 stehende (Zwischen-)Ergebnis addiert, das natürlich zu Beginn der Wandlung gelöscht wurde.
' In Spalte 0 steht, wie lang der Summand ist, so dass nur die relevanten Stellen addiert werden.
' Die Addition wird also abgebrochen, sobald keine relevanten Stellen mehr zu addieren sind.
' Das Ergebnis aus Zeile 1 wird zum Abschluss in einen ASCII-String gewandelt und ausgegeben.
' Wer füllt die DezimalStellenTabelle aus?
' Dies geschieht automatisch, wenn HexInDecAscii(xInStrg$) aufgerufen wird.
' In aTab&(0, 0) steht, bis zu welchem Bit (0 ... 127) der Inhalt der Tabelle bereits aufgefüllt wurde.
' In aTab&(0, 1) steht, in welcher Zeile die DezimalZiffernTabelle beginnt.
' Werden höherwertige Bits als bei den früheren Aufrufen benötigt, so werden die entsprechenden Zeilen der Tabelle
' ergänzt unter Verwendung der bereits genannten Funktion AddBin&(xDst&, xSrc1&, xSrc2&).
' In der Tabelle enthält eine Zeile den doppelten Wert der vorausgehenden Zeile, so dass die Multiplikation mit 2
' leicht realisiert werden kann durch die Addition Z(n) = Z(n-1) + Z(n-1).
' Die erste Zeile der Tabelle (Zeile 2) wird per Programm vorbesetzt, indem aTab&(2, 0) = 1 und aTab&(2, 1) = 1
' ausgeführt wird. Ersteres ist die Länge der Zahl und zweiteres ihr Wert (2^0).
' PlausibilitätsPrüfung von aTab&():
' Es müssen aTab&(0, 0)<128 und aTab&(0, 1)=2 und aTab&(2, 0)=1 und aTab&(2, 1)=1 sein, sonst werden die genannten
' Elemente initialisiert (die Tabelle wird jedoch zuvor nicht gelöscht).
' aTab&() enthält 2 Zeilen mehr, als für die DezimalZiffernTabelle benötigt werden und zwar:
' - Zeile 1 wird als ErgenisZeile benutzt und
' - Zeile 0 wird "missbraucht", um den Anfang und den "Füllstand" der Tabelle zu hinterlegen, wie bereits beschrieben.
' Prüfung bzw. "Überarbeitung" des EingangsWertes xInStrg$:
' - KleinBuchstaben werden in GrossBuchstaben gewandelt
' - Leerzeichen vorne und hinten werden abgeschnitten
' - undefinierte Zeichen (definiert sind 0 ... 9 und A ... F) werden für eine Meldung gesammelt und aus dem Eingangswert eliminiert
' - vorlaufende Nullen werden abgeschnitten
' - die verbleibende Länge des Strings wird auf eine max. zulässige Länge von 32 geprüft (Abbruch bei Überschreitung).
' - der ErgebnisString enthält ggfs hinter dem Ergebnis in Klammern die Informationen:
' - In:xxx - die tatsächlich ausgewerteten Zeichen
' - Ignored:xxx - die ignorierten (weil "undefinierten") Zeichen - vorlaufende Nullen werden kommentarlos ignoriert.
' ParameterÜbergabe:
' HexInDecAscii(xInStrg$) und AddBin&(xDst&, xSrc1&, xSrc2&) greifen auf das Array aTab&() zu.
' Die aufrufende Funktion Hex... übergibt 3 ZeilenNrn an die aufgerufene Funktion Add...:
' 1. die Nr der Zeile, in der Add... das Ergebnis (die Summe) ablegen soll und
' 2. und 3. die Nrn der Zeilen, aus denen Add... die Summanden entnehmen soll.
' Die Funktion Add... "weiss nicht", was sie tut und verlässt sich ganz darauf, dass Hex... die richtigen ZeilenNrn vorgibt
' und die entsprechenden Zeilen zuvor mit Inhalt gefüllt bzw. die ErgebnisZeile geloscht hat.
' Die Funktion Add... gibt lediglich die Länge (StellenZahl) des Ergebnisses zurück.
' Die Ziffern der Summe werden von Hex... aus Zeile 1 von aTab&() entnommen.
' HexInDecAscii(xInStrg$) kann als TabellenBlattFunktion verwendet werden, AddBin&(xDst&, xSrc1&, xSrc2&) jedoch nicht (ist nicht sinnvoll)
xTabNul& = 2 ' DezimalZiffernTabelle beginnt in Zeile 2 von aTab&()
' PlausibilitätsPrüfung und ggfs Initialisierung der Tabelle:
If aTab&(xTabNul&, 0) <> 1 Or aTab&(xTabNul&, 1) <> 1 Or aTab&(0, 0) <> 127 Or aTab&(0, 1) > xTabNul& Then aTab&(0, 0) = 0: aTab&(0, 1) = xTabNul&: aTab&(xTabNul&, 0) = 1: aTab&(xTabNul&, 1) = 1
For xZeichenNr& = 0 To 39 ' ErgebnisZeile (Zeile 1) löschen
aTab&(1, xZeichenNr&) = 0
Next xZeichenNr&
xInStrg$ = UCase$(Trim$(xInStrg$)) ' EingangsWert überarbeiten
xUndef$ = CReplac(xInStrg$, "0123456789ABCDEF", "") ' ungültige Zeichen für Meldung sammeln
xChgd$ = " " & CReplac(xInStrg$, xUndef$, "") ' ungültige Zeichen eliminieren
Do While InStr(xChgd$, " 0"): xChgd$ = Replace(xChgd$, " 0", " "): Loop ' VorNullen löschen
xChgd$ = Trim$(xChgd$)
If Len(xChgd$) > 32 Then HexInDecAscii = "OverFlow (length>32)": Exit Function
Cancel = True
For xZeichenNr& = 0 To Len(xChgd$) - 1 ' HexZeichen isolieren
xItm& = InStr("123456789ABCDEF", Mid$(xChgd$, Len(xChgd$) - xZeichenNr&, 1)) ' HexInDec "zu Fuss"; unbekannte Zeichen werden als 0 gedeutet!
For xBpZ& = 0 To 3 ' 4 Bit pro HexZeichen isolieren
xBitVal& = xItm& And 1: xItm& = Int(xItm& / 2): xBitNr& = 4 * xZeichenNr& + xBpZ&
If xBitVal& > 0 Then
If xBitNr& > aTab&(0, 0) Then ' ggfs Tabelle ergänzen
For xTabBit& = aTab&(0, 0) + 1 To Int(xBitNr& / 4) * 4 + 3 ' aufrunden auf ViererGruppenEnde
xNop& = AddBin&(xTabBit& + xTabNul&, xTabBit& + xTabNul& - 1, xTabBit& + xTabNul& - 1)
' Par1: aktuelle TabellenZeile ; Par2 und Par3: vorherige TabellenZeile (Multiplikation mit 2)
' xNop&: irrelevant
Next xTabBit&
aTab&(0, 0) = xTabBit& - 1 ' "FüllStand" der Tabelle aktualisieren
End If
xMaxDcd& = AddBin&(1, 1, xBitNr& + xTabNul&) ' (Zwischen-)Ergebnis bilden
' Par1: Zeile 1 Ergebnis ; Par2: Zeile 1 ZwischenErgebnis ; Par3: Wert aus Tabelle
' xMaxDcd&: Anzahl relevante Dekaden
End If
Next xBpZ& ' nächstes Bit des HexZeichens
Next xZeichenNr& ' nächstes HexZeichen
xOutStrg$ = "" ' Ergebnis (Zeile 1 von aTab&() in ASCII-String wandeln
For xZeichenNr& = xMaxDcd& To 1 Step -1
xOutStrg$ = xOutStrg$ & Chr$(aTab&(1, xZeichenNr&) + 48)
Next xZeichenNr&
' ggfs Meldung
If xInStrg$ <> xChgd$ Then xChgd$ = "In:" & xChgd$ Else xChgd$ = ""
If xUndef$ <> "" Then xUndef$ = "Ignored:" & xUndef$
xTmp$ = Trim$(xChgd$ & " " & xUndef$)
If xTmp$ <> "" Then xTmp$ = " (" & xTmp$ & ")"
HexInDecAscii = xOutStrg$ & xTmp$
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Private Function AddBin&(ByVal xDst&, ByVal xSrc1&, ByVal xSrc2&)
' addiert DezimalZiffern der DezimalZiffernTabelle aTab&(2 ,1) ... aTab&(130, 39)
' Die Parameter sind die "realen" ZeilenNrn in aTab&() von Summe, Summand1 und Summand2
' Zeile 2 enthält die Zahl 1 entsprechend 2^0
' Zeile 3 enthält die Zahl 2 entsprechend 2^1
' u.s.w. ...
' Zeile 130 enthält die Zahl 170141183460469231731687303715884105728 entsprechend 2^127
xCry& = 0 ' Übertrag löschen
xLim& = Min(Max(aTab&(xSrc1&, 0), aTab&(xSrc2&, 0)) + 1, 39) ' Anzahl Stellen bestimmen
For xDcd& = 1 To xLim& Step 1
xErg& = aTab&(xSrc1&, xDcd&) + aTab&(xSrc2&, xDcd&) + xCry&
aTab&(xDst&, xDcd&) = xErg& Mod 10
xCry& = Int(xErg& / 10)
If xErg& Then xMaxDcd& = xDcd& ' relevante(ste) Stelle merken
Next xDcd&
If xCry& Then xMaxDcd& = xDcd&: Stop ' Notbremse bei Überlauf ins Jenseits
If aTab&(xDst&, 0) < xMaxDcd& Then aTab&(xDst&, 0) = xMaxDcd& ' Anzahl relevanter DezimalStellen eintragen
AddBin& = xMaxDcd&
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' weitere benutzte Funktionen Min(), Max() und cReplac() :
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function Min(ByVal x1, ByVal x2)
If x1 < x2 Then Min = x1 Else Min = x2
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function Max(ByVal x1, ByVal x2)
If x1 > x2 Then Max = x1 Else Max = x2
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function CReplac(ByVal txt$, ByVal xo$, ByVal xn$)
' ersetzt in txt$ jedes Zeichen, das in der "Liste" xo$ enthalten ist,
' durch das Zeichen bzw. den String xn$
Dim xT$, xP&
xT$ = txt$
xP& = 1
Do While xP& <= Len(xT$)
If InStr(xo$, Mid$(xT$, xP&, 1)) Then
xT$ = Left$(xT$, xP& - 1) & xn$ & Mid$(xT$, xP& + 1)
xP& = xP& + Len(xn$)
Else
xP& = xP& + 1
End If
Loop
CReplac = xT$
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' 2018-06-06 <HB>