Base64 de/encoder the second edition :-)

D.J.Peters · Post by **D.J.Peters** » Nov 09, 2015 6:31

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

dodicat · Post by **dodicat** » Nov 11, 2015 13:18

Line 32 in function decode you have a hanging -
dim as long nChars=Len(s)-

Should it be Len(s)-1 perhaps?

D.J.Peters · Post by **D.J.Peters** » Nov 11, 2015 13:32

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 !

Joshy

bcohio2001 · Post by **bcohio2001** » Apr 12, 2017 0:17

Was in need of decoding/encoding a ubyte ptr.
Here is my adaption:

Code: Select all

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

Note: EncodeBin not tested.

MrSwiss · Post by **MrSwiss** » Jun 24, 2017 21:18

I've added a validator Function, to the Base64 namespace:

Code: Select all

' 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

Base64 de/encoder the second edition :-)

Base64 de/encoder the second edition :-)

Re: Base64 de/encoder the second edition :-)

Re: Base64 de/encoder the second edition :-)

Re: Base64 de/encoder the second edition :-)

Re: Base64 de/encoder the second edition :-)