''' @brief Converts a normal STRING or binary data to a base64 STRING.

''' @param src The normal STRING or binary data to be converted.

''' @return The base64 STRING.

FUNCTION Base64_Encode$ (src AS STRING)



''' @brief Converts a base64 STRING to a normal STRING or binary data.

''' @param src The base64 STRING to be converted.

''' @return The normal STRING or binary data.

FUNCTION Base64_Decode$ (src AS STRING)



''' @brief Loads a binary file encoded with Bin2Data (CONST).

''' @param src The base64 STRING containing the encoded data.

''' @param ogSize The original size of the data.

''' @param isComp Whether the data is compressed.

''' @return The normal STRING or binary data.

FUNCTION Base64_LoadResourceString$ (src AS STRING, ogSize AS _UNSIGNED LONG, isComp AS _BYTE)



''' @brief Loads a binary file encoded with Bin2Data (DATA).

''' Usage:

'''  1. Encode the binary file with Bin2Data.

'''  2. Include the file or its contents.

'''  3. Load the file like so:

'''      Restore label_generated_by_bin2data

'''      Dim buffer As String

'''      buffer = Base64_LoadResourceData

''' @return The normal STRING or binary data.

FUNCTION Base64_LoadResourceData$

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

(02-24-2025, 09:00 PM)Pete Wrote: Hey Sam, @a740g

A quarter of a century ago I wrote my own encryption for office data. It worked great but by today's standards would be considered obsolete. My question is how involved would this be using this new QB64 encryption function to get even something simple like a password encrypted?

So say  want to encrypt my password to this forum:

password$ = "peteistremendousbutsteveisjustamazing"

How would I encrypt that with this new feature so, unlike the example in the wiki, someone can't just decode it with _BASE64DECODE$? I would think there should be a key involved.

Pete

(02-24-2025, 09:00 PM)Pete Wrote: Hey Sam, @a740g

A quarter of a century ago I wrote my own encryption for office data. It worked great but by today's standards would be considered obsolete. My question is how involved would this be using this new QB64 encryption function to get even something simple like a password encrypted?

So say  want to encrypt my password to this forum:

password$ = "peteistremendousbutsteveisjustamazing"

How would I encrypt that with this new feature so, unlike the example in the wiki, someone can't just decode it with _BASE64DECODE$? I would think there should be a key involved.

Pete