Kontakt
DSVGO
Historie | |
09.10.2002 | Teilweise "+" durch "Or" ersetzt wg. Performance |
02.09.2002 | Routinen zur Dekodierung; Download mit Beispiel-Anwendung |
12.08.2002 | Neue Version für Unicode-Strings (nach Hinweis von Benjamin Bock) |
25.04.2002 | API-Deklaration für ArrPtr hinzugefügt (Hinweis von Daniel Jaeger) |
11.02.2002 | Erste Version |
Für die Übertragung von Daten hat sich im Internet die base64-Methode gemäß RFC 1521 durchgesetzt. Beispiele sind z.B. (binäre) Anlagen, die einer eMail beigefügt werden.
Der Vorteil der Base64-Kodierung ist die Nutzung eines sehr eingeschränkten Alphabets aus 64 Zeichen, so dass für die Darstellung 6 Bits ausreichen. Dies sichert die korrekte Übertragung auch über "ältere" Leitungen und Protokolle. Die für die Übertragung ausgewählten Zeichen sind außerdem gerade so ausgewählt, dass sie in allen verbreiteten Zeichencode-Tabellen an der gleichen Stelle vorkommen (z.B. ASCII und EBCDIC).
Da Binärdaten im Allgemeinen aus mehr als 64 verschiedenen Zeichen bestehen, wird eine spezielle Konvertierung benutzt: Dabei werden aus jeweils 3 Quell-Zeichen (mit je 8 Bit, insgesamt also 24 Bit) genau 4 Base64-Zeichen (mit je 6 Bit, s.o.) erzeugt. Das heißt, Binärdaten werden durch die Base64-Kodierung um etwa 33% länger:
3 Bytes Input: AAAAAAAA BBBBBBBB CCCCCCCC 4 Bytes Output: 00AAAAAA 00AABBBB 00BBBBCC 00CCCCCC
Jedem resultierenden 6-Bit Code wird eindeutig ein bestimmtes Zeichen zugeordnet:
Code: 0-25 26-51 52-61 62 63 Zeichen: A-Z a-z 0-9 + /
Falls die Quelldaten eine nicht durch 3 teilbare Länge haben, wird einfach mit dem Base64-Sonderzeichen "=" aufgefüllt.
Im folgenden (fiktiven) Beispiel wird eine Binärdatei in ein Base64-File kopiert:
Dim FileBytes() As Byte Dim Base64Bytes() As Byte ReadBinFile "C:\Test\xyz.exe", FileBytes Base64EncodeArray FileBytes, Base64Bytes WriteBinFile "C:\Test\xyz.b64", Base64Bytes
Die folgenden Zeilen geben die Base64-Darstellung von "AAAAAAA" aus (also "QUFBQUFBQQ=="):
MsgBox Base64EncodeUnicode("AAAAAAA") 'sehr sicher MsgBox Base64EncodeAscii("AAAAAAA") 'sehr schnell
Die folgenden Zeilen dekodieren jeweils den Base64-String "QUFBQUFBQQ==":
MsgBox Base64DecodeUnicode("QUFBQUFBQQ==") 'sehr sicher MsgBox Base64DecodeAscii("QUFBQUFBQQ==") 'sehr schnell
Die Datei base64.zip enthält nicht nur den kompletten hier gezeigten Quelltext, sondern auch eine größere Beispiel-Anwendung dazu.
Um die Base64-Kodierung schnell durchführen zu können, werden folgende Deklarationen benötigt (legen Sie dafür am Besten ein neues Modul z.B. mit dem Namen "modBase64" an):
Option Explicit 'Base64-Tabellen: Private Base64Initialized As Boolean Private Base64EncodeByte(0 To 63) As Byte Private Base64EncodeWord(0 To 63) As Integer Private Base64DecodeByte(0 To 255) As Byte Private Base64DecodeWord(0 To 255) As Integer Private Unicode2Ascii(0 To 16383) As Integer Private Ascii2Unicode(0 To 255) As Integer Private Const Base64EmptyByte As Byte = 61 '=' Private Const Base64EmptyWord As Integer = 61
Die folgende Prozedur sorgt dafür, dass die gerade deklarierten Übersetzungs-Tabellen gefüllt werden:
Private Sub Base64Init() Const Chars64 As String _ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" _ & "abcdefghijklmnopqrstuvwxyz" _ & "0123456789+/" 'Deklarationen: Dim i As Integer Dim Code As Integer 'Base64-Tabellen füllen: For i = 0 To 63 Code = Asc(Mid$(Chars64, i + 1, 1)) Base64EncodeByte(i) = Code Base64DecodeByte(Code) = i Base64EncodeWord(i) = Code Base64DecodeWord(Code) = i Next i 'Unicode-Tabellen füllen: For i = 0 To 255 Code = AscW(Chr$(i)) Ascii2Unicode(i) = Code Unicode2Ascii(Code) = i Next i Base64Initialized = True End Sub
Die folgenden Zeilen müssen im Deklarationsteil des Moduls eingefügt werden. Sie dienen zum schnellen Integer-Array-Mapping von Strings:
Public Declare Function ArrPtr Lib "msvbvm50.dll" _ Alias "VarPtr" (Ptr() As Any) As Long '<-- VB5 Public Declare Function ArrPtr Lib "msvbvm60.dll" _ Alias "VarPtr" (Ptr() As Any) As Long '<-- VB6 Private Declare Sub PokeLng Lib "kernel32" Alias "RtlMoveMemory" ( _ ByVal Addr As Long, Source As Long, _ Optional ByVal Bytes As Long = 4)
Kommentieren Sie bitte die eine Überflüssige der beiden ArrPtr-Deklarationen aus!
Die folgende Prozedur konvertiert ein Byte-Array in seine Base64-Darstellung. Man beachte die "kunstvolle" Implementierung der in VB fehlenden Shift-Operationen:
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Sub Base64EncodeArray( _ ByRef Bytes() As Byte, _ ByRef OutBytes() As Byte _ ) 'Deklarationen: Dim LB As Long Dim UB As Long Dim OutUB As Long Dim i As Long Dim j As Long Dim b1 As Byte Dim b2 As Byte Dim b3 As Byte 'Input-Array checken: LB = LBound(Bytes) UB = UBound(Bytes) If UB < LB Then Exit Sub 'Benötigte Größe berechnen: OutUB = LB + ((UB - LB) \ 3) * 4 + 3 ReDim OutBytes(LB To OutUB) 'Los gehts: If Not Base64Initialized Then Base64Init j = LB For i = LB To UB - 2 Step 3 'Aus 3 Bytes... b1 = Bytes(i) b2 = Bytes(i + 1) b3 = Bytes(i + 2) '...werden 4 Base64-Bytes: OutBytes(j) = Base64EncodeByte(b1 \ &H4) OutBytes(j + 1) = Base64EncodeByte((b1 And &H3) * &H10 Or b2 \ &H10) OutBytes(j + 2) = Base64EncodeByte((b2 And &HF) * &H4 Or b3 \ &H40) OutBytes(j + 3) = Base64EncodeByte(b3 And &H3F) j = j + 4 Next i 'Ggf. fehlende Bytes berücksichtigen: Select Case UB - i Case 0 '2 Bytes fehlen: b1 = Bytes(i) OutBytes(j) = Base64EncodeByte(b1 \ &H4) OutBytes(j + 1) = Base64EncodeByte((b1 And &H3) * &H10) OutBytes(j + 2) = Base64EmptyByte OutBytes(j + 3) = Base64EmptyByte Case 1 '1 Byte fehlt: b1 = Bytes(i) b2 = Bytes(i + 1) OutBytes(j) = Base64EncodeByte(b1 \ &H4) OutBytes(j + 1) = Base64EncodeByte((b1 And &H3) * &H10 Or b2 \ &H10) OutBytes(j + 2) = Base64EncodeByte((b2 And &HF) * &H4) OutBytes(j + 3) = Base64EmptyByte End Select End Sub
Die Base64-Kodierung eines Strings könnte man leicht mit der oben gezeigten Base64EncodeArray-Funktion und der in VB vorhandenen StrConv-Funktion durchführen. Dafür wären aber zwei (zeitraubende) Aufrufe der StrConv-Funktion nötig, um den String von der 16Bit-(Unicode-)Darstellung in eine 8Bit-Darstellung umzuwandlen (und anschließend umgekehrt).
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Function Base64DecodeUnicode2( _ ByRef Text As String _ ) As String 'Platz für Ergebnis deklarieren: Dim Bytes() As Byte If Len(Text) Then Base64DecodeArray StrConv(Text, vbFromUnicode), Bytes() Base64DecodeUnicode2 = StrConv(Bytes, vbUnicode) End If End Function
Die hier gezeigte Funktion erspart sich die oben genannten überflüssigen Konvertierungen, indem sie direkt auf die Speicherbereiche der beteiligten Strings zugreift:
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Function Base64EncodeAscii( _ ByRef Text As String _ ) As String Dim Chars() As Integer 'Unicode-Darstellung des Textes Dim SavePtr As Long 'Original Daten-Pointer Dim SADescrPtr As Long 'Safe Array Descriptor Dim DataPtr As Long 'pvData - Daten-Pointer Dim CountPtr As Long 'Pointer zu nElements Dim TextLen As Long Dim i As Long Dim Chars64() As Integer 'Unicode-Darstellung des Base64-Textes Dim SavePtr64 As Long 'Original Daten-Pointer Dim SADescrPtr64 As Long 'Safe Array Descriptor Dim DataPtr64 As Long 'pvData - Daten-Pointer Dim CountPtr64 As Long 'Pointer zu nElements Dim TextLen64 As Long Dim j As Long Dim b1 As Integer Dim b2 As Integer Dim b3 As Integer 'Platzbedarf checken: TextLen = Len(Text) If TextLen = 0 Then Exit Function TextLen64 = ((TextLen + 2) \ 3) * 4 Base64EncodeAscii = Space$(TextLen64) 'Input-String durch Integer-Array mappen: ReDim Chars(1 To 1) SavePtr = VarPtr(Chars(1)) PokeLng VarPtr(SADescrPtr), ByVal ArrPtr(Chars) DataPtr = SADescrPtr + 12 CountPtr = SADescrPtr + 16 PokeLng DataPtr, StrPtr(Text) PokeLng CountPtr, TextLen 'Output-String: (Base64) durch Integer-Array mappen: ReDim Chars64(0 To 0) SavePtr64 = VarPtr(Chars64(0)) PokeLng VarPtr(SADescrPtr64), ByVal ArrPtr(Chars64) DataPtr64 = SADescrPtr64 + 12 CountPtr64 = SADescrPtr64 + 16 PokeLng DataPtr64, StrPtr(Base64EncodeAscii) PokeLng CountPtr64, TextLen64 'Los gehts: If Not Base64Initialized Then Base64Init For i = 1 To TextLen - 2 Step 3 b1 = Chars(i) b2 = Chars(i + 1) b3 = Chars(i + 2) Chars64(j) = Base64EncodeWord(b1 \ &H4) Chars64(j + 1) = Base64EncodeWord((b1 And &H3) * &H10 Or b2 \ &H10) Chars64(j + 2) = Base64EncodeWord((b2 And &HF) * &H4 Or b3 \ &H40) Chars64(j + 3) = Base64EncodeWord(b3 And &H3F) j = j + 4 Next i 'Ggf. fehlende Bytes berücksichtigen: Select Case TextLen - i Case 0 '2 Bytes fehlen: b1 = Chars(i) Chars64(j) = Base64EncodeWord(b1 \ &H4) Chars64(j + 1) = Base64EncodeByte((b1 And &H3) * &H10) Chars64(j + 2) = Base64EmptyWord Chars64(j + 3) = Base64EmptyWord Case 1 '1 Byte fehlt: b1 = Chars(i) b2 = Chars(i + 1) Chars64(j) = Base64EncodeWord(b1 \ &H4) Chars64(j + 1) = Base64EncodeWord((b1 And &H3) * &H10 Or b2 \ &H10) Chars64(j + 2) = Base64EncodeWord((b2 And &HF) * &H4) Chars64(j + 3) = Base64EmptyWord End Select 'Integer-Arrays restaurieren: PokeLng DataPtr64, SavePtr64 PokeLng CountPtr64, 1 ' PokeLng DataPtr, SavePtr PokeLng CountPtr, 1 End Function
Achtung: Diese Routine führt bei Unicode-(Sonder-)Zeichen zu Fehlern! (Apropos: Warum ist eigentlich Asc(Chr$(128)) nicht gleich AscW(Chr$(128))?) Diese Routine darf also nur dann eingesetzt werden, wenn 100%-ig klar ist, dass der Inhalt aus "normalen" Zeichen besteht (etwa Quelltexte)!
Die nun gezeigte Funktion erspart sich ebenfalls die überflüssigen Konvertierungen, indem sie direkt auf die Speicherbereiche der beteiligten Strings zugreift. Durch Nutzung der Unicode-Übersetzungs-Tabellen hat sie aber keine Probleme mit Sonderzeichen, ist aber trotzdem schneller als die oben gezeigte Base64EncodeUnicode2-Funktion.
Hier nur die Änderungen gegenüber der eben gezeigten Base64EncodeAscii-Funktion:
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Function Base64EncodeUnicode( _ ByRef Text As String _ ) As String '... b1 = Unicode2Ascii(Chars(i)) b2 = Unicode2Ascii(Chars(i + 1)) b3 = Unicode2Ascii(Chars(i + 2)) '... End Function
Die zu kodierenden Unicode-Zeichen werden also einzeln via Unicode2Ascii-Tabelle in Ascii-Zeichen konvertiert.
Die Base64-Dekodierungs-Routinen entsprechen weitestgehend den Kodierungs-Routinen. Bis auf die modifizierte Berechnung des Speicherplatzes werden "nur" andere Übersetzungs-Tabellen verwendet.
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Sub Base64DecodeArray( _ ByRef Bytes() As Byte, _ ByRef OutBytes() As Byte _ ) 'Deklarationen: Dim LB As Long Dim UB As Long Dim OutUB As Long Dim i As Long Dim j As Long Dim b1 As Byte Dim b2 As Byte Dim b3 As Byte Dim b4 As Byte 'Input-Array checken: LB = LBound(Bytes) UB = UBound(Bytes) If UB < LB Then Exit Sub 'Benötigte Größe berechnen: If Bytes(UB) = Base64EmptyByte Then UB = UB - 1 If Bytes(UB) = Base64EmptyByte Then UB = UB - 1 OutUB = LB + (UB - LB) * 3 \ 4 ReDim OutBytes(LB To OutUB) 'Los gehts: If Not Base64Initialized Then Base64Init j = LB For i = LB To UB - 3 Step 4 'Aus 4 Base64-Bytes... b1 = Base64DecodeByte(Bytes(i)) b2 = Base64DecodeByte(Bytes(i + 1)) b3 = Base64DecodeByte(Bytes(i + 2)) b4 = Base64DecodeByte(Bytes(i + 3)) '...werden 3 Bytes: OutBytes(j) = b1 * &H4 Or b2 \ &H10 OutBytes(j + 1) = (b2 And &HF) * &H10 Or b3 \ &H4 OutBytes(j + 2) = (b3 And &H3) * &H40 Or b4 j = j + 3 Next i 'Ggf. fehlende Bytes berücksichtigen: Select Case OutUB - j Case 0 '1 Byte fehlt: b1 = Base64DecodeByte(Bytes(i)) b2 = Base64DecodeByte(Bytes(i + 1)) OutBytes(j) = b1 * &H4 Or b2 \ &H10 Case 1 '2 Bytes fehlen: b1 = Base64DecodeByte(Bytes(i)) b2 = Base64DecodeByte(Bytes(i + 1)) b3 = Base64DecodeByte(Bytes(i + 2)) OutBytes(j) = b1 * &H4 Or b2 \ &H10 OutBytes(j + 1) = (b2 And &HF) * &H10 Or b3 \ &H4 End Select End Sub
Nur für "normale" Texte geeignet:
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Function Base64DecodeAscii( _ ByRef Text As String _ ) As String 'Input-Variablen (Unicode): Dim Chars64() As Integer 'Unicode-Darstellung des Base64-Textes Dim SavePtr64 As Long 'Original Daten-Pointer Dim SADescrPtr64 As Long 'Safe Array Descriptor Dim DataPtr64 As Long 'pvData - Daten-Pointer Dim CountPtr64 As Long 'Pointer zu nElements Dim TextLen64 As Long Dim i As Long 'Output-Variablen (Base64): Dim Chars() As Integer 'Unicode-Darstellung des Textes Dim SavePtr As Long 'Original Daten-Pointer Dim SADescrPtr As Long 'Safe Array Descriptor Dim DataPtr As Long 'pvData - Daten-Pointer Dim CountPtr As Long 'Pointer zu nElements Dim TextLen As Long Dim j As Long 'Sonstiges: Dim b1 As Integer Dim b2 As Integer Dim b3 As Integer Dim b4 As Integer 'Vorab-Prüfung: TextLen64 = Len(Text) If TextLen64 = 0 Then Exit Function 'Input-String durch Integer-Array mappen: ReDim Chars64(1 To 1) SavePtr64 = VarPtr(Chars64(1)) PokeLng VarPtr(SADescrPtr64), ByVal ArrPtr(Chars64) DataPtr64 = SADescrPtr64 + 12 CountPtr64 = SADescrPtr64 + 16 PokeLng DataPtr64, StrPtr(Text) PokeLng CountPtr64, TextLen64 'Platzbedarf bestimmen: If Chars64(TextLen64) = Base64EmptyWord Then TextLen64 = TextLen64 - 1 If Chars64(TextLen64) = Base64EmptyWord Then TextLen64 = TextLen64 - 1 TextLen = TextLen64 * 3 \ 4 Base64DecodeAscii = Space$(TextLen) 'Output-String durch Integer-Array mappen: ReDim Chars(0 To 0) SavePtr = VarPtr(Chars(0)) PokeLng VarPtr(SADescrPtr), ByVal ArrPtr(Chars) DataPtr = SADescrPtr + 12 CountPtr = SADescrPtr + 16 PokeLng DataPtr, StrPtr(Base64DecodeAscii) PokeLng CountPtr, TextLen 'Los gehts: If Not Base64Initialized Then Base64Init For i = 1 To TextLen64 - 3 Step 4 'Aus 4 Base64-Words... b1 = Base64DecodeWord(Chars64(i)) b2 = Base64DecodeWord(Chars64(i + 1)) b3 = Base64DecodeWord(Chars64(i + 2)) b4 = Base64DecodeWord(Chars64(i + 3)) '...werden 3 Words: Chars(j) = b1 * &H4 Or b2 \ &H10 Chars(j + 1) = (b2 And &HF) * &H10 Or b3 \ &H4 Chars(j + 2) = (b3 And &H3) * &H40 Or b4 j = j + 3 Next i 'Ggf. fehlende Words berücksichtigen: Select Case TextLen64 - i Case 1 '1 Word fehlt: b1 = Base64DecodeWord(Chars64(i)) b2 = Base64DecodeWord(Chars64(i + 1)) Chars(j) = b1 * &H4 Or b2 \ &H10 Case 2 '2 Words fehlen: b1 = Base64DecodeWord(Chars64(i)) b2 = Base64DecodeWord(Chars64(i + 1)) b3 = Base64DecodeWord(Chars64(i + 2)) Chars(j) = b1 * &H4 Or b2 \ &H10 Chars(j + 1) = (b2 And &HF) * &H10 Or b3 \ &H4 End Select 'Integer-Arrays restaurieren: PokeLng DataPtr, SavePtr PokeLng CountPtr, 1 ' PokeLng DataPtr64, SavePtr64 PokeLng CountPtr64, 1 End Function
Auch für Unicode-(Sonder-)Zeichen geeignet:
' ©2002 by Jost Schwider, http://vb-tec.de/ Public Function Base64DecodeUnicode( _ ByRef Text As String _ ) As String '... Chars(j) = Ascii2Unicode(b1 * &H4 Or b2 \ &H10) Chars(j + 1) = Ascii2Unicode((b2 And &HF) * &H10 Or b3 \ &H4) Chars(j + 2) = Ascii2Unicode((b3 And &H3) * &H40 Or b4) '... End Function
© Jost Schwider, 11.02.2002-09.10.2002 - http://vb-tec.de/base64.htm