Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0504: Base64-Kodierung

 von 

Beschreibung 

Der Base64 Algorithmus wird verwendet um Binärdateien in einer Folge von darstellbaren ASCII-Zeichen zu verwandeln. Er wird überwiegend zur Übermittlung von Attachments in E-mail verwendet. Durch Änderung der Austauschtabelle kann man eine einfache Verschlüsselung erzeugen.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [4,89 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'-------------- Anfang Projektdatei Base64.vbp --------------
'------- Anfang Formular "cmdClear1" alias Form1.frm  -------
' Steuerelement: Schaltfläche "cmdClear2"
' Steuerelement: Schaltfläche "cmdClear1"
' Steuerelement: Optionsfeld-Steuerelement "optCodeType" (Index von 0 bis 1)
' Steuerelement: Textfeld "txtEncoded"
' Steuerelement: Schaltfläche "Command5"
' Steuerelement: Schaltfläche "Command4"
' Steuerelement: Textfeld "txtDecoded"


' Autor: K. Langbein Klaus@ActiveVB.de

' Beschreibung: Demonstration der Base64-Kodierung und einer einfachen
' Methode der Verschluesselung mit dem gleichen Algorithmus.
Option Explicit

Dim UsedCode As String

Private Sub chkEncrypt_Click()
    If chkEncrypt.Value = 1 Then
        UsedCode = codeB
        chkBase64.Value = 0
    End If
End Sub

Function TestText$()
    Dim OutText As String
    Dim Oneline As String
    Dim k As Long
    Dim i As Long
    
    Randomize
    For i = 65 To 82
        k = Rnd * 30 + 1
        Oneline = String$(k, i) + vbCrLf
        OutText = OutText + Oneline
    Next i
    
    TestText = OutText
End Function

Private Sub cmdClear1_Click()
    txtDecoded = ""
End Sub

Private Sub cmdClear2_Click()
    txtEncoded = ""
End Sub

Private Sub Command4_Click()
    Dim test As String
    
    test = txtDecoded.text
    test = base64_encode(B64(), test)
    txtEncoded.text = TextBlock(test, 45)
End Sub

Private Sub Command5_Click()
    Dim test As String
    
    test = txtEncoded.text
    test = RemoveCRLF(test)
    test = base64_decode(Rev64, test)
    txtDecoded.text = test
End Sub

Private Sub Form_Load()
    optCodeType(0).Value = -1
    txtDecoded.text = TestText$
End Sub

Private Sub optCodeType_Click(Index As Integer)
    Select Case Index
    Case 0
        UsedCode = Base64
    Case 1
        UsedCode = codeB
    End Select
    
    Call IniCode(UsedCode)
End Sub


'-------- Ende Formular "cmdClear1" alias Form1.frm  --------
'--------- Anfang Modul "Module1" alias base64.bas  ---------


' Autor: K. Langbein Klaus@ActiveVB.de

' Beschreibung:
' Demonstration der Base64-Kodierung und Dekodierung


' Dies ist die richtige Austauschtabelle fuer Base64.
Option Explicit
Global Const Base64 = _
 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

' Man koennte aber jede beliebige andere Anordnung der Zeichen waehlen.
Global Const codeB = _
 "1ABwCDeEoFuGyHs8ItJKL3M57NgOzPnQxRS0iTU+V9WXvYZabcdfhjkl6mp2q4r/"

Global B64() As Byte
Global Rev64() As Byte

Function base64_encode(Code() As Byte, Source As String) As String
    Dim n As Long
    Dim i As Long
    Dim c1 As Integer
    Dim c2 As Integer
    Dim c3 As Integer
    Dim w(4) As Integer
    Dim sourceB() As Byte
    Dim Result() As Byte
    Dim l As Long
    Dim k As Long
    Dim rest As Long
    Dim cnt
    
    l = Len(Source)
    If l = 0 Then
        Exit Function
    End If
    sourceB() = StrConv(Source, vbFromUnicode)
    
    rest = l Mod 3
    If rest > 0 Then
        n = ((l \ 3) + 1) * 3
        ReDim Preserve sourceB(n - 1)
    Else
        n = l
    End If
    
    ReDim Result(4 * n / 3 - 1) ' Das Ergebnis ist 4/3 mal so lang
    
    cnt = 0
    For i = 0 To n / 3 - 1
    
        k = 3 * i 'Damit k nur ein- statt dreimal berechnet werden muss.
        c1 = sourceB(k)     ' Je drei Byte werden gelesen
        c2 = sourceB(k + 1)
        c3 = sourceB(k + 2)
        
        w(1) = Int(c1 / 4)  ' Je 6 Bit werden extrahiert
        w(2) = (c1 And 3) * 16 + Int(c2 / 16)
        w(3) = (c2 And 15) * 4 + Int(c3 / 64)
        w(4) = c3 And 63
          
        k = 4 * i 'Dami k nur ein- statt viermal berechnet werden muss
        Result(k) = B64(w(1))     ' Die 6-Bit-Werte werden nach Tabelle
        Result(k + 1) = B64(w(2)) ' durch Zeichen ersetzt.
        Result(k + 2) = B64(w(3))
        Result(k + 3) = B64(w(4))
    
    Next i
    
    ' Je nach ueberzaehligen Bytes im Ergebnis wird dieses
    ' Fuellbytes aufgefuellt. Das Fuellbyte ist ein "="
    
    Select Case rest
    
    Case 0
    ' nix tun
    Case 1
        
        Result(UBound(Result)) = 61
        Result(UBound(Result) - 1) = 61
    Case 2
        '
        Result(UBound(Result)) = 61
    End Select
    
    base64_encode = StrConv(Result, vbUnicode)

End Function

Function base64_decode(Code() As Byte, Source As String) As String

    On Error Goto err1
    
    Dim n As Long
    Dim w1 As Integer
    Dim w2 As Integer
    Dim w3 As Integer
    Dim w4 As Integer
    Dim sourceB() As Byte
    Dim Result() As Byte
    Dim l As Long
    Dim rest As Long
    Dim cnt As Long
    
    l = Len(Source)
    If l = 0 Then
        Exit Function
    End If
    
    rest = l Mod 4
    If rest > 0 Then ' Falls Textlaenge nicht ein Vielfaches von 4 ist
                     ' Werden einfach ein paar Nullen angehaengt.
        Source = Source + String$(4 - rest, 0)
        l = Len(Source)
    End If
    
    ' Der String wird in ein Feld umgewandelt
    sourceB() = StrConv(Source, vbFromUnicode)
    ReDim Result(l) ' Das ist mehr Platz als benoetigt, schadet aber nicht.
   
    For n = 0 To UBound(sourceB) Step 4
        w1 = Code(sourceB(n))
        w2 = Code(sourceB(n + 1))
        w3 = Code(sourceB(n + 2))
        w4 = Code(sourceB(n + 3))
        
        Result(cnt) = ((w1 * 4 + Int(w2 / 16)) And 255)
        cnt = cnt + 1
        Result(cnt) = ((w2 * 16 + Int(w3 / 4)) And 255)
        cnt = cnt + 1
        Result(cnt) = ((w3 * 64 + w4) And 255)
        cnt = cnt + 1
    Next n
   
done:

    ReDim Preserve Result(cnt - 1) ' Nullen abschneiden
    ' und zurueck in String verwandeln.
    base64_decode = StrConv(Result, vbUnicode)
    Exit Function
   
err1:
    Select Case Err
   
    Case 9
        ' Dies sollte eigentlich nicht passieren...
        Resume Next
        
    Case Else
        MsgBox Error
    
    End Select

End Function

Sub IniCode(Code As String)
    ReDim B64(63)
    ' Die Austauschtabelle wird in ein Bytearray uebertragen.
    B64() = StrConv(Code, vbFromUnicode)
    
    ' Und hier wird eine 2. umgekehrte Tabelle fuer die Dekodierung
    ' erstellt. Dies ist schneller, als die Tabelle
    ' jeweils nach dem Zeichen zu durchsuchen.
    Call ReverseCode(B64, Rev64)
End Sub

Function RemoveCRLF(text As String) As String
    Dim OutText As String
    Dim Oneline As String
    Dim pos1 As Long
    Dim pos2 As Long
    
    ' Carriage-Return und Line-Feed koennen per Definition
    ' nicht in einem mit Base64 kodierten Text enthalten sein.
    ' Sie werden aber meist nach je 45-60 Zeichen eingefuegt,
    ' um den Text lesbar zu machen. Hier werden sie wieder entfernt.
    
    pos1 = 1
    Do
        
        pos2 = InStr(pos1, text, vbCrLf, 1)
        If pos2 > 0 Then
            Oneline = Mid$(text, pos1, pos2 - pos1)
            OutText = OutText + Oneline
            pos1 = pos2 + 2
        Else
            Oneline = Mid$(text, pos1)
            OutText = OutText + Oneline
        End If
    
    Loop Until pos2 = 0
    
    RemoveCRLF = OutText
End Function

Function TextBlock(text As String, ByVal nChars As Long) As String
    ' Erzeugung eines Textblockes mit konstanter
    ' Zeilenlaenge fuer die Darstellung. Dies wird bei
    ' Mailattachments auch gemacht.

    Dim OutText As String
    Dim Oneline As String
    Dim i As Long
    
    For i = 1 To Len(text) Step nChars
        Oneline = Mid$(text, i, nChars) + vbCrLf
        OutText = OutText + Oneline
    Next i

    TextBlock = OutText
End Function

Sub ReverseCode(Code() As Byte, Rev() As Byte)
    Dim i As Integer
    ReDim Rev(255) '255 ist der maximale Wert der auftauchen koennte.
    
    For i = 0 To UBound(Code)
        Rev(Code(i)) = i
    Next i
    
    ' Rev() wird modifiziert zureuckgegeben, da wir es Byref
    ' uebergeben haben
End Sub
'---------- Ende Modul "Module1" alias base64.bas  ----------
'--------------- Ende Projektdatei Base64.vbp ---------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von vwm am 23.02.2007 um 11:11

Hi Frank,

cool, eine Antwort nach fünf Jahren!

Sie haben natürlich recht, zur Geheimhaltung ist B64 nicht gedacht. Ein minimaler Schutz kann zwar durch verwenden eines eigenen Alphabetes erreicht werden (siehe "Global Const codeB" im Beispiel), aber einer ernsthaften Kryptoanalyse hält das nicht stand -- einer neugierigen kleinen Schwester vielleicht.

Schöne Grüße

vwm

Kommentar von Frank Schwab am 22.02.2007 um 18:35

Hallo,

bitte nennen Sie das, was Base64 macht nicht "Verschlüsselung", denn da ist kein Schlüssel drin. Das ist nur eine Umkodierung. Ich habe schon jede Menge Programmierbeispiele gesehen, in denen Kennwörter mit Base64 "verschlüsselt" werden. Da das aber gar nicht stimmt, da ja gar kein Schlüssel verwendet wird, wiegen sich die Benutzer solcher "Verschlüsselungsroutinen" in einer falcshen Sicherheit. Einen Base64-kodierten Text kann ich mit jeder Base64-Dekodierroutine wieder in lesbaren Text zurückverwandeln.

Vorsicht! Das ist *keine* Verschlüsselung, sondern bloß eine Umkodierung!

Frank

Kommentar von GESIA am 01.12.2005 um 20:38

Nach einiger Verwendung des Codes habe ich festgestellt, dass der Code bei großen Datenmengen langsam ist, was auf die schlechte RemoveCrLf-Routine zurückzuführen ist, und, dass er mit untypischen 8bit-Zeichen abbricht, wenn beim Decodieren nicht zugelassene Zeichen Text vorkommen.

Beide Probleme lassen sich jedoch ganz einfach lösen, indem man die RemoveCrLf-Funktion durch folgenden Eintrag ersetzt:

For n = 0 To 255
If InStr(Base64, Chr(n)) = 0 Then Source = Replace(Source, Chr(n), "")
Next n
n = 0


Dies entfernt alle nicht zugelassenen Zeichen. Sieht ziemlich langsam aus, ist aber auch bei großen Datenmengen noch ziemlich schnell.

Kommentar von Sebastian Steiner am 16.06.2004 um 19:33

Hallo.
Ich kriege das irgendwie nicht zum Laufen. Beim Ausführen ist immer result(k) = ... in der Encrypt-Routine markiert und es kommt eine Fehlermeldung "Fehler 9 - Index außerhalb des gültigen Bereichs".
Was mache ich vielleicht falsch?
Viele Grüße!
Sebastian

Kommentar von vwm am 20.08.2003 um 02:58

Hi GESIA und Whitie,

ich glaube, Ihr verwechselt da tatsächlich manches. Vorne weg: Wenn Ihr es ganz genau wissen wollt, eine Definition, was und wie in Mails zu finden sein soll findet Ihr hier: http://www.ietf.org/rfc/rfc2045.txt [1](leider auf Englisch).

Ich versuche mal, es zusammenzufassen. Das Problem ist folgendes: Ursprünglich gedacht sind EMails nur für Text.
Problem 1: Binärdateien (Bilder, Programme usw.) können damit nicht übertragen werden.
Problem 2: Text ist auch nicht immer Text. Es gibt da eine ganze reihe von sog. Codepages (oder zeichentabellen, oder charsets, etc.). Sie sind für verschiedene Sprachen definiert (mit und ohne Umlaute), für unterschiedliche Computer-Systeme usw.

Es gibt jetzt einen einfachen Trick, diese Einschränkungen zu umgehen: man sucht sich ein "Alphabet", dessen Zeichen bei möglichst vielen dieser Codepages einheitlich ist, und Formt eine beliebige Zeichenfolge so um, das sie nur noch diese einheitlichen Zeichen enthält. Ein solches "Alphabet" ist die

Global Const Base64
. Sie ist als Standart fest definiert (z.B. in o.G. RFC 2054 [1]).

Wenn man nun einen Text oder ein Bild oder was auch immer damit verschlüsselt, ist sichergestellt, das fehlerfrei mit (fast) allen Mailprogrammen über (fast) alle Server auf (fast) alle Systeme übertragen werden kann. Wenn Ihr es dann auf dem Zielsystem wieder entschlüsselt heißt das aber noch lange nicht, das das Zielsystem dann auch damit umgehen kann. Und da liegt wohl Euer Problem:

@ whitie: probier doch mal, den Text statt mit dem Editor mit einem Browser (z.B. Mozilla Firebird oder Internet Explorer) zu öffnen. Da gibt es im Menü View (Ansicht) einen Punkt Character Coding (oder Encoding o.Ä) probier verschiedene Einstellungen aus, da sollte eigentlich die richtige dabei sein.

@Gesia: Wie gesagt: Codpages und Base64 Verschlüsselung sind zwei paar Schuhe. Man kann natürlich auch zwischen codepages hin und her konvertieren, aber leider braucht es dafür einen anderen Algorithmus. Aber bevor ich hier weiter ins blaue schieße, schreib doch mal, was genau Du eigentlich konkret erreichen wilst.

Schöne Grüße

VWM

[1] http://www.ietf.org/rfc/rfc2045.txt

Kommentar von whitie am 13.08.2003 um 16:31

Die Mail's die ich im System habe sind Base64 codiert:
Content-Type: application/octet-stream; name="XXXXX.for"
Content-Disposition: attachment; filename="XXXXX.for"
Content-Transfer-Encoding: base64

Trotzdem gibt es im gespeicherten Anhang (wenn ich ihn mit dem w2000Editor aufmache) keine Umlaute sondern Sonderzeichen. In der Global Const Base64 existieren ebenfalls keine Umlaute.

Habe ich da was nicht richtig verstanden ;-))?

Udo

Kommentar von GESIA am 11.08.2003 um 12:53

Also Base64 oder einen beliebigen, eigenen Code kann man so erstellen und entschlüsseln, aber in Emails werden auch oft "iso-8859-1", "iso-8859-15" oder "7bit" verwendet.

Da Schlüssel wird ja am Anfang festgelegt, mit

Global Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Da müsste man doch auch einen Schlüssel für die oben genannten "charsets" eintragen können, oder?

Frage: Wo kriege ich diese Schlüssel hier?

Danke im vorraus.