Tipp 055: Zeichenfolge zu Base64 kodieren und dekodireren bzw. umwandeln

Form                     frmBase64
Label                    lblAscii
Label                    lblBinär
TextBox                  txtBase64

' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld

Option Explicit
 

 
Private Sub txtBase64_Change()
 
   Me.Caption = "Base64-Kodierung | www.visualbasicworld.de" _
      & " | Zeichen-Base64: " & Len(txtBase64.Text)
 
   txtData.Text = Base64ToData(txtBase64.Text)
 
End Sub
 

 
Private Sub txtData_Change()
 
   Me.Caption = "Base64-Kodierung | www.visualbasicworld.de" & _
      " | Zeichen-ASCII: " & Len(txtData.Text)
 
   txtBase64.Text = DataToBase64(txtData.Text)
 
End Sub

' VISUAL BASIC WORLD
' ===========================================
' Das große Portal zum Thema Visual Basic.
'
' Wenn Ihnen dieser Source Code gefallen hat,
' dann empfehlen Sie Visual Basic World bitte
' weiter und/oder setzen Sie einen Link auf:
'
' http://www.visualbasicworld.de/
'
' Vernetzen Sie sich mit uns:
'
' http://twitter.com/visualbasicwrld

Option Explicit
 
Global Const Base64CodeTafel = _
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 

 
 
Public Function DataToBase64(strData As String) As String
 
'========================================================='
'= Funktion wandelt ASCII-Daten in Base64 kodierte Daten ='
'========================================================='
 
   Dim lngZähler As Long
   Dim lngCounter As Long
 
   Dim lngMax As Long
 
   Dim lngBuffer As Long
   Dim strBuffer As String
 
   lngMax = Len(strData)
 
   For lngZähler = 1 To lngMax
 
      strBuffer = strBuffer & _
         Format(DezToBin(Asc(Mid$(strData, lngZähler, 1))), "00000000")
 
      lngBuffer = Len(strBuffer)
         'Der Zwischenspeicher wird gefüllt und die Länge des gespeicherten String
         'vermerkt. Die Zwischenspeicherung der Textlänge erfolgt vor allem aus
         'Performance-Gründen, da dieser Wert mehrmals benötigt wird.
 
      If lngBuffer = 24 Or lngZähler = lngMax Then
         'Verarbeitung in Gruppen zu 24-Bit bzw. 8-Byte.
 
         If Not lngBuffer Mod 6 = 0 Then
            strBuffer = strBuffer & Mid$("000000", 1, 6 - lngBuffer Mod 6)
            lngBuffer = Len(strBuffer)
         End If
            'Die Binärbits die zuvor je Byte in 8er-Gruppen organisiert waren werden im
            'Nächsten Schritt in 6er-Gruppen neu sortiert. Damit diese Neuorganisation
            'auch stets aufgeht werden hier fehlende Bits (zum Sextett) durch angehängte
            '0-Bits geschlossen. Dies ist jedoch nicht immer erforderlich und auch stets
            'nur im letzten Durchgang der Codierung. Daher erfolgt zuvor eine Abfrage
            'mit Hilfe der Modulo-Funktion.
 
 
         For lngCounter = 1 To lngBuffer Step 6
            DataToBase64 = DataToBase64 & _
               Mid$(Base64CodeTafel, 1 + BinToDez(Mid$(strBuffer, lngCounter, 6)), 1)
               'Sind alle Bits bereit zur Verarbeitung und die Gruppen zu ganzen
               '6er-Verbänden geschlossen werden die Bits neu kodiert, indem die
               'Binärzahlenwerte wieder ins Dezimalsystem übertragen werden.
         Next
 
         strBuffer = ""
 
      End If
 
   Next
 
   If Not Len(strData) Mod 3 = 0 Then _
      DataToBase64 = DataToBase64 & Mid$("==", 1, 3 - Len(strData) Mod 3)
         'Wenn die Anzahl des Eingabebytes nicht durch drei teilbar ist werden die
         'fehlenden Bytes mit Füllbits ("0") geschlossen. Um bei der Dekodierung zu
         'erkennen welche Bytes vollständig nachträglich angefügt wurden werden diese
         'mit "=" kodiert. Da maximal zwei Bytes komplett mit Füllbits zu füllen sind
         'können nie mehr als zwei "==" kodiert werden.
 
End Function
 

 
Public Function Base64ToData(strBase64 As String) As String
 
'==========================================================='
'= Funktion wandelt Base64-Daten in gewöhnlichen Daten um. ='
'==========================================================='
 
   Dim lngZähler As Long
   Dim lngCounter As Long
   Dim lngMax As Long
 
   Dim strBuffer As String
   
'== Unzulässige Zeichen ausfiltern ==='
 
   'Der Base64 Algorithmus gestattet lediglich die Verwendung der festgelegten
   '64 Zeichen zur Kodierung. Alle übrigen Zeichen im Zeichen-Stream sind damit
   'nicht Bestandteil des Base64-Datenstreams und werden entfernt. Dies ermöglicht
   'eine Formatierung der Daten per Leerzeichen oder ähnliches, da diese bei der
   'Dekodierung ohnehin entfernt werden.
 
   lngMax = Len(strBase64)
 
   For lngZähler = 1 To lngMax
 
      strBuffer = Mid$(strBase64, lngZähler, 1)
      If InStr(Base64CodeTafel, strBuffer) = 0 Then
         strBase64 = Replace(strBase64, strBuffer, "")
         lngMax = Len(strBase64)
      End If
 
   Next
 
   strBuffer = ""
   
'== Base64 codierten Datenstream umwandeln ==='
 
   'Die "Entschlüsselung" des Base64-Streams geschieht umgekehrt zur Kodierung.
   'Zunächst werden die einzelnen Buchstaben in Binärform überführt. Sodann
   'werden Gruppen zu 24 Bits in drei Zeichen á 8 Bit übertragen. Diese werden
   'aus den sich hieraus ergebenden ASCII-Codes werden mit der Chr-Funktion
   'Buchstaben und Zeichen gebildet. Diese werden dem Ergebnisstring angehängt
   'und so fort bis der gesamte Datenstrom übertragen wurde.
 
   For lngZähler = 1 To lngMax
 
       strBuffer = strBuffer & _
         Format(DezToBin(InStr(Base64CodeTafel, _
            Mid$(strBase64, lngZähler, 1)) - 1), "000000")
 
       If (Len(strBuffer) = 24) Or (lngZähler = lngMax) Then
 
            For lngCounter = 1 To Len(strBuffer) Step 8
 
               Base64ToData = Base64ToData & _
                  Chr(BinToDez(Mid$(strBuffer, lngCounter, 8)))
 
            Next
 
            strBuffer = ""
 
 
       End If
 
   Next
 
End Function
 

 
Private Function DezToBin(ByVal dblDezimal As Double) As String
 
   '======================================================================'
   '= Funktion wandelt eine Zahl aus dem Dezimal- in das Binärsystem um. ='
   '======================================================================'
 
   DezToBin = ""
 
   Do
 
      DezToBin = dblDezimal Mod 2 & DezToBin
 
      dblDezimal = dblDezimal \ 2
 
   Loop Until dblDezimal < 1
 
End Function
 

 
 
Private Function BinToDez(ByVal strBinär As String) As Double
 
   '======================================================================'
   '= Funktion wandelt eine Zahl aus dem Binär- in das Dezimalsystem um. ='
   '======================================================================'
 
   Dim lngZähler As Long
   Dim lngMax As Long
 
   lngMax = Len(strBinär)
 
   For lngZähler = 0 To (lngMax - 1)
 
      BinToDez = BinToDez + CDbl(Mid$(strBinär, lngMax - (lngZähler), 1)) * (2 ^ lngZähler)
 
   Next
 
End Function