Share your advanced knowledge/code with the community.
User avatar
SinisterSoft
 
Posts: 60
Joined: Sun Apr 06, 2014 11:41 pm
Location: Preston, UK

Base64 encode decode memory and strings

by SinisterSoft Fri Feb 05, 2016 9:26 am

Here are a few routines to help encode decode to/from base64...

Code: Select all
Global base64$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

Procedure.l   Base64Decoder(*in,insize,*out,outsize)
   actual=0   
   If insize%4=0
      For loop=0 To insize Step 4
         c0=(FindString(base64$,PeekS(*in,loop,1,#PB_Ascii))-1)&$3f
         c1=(FindString(base64$,PeekS(*in,loop+1,1,#PB_Ascii))-1)&$3f
         PokeB(*out,actual,((c0<<2)|(c1>>4))&$ff)
         actual+1
         If actual>=outsize
            Break
         EndIf
         c2=(FindString(base64$,PeekS(*in,loop+2,1,#PB_Ascii))-1)&$3f
         PokeB(*out,actual,((c1<<4)|(c2>>2))&$ff)
         actual+1
         If actual>=outsize
            Break
         EndIf
         c3=(FindString(base64$,PeekS(*in,loop+3,1,#PB_Ascii))-1)&$3f
         PokeB(*out,actual,((c2<<6)|c3)&$ff)
         actual+1
         If actual>=outsize
            Break
         EndIf
      Next
   EndIf
   ProcedureReturn actual
EndProcedure

Procedure$ Base64Encoder(*in,insize)
   index=0
   out$=""
   While index<insize
      b0=PeekB(*in,index)&$ff
      b1=PeekB(*in,index+1)&$ff
      b2=PeekB(*in,index+2)&$ff
      index+3
      out$+Mid(base64$,((b0>>2)&$3f)+1,1)
      out$+Mid(base64$,(((b0<<4)|(b1>>4))&$3f)+1,1)
      out$+Mid(base64$,(((b1<<2)|(b2>>6))&$3f)+1,1)
      out$+Mid(base64$,(b2&$3f)+1,1)
   Wend
   outsize=((Len(out$)+3)/4)*4
   out$=LSet(out$,outsize,"=")
   ProcedureReturn out$
EndProcedure

Procedure.l Base64Decode(string$,*out,outsize)
   If string$<>""
      insize=((Len(string$)+3)/4)*4
      string$=LSet(string$,insize,"=")
      *input=AllocateMemory(insize+10)
      If *input
         PokeS(*input,0,string$,insize,#PB_Ascii)
         actual=Base64Decoder(*input,insize,*out,outsize)
         FreeMemory(*input)
      EndIf
   EndIf
   ProcedureReturn actual
EndProcedure

Procedure$ Base64DecodeString(string$)
   string$=Trim(string$)
   If string$<>""
      outsize=(Len(string$)*1.5)+64
      *out=AllocateMemory(outsize)
      If *out
         actual=Base64Decode(string$,*out,outsize)
         If actual
            result$=PeekS(*out,0,actual,#PB_UTF8)
         EndIf
         FreeMemory(*out)
      EndIf
   EndIf
   ProcedureReturn result$
EndProcedure

Procedure$ Base64EncodeString(string$)
   If string$<>""
      size=Len(string$)*2
      *mem=AllocateMemory(size)
      If *mem
         size=PokeS(*mem,0,string$,-1,#PB_UTF8)
         result$=Base64Encoder(*mem,size)
         FreeMemory(*mem)
      EndIf
   EndIf
   ProcedureReturn result$
EndProcedure

a$=Base64EncodeString("This is a test")
Debug("encoded="+a$)
Debug("decoded="+Base64DecodeString(a$))
spidernet
 
Posts: 67
Joined: Tue Feb 02, 2016 3:50 pm

Re: Base64 encode decode memory and strings

by spidernet Wed Feb 24, 2016 7:44 pm

Thank you, works well.

Can use with any character set by replacing #PB_UTF8 to #PB_Unicode.
User avatar
SinisterSoft
 
Posts: 60
Joined: Sun Apr 06, 2014 11:41 pm
Location: Preston, UK

Re: Base64 encode decode memory and strings

by SinisterSoft Wed Feb 24, 2016 8:53 pm

Maybe, maybe not. You will have to try it to find out. :)
spidernet
 
Posts: 67
Joined: Tue Feb 02, 2016 3:50 pm

Re: Base64 encode decode memory and strings

by spidernet Fri Feb 26, 2016 2:59 pm

Yes, I confirm that it encodes and decodes Asian and Arabic characters if use #PB_Unicode flag. :)
User avatar
SinisterSoft
 
Posts: 60
Joined: Sun Apr 06, 2014 11:41 pm
Location: Preston, UK

Re: Base64 encode decode memory and strings

by SinisterSoft Fri Feb 26, 2016 3:13 pm

:)
User avatar
SparrowhawkMMU
 
Posts: 262
Joined: Wed Aug 19, 2015 3:02 pm
Location: United Kingdom

Re: Base64 encode decode memory and strings

by SparrowhawkMMU Fri Feb 26, 2016 4:28 pm

Nice, thank you!

+1
User avatar
Arbrakaan
 
Posts: 56
Joined: Mon Feb 24, 2014 10:54 pm
Location: Geneva

Re: Base64 encode decode memory and strings

by Arbrakaan Mon Feb 29, 2016 7:00 am

Great ! Thanks.
User avatar
Peter
 
Posts: 479
Joined: Mon Feb 24, 2014 10:17 pm
Location: 127.0.0.1

Re: Base64 encode decode memory and strings

by Peter Thu Jun 01, 2017 8:58 am

here's another one:

Code: Select all
Procedure.s Base64EncodeString(Input.s)
  !  return btoa(encodeURIComponent(v_input).replace(/%([0-9A-F]{2})/g,
  !    function toSolidBytes(match, p1) {
  !      return String.fromCharCode('0x' + p1);
  !  }));
EndProcedure

Procedure.s Base64DecodeString(Input.s)
  !  return decodeURIComponent(atob(v_input).split('').map(function(c) {
  !    return '%' + ('00' + c.charCodeAt(0).toString(16)).slice(-2);
  !  }).join(''));
EndProcedure

Define myString.s = "Hello World! <!'> öäü 官話 éèê" + Chr(34)

Debug myString

Define b64.s = Base64EncodeString(myString)

Debug b64

Debug Base64DecodeString(b64)


(taken from: https://developer.mozilla.org/en-US/docs/Web/API/WindowBase64/Base64_encoding_and_decoding)

Greetings ... Peter
Stefan
 
Posts: 23
Joined: Mon Feb 05, 2018 9:44 pm

Re: Base64 encode decode memory and strings

by Stefan Fri Mar 23, 2018 7:20 am

How can I decode and encode pictures with this code?
Can you give an example, please?
Return to Tricks 'n' Tips

Who is online

Users browsing this forum: No registered users and 1 guest