Visual Basic - Technik, FAQ, Tricks, Beispiele

Home / System / Internet / Base64

Base64-Kodierung - Hin und zurück

Historie
09.10.2002Teilweise "+" durch "Or" ersetzt wg. Performance
02.09.2002Routinen zur Dekodierung; Download mit Beispiel-Anwendung
12.08.2002Neue Version für Unicode-Strings (nach Hinweis von Benjamin Bock)
25.04.2002API-Deklaration für ArrPtr hinzugefügt (Hinweis von Daniel Jaeger)
11.02.2002Erste Version

Einleitung

Warum gerade Base64?

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).

Prinzip

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.

Beispiele

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

Code/Quelltext - Allgemein

Download

Die Datei base64.zip enthält nicht nur den kompletten hier gezeigten Quelltext, sondern auch eine größere Beispiel-Anwendung dazu.

Übersetzungs-Tabellen

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

API-Deklarationen

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!

Code/Quelltext - Kodierung

Base64EncodeArray

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

Base64EncodeUnicode - Langsamere Version

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

Base64EncodeAscii

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)!

Base64EncodeUnicode

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.

Code/Quelltext - Dekodierung

Die Base64-Dekodierungs-Routinen entsprechen weitestgehend den Kodierungs-Routinen. Bis auf die modifizierte Berechnung des Speicherplatzes werden "nur" andere Übersetzungs-Tabellen verwendet.

Base64DecodeArray

' ©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

Base64DecodeAscii

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

Base64DecodeUnicode

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