namespace Base64
dim as string*64 B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" _
& "abcdefghijklmnopqrstuvwxyz" _
& "0123456789+/"
Function Encode(S As String) As String
#define E0 (S[j] shr 2)
#define E1 (((S[j] and &H03) shl 4) + (S[j+1] shr 4))
#define E2 (((S[j+1] and &H0F) shl 2) + (S[j+2] shr 6))
#define E3 (S[j+2] and &H3F)
dim as long nChars = len(S)
if nChars=0 then return ""
dim as long j,k,m = nChars mod 3
dim as string r=string(((nChars+2)\3)*4,"=")
nChars-= (m+1)
For j = 0 To nChars Step 3
r[k]=B64[e0] : r[k+1]=B64[e1] : r[k+2]=B64[e2] : r[k+3]=B64[e3]:k+=4
Next
if m then
r[k]=B64[e0] : r[k+1]=B64[e1] : r[k+3]=61
If m = 2 Then r[k+2]=B64[e2] Else r[k+2]=61
end if
return r
#undef E0
#undef E1
#undef E2
#undef E3
End Function
Function Decode(s As String ) As String
#define P0(p) instr(B64,chr(s[n+p]))-1
Dim As String O
dim as long nChars=Len(s)-1
if nChars<0 then return ""
for n As long = 0 To nChars Step 4
var b = P0(1), c = P0(2), d = P0(3)
if b>-1 then
var a = P0(0) : O+= chr((a shl 2 + b shr 4))
end if
if c>-1 then O+= chr((b shl 4 + c shr 2))
if d>-1 then O+= chr((c shl 6 + d ))
next
return O
#undef P0
end function
Function EncodeMemory(buffer as any ptr,size as long) As String
#define E0 (S[j] shr 2)
#define E1 (((S[j] and &H03) shl 4) + (S[j+1] shr 4))
#define E2 (((S[j+1] and &H0F) shl 2) + (S[j+2] shr 6))
#define E3 (S[j+2] and &H3F)
dim as long nChars = size
if nChars=0 then return ""
dim as ubyte ptr S=buffer
dim as long j,k,m = nChars mod 3
dim as string r=string(((nChars+2)\3)*4,"=")
nChars-= (m+1)
For j = 0 To nChars Step 3
r[k]=B64[e0] : r[k+1]=B64[e1] : r[k+2]=B64[e2] : r[k+3]=B64[e3]:k+=4
Next
if m then
r[k]=B64[e0] : r[k+1]=B64[e1] : r[k+3]=61
If m = 2 Then r[k+2]=B64[e2] Else r[k+2]=61
end if
return r
#undef E0
#undef E1
#undef E2
#undef E3
End Function
Function DecodeMemory(s As String,byref nBytes as integer) As any ptr
#define P0(p) instr(B64,chr(s[n+p]))-1
dim as long nChars=Len(s)
if nChars<1 then return 0
nBytes=nChars : nChars-=1
dim as ubyte ptr O,buffer=callocate(nBytes)
O=buffer
for n As long = 0 To nChars Step 4
var b = P0(1), c = P0(2), d = P0(3)
if b>-1 then
var a = P0(0) : *O = (a shl 2 + b shr 4) : O+=1
end if
if c>-1 then *O = (b shl 4 + c shr 2) : O+=1
if d>-1 then *O = (c shl 6 + d) : O+=1
next
return buffer
#undef P0
end function
end namespace 'Base64
'
' main
'
dim as string MSG = "Your FreeBASIC version " & __FB_VERSION__ & " what a fun."
dim as string E64 = Base64.Encode(msg)
dim as string D64 = Base64.Decode(E64)
? "message : " & msg
print
? "encoded string : " & E64
? "decoded string : " & D64
print
E64 = Base64.EncodeMemory(strptr(msg),len(msg))
var pMemory = Base64.DecodeMemory(E64)
? "encoded Memory : " & E64
? "decoded Memory : " & *cptr(zstring ptr,pMemory)
deallocate pMemory
sleep
Last edited by D.J.Peters on Apr 05, 2018 0:10, edited 3 times in total.
dodicat you are right
It was a simple 1:1 copy and paste from geany or FBIDE to forum.
Who robs the "1" the clipborad, firefox or the forum PHP really mystic. :-)
I mean the first or last char can be lost OK but not inside a block of chars !
Namespace Base64
'Dim As String * 64 B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" _
' & "abcdefghijklmnopqrstuvwxyz" _
' & "0123456789+/"
Dim As String * 64 B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Function Encode(S As String) As String
#Define E0 (S[j+0] Shr 2)
#Define E1 (((S[j+0] And &H03) Shl 4) + (S[j+1] Shr 4))
#Define E2 (((S[j+1] And &H0F) Shl 2) + (S[j+2] Shr 6))
#Define E3 (S[j+2] And &H3F)
Dim As Long nChars = Len(S)
If nChars=0 Then Return ""
Dim As Long j,k,m = nChars Mod 3
Dim As String r=String(((nChars+2)\3)*4,"=")
nChars-= (m+1)
For j = 0 To nChars Step 3
r[k+0]=B64[e0] : r[k+1]=B64[e1] : r[k+2]=B64[e2] : r[k+3]=B64[e3]:k+=4
Next
If m Then
r[k+0]=B64[e0] : r[k+1]=B64[e1] : r[k+3]=61
If m = 2 Then
r[k+2]=B64[e2]
Else
r[k+2]=61
EndIf
End If
Return r
#Undef E0
#Undef E1
#Undef E2
#Undef E3
End Function
'
Function Decode(s As String ) As String
#Define P0(p) InStr(B64,Chr(s[n+p]))-1
Dim As String O
Dim As Long nChars=Len(s)-1
If nChars<0 Then Return ""
For n As Long = 0 To nChars Step 4
Var b = P0(1), c = P0(2), d = P0(3)
If b>-1 Then
Var a = P0(0) : O+= Chr((a Shl 2 + b Shr 4))
End If
If c>-1 Then O+= Chr((b Shl 4 + c Shr 2))
If d>-1 Then O+= Chr((c Shl 6 + d))
Next
Return O
#Undef P0
End Function
'
'My additions
Function EncodeBin(ByVal S As UByte Ptr, ByVal DLen As ULong) As String
#Define E0 (S[j+0] Shr 2)
#Define E1 (((S[j+0] And &H03) Shl 4) + (S[j+1] Shr 4))
#Define E2 (((S[j+1] And &H0F) Shl 2) + (S[j+2] Shr 6))
#Define E3 (S[j+2] And &H3F)
If DLen=0 Then Return ""
Dim As Long j,k,m = DLen Mod 3
Dim As String r=String(((DLen+2)\3)*4,"=")
DLen-= (m+1)
For j = 0 To DLen Step 3
r[k+0]=B64[e0] : r[k+1]=B64[e1] : r[k+2]=B64[e2] : r[k+3]=B64[e3]:k+=4
Next
If m Then
r[k+0]=B64[e0] : r[k+1]=B64[e1] : r[k+3]=61
If m = 2 Then
r[k+2]=B64[e2]
Else
r[k+2]=61
EndIf
End If
Return r
#Undef E0
#Undef E1
#Undef E2
#Undef E3
End Function
'
Sub DecodeBin(S As String, ByRef O As UByte Ptr, ByRef DLen As ULong)
If (Len(S) Mod 4) Then
DLen = 0
Exit Sub
EndIf
#Define P0(p) InStr(B64,Chr(S[n+p]))-1
'Dim As String O
'Java:
'byte decoded[] = new byte[((input.length() * 3) / 4) - (input.indexOf('=') > 0 ? (input.length() - input.indexOf('=')) : 0)];
DLen = Len(S) * 3 / 4
If InStr(S, "=") Then DLen -= Len(S) - InStr(S, "=")
O = Allocate(DLen)
Dim As Long i, nChars=Len(S)-1
'If nChars < 0 Then Return ""
For n As Long = 0 To nChars Step 4
Var b = P0(1), c = P0(2), d = P0(3)
If b>-1 Then
Var a = P0(0)
O[i] = Cast(UByte, (a Shl 2 + b Shr 4))
i += 1
End If
If c>-1 Then
O[i] = Cast(UByte, (b Shl 4 + c Shr 2))
i += 1
EndIf
If d>-1 Then
O[i] = Cast(UByte, (c Shl 6 + d))
i += 1
EndIf
Next
'Return O
#Undef P0
End Sub
End Namespace 'Base64
' validator added: 2017-06-24, by MrSwiss
Function Valid(s As String, c As String=B64) As Boolean
' encoded len(s) must be a multiple of 4, basic test
If Len(s) Mod 4 Then Return TRUE
c += "=" ' add padding char, to Alphabet (isn't in Alphabet)
Dim As UByte tmp, cnt
For j As UInteger = 0 To Len(s) - 1 ' check whole string (byte by byte)
tmp = s[j] : cnt = 0 ' get next char | reset counter
For i As UInteger = 0 to 64 ' walk through Alphabet
If tmp = c[i] Then cnt += 1 : Exit For ' if found, quit 'For i'
Next
If cnt = 0 Then Return TRUE ' if NOT found, return ERROR
Next
Return FALSE ' return OK (no ERROR)
End Function