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
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 !
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