To and From Base-64

[SMcNeill]

Umm...  I had a topic here already on this subject, with the code I'd originally posted being (Windows-Only).  I went back to modify that time as I was posting code which would turn my Windows-Only comment into a thing of the past, and... umm...  some mod.... *whistles innocently*... who may, or may not have been me...  *whistles a little more*...  completely ended up destroying that whole topic, rather than just renaming it!!

*Whistles Innocently a whole lot!*

But, since these things happen, and nobody will cop up to deleting and obliterating my old topic...  *hum humm deee hummm* ,,, then I guess I'll just start a new one, so I can share the new code which works on all OSes.

Code: (Select All)

_ControlChr Off



a$ = "Hello World"

Print "Original: "; a$



a1$ = To64$(a$)

Print "Encrypted: "; a1$



b$ = From64$(a1$)

Print "Restored: "; b$





$If BASE64 = UNDEFINED Then

    $Let BASE64 = TRUE

    $If WIN Then

        Declare Dynamic Library "Crypt32"

            Function CryptBinaryToStringA& (Compressed$, Byval numElements&, Byval format&, Byval buffer As _Offset, length&)

            Function CryptStringToBinaryA& (s$, Byval length&, Byval flags&, Byval r As _Offset, ret_length&, skip&, flag2&)

        End Declare



        Function To64$ (original$)

            If CryptBinaryToStringA(original$, Len(original$), &H40000001&, 0, l&) Then temp$ = Space$(l&) Else Exit Function

            If CryptBinaryToStringA(original$, Len(original$), &H40000001&, _Offset(temp$), l&) Then To64$ = temp$

        End Function



        Function From64$ (base64$)

            If CryptStringToBinaryA(base64$, Len(base64$), 6&, 0, l&, 0&, 0&) Then temp$ = Space$(l&) Else Exit Function

            If CryptStringToBinaryA(base64$, Len(base64$), 6&, _Offset(temp$), l&, 0&, 0&) Then From64$ = temp$

        End Function

    $Else

            'Note that these two versions were shamelessly stolen from A740g and taken directly from his work.

            'Orignial code and library can be found on the forums here: https://qb64phoenix.com/forum/showthread.php?tid=2184





            ' Converts a normal string or binary data to a base64 string

            Function To64$ (s As String)

            Const BASE64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"



            Dim srcSize As _Unsigned Long: srcSize = Len(s)

            Dim srcSize3rem As _Unsigned Long: srcSize3rem = srcSize Mod 3

            Dim srcSize3mul As _Unsigned Long: srcSize3mul = srcSize - srcSize3rem

            Dim buffer As String: buffer = Space$(((srcSize + 2) \ 3) * 4) ' preallocate complete buffer

            Dim j As _Unsigned Long: j = 1



            Dim i As _Unsigned Long: For i = 1 To srcSize3mul Step 3

            Dim char1 As _Unsigned _Byte: char1 = Asc(s, i)

            Dim char2 As _Unsigned _Byte: char2 = Asc(s, i + 1)

            Dim char3 As _Unsigned _Byte: char3 = Asc(s, i + 2)



            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShR(char1, 2)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL((char1 And 3), 4) Or _ShR(char2, 4)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL((char2 And 15), 2) Or _ShR(char3, 6)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (char3 And 63))

            j = j + 1

            Next i



            ' Add padding

            If srcSize3rem > 0 Then

            char1 = Asc(s, i)



            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShR(char1, 2)))

            j = j + 1



            If srcSize3rem = 1 Then

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL(char1 And 3, 4)))

            j = j + 1

            Asc(buffer, j) = 61 ' "="

            j = j + 1

            Asc(buffer, j) = 61 ' "="

            Else ' srcSize3rem = 2

            char2 = Asc(s, i + 1)



            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL((char1 And 3), 4) Or _ShR(char2, 4)))

            j = j + 1

            Asc(buffer, j) = Asc(BASE64_CHARACTERS, 1 + (_ShL(char2 And 15, 2)))

            j = j + 1

            Asc(buffer, j) = 61 ' "="

            End If

            End If



            To64$ = buffer

            End Function



            ' Converts a base64 string to a normal string or binary data

            Function From64$ (s As String)

            Dim srcSize As _Unsigned Long: srcSize = Len(s)

            Dim buffer As String: buffer = Space$((srcSize \ 4) * 3) ' preallocate complete buffer

            Dim j As _Unsigned Long: j = 1

            Dim As _Unsigned _Byte index, char1, char2, char3, char4



            Dim i As _Unsigned Long: For i = 1 To srcSize Step 4

            index = Asc(s, i): GoSub find_index: char1 = index

            index = Asc(s, i + 1): GoSub find_index: char2 = index

            index = Asc(s, i + 2): GoSub find_index: char3 = index

            index = Asc(s, i + 3): GoSub find_index: char4 = index



            Asc(buffer, j) = _ShL(char1, 2) Or _ShR(char2, 4)

            j = j + 1

            Asc(buffer, j) = _ShL(char2 And 15, 4) Or _ShR(char3, 2)

            j = j + 1

            Asc(buffer, j) = _ShL(char3 And 3, 6) Or char4

            j = j + 1

            Next i



            ' Remove padding

            If Right$(s, 2) = "==" Then

            buffer = Left$(buffer, Len(buffer) - 2)

            ElseIf Right$(s, 1) = "=" Then

            buffer = Left$(buffer, Len(buffer) - 1)

            End If



            From64$ = buffer

            Exit Function



            find_index:

            If index >= 65 And index <= 90 Then

            index = index - 65

            ElseIf index >= 97 And index <= 122 Then

            index = index - 97 + 26

            ElseIf index >= 48 And index <= 57 Then

            index = index - 48 + 52

            ElseIf index = 43 Then

            index = 62

            ElseIf index = 47 Then

            index = 63

            End If

            Return

            End Function

    $End If 

$End If 

And, as long as we're whistling innocently, I'd also like to point out to @a740g that I have no idea why large portions of this code may, or may not, resemble his so uncannily!  *Whistle thistle hum and drum...*

[a740g]

[a740g]

Bench the Win32 and QB64 From64() with and without optimizations enabled. You'll may see some interesting numbers.