Code-Beispiel

BASE64 Kodier / Dekodier-Funktion

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	ThePuppetMaster	18.01.2008

Dieses Beispiel zeigt, wie ein Text in BASE64 Kodiert, und auch wieder Dekodiert werden kann.

Hierzu sind die folgenden Funktionennötig. (Darunter findet sich ein kleines Beispiel zur Nutzung.

Idealer weise wird der Code in eine .bi kopiert und in das Projekt eingebunden. Spart auch Platz .)

'###############################################################################################################

Const Base64_String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Dim Shared Base64_Rev64() As UByte







'###############################################################################################################

Declare Function    Base64_Encode       (V_Source As String) As String

Declare Function    Base64_Decode       (V_Source As String) As String

Declare Function    Base64_RemoveCRLF   (V_Text As String) As String

Declare Function    Base64_TextBlock    (V_Text As String, ByVal V_Chars As ULong) As String

Declare Sub         Base64_ReverseCode  (V_Code() As UByte, B_Rev() As UByte)







'###############################################################################################################

Function Base64_Encode(V_Source As String) As String

Dim X as ULong

Dim B64() As Byte

ReDim B64(63) As Byte

For X = 1 to Len(Base64_String)

    B64(X-1) = Asc(Mid(Base64_String, X, 1))

Next

Base64_ReverseCode(B64(), Base64_Rev64())

Dim XL As ULong

Dim SourceB() As UByte

Dim XRest As ULong

Dim XN As ULong

Dim Result() As UByte

Dim XCNT as ULong

Dim Y As ULong

Dim c1 As Integer

Dim c2 As Integer

Dim c3 As Integer

Dim w(4) As Integer

XL = Len(V_Source)

If XL = 0 Then Return ""

Redim SourceB(XL) as UByte

For X = 1 to XL

    SourceB(X-1) = Asc(Mid(V_Source, X, 1))

Next

XRest = XL Mod 3

If XRest > 0 Then

    XN = ((XL \ 3) + 1) * 3

    ReDim Preserve V_SourceB(XL - 1) as UByte

Else: XN = XL

End If

ReDim Result(4 * XN / 3 - 1)

XCNT = 0

For X = 0 To XN / 3 - 1

    Y = 3 * X

    c1 = SourceB(Y)

    c2 = SourceB(Y + 1)

    c3 = SourceB(Y + 2)

    w(1) = Int(c1 / 4)

    w(2) = (c1 And 3) * 16 + Int(c2 / 16)

    w(3) = (c2 And 15) * 4 + Int(c3 / 64)

    w(4) = c3 And 63

    Y = 4 * X

    Result(Y) = B64(w(1))

    Result(Y + 1) = B64(w(2))

    Result(Y + 2) = B64(w(3))

    Result(Y + 3) = B64(w(4))

Next

Select Case XRest

    Case 0

    Case 1

        Result(UBound(Result)) = 61

        Result(UBound(Result) - 1) = 61

    Case 2: Result(UBound(Result)) = 61

End Select

Dim D as String

For X = 0 to UBound(Result)

    D += Chr(Result(X))

Next

Return D

End Function









'---------------------------------------------------------------------------------------------------------------

Function Base64_Decode(V_Source As String) As String

Dim X as ULong

Dim D as String = V_Source

Dim B64() As Byte

ReDim B64(63) As Byte

For X = 1 to Len(Base64_String)

    B64(X-1) = Asc(Mid(Base64_String, X, 1))

Next

Base64_ReverseCode(B64(), Base64_Rev64())

Dim Code() As Byte

ReDim Code(255) As Byte

For X = 0 to 255

    Code(X) = Base64_Rev64(X)

Next

Dim XCNT As ULong

Dim XRest As ULong

Dim XL As ULong

Dim w1 As Integer

Dim w2 As Integer

Dim w3 As Integer

Dim w4 As Integer

Dim SourceB() As UByte

Dim Result() As UByte

XL = Len(D)

If XL = 0 Then Exit Function

XRest = XL Mod 4

If XRest > 0 Then

    D = D + String$(4 - XRest, 0)

    XL = Len(D)

End If

Redim SourceB(XL) as UByte

For X = 1 to XL

    SourceB(X-1) = Asc(Mid(D, X, 1))

Next

ReDim Result(XL)

For X = 0 To UBound(sourceB) Step 4

    w1 = Code(SourceB(X))

    w2 = Code(SourceB(X + 1))

    w3 = Code(SourceB(X + 2))

    w4 = Code(SourceB(X + 3))

    Result(XCNT) = ((w1 * 4 + Int(w2 / 16)) And 255)

    XCNT += 1

    Result(XCNT) = ((w2 * 16 + Int(w3 / 4)) And 255)

    XCNT += 1

    Result(XCNT) = ((w3 * 64 + w4) And 255)

    XCNT += 1

Next

ReDim Preserve Result(XCNT - 1) as UByte

D = ""

For X = 0 to UBound(Result)

    If Result(X) = 0 Then Exit For

    D += Chr(Result(X))

Next

Return D

End Function







'---------------------------------------------------------------------------------------------------------------

Function Base64_RemoveCRLF(V_Text As String) As String

Dim XOutText As String

Dim XOneline As String

Dim XPos1 As Long

Dim XPos2 As Long

XPos1 = 1

Do

    XPos2 = InStr(XPos1, V_Text, Chr(13,10))

    If XPos2 > 0 Then

        XOneline = Mid(V_text, XPos1, XPos2 - XPos1)

        XOutText += XOneline

        XPos1 = XPos2 + 2

    Else: XOneline = Mid(V_text, XPos1): XOutText += XOneline

    End If

Loop Until XPos2 = 0

Return XOutText

End Function







'---------------------------------------------------------------------------------------------------------------

Function Base64_TextBlock(V_Text As String, ByVal V_Chars As ULong) As String

Dim XOutText As String

Dim XOneline As String

Dim X As ULong

For X = 1 To Len(V_text) Step V_Chars

    XOneline = Mid(V_Text, X, V_Chars) + Chr(13,10)

    XOutText += XOneline

Next

Return XOutText

End Function







'---------------------------------------------------------------------------------------------------------------

Sub Base64_ReverseCode(V_Code() As UByte, B_Rev() As UByte)

Dim X As UInteger

ReDim B_Rev(255) as UByte

For X = 0 To UBound(V_Code)-1

    B_Rev(V_Code(X)) = X

Next

End Sub

Und hier das Beispiel:

Dim D as String

Dim T as String

D = "Test.Hallo! Wie geht es dir?"

Print ">" & D & "<"

T = Base64_Encode(D)

Print ">" & T & "<"

Print ">" & Base64_Decode(T) & "<"

Viel Erfolg!

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 18.01.2008 von ThePuppetMaster angelegt.
Die aktuellste Version wurde am 18.01.2008 von ThePuppetMaster gespeichert.

Bearbeiten

Versionen