mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-20 09:04:43 +00:00
147 lines
5 KiB
Text
147 lines
5 KiB
Text
|
'-----------------------------------------------------------------------------------------------------------------------
|
||
|
' Base64 Encoder and Decoder library
|
||
|
' a740g
|
||
|
'-----------------------------------------------------------------------------------------------------------------------
|
||
|
|
||
|
' Converts a normal string or binary data to a base64 string
|
||
|
Function Base64_Encode$ (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
|
||
|
|
||
|
Base64_Encode = buffer
|
||
|
End Function
|
||
|
|
||
|
|
||
|
' Converts a base64 string to a normal string or binary data
|
||
|
Function Base64_Decode$ (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
|
||
|
|
||
|
Base64_Decode = 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
|
||
|
|
||
|
|
||
|
' This function loads a resource directly from a string variable or constant (like the ones made by Bin2Data)
|
||
|
Function Base64_LoadResourceString$ (src As String, ogSize As _Unsigned Long, isComp As _Byte)
|
||
|
' Decode the data
|
||
|
Dim buffer As String: buffer = Base64_Decode(src)
|
||
|
|
||
|
' Expand the data if needed
|
||
|
If isComp Then buffer = _Inflate$(buffer, ogSize)
|
||
|
|
||
|
Base64_LoadResourceString = buffer
|
||
|
End Function
|
||
|
|
||
|
|
||
|
' Loads a binary file encoded with Bin2Data
|
||
|
' Usage:
|
||
|
' 1. Encode the binary file with Bin2Data
|
||
|
' 2. Include the file or it's contents
|
||
|
' 3. Load the file like so:
|
||
|
' Restore label_generated_by_bin2data
|
||
|
' Dim buffer As String
|
||
|
' buffer = Base64_LoadResourceData ' buffer will now hold the contents of the file
|
||
|
Function Base64_LoadResourceData$
|
||
|
Dim ogSize As _Unsigned Long, resize As _Unsigned Long, isComp As _Byte
|
||
|
Read ogSize, resize, isComp ' read the header
|
||
|
|
||
|
Dim buffer As String: buffer = Space$(resize) ' preallocate complete buffer
|
||
|
|
||
|
' Read the whole resource data
|
||
|
Dim i As _Unsigned Long: Do While i < resize
|
||
|
Dim chunk As String: Read chunk
|
||
|
Mid$(buffer, i + 1) = chunk
|
||
|
i = i + Len(chunk)
|
||
|
Loop
|
||
|
|
||
|
' Decode the data
|
||
|
buffer = Base64_Decode(buffer)
|
||
|
|
||
|
' Expand the data if needed
|
||
|
If isComp Then buffer = _Inflate$(buffer, ogSize)
|
||
|
|
||
|
Base64_LoadResourceData = buffer
|
||
|
End Function
|