BaseU_BF -Base64 replacement for Unicode env. - 35% smaller + AES + Compression + StringCrypter - Modules

Share your advanced PureBasic knowledge/code with the community.
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

BaseU_BF -Base64 replacement for Unicode env. - 35% smaller + AES + Compression + StringCrypter - Modules

Post by Saki »

Base64 replacement for Unicode environments - 35% smaller

This is Saki's BaseU_BF.

The simplest method to transfer binary data in unicode strings.
In Unicode environments about 35% smaller than Base64.

Extremely fast !

No buffers need to be defined.
Simply a pointer to the data is passed, as well as the desired length.
An encrypted Unicode string is returned which can be handled like ordinary text.

This string can be easily decoded and returns a pointer to the data back.

With MemorySize() the length of the returned data can be easily determined.

Mono line and multi line will be supported.
The line length of the encoded string can be set freely.
This is a considerable simplification of the handling.

Compared to Base64 the handling is extremely simplified.
It is no different than using UCase() and LCase() for example.

A simple but efficient encryption is enabled as preset,
which does not require a password.
An integer number can be set as password.
It's a hard-to-locate and hard-to-explore blazing fast crypting method.

Also versions with integrated AES crypter and crypt randomized IV are available.

And versions with LZMA compression are alvailable.

With integrated advanced string crypter.

There is probably no easier way to protect text,
images and data from manipulation than with the Unicode_Tools_BF
viewtopic.php?f=12&t=77295

The demo part attached to this module can be used to encode either a string or an image
Image

As with all other data functions related to this code, the underlying Unicode characters can be varied arbitrarily.
Here an offset of 100000 is used as a basis.
This does not change the compatibility !
Image

Standard module - very small
Writing speed is good for creating up to approximately 3000 lines, try simple.
To pack very large amounts of data into strings, use the HighSpeed module.
It is larger, but easily a thousand times faster.

Code: Select all

DeclareModule BaseU_BF
  EnableExplicit
  ; Sakis BaseU © - Unicode based string to binary - binary to string Generator
  ; This code is free for use, changing and enhancing
  ; character_offset - Base character offset - As sample 30, 160, 230 - Try what ever you want
  ; Seed - set as a integer - This works as password for the integrated data crypter
  Declare BaseU_Decoder_BF(Data_BF$, seed=0)
  Declare.s BaseU_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, seed=0)
  Declare.s StringEncoderBU_BF(string$, length_line, character_offset=230, seed=0)
  Declare.s StringDecoderBU_BF(string$, seed=0)
EndDeclareModule

Module BaseU_BF
  Procedure.s BaseU_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, seed=0)
    Protected i, ii, iii, breaks, len_source.q, padding=3, string$, new_string$, temp_string$, last$, length$
    Macro Create_length_string
      length$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length$+ii, PeekA(@len_source+i)) : ii+2 : Next i
    EndMacro
    len_source.q=len_buffer : len_buffer+padding : RandomSeed(seed)
    breaks=len_buffer/length_data_line : breaks+Bool(len_buffer%length_data_line) : string$=Space(len_buffer+breaks-1)
    For i=0 To len_buffer-1 : ii+1 : iii+1
      PokeA(@string$+i+ii, character_offset) : PokeA(@string$+i+ii-1, PeekA(*buffer+i)+Random(254, 1))
      If Not iii%length_data_line : ii+1 : PokeW(@string$+i+ii, 10) : ii+1 : EndIf
    Next 
    If breaks<2 : Create_length_string : ProcedureReturn string$+length$ : EndIf
    iii=(length_data_line+1) : new_string$=Space(breaks*iii) : ii=0 : iii*2
    For i=1 To breaks : temp_string$=StringField(string$, i, #LF$)+#LF$
      CopyMemory(@temp_string$, @new_string$+ii, iii) : ii+iii 
    Next
    Create_length_string : new_string$+length$ : ProcedureReturn new_string$
  EndProcedure
  
  Procedure BaseU_Decoder_BF(Data_BF$, seed=0)
    Data_BF$=RemoveString(Data_BF$, #LF$)
    Protected *data_start_pointer=@Data_BF$, len_data.q, data_size=Len(Data_BF$)*2
    Protected i, ii, offset, *buffer, *catch_buffer, len_buffer, *catch_buffer_new : len_buffer=data_size/2
    RandomSeed(seed) : *buffer=AllocateMemory(data_size) : CopyMemory(*data_start_pointer, *buffer, data_size)
    Repeat : If Not PeekW(*buffer+i) : PokeW(*buffer+i, 2560) : offset+1 : EndIf : i+2 : Until i>data_size
    *catch_buffer=AllocateMemory(data_size/2-offset)
    For i=0 To len_buffer-offset-1 : PokeA(*catch_buffer+i, PeekA(*buffer+ii)-Random(254, 1)) : ii+2 : Next
    ii=12 : For i=0 To 5 : PokeA(@len_data+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    *catch_buffer_new=AllocateMemory(len_data)
    CopyMemory(*catch_buffer, *catch_buffer_new, MemorySize(*catch_buffer_new))
    FreeMemory(*catch_buffer) : FreeMemory(*buffer)
    ProcedureReturn *catch_buffer_new
  EndProcedure
  
  Procedure.s StringEncoderBU_BF(string$, length_line, character_offset=230, seed=0)
    ProcedureReturn BaseU_Encoder_BF(@string$, StringByteLength(string$), length_line, character_offset, seed)
  EndProcedure
  
  Procedure.s StringDecoderBU_BF(string$, seed=0)
    Protected *buffer=BaseU_Decoder_BF(string$, seed), result$=PeekS(*buffer)
    FreeMemory(*buffer) : ProcedureReturn result$
  EndProcedure
  
EndModule
UseModule BaseU_BF

; #################### Encode and decode a string #######################
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Define string$="Hello World, this is Saki's BaseU_BF"+#LF$+
                 "The simplest method to transfer binary data in unicode strings"+#LF$+
                 "In Unicode environments about 35% smaller than Base64"
  
  ; Define i : For i=1 To 10 : string$+string$ : Next i ; Multi loop test
  
  Define length_line=60
  Define character_offset=230
  Define seed=0
  string$=StringEncoderBU_BF(string$, length_line, character_offset, seed)
  Debug string$
  Debug StringDecoderBU_BF(string$, seed)
CompilerEndIf

; ; #################### Encode and decode a image ########################
; CompilerIf #PB_Compiler_IsMainFile
;   EnableExplicit
;   
;   Define path$=OpenFileRequester("Select a image", "", "", 0) : If path$="" : End : EndIf
;   
;   If FileSize(path$)<1 : End : EndIf
;   Define file=ReadFile(#PB_Any, path$) : Define *buffer=AllocateMemory(Lof(file))
;   If Not ReadData(file, *buffer, Lof(file)) : CloseFile(file) : End : EndIf
;   
;   ; You can remove what you not want
;   UsePNGImageDecoder() : UseJPEGImageDecoder() : UseGIFImageDecoder() : UseTIFFImageDecoder()

;   Define BaseU$=BaseU_Encoder_BF(*buffer, MemorySize(*buffer), 80)
;   Define *buffer_1=BaseU_Decoder_BF(BaseU$)
;   
;   Debug BaseU$
;   
;   Define image_ID=CatchImage(#PB_Any, *buffer_1)
;   
;   Define window_ID=OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
;   If IsImage(image_ID)
;     Define image_gadget_ID=ImageGadget(#PB_Any,
;                                        WindowWidth(window_ID)/2-ImageWidth(image_ID)/2,
;                                        WindowHeight(window_ID)/2-ImageHeight(image_ID)/2,
;                                        0,
;                                        0,
;                                        ImageID(image_ID))
;   Else
;     CloseWindow(window_ID)
;     MessageRequester("Hint", "Embedded image not usable")
;     End
;   EndIf
;   
;   Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
; CompilerEndIf

High speed variant - StringFields_BF using - Can read and write more as 100,000 lines (length=100 characters) on my machine in one second

Code: Select all

DeclareModule BaseU_BF
  EnableExplicit
  ; StringFields_BF using high speed variant
  ; Sakis BaseU © - Unicode based string to binary - binary to string Generator
  ; This code is free for use, changing and enhancing
  ; character_offset - Base character offset - As sample 30, 160, 230 - Try what ever you want
  ; Seed - set as a integer - This works as password for the integrated data crypter
  Declare BaseU_Decoder_BF(Data_BF$, seed=0)
  Declare.s BaseU_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, seed=0)
  Declare.s StringEncoderBU_BF(string$, length_line, character_offset=230, seed=0)
  Declare.s StringDecoderBU_BF(string$, seed=0)
EndDeclareModule

Module BaseU_BF
  ; StringField_Tool_BF - By Saki - Unicode - This code is free for using and enhancing
  Global NewList index(), NewList indexes.s(), empty_fields.q, start_index.q=1, end_index.q=-1
  AddElement(index()) : AddElement(indexes())
  Procedure StringFields_BF(string$, separator$, mode=1, ignore_empty_fields=1)
    Select mode
      Case 0 : Protected add_first=1 : Case 2 : Protected add_last=1 : Case 3 : add_first=1 : add_last=1
    EndSelect
    Protected skip_first : If start_index<1 : start_index=1 : EndIf
    Protected i, ii, iii, iiii, pos_1, pos_2, length_result, comp, count_index, amount_indexes
    Protected len_separator=StringByteLength(separator$), skip_last, *string=@string$
    Protected *separator=@separator$, *pointer.word, byte_pos_last, result$ 
    If end_index=-1 : end_index=1e18 : EndIf : end_index-1
    If start_index>end_index : start_index=end_index+1 : EndIf : If Not PeekW(*string) : ProcedureReturn 0 : EndIf
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    If comp=CompareMemory(*string, *separator, len_separator) : end_index+1 : count_index+1 : skip_first=1 : EndIf
    If add_first
      If skip_first And start_index : start_index-2 : end_index-1 : EndIf
    Else
      If skip_first And start_index : start_index-1 : EndIf 
    EndIf
    i=-2
    Repeat
      i+2 : comp=CompareMemory(*string+i, *separator, len_separator)
      If comp
        iii=i : count_index+1 : ii+1 : i+len_separator-2 : amount_indexes+1 : AddElement(index()) : index()=i+2
      EndIf 
      *pointer=*string+i+len_separator
    Until count_index>end_index Or Not *pointer\w
    iiii=i : byte_pos_last=iii+len_separator
    If comp=CompareMemory(*string+i-len_separator-1, *separator, len_separator) : skip_last=1 : EndIf
    If end_index>count_index : end_index=count_index : EndIf : amount_indexes=ii : i=skip_first
    If start_index>amount_indexes : start_index=amount_indexes-1 : EndIf : i+start_index+skip_first+skip_last
    If skip_first : i-1 : EndIf : If skip_last : i-1 : EndIf
    If amount_indexes
      Repeat 
        If ListSize(index())>i : SelectElement(index(), i) : pos_1=index() : EndIf
        If ListSize(index())>i+1 : SelectElement(index(), i+1) : pos_2=index() : EndIf
        length_result=(pos_2-pos_1-len_separator)>>1
        If pos_2-pos_1>0
          If length_result>0
            result$=PeekS(*string+pos_1, length_result) : AddElement(indexes()) : indexes()=result$ 
          Else 
            empty_fields+1
            If ignore_empty_fields : result$=#Null$ : Else : result$="" : AddElement(indexes()) : EndIf         
          EndIf
        EndIf
        i+1
      Until i>end_index Or i=amount_indexes
      If add_last And skip_last
        result$=PeekS(*string+byte_pos_last, (iiii-byte_pos_last+len_separator)>>1)
        AddElement(indexes()) : indexes()=result$ 
      EndIf
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.s GetStringFields_BF(field)
    If field <1 : ProcedureReturn "" : EndIf
    SelectElement(indexes(), field) : If field<ListSize(indexes()) : ProcedureReturn indexes() : EndIf
  EndProcedure
  
  Procedure FreeAllStringFields_BF()
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    empty_fields.q=0 : start_index.q=1 : end_index.q=-1 : ProcedureReturn 1
  EndProcedure
  
  Procedure.s BaseU_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, seed=0)
    Protected i, ii, iii, breaks, len_source.q, padding=3, string$, new_string$, temp_string$, last$, length$
    Macro Create_length_string
      length$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length$+ii, PeekA(@len_source+i)) : ii+2 : Next i
    EndMacro
    len_source.q=len_buffer : len_buffer+padding : RandomSeed(seed)
    breaks=len_buffer/length_data_line : breaks+Bool(len_buffer%length_data_line) : string$=Space(len_buffer+breaks-1)
    For i=0 To len_buffer-1 : ii+1 : iii+1
      PokeA(@string$+i+ii, character_offset) : PokeA(@string$+i+ii-1, PeekA(*buffer+i)+Random(254, 1))
      If Not iii%length_data_line : ii+1 : PokeW(@string$+i+ii, 10) : ii+1 : EndIf
    Next 
    If breaks<2 : Create_length_string : ProcedureReturn string$+length$ : EndIf
    iii=(length_data_line+1) : new_string$=Space(breaks*iii) : ii=0 : iii*2
    StringFields_BF(string$, #LF$, 3)
    For i=1 To breaks : temp_string$=GetStringFields_BF(i)+#LF$
      CopyMemory(@temp_string$, @new_string$+ii, iii) : ii+iii 
    Next
    FreeAllStringFields_BF() : Create_length_string : new_string$+length$ : ProcedureReturn new_string$
  EndProcedure
  
  Procedure BaseU_Decoder_BF(Data_BF$, seed=0)
    Data_BF$=RemoveString(Data_BF$, #LF$)
    Protected *data_start_pointer=@Data_BF$, len_data.q, data_size=Len(Data_BF$)*2
    Protected i, ii, *buffer, *catch_buffer, *catch_buffer_new, len_buffer=data_size/2
    RandomSeed(seed) : *buffer=AllocateMemory(data_size) : CopyMemory(*data_start_pointer, *buffer, data_size)
    *catch_buffer=AllocateMemory(data_size/2)
    For i=0 To len_buffer-1 : PokeA(*catch_buffer+i, PeekA(*buffer+ii)-Random(254, 1)) : ii+2 : Next
    ii=12 : For i=0 To 5 : PokeA(@len_data+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    *catch_buffer_new=AllocateMemory(len_data)
    CopyMemory(*catch_buffer, *catch_buffer_new, MemorySize(*catch_buffer_new))
    FreeMemory(*catch_buffer) : FreeMemory(*buffer)
    ProcedureReturn *catch_buffer_new
  EndProcedure
  
  Procedure.s StringEncoderBU_BF(string$, length_line, character_offset=230, seed=0)
    ProcedureReturn BaseU_Encoder_BF(@string$, StringByteLength(string$), length_line, character_offset, seed)
  EndProcedure
  
  Procedure.s StringDecoderBU_BF(string$, seed=0)
    Protected *buffer=BaseU_Decoder_BF(string$, seed), result$=PeekS(*buffer)
    FreeMemory(*buffer) : ProcedureReturn result$
  EndProcedure
  
EndModule
UseModule BaseU_BF

; #################### Encode and decode a string #######################
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Define string$="Hello World, this is Saki's BaseU_BF"+#LF$+
                 "The simplest method to transfer binary data in unicode strings"+#LF$+
                 "In Unicode environments about 35% smaller than Base64"
  
  ; Define i : For i=1 To 10 : string$+string$ : Next i ; Multi loop test
  
  Define length_line=60
  Define character_offset=230
  Define seed=0
  string$=StringEncoderBU_BF(string$, length_line, character_offset, seed)
  Debug string$
  Debug StringDecoderBU_BF(string$, seed)
CompilerEndIf

; ; #################### Encode and decode a image ########################
; CompilerIf #PB_Compiler_IsMainFile
;   EnableExplicit
;   
;   Define path$=OpenFileRequester("Select a image", "", "", 0) : If path$="" : End : EndIf
;   
;   If FileSize(path$)<1 : End : EndIf
;   Define file=ReadFile(#PB_Any, path$) : Define *buffer=AllocateMemory(Lof(file))
;   If Not ReadData(file, *buffer, Lof(file)) : CloseFile(file) : End : EndIf
;   
;   ; You can remove what you not want
;   UsePNGImageDecoder() : UseJPEGImageDecoder() : UseGIFImageDecoder() : UseTIFFImageDecoder()
;   
;   Define line_length=100
;   Define BaseU$=BaseU_Encoder_BF(*buffer, MemorySize(*buffer), line_length)
;   Define *buffer_1=BaseU_Decoder_BF(BaseU$)
;   
;   Debug BaseU$
;   
;   Define image_ID=CatchImage(#PB_Any, *buffer_1)
;   
;   Define window_ID=OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
;   If IsImage(image_ID)
;     Define image_gadget_ID=ImageGadget(#PB_Any,
;                                        WindowWidth(window_ID)/2-ImageWidth(image_ID)/2,
;                                        WindowHeight(window_ID)/2-ImageHeight(image_ID)/2,
;                                        0,
;                                        0,
;                                        ImageID(image_ID))
;   Else
;     CloseWindow(window_ID)
;     MessageRequester("Hint", "Embedded image not usable")
;     End
;   EndIf
;   
;   Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
; CompilerEndIf

High speed variant with integrated AES encryption and crypt randmized IV - StringFields_BF using.

Code: Select all

DeclareModule BaseU_AES_BF
  EnableExplicit
  ; StringFields_BF using high speed
  ; Variant with integrated AES encryption and automatically crypt randomized IV
  ; Sakis BaseU_AES © - Unicode based string to binary - binary to string Generator
  ; This code is free for use, changing and enhancing
  ; character_offset - Base character offset - As sample 30, 160, 230 - Try what ever you want
  Declare BaseU_AES_Decoder_BF(Data_BF$, password$="")
  Declare.s BaseU_AES_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, password$="")
  Declare.s StringEncoderBU_AES_BF(string$, length_line, character_offset=230, password$="")
  Declare.s StringDecoderBU_AES_BF(string$, password$="")
EndDeclareModule

Module BaseU_AES_BF
  UseMD5Fingerprint()
  ; StringField_Tool_BF - By Saki - Unicode - This code is free for using and enhancing
  Global NewList index(), NewList indexes.s(), empty_fields.q, skip_first, start_index.q=1, end_index.q=-1
  AddElement(index()) : AddElement(indexes())
 Global NewList index(), NewList indexes.s(), empty_fields.q, start_index.q=1, end_index.q=-1
  AddElement(index()) : AddElement(indexes())
  Procedure StringFields_BF(string$, separator$, mode=1, ignore_empty_fields=1)
    Select mode
      Case 0 : Protected add_first=1 : Case 2 : Protected add_last=1 : Case 3 : add_first=1 : add_last=1
    EndSelect
    Protected skip_first : If start_index<1 : start_index=1 : EndIf
    Protected i, ii, iii, iiii, pos_1, pos_2, length_result, comp, count_index, amount_indexes
    Protected len_separator=StringByteLength(separator$), skip_last, *string=@string$
    Protected *separator=@separator$, *pointer.word, byte_pos_last, result$ 
    If end_index=-1 : end_index=1e18 : EndIf : end_index-1
    If start_index>end_index : start_index=end_index+1 : EndIf : If Not PeekW(*string) : ProcedureReturn 0 : EndIf
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    If comp=CompareMemory(*string, *separator, len_separator) : end_index+1 : count_index+1 : skip_first=1 : EndIf
    If add_first
      If skip_first And start_index : start_index-2 : end_index-1 : EndIf
    Else
      If skip_first And start_index : start_index-1 : EndIf 
    EndIf
    i=-2
    Repeat
      i+2 : comp=CompareMemory(*string+i, *separator, len_separator)
      If comp
        iii=i : count_index+1 : ii+1 : i+len_separator-2 : amount_indexes+1 : AddElement(index()) : index()=i+2
      EndIf 
      *pointer=*string+i+len_separator
    Until count_index>end_index Or Not *pointer\w
    iiii=i : byte_pos_last=iii+len_separator
    If comp=CompareMemory(*string+i-len_separator-1, *separator, len_separator) : skip_last=1 : EndIf
    If end_index>count_index : end_index=count_index : EndIf : amount_indexes=ii : i=skip_first
    If start_index>amount_indexes : start_index=amount_indexes-1 : EndIf : i+start_index+skip_first+skip_last
    If skip_first : i-1 : EndIf : If skip_last : i-1 : EndIf
    If amount_indexes
      Repeat 
        If ListSize(index())>i : SelectElement(index(), i) : pos_1=index() : EndIf
        If ListSize(index())>i+1 : SelectElement(index(), i+1) : pos_2=index() : EndIf
        length_result=(pos_2-pos_1-len_separator)>>1
        If pos_2-pos_1>0
          If length_result>0
            result$=PeekS(*string+pos_1, length_result) : AddElement(indexes()) : indexes()=result$ 
          Else 
            empty_fields+1
            If ignore_empty_fields : result$=#Null$ : Else : result$="" : AddElement(indexes()) : EndIf         
          EndIf
        EndIf
        i+1
      Until i>end_index Or i=amount_indexes
      If add_last And skip_last
        result$=PeekS(*string+byte_pos_last, (iiii-byte_pos_last+len_separator)>>1)
        AddElement(indexes()) : indexes()=result$ 
      EndIf
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.s GetStringFields_BF(field)
    If field <1 : ProcedureReturn "" : EndIf
    SelectElement(indexes(), field) : If field<ListSize(indexes()) : ProcedureReturn indexes() : EndIf
  EndProcedure
  
  Procedure FreeAllStringFields_BF()
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    empty_fields.q=0 : start_index.q=1 : end_index.q=-1 : ProcedureReturn 1
  EndProcedure
  
  Procedure.s BaseU_AES_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, password$="")
    Protected i, ii, iii, i1, depth, breaks, len_source.q, padding=3, string$, new_string$, temp_string$, last$, length$, iv$
    Protected fixed$=StringFingerprint(password$+"%$(s4DäÖÄö", #PB_Cipher_MD5) : Dim register.q(3)
    Repeat ; 16 Bytes
      PokeA(@register(0)+i, Val("$"+PeekS(@fixed$+ii, 2))) : ii+SizeOf(character)<<1 : i+1 ; Create a key
    Until ii=StringByteLength(fixed$) : i=0 : ii=0
    If OpenCryptRandom() : CryptRandomData(@register(2), 16) : Else : RandomData(@register(2), 16) : EndIf
    register(0)!register(2) : register(1)!register(3) 
    Macro Create_length_string
      length$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length$+ii, PeekA(@len_source+i)) : ii+2 : Next i
    EndMacro
    Macro Create_string
      iv$=LSet(Chr(character_offset<<8), 16, Chr(character_offset<<8))
      ii=0 : For i=0 To 15 : PokeA(@iv$+ii, PeekA(@register(2)+i)) : ii+2 : Next i
    EndMacro
    len_source.q=len_buffer : len_buffer+padding
    breaks=len_buffer/length_data_line : breaks+Bool(len_buffer%length_data_line)
    string$=Space(len_buffer+breaks-1) : ii=0
    For i=0 To len_buffer-1 : ii+1 : iii+1
      Repeat
        If Not i1 : AESEncoder(@register(0), @register(0), 16, @register(0), 128, 0, #PB_Cipher_ECB) : EndIf
        depth=PeekA(@register(0)+i1) : i1+1 : If i1>15 : i1=0 : EndIf
      Until depth
      i1=0 : PokeA(@string$+i+ii, character_offset) : PokeA(@string$+i+ii-1, PeekA(*buffer+i)+depth)
      If Not iii%length_data_line : ii+1 : PokeW(@string$+i+ii, 10) : ii+1 : EndIf
    Next 
    ii=0 : If breaks<2 : Create_length_string : Create_string : ProcedureReturn string$+iv$+length$ : EndIf
    iii=(length_data_line+1) : new_string$=Space(breaks*iii) : iii*2
    StringFields_BF(string$, #LF$, 3)
    For i=1 To breaks : temp_string$=GetStringFields_BF(i)+#LF$
      CopyMemory(@temp_string$, @new_string$+ii, iii) : ii+iii 
    Next
    FreeAllStringFields_BF() : Create_length_string : Create_string : new_string$+iv$+length$ : ProcedureReturn new_string$
  EndProcedure
  
  Procedure BaseU_AES_Decoder_BF(Data_BF$, password$="")
    Data_BF$=RemoveString(Data_BF$, #LF$)
    Protected *data_start_pointer=@Data_BF$, len_data.q, data_size=Len(Data_BF$)*2
    Protected i, ii, i1, depth, *buffer, *catch_buffer, len_buffer, *catch_buffer_new
    Protected fixed$=StringFingerprint(password$+"%$(s4DäÖÄö", #PB_Cipher_MD5) : Dim register.q(3)
    Repeat ; 16 Bytes
      PokeA(@register(0)+i, Val("$"+PeekS(@fixed$+ii, 2))) : ii+SizeOf(character)<<1 : i+1 ; Create a key
    Until ii=StringByteLength(fixed$) : i=0 : ii=0
    ii=0 : len_buffer=data_size/2 : *buffer=AllocateMemory(data_size) : CopyMemory(*data_start_pointer, *buffer, data_size)
    *catch_buffer=AllocateMemory(data_size/2) : ii=0
    ii=44 : For i=0 To 15 : PokeA(@register(2)+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    ii=0 : register(0)!register(2) : register(1)!register(3) 
    For i=0 To len_buffer-1
      Repeat
        If Not i1 : AESEncoder(@register(0), @register(0), 16, @register(0), 128, 0, #PB_Cipher_ECB) : EndIf
        depth=PeekA(@register(0)+i1) : i1+1 : If i1>15 : i1=0 : EndIf
      Until depth
      i1=0 : PokeA(*catch_buffer+i, PeekA(*buffer+ii)-depth) : ii+2
    Next
    ii=12 : For i=0 To 5 : PokeA(@len_data+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    *catch_buffer_new=AllocateMemory(len_data)
    CopyMemory(*catch_buffer, *catch_buffer_new, MemorySize(*catch_buffer_new))
    FreeMemory(*catch_buffer) : FreeMemory(*buffer)
    ProcedureReturn *catch_buffer_new
  EndProcedure
  
  Procedure.s StringEncoderBU_AES_BF(string$, length_line, character_offset=230, password$="")
    ProcedureReturn BaseU_AES_Encoder_BF(@string$, StringByteLength(string$), length_line, character_offset, password$)
  EndProcedure
  
  Procedure.s StringDecoderBU_AES_BF(string$, password$="")
    Protected *buffer=BaseU_AES_Decoder_BF(string$, password$), result$=PeekS(*buffer)
    FreeMemory(*buffer) : ProcedureReturn result$
  EndProcedure
  
EndModule
UseModule BaseU_AES_BF

; ; #################### Encode and decode a string #######################
; CompilerIf #PB_Compiler_IsMainFile
;   EnableExplicit
;   
;   Define string$="Hello World, this is Saki's BaseU_BF"+#LF$+
;                  "The simplest method to transfer binary data in unicode strings"+#LF$+
;                  "In Unicode environments about 35% smaller than Base64"
;   
;   ; Define i : For i=1 To 10 : string$+string$ : Next i ; Multi loop test
;   
;   Define length_line=60
;   Define character_offset=230
;   Define password$=""
;   string$=StringEncoderBU_AES_BF(string$, length_line, character_offset, password$)
;   Debug string$
;   Debug StringDecoderBU_AES_BF(string$, password$)
; CompilerEndIf

; #################### Encode and decode a image ########################
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Define path$=OpenFileRequester("Select a image", "", "", 0) : If path$="" : End : EndIf
  
  If FileSize(path$)<1 : End : EndIf
  Define file=ReadFile(#PB_Any, path$) : Define *buffer=AllocateMemory(Lof(file))
  If Not ReadData(file, *buffer, Lof(file)) : CloseFile(file) : End : EndIf
  
  ; You can remove what you not want
  UsePNGImageDecoder() : UseJPEGImageDecoder() : UseGIFImageDecoder() : UseTIFFImageDecoder()
  
  Define line_length=100
  Define BaseU_AES$=BaseU_AES_Encoder_BF(*buffer, MemorySize(*buffer), line_length)
  Define *buffer_1=BaseU_AES_Decoder_BF(BaseU_AES$)
  
  Debug BaseU_AES$
  
  Define image_ID=CatchImage(#PB_Any, *buffer_1)
  
  Define window_ID=OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If IsImage(image_ID)
    Define image_gadget_ID=ImageGadget(#PB_Any,
                                       WindowWidth(window_ID)/2-ImageWidth(image_ID)/2,
                                       WindowHeight(window_ID)/2-ImageHeight(image_ID)/2,
                                       0,
                                       0,
                                       ImageID(image_ID))
  Else
    CloseWindow(window_ID)
    MessageRequester("Hint", "Embedded image not usable")
    End
  EndIf
  
  Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
CompilerEndIf

High speed variant with additional LZMA compression

Code: Select all

DeclareModule BaseU_BF
  EnableExplicit
  ; StringFields_BF using high speed - With compression
  ; Sakis BaseU © - Unicode based string to binary - binary to string Generator
  ; This code is free for use, changing and enhancing
  ; character_offset - Base character offset - As sample 30, 160, 230 - Try what ever you want
  ; Seed - set as a integer - This works as password for the integrated data crypter
  Declare BaseU_Decoder_BF(Data_BF$, seed=0)
  Declare.s BaseU_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, seed=0)
  Declare.s StringEncoderBU_BF(string$, length_line, character_offset=230, seed=0)
  Declare.s StringDecoderBU_BF(string$, seed=0)
  Declare CompressionPercentBU_BF() ; This function show the actual compression as percent
EndDeclareModule

Module BaseU_BF
  ; StringField_Tool_BF - By Saki - Unicode - This code is free for using and enhancing
  Global NewList index(), NewList indexes.s(), empty_fields.q, start_index.q=1, end_index.q=-1, compression_percent.d
  AddElement(index()) : AddElement(indexes())
  Procedure StringFields_BF(string$, separator$, mode=1, ignore_empty_fields=1)
    Select mode
      Case 0 : Protected add_first=1 : Case 2 : Protected add_last=1 : Case 3 : add_first=1 : add_last=1
    EndSelect
    Protected skip_first : If start_index<1 : start_index=1 : EndIf
    Protected i, ii, iii, iiii, pos_1, pos_2, length_result, comp, count_index, amount_indexes
    Protected len_separator=StringByteLength(separator$), skip_last, *string=@string$
    Protected *separator=@separator$, *pointer.word, byte_pos_last, result$ 
    If end_index=-1 : end_index=1e18 : EndIf : end_index-1
    If start_index>end_index : start_index=end_index+1 : EndIf : If Not PeekW(*string) : ProcedureReturn 0 : EndIf
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    If comp=CompareMemory(*string, *separator, len_separator) : end_index+1 : count_index+1 : skip_first=1 : EndIf
    If add_first
      If skip_first And start_index : start_index-2 : end_index-1 : EndIf
    Else
      If skip_first And start_index : start_index-1 : EndIf 
    EndIf
    i=-2
    Repeat
      i+2 : comp=CompareMemory(*string+i, *separator, len_separator)
      If comp
        iii=i : count_index+1 : ii+1 : i+len_separator-2 : amount_indexes+1 : AddElement(index()) : index()=i+2
      EndIf 
      *pointer=*string+i+len_separator
    Until count_index>end_index Or Not *pointer\w
    iiii=i : byte_pos_last=iii+len_separator
    If comp=CompareMemory(*string+i-len_separator-1, *separator, len_separator) : skip_last=1 : EndIf
    If end_index>count_index : end_index=count_index : EndIf : amount_indexes=ii : i=skip_first
    If start_index>amount_indexes : start_index=amount_indexes-1 : EndIf : i+start_index+skip_first+skip_last
    If skip_first : i-1 : EndIf : If skip_last : i-1 : EndIf
    If amount_indexes
      Repeat 
        If ListSize(index())>i : SelectElement(index(), i) : pos_1=index() : EndIf
        If ListSize(index())>i+1 : SelectElement(index(), i+1) : pos_2=index() : EndIf
        length_result=(pos_2-pos_1-len_separator)>>1
        If pos_2-pos_1>0
          If length_result>0
            result$=PeekS(*string+pos_1, length_result) : AddElement(indexes()) : indexes()=result$ 
          Else 
            empty_fields+1
            If ignore_empty_fields : result$=#Null$ : Else : result$="" : AddElement(indexes()) : EndIf         
          EndIf
        EndIf
        i+1
      Until i>end_index Or i=amount_indexes
      If add_last And skip_last
        result$=PeekS(*string+byte_pos_last, (iiii-byte_pos_last+len_separator)>>1)
        AddElement(indexes()) : indexes()=result$ 
      EndIf
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.s GetStringFields_BF(field)
    If field <1 : ProcedureReturn "" : EndIf
    SelectElement(indexes(), field) : If field<ListSize(indexes()) : ProcedureReturn indexes() : EndIf
  EndProcedure
  
  Procedure FreeAllStringFields_BF()
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    empty_fields.q=0 : start_index.q=1 : end_index.q=-1 : ProcedureReturn 1
  EndProcedure
  
  Procedure.s BaseU_Encoder_BF(*buffer, len_buffer, length_data_line=100, character_offset=230, seed=0)
    Protected i, ii, iii, breaks, len_source.q, padding=3, string$, new_string$, temp_string$, last$, length$
    Macro Create_length_string
      length$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length$+ii, PeekA(@len_source+i)) : ii+2 : Next i
    EndMacro
    RandomSeed(seed)
    
    UseLZMAPacker()
    Protected length_uncompressed$, length_uncompressed.q=len_buffer
    Protected *buffer_compressed=AllocateMemory(len_buffer*1.5)
    Protected size_compressed=CompressMemory(*buffer, len_buffer, *buffer_compressed,
                                             MemorySize(*buffer_compressed), #PB_PackerPlugin_Lzma)
    If size_compressed<len_buffer
      compression_percent=100-100/length_uncompressed*size_compressed
      CopyMemory(*buffer_compressed, *buffer, size_compressed)
      len_buffer=size_compressed+padding
    Else
      compression_percent=-1
      len_buffer=len_buffer+padding
    EndIf
    FreeMemory(*buffer_compressed)
    
    len_source.q=len_buffer : len_buffer+padding 
    
    Macro Create_length_uncompressed
      length_uncompressed$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length_uncompressed$+ii, PeekA(@length_uncompressed+i)) : ii+2 : Next i
    EndMacro
    
    breaks=len_buffer/length_data_line : breaks+Bool(len_buffer%length_data_line) : string$=Space(len_buffer+breaks-1)
    For i=0 To len_buffer-1 : ii+1 : iii+1
      PokeA(@string$+i+ii, character_offset) : PokeA(@string$+i+ii-1, PeekA(*buffer+i)+Random(254, 1))
      If Not iii%length_data_line : ii+1 : PokeW(@string$+i+ii, 10) : ii+1 : EndIf
    Next 
    If breaks<2 : Create_length_string : Create_length_uncompressed : ProcedureReturn string$+length_uncompressed$+length$ : EndIf
    iii=(length_data_line+1) : new_string$=Space(breaks*iii) : ii=0 : iii*2
    StringFields_BF(string$, #LF$, 3)
    For i=1 To breaks : temp_string$=GetStringFields_BF(i)+#LF$
      CopyMemory(@temp_string$, @new_string$+ii, iii) : ii+iii 
    Next
    FreeAllStringFields_BF() : Create_length_string : Create_length_uncompressed
    new_string$+length_uncompressed$+length$ : ProcedureReturn new_string$
  EndProcedure
  
  Procedure BaseU_Decoder_BF(Data_BF$, seed=0)
    Data_BF$=RemoveString(Data_BF$, #LF$)
    Protected *data_start_pointer=@Data_BF$, len_data.q, data_size=Len(Data_BF$)*2
    Protected i, ii, *buffer, *catch_buffer, len_buffer, *catch_buffer_new
    len_buffer=data_size/2 : RandomSeed(seed)
    *buffer=AllocateMemory(data_size) : CopyMemory(*data_start_pointer, *buffer, data_size)
    *catch_buffer=AllocateMemory(data_size/2)
    For i=0 To len_buffer-1 : PokeA(*catch_buffer+i, PeekA(*buffer+ii)-Random(254, 1)) : ii+2 : Next
    
    UseLZMAPacker()
    Protected len_uncompressed
    ii=12 : For i=0 To 5 : PokeA(@len_data+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    ii=24 : For i=0 To 5 : PokeA(@len_uncompressed+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    *catch_buffer_new=AllocateMemory(len_data)
    CopyMemory(*catch_buffer, *catch_buffer_new, MemorySize(*catch_buffer_new))
    FreeMemory(*catch_buffer) : FreeMemory(*buffer)
    Protected *buffer_uncompressed=AllocateMemory(len_uncompressed)
    Protected size_uncompressed=UncompressMemory(*catch_buffer_new, MemorySize(*catch_buffer_new),
                                                 *buffer_uncompressed, MemorySize(*buffer_uncompressed),
                                                 #PB_PackerPlugin_Lzma)
    
    If size_uncompressed<>-1
      Swap *buffer_uncompressed, *catch_buffer_new
      compression_percent=100-100/size_uncompressed*len_data
    Else
      compression_percent=-1
    EndIf
    FreeMemory(*buffer_uncompressed)
    
    ProcedureReturn *catch_buffer_new
  EndProcedure
  
  Procedure.s StringEncoderBU_BF(string$, length_line, character_offset=230, seed=0)
    ProcedureReturn BaseU_Encoder_BF(@string$, StringByteLength(string$), length_line, character_offset, seed)
  EndProcedure
  
  Procedure.s StringDecoderBU_BF(string$, seed=0)
    Protected *buffer=BaseU_Decoder_BF(string$, seed), result$=PeekS(*buffer)
    FreeMemory(*buffer) : ProcedureReturn result$
  EndProcedure
  
  Procedure CompressionPercentBU_BF() : ProcedureReturn compression_percent : EndProcedure
  
EndModule
UseModule BaseU_BF

; ; #################### Encode and decode a string #######################
; CompilerIf #PB_Compiler_IsMainFile
;   EnableExplicit
;   
;   Define string$="Hello World, this is Saki's BaseU_BF"+#LF$+
;                  "The simplest method to transfer binary data in unicode strings"+#LF$+
;                  "In Unicode environments about 35% smaller than Base64"
;   
;   ; Define i : For i=1 To 10 : string$+string$ : Next i ; Multi loop test
;   
;   Define length_line=60
;   Define character_offset=230
;   Define seed=0
;   string$=StringEncoderBU_BF(string$, length_line, character_offset, seed)
;   Debug string$
;   Debug StringDecoderBU_BF(string$, seed)
; CompilerEndIf

; #################### Encode and decode a image ########################
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Define path$=OpenFileRequester("Select a image", "", "", 0) : If path$="" : End : EndIf
  
  If FileSize(path$)<1 : End : EndIf
  Define file=ReadFile(#PB_Any, path$) : Define *buffer=AllocateMemory(Lof(file))
  If Not ReadData(file, *buffer, Lof(file)) : CloseFile(file) : End : EndIf
  
  ; You can remove what you not want
  UsePNGImageDecoder() : UseJPEGImageDecoder() : UseGIFImageDecoder() : UseTIFFImageDecoder()
  
  Define line_length=100
  Define BaseU$=BaseU_Encoder_BF(*buffer, MemorySize(*buffer), line_length)
  Define *buffer_1=BaseU_Decoder_BF(BaseU$)
  
  Debug BaseU$
  
  Debug Str(CompressionPercentBU_BF())+" % compression" ; This function show the actual compression as percent
  
  Define image_ID=CatchImage(#PB_Any, *buffer_1)
  
  Define window_ID=OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If IsImage(image_ID)
    Define image_gadget_ID=ImageGadget(#PB_Any,
                                       WindowWidth(window_ID)/2-ImageWidth(image_ID)/2,
                                       WindowHeight(window_ID)/2-ImageHeight(image_ID)/2,
                                       0,
                                       0,
                                       ImageID(image_ID))
  Else
    CloseWindow(window_ID)
    MessageRequester("Hint", "Embedded image not usable")
    End
  EndIf
  
  Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
CompilerEndIf

High speed variant with integrated AES encryption, crypt randmized IV and additional LZMA compression

Code: Select all

DeclareModule BaseU_AES_BF
  EnableExplicit
  ; StringFields_BF using high speed
  ; Variant with integrated AES encryption, automatically crypt randomized IV and compression
  ; Sakis BaseU_AES © - Unicode based string to binary - binary to string Generator
  ; This code is free for use, changing and enhancing
  ; character_offset - Base character offset - As sample 30, 160, 230 - Try what ever you want
  Declare BaseU_AES_Decoder_BF(Data_BF$, password$="")
  Declare.s BaseU_AES_Encoder_BF(*bufferA, len_buffer, length_data_line=100, character_offset=230, password$="")
  Declare.s StringEncoderBU_AES_BF(string$, length_line, character_offset=230, password$="")
  Declare.s StringDecoderBU_AES_BF(string$, password$="")
  Declare CompressionPercentBU_AES_BF() ; This function show the actual compression as percent
EndDeclareModule

Module BaseU_AES_BF
  UseMD5Fingerprint()
  ; StringField_Tool_BF - By Saki - Unicode - This code is free for using and enhancing
  Global NewList index(), NewList indexes.s(), empty_fields.q, start_index.q=1, end_index.q=-1, compression_percent.d
  AddElement(index()) : AddElement(indexes())
  Procedure StringFields_BF(string$, separator$, mode=1, ignore_empty_fields=1)
    Select mode
      Case 0 : Protected add_first=1 : Case 2 : Protected add_last=1 : Case 3 : add_first=1 : add_last=1
    EndSelect
    Protected skip_first : If start_index<1 : start_index=1 : EndIf
    Protected i, ii, iii, iiii, pos_1, pos_2, length_result, comp, count_index, amount_indexes
    Protected len_separator=StringByteLength(separator$), skip_last, *string=@string$
    Protected *separator=@separator$, *pointer.word, byte_pos_last, result$ 
    If end_index=-1 : end_index=1e18 : EndIf : end_index-1
    If start_index>end_index : start_index=end_index+1 : EndIf : If Not PeekW(*string) : ProcedureReturn 0 : EndIf
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    If comp=CompareMemory(*string, *separator, len_separator) : end_index+1 : count_index+1 : skip_first=1 : EndIf
    If add_first
      If skip_first And start_index : start_index-2 : end_index-1 : EndIf
    Else
      If skip_first And start_index : start_index-1 : EndIf 
    EndIf
    i=-2
    Repeat
      i+2 : comp=CompareMemory(*string+i, *separator, len_separator)
      If comp
        iii=i : count_index+1 : ii+1 : i+len_separator-2 : amount_indexes+1 : AddElement(index()) : index()=i+2
      EndIf 
      *pointer=*string+i+len_separator
    Until count_index>end_index Or Not *pointer\w
    iiii=i : byte_pos_last=iii+len_separator
    If comp=CompareMemory(*string+i-len_separator-1, *separator, len_separator) : skip_last=1 : EndIf
    If end_index>count_index : end_index=count_index : EndIf : amount_indexes=ii : i=skip_first
    If start_index>amount_indexes : start_index=amount_indexes-1 : EndIf : i+start_index+skip_first+skip_last
    If skip_first : i-1 : EndIf : If skip_last : i-1 : EndIf
    If amount_indexes
      Repeat 
        If ListSize(index())>i : SelectElement(index(), i) : pos_1=index() : EndIf
        If ListSize(index())>i+1 : SelectElement(index(), i+1) : pos_2=index() : EndIf
        length_result=(pos_2-pos_1-len_separator)>>1
        If pos_2-pos_1>0
          If length_result>0
            result$=PeekS(*string+pos_1, length_result) : AddElement(indexes()) : indexes()=result$ 
          Else 
            empty_fields+1
            If ignore_empty_fields : result$=#Null$ : Else : result$="" : AddElement(indexes()) : EndIf         
          EndIf
        EndIf
        i+1
      Until i>end_index Or i=amount_indexes
      If add_last And skip_last
        result$=PeekS(*string+byte_pos_last, (iiii-byte_pos_last+len_separator)>>1)
        AddElement(indexes()) : indexes()=result$ 
      EndIf
    EndIf
    ProcedureReturn 1
  EndProcedure
  
  Procedure.s GetStringFields_BF(field)
    If field <1 : ProcedureReturn "" : EndIf
    SelectElement(indexes(), field) : If field<ListSize(indexes()) : ProcedureReturn indexes() : EndIf
  EndProcedure
  
  Procedure FreeAllStringFields_BF()
    ClearList(index()) : AddElement(index()) : ClearList(indexes()) : AddElement(indexes())
    empty_fields.q=0 : start_index.q=1 : end_index.q=-1 : ProcedureReturn 1
  EndProcedure
  
  Procedure.s BaseU_AES_Encoder_BF(*buffer_base, len_buffer, length_data_line=100, character_offset=230, password$="")
    Protected i, ii, iii, i1, depth, breaks, len_source.q, padding=3, string$, new_string$, temp_string$, last$, length$, iv$
    Protected fixed$=StringFingerprint(password$+"%$(s4DäÖÄö", #PB_Cipher_MD5) : Dim register.q(3)
    Repeat ; 16 Bytes
      PokeA(@register(0)+i, Val("$"+PeekS(@fixed$+ii, 2))) : ii+SizeOf(character)<<1 : i+1 ; Create a key
    Until ii=StringByteLength(fixed$) : i=0 : ii=0
    If OpenCryptRandom() : CryptRandomData(@register(2), 16) : Else : RandomData(@register(2), 16) : EndIf
    register(0)!register(2) : register(1)!register(3) 
    Macro Create_length_string
      length$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length$+ii, PeekA(@len_source+i)) : ii+2 : Next i
    EndMacro
    Macro Create_string
      iv$=LSet(Chr(character_offset<<8), 16, Chr(character_offset<<8))
      ii=0 : For i=0 To 15 : PokeA(@iv$+ii, PeekA(@register(2)+i)) : ii+2 : Next i
    EndMacro
    
    UseLZMAPacker()
    Protected *buffer=AllocateMemory(len_buffer) : CopyMemory(*buffer_base, *buffer, len_buffer)
    Protected length_uncompressed$, length_uncompressed.q=len_buffer
    Protected *buffer_compressed=AllocateMemory(len_buffer*1.5)
    Protected size_compressed=CompressMemory(*buffer, len_buffer, *buffer_compressed,
                                             MemorySize(*buffer_compressed), #PB_PackerPlugin_Lzma)
    If size_compressed<len_buffer
      compression_percent=100-100/length_uncompressed*size_compressed
      CopyMemory(*buffer_compressed, *buffer, size_compressed)
      len_buffer=size_compressed+padding
    Else
      compression_percent=-1
      len_buffer=len_buffer+padding
    EndIf
    FreeMemory(*buffer_compressed)
    
    len_source.q=len_buffer : len_buffer+padding 
    
    Macro Create_length_uncompressed
      length_uncompressed$=LSet(Chr(character_offset<<8), 6, Chr(character_offset<<8))
      ii=0 : For i=0 To 5 : PokeA(@length_uncompressed$+ii, PeekA(@length_uncompressed+i)) : ii+2 : Next i
    EndMacro
    
    breaks=len_buffer/length_data_line : breaks+Bool(len_buffer%length_data_line)
    string$=Space(len_buffer+breaks-1) : ii=0
    For i=0 To len_buffer-1 : ii+1 : iii+1
      Repeat
        If Not i1 : AESEncoder(@register(0), @register(0), 16, @register(0), 128, 0, #PB_Cipher_ECB) : EndIf
        depth=PeekA(@register(0)+i1) : i1+1 : If i1>15 : i1=0 : EndIf
      Until depth
      i1=0 : PokeA(@string$+i+ii, character_offset) : PokeA(@string$+i+ii-1, PeekA(*buffer+i)+depth)
      If Not iii%length_data_line : ii+1 : PokeW(@string$+i+ii, 10) : ii+1 : EndIf
    Next 
    ii=0 : If breaks<2 : Create_length_string : Create_string : Create_length_uncompressed
    FreeMemory(*buffer) : ProcedureReturn string$+iv$+length_uncompressed$+length$ : EndIf
    iii=(length_data_line+1) : new_string$=Space(breaks*iii) : iii*2
    StringFields_BF(string$, #LF$, 3)
    For i=1 To breaks : temp_string$=GetStringFields_BF(i)+#LF$
      CopyMemory(@temp_string$, @new_string$+ii, iii) : ii+iii 
    Next
    FreeAllStringFields_BF() : Create_length_string : Create_string : Create_length_uncompressed
    new_string$+iv$+length_uncompressed$+length$ : FreeMemory(*buffer) : ProcedureReturn new_string$
  EndProcedure
  
  Procedure BaseU_AES_Decoder_BF(Data_BF$, password$="")
    Data_BF$=RemoveString(Data_BF$, #LF$)
    Protected *data_start_pointer=@Data_BF$, len_data.q, data_size=Len(Data_BF$)*2
    Protected i, ii, i1, depth, *buffer, *catch_buffer, len_buffer, *catch_buffer_new
    Protected fixed$=StringFingerprint(password$+"%$(s4DäÖÄö", #PB_Cipher_MD5) : Dim register.q(3)
    Repeat ; 16 Bytes
      PokeA(@register(0)+i, Val("$"+PeekS(@fixed$+ii, 2))) : ii+SizeOf(character)<<1 : i+1 ; Create a key
    Until ii=StringByteLength(fixed$) : i=0 : ii=0
    len_buffer=data_size/2 : *buffer=AllocateMemory(data_size) : CopyMemory(*data_start_pointer, *buffer, data_size)
    *catch_buffer=AllocateMemory(data_size/2)
    ii=56 : For i=0 To 15 : PokeA(@register(2)+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    ii=0 : register(0)!register(2) : register(1)!register(3) 
    For i=0 To len_buffer-1
      Repeat
        If Not i1 : AESEncoder(@register(0), @register(0), 16, @register(0), 128, 0, #PB_Cipher_ECB) : EndIf
        depth=PeekA(@register(0)+i1) : i1+1 : If i1>15 : i1=0 : EndIf
      Until depth
      i1=0 : PokeA(*catch_buffer+i, PeekA(*buffer+ii)-depth) : ii+2
    Next
    
    UseLZMAPacker()
    Protected len_uncompressed
    ii=12 : For i=0 To 5 : PokeA(@len_data+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    ii=24 : For i=0 To 5 : PokeA(@len_uncompressed+i, PeekA(*data_start_pointer+StringByteLength(Data_BF$)-ii)) : ii-2 : Next
    *catch_buffer_new=AllocateMemory(len_data)
    CopyMemory(*catch_buffer, *catch_buffer_new, MemorySize(*catch_buffer_new))
    FreeMemory(*catch_buffer) : FreeMemory(*buffer)
    Protected *buffer_uncompressed=AllocateMemory(len_uncompressed)
    Protected size_uncompressed=UncompressMemory(*catch_buffer_new, MemorySize(*catch_buffer_new),
                                                 *buffer_uncompressed, MemorySize(*buffer_uncompressed),
                                                 #PB_PackerPlugin_Lzma)
    
    If size_uncompressed<>-1
      Swap *buffer_uncompressed, *catch_buffer_new
      compression_percent=100-100/size_uncompressed*len_data
    Else
      compression_percent=-1
    EndIf
    FreeMemory(*buffer_uncompressed)
    
    ProcedureReturn *catch_buffer_new
  EndProcedure
  
  Procedure.s StringEncoderBU_AES_BF(string$, length_line, character_offset=230, password$="")
    ProcedureReturn BaseU_AES_Encoder_BF(@string$, StringByteLength(string$), length_line, character_offset, password$)
  EndProcedure
  
  Procedure.s StringDecoderBU_AES_BF(string$, password$="")
    Protected *buffer=BaseU_AES_Decoder_BF(string$, password$), result$=PeekS(*buffer)
    FreeMemory(*buffer) : ProcedureReturn result$
  EndProcedure
  
  Procedure CompressionPercentBU_AES_BF() : ProcedureReturn compression_percent : EndProcedure
  
EndModule
UseModule BaseU_AES_BF

; #################### Encode and decode a string #######################
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  Define string$="Hello World, this is Saki's BaseU_BF"+#LF$+
                 "The simplest method to transfer binary data in unicode strings"+#LF$+
                 "In Unicode environments about 35% smaller than Base64"
  
  ; Define i : For i=1 To 10 : string$+string$ : Next i ; Multi loop test
  
  Define length_line=30
  Define character_offset=230
  Define password$=""
  string$=StringEncoderBU_AES_BF(string$, length_line, character_offset, password$)
  Debug string$
  Debug StringDecoderBU_AES_BF(string$, password$)
CompilerEndIf

; ; #################### Encode and decode a image ########################
; CompilerIf #PB_Compiler_IsMainFile
;   EnableExplicit
;   
;   Define path$=OpenFileRequester("Select a image", "", "", 0) : If path$="" : End : EndIf
;   
;   If FileSize(path$)<1 : End : EndIf
;   Define file=ReadFile(#PB_Any, path$) : Define *buffer=AllocateMemory(Lof(file))
;   If Not ReadData(file, *buffer, Lof(file)) : CloseFile(file) : End : EndIf
;   
;   ; You can remove what you not want
;   UsePNGImageDecoder() : UseJPEGImageDecoder() : UseGIFImageDecoder() : UseTIFFImageDecoder()
;   
;   Define line_length=100
;   Define BaseU_AES$=BaseU_AES_Encoder_BF(*buffer, MemorySize(*buffer), line_length)
;   Define *buffer_1=BaseU_AES_Decoder_BF(BaseU_AES$)
;   
;   Debug BaseU_AES$
;   
;   Debug Str(CompressionPercentBU_AES_BF())+" % compression" ; This function show the actual compression as percent
;   
;   Define image_ID=CatchImage(#PB_Any, *buffer_1)
;   
;   Define window_ID=OpenWindow(#PB_Any, 0, 0, 600, 400, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
;   If IsImage(image_ID)
;     Define image_gadget_ID=ImageGadget(#PB_Any,
;                                        WindowWidth(window_ID)/2-ImageWidth(image_ID)/2,
;                                        WindowHeight(window_ID)/2-ImageHeight(image_ID)/2,
;                                        0,
;                                        0,
;                                        ImageID(image_ID))
;   Else
;     CloseWindow(window_ID)
;     MessageRequester("Hint", "Embedded image not usable")
;     End
;   EndIf
;   
;   Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
; CompilerEndIf
Last edited by Saki on Fri Jun 25, 2021 7:23 pm, edited 40 times in total.
地球上の平和
User avatar
idle
Always Here
Always Here
Posts: 5049
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: BaseU_BF -Base64 replacement for Unicode environments - 35% smaller - Module

Post by idle »

Well done it's ~35% smaller than the Base64 of a Unicode string but bare in mind what's being encoded as it might be better to convert the string to UTF8 and then base64 that.

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  Define len.i,ratio.f 
  Define test$="Hello World, this is Saki's BaseU_BF"+#LF$+
               "The simplest method to transfer binary data in unicode strings"+#LF$+
               "In Unicode environments about 35% smaller than Base64"
  
  ; Define i : For i=1 To 10 : test$+test$ : Next i ; Multi loop test
  len = StringByteLength(test$) 
  Debug "Unicode" 
  Debug len 
  
  Debug "BaseU_BF"
  Define length_line=60
  Define binary_string$=BaseU_Encoder_BF(@test$, StringByteLength(test$), length_line)
  Debug Str(StringByteLength(binary_string$)) + " ratio " + StrF(StringByteLength(binary_string$)/len,2)
  
  Debug "B64"
  Define b64.s 
  b64 = Base64Encoder(@test$,StringByteLength(test$))
  Debug Str(StringByteLength(b64)) + " ratio " + StrF(StringByteLength(b64)/len,2) 
  
  Debug "UTF8" 
  Define *utf8 = UTF8(test$) 
  Debug Str(MemorySize(*utf8)) + " ratio " + StrF(MemorySize(*utf8)/len,2)
  Debug "B64 OF UTF8"
  b64 = Base64Encoder(*utf8,MemorySize(*utf8))
  Debug Str(StringByteLength(b64)) + " ratio " + StrF(StringByteLength(b64)/len,2) 
    
CompilerEndIf
User avatar
Saki
Addict
Addict
Posts: 830
Joined: Sun Apr 05, 2020 11:28 am
Location: Pandora

Re: BaseU_BF -Base64 replacement for Unicode environments - 35% smaller + AES - Modules

Post by Saki »

Many thanks @idle

New codes added.

A variant with supporting AES and a fully automatic randomized IV has been added.
This means that all encrypted data is encrypted completely differently for each encryption process.
The behavior of the crypter is similar to the CBC mode with randomized IV.

Creating, storing and loading encrypted and formatted strings or binary data,
even with randomized IV, is no more difficult than outputting "Hello World" in a "MessageRequester". 8)

Code: Select all

  Define string$="Hello World,how are you ?"+#LF$+"I hope you are well"
  Define length_line=36
  Define encrypted_string$=BaseU_Encoder_BF(@string$, StringByteLength(string$), length_line)
  Debug encrypted_string$
  Define *buffer=BaseU_Decoder_BF(encrypted_string$)
  Debug PeekS(*buffer)
地球上の平和
Post Reply