Fast QB64 base64 encoder & decoder

[a740g]

This is a single-file, simple and 100% QB64 implementation of Base64 encode and decode. It may not be as fast as a C LUT based implementation, but it is good enough if you want a no nonsense QB64 library. 

Code: (Select All)

' Two functions

FUNCTION Base64_Encode$ (s AS STRING)

FUNCTION Base64_Decode$ (s AS STRING)

Base64_Decode() is more optimized than Base64_Encode() because I am guessing that is what most folks may want to use. It's much faster than my earlier implementation that you can find here: Something Tricky (qb64phoenix.com).

Here are some numbers from my Ryzen 5600X box.



Always find the latest version of this library here:  InForm-PE/InForm/extensions

[Dav]

Nice implementation!  And As always your code is polished.

- Dav

[SpriggsySpriggs]

Makes me wonder how fast mine is.

https://qb64forum.alephc.xyz/index.php?t...#msg131690

EDIT: Hmm, very slow, also fails to decode the text from LOREM_IPSUM. Very odd. Never had any problems before and it worked with other Base64 strings that I had in the past. Was also a direct copy of a Rosetta task, so the algorithm might not be good. It fails on the "b4" line of the decode$ function.

2nd EDIT: Nice. If I dig up my Win32 version, it is super fast on my PC.
Samuel's algo:
   

Win32:
   

Code: (Select All)

Option _Explicit



Const ITERATIONS = 100000

Const LOREM_IPSUM = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."



Dim encTxt As String, decTxt As String, i As Long, t As Double



Print ITERATIONS; "iterations,"; Len(LOREM_IPSUM); "bytes."



Print "Base64 encode..."



t = Timer

For i = 1 To ITERATIONS

    encTxt = encodeBase64(LOREM_IPSUM)

Next

Print Using "#####.##### seconds"; Timer - t



Print "Base64 decode..."



t = Timer

For i = 1 To ITERATIONS

    decTxt = decodeBase64(encTxt)

Next

Print Using "#####.##### seconds"; Timer - t



If _StrCmp(decTxt, LOREM_IPSUM) = 0 Then

    Print "Passed"

Else

    Print "Failed"

End If



Declare Dynamic Library "Crypt32"

    Function CryptBinaryToString& Alias "CryptBinaryToStringA" (ByVal pbBinary As _Offset, Byval cbBinary As Long, Byval dwFlags As Long, Byval pszString As _Offset, Byval pcchString As _Offset)

    Function CryptStringToBinary& Alias "CryptStringToBinaryA" (ByVal pszString As _Offset, Byval cchString As Long, Byval dwFlags As Long, Byval pbBinary As _Offset, Byval pcbBinary As _Offset, Byval pdwSkip As _Offset, Byval pdwFlags As _Offset)

End Declare



Function encodeBase64$ (encode As String)

    Const CRYPT_STRING_NOCRLF = &H40000000

    Const CRYPT_STRING_BASE64 = &H00000001



    Dim a As Long

    Dim lengthencode As Long

    Dim encoded As String

    Dim lengthencoded As Long



    lengthencode = Len(encode)



    a = CryptBinaryToString(_Offset(encode), lengthencode, CRYPT_STRING_BASE64 Or CRYPT_STRING_NOCRLF, 0, _Offset(lengthencoded))

    'Calculate buffer length

    If a <> 0 Then

        encoded = Space$(lengthencoded)

    Else

        encodeBase64 = ""

        Exit Function

    End If

    a = CryptBinaryToString(_Offset(encode), lengthencode, CRYPT_STRING_BASE64 Or CRYPT_STRING_NOCRLF, _Offset(encoded), _Offset(lengthencoded))

    'Acual conversion

    If a <> 0 Then

        encodeBase64 = encoded

    Else

        encodeBase64 = ""

    End If

End Function



Function decodeBase64$ (decode As String)

    Const CRYPT_STRING_BASE64_ANY = &H00000006



    Dim a As Long

    Dim lengthdecode As Long

    Dim decoded As String

    Dim lengthdecoded As Long



    lengthdecode = Len(decode)

    a = CryptStringToBinary(_Offset(decode), lengthdecode, CRYPT_STRING_BASE64_ANY, 0, _Offset(lengthdecoded), 0, 0)

    'Calculate buffer length

    If a <> 0 Then

        decoded = Space$(lengthdecoded)

    Else

        decodeBase64 = ""

        Exit Function

    End If

    a = CryptStringToBinary(_Offset(decode), lengthdecode, CRYPT_STRING_BASE64_ANY, _Offset(decoded), _Offset(lengthdecoded), 0, 0)

    'Actual conversion

    If a <> 0 Then

        decodeBase64 = decoded

    Else

        decodeBase64 = ""

    End If

End Function