## Dodicat

General FreeBASIC programming questions.
newby12
Posts: 33
Joined: Dec 26, 2021 1:57

### Dodicat

Hi Dodicat!!

I was wondering if you can figure out , how to restore n1 from s1

n1 = 8 bits of random input

v1 = val( "&B" + mid( n1 , 1 , 2 ) )
v2 = val( "&B" + mid( n1 , 3 , 2 ) )
v3 = val( "&B" + mid( n1 , 5 , 2 ) )
v4 = val( "&B" + mid( n1 , 7 , 2 ) )

h1 = 0
if v1 > 1 then v1-= 2 : h1+= 8
if v1 > 0 then v1-= 1 : h1+= 4

if v2 > 1 then v2-= 2 : h1+= 2
if v2 > 0 then v2-= 1 : h1+= 1

h2 = 0
if v3 > 1 then v3-= 2 : h2+= 8
if v3 > 0 then v3-= 1 : h2+= 4

if v4 > 1 then v4-= 2 : h2+= 2
if v4 > 0 then v4-= 1 : h2+= 1

s1 = bin( h1 )
s1+= right( "0000" + bin( h2 ) , 4 )

map+= mid( s1 , 2 , 1 )
s1 = "1" + mid( s1 , 3 )

Need to turn s1 back into n1 solving the h1 , h2 vals...

Yes it's for compression..

It can compress any size file down to around 61,600 bytes.. It's slow and takes 50 seconds to compress Zlib.dll ( 225K ) down to 61K

Here's the whole source..

Code: Select all

``````
'Redditt_Zip
'
'albert_redditt@yahoo.com

'Albert Allen Redditt
'315 W. Carrillo St. #104
'Santa Barbara, Ca. 93101 U.S.A.

'Source code in Free BASIC
'For a good IDE , try FBIDE

'=====================================================================
'=====================================================================
'Start Z lib
'=====================================================================
'=====================================================================
Namespace Zlibrary

#define Z_NO_COMPRESSION  0
#define Z_BEST_SPEED   1
#define Z_BEST_COMPRESSION  9
#define Z_DEFAULT_COMPRESSION  (-1)

#inclib "zlib"
Extern "C"
Declare Function compressBound( Byval sourceLen As Ulong ) As Ulong
Declare Function uncompress( Byval dest As Ubyte Ptr , Byval destLen As Uinteger Ptr ,  Byval source As  Ubyte Ptr , Byval sourceLen As Ulong ) As Long
Declare Function compress( Byval dest As Ubyte Ptr , Byval destLen As Uinteger Ptr , Byval source As  Ubyte Ptr , Byval sourceLen As Ulong ) As Long
declare function compress2( byval dest as ubyte ptr , byval destLen as uinteger ptr , byval source as const ubyte ptr , byval sourceLen as uLong , byval level as long ) as long
End Extern

Function getpassedinfo( text As String , Byref passed_length As Integer ) As String
Dim As String var1 , var2
Dim As Integer pst
#macro splice( stri , char , var1 , var2 )
pst = Instr( stri , char )
var1 = "" : var2 = ""
If pst <> 0 Then
var1 = Mid( stri , 1 , pst - 1 )
var2 = Mid( stri , pst + 1 )
Else
var1 = stri
End If
#endmacro
splice( text , "|" , var1 , var2 )
text = var2
passed_length = Valint( var1 )
Return text
End Function

'=================   UNPACK ===============
Function unpack( file As String ) As String
Dim As Integer passed_length
Dim As String text = getpassedinfo( file , passed_length )
Dim As Integer stringlength , destinationlength
stringlength = Len( text )
destinationlength = passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr  destination =Callocate( destinationlength , 1 )
source = @text[ 0 ]
Var mistake = uncompress( destination , @destinationlength , source , stringlength )
If mistake <> 0 Then Print "There was an error" : Sleep : End
Dim As String uncompressed
uncompressed = String( destinationlength , 0 )
For i As Integer = 0 To destinationlength - 1
uncompressed[ i ] = ( destination[ i ] )
Next
Deallocate destination
Return uncompressed
End Function

'===================  PACK ============
Function pack( file As String ) As String
Dim As String text = file
Dim As Integer stringlength , destinationlength
stringlength = Len( text )
destinationlength = compressBound( stringlength )
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate( destinationlength , 1 )
source = @text[ 0 ]
Var mistake = compress2( destination , @destinationlength , source , stringlength , Z_BEST_COMPRESSION )''<----  use compress2
If mistake <> 0 Then Print "There was an error"
Dim As String compressed
compressed = String( destinationlength , 0 )
For n As Integer=0 To destinationlength - 1
compressed[ n ] = destination[ n ]
Next n
compressed = stringlength & "|" + compressed
Deallocate destination
Return compressed
End Function

End Namespace
'=====================================================================
'=====================================================================
'End Z lib
'=====================================================================
'=====================================================================

'=====================================================================
'=====================================================================
'Start program
'=====================================================================
'=====================================================================
#define WIN_INCLUDEALL
#Include "windows.bi"
#Include "File.bi"

Declare Sub getfilename()
Declare Function get_file( file as string ) as string
Declare Function  compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

dim shared as string file , extension , file_name

Dim As MSG msg
Dim shared As HWND hWnd

screen 19

dim as string data0 = "Redditt_Zip"
dim as string data1 = "albert_redditt@yahoo.com"
dim as string data2 = "Albert Allen Redditt"
dim as string data3 = "315 W. Carrillo St. #104"
dim as string data4 = "Santa Barbara, Ca. 93101 U.S.A"

'Set show to 1 for 8 byte printout , set show to 0 for compression printout
dim shared as longint show = 0

dim as double time1 , time2 , time3 , time4
dim as single cpr
dim as longint loops = 0
dim as string s
do

randomize

dim as longint size = 8

if show = 1 then
s = ""
For n As ulongint = 1 To size
s+= chr( Int( Rnd * 256 ) )
Next
else
getfilename()
s = get_file( file )
size = len( s )
print
print file_name , "Length = " ; size
print
end if

time1=timer
'begin compress
dim as string comp = s
if show = 0 then
loops = 0
do
loops+=1
dim as longint chk = len( comp )
comp = compress_loop( comp )
comp = Zlibrary.pack( comp )
cpr = 100 - ( 100 / ( size / len( comp ) ) )
print "Loop = " ; loops ; "  Size = " ; len( comp ) ; "  Compression = " ; cpr ; "%"
if len( comp ) >= chk then exit do
if inkey = " " then end
loop
else
for a as longint = 1 to 1 step 1
comp = compress_loop( comp )
next
end if
'end compress
time2 = timer

time3=timer
'begin decompress
dim as string final_out = comp
for a as longint = 1 to 1 step 1
final_out = decompress_loop( final_out )
next
'end decompress
time4 = timer

'sleep

print
print "Input = "; size
print "Output = " ; len( comp )
print
print "Compress Time seconds  = "; time2 - time1 ,  "Minutes = " ; ( time2 - time1 ) / 60
print "Decompress Time = "; time4 - time3
print

if s = final_out then print "Decompressed OK" else print "Decompression Failed."
print string( 99 , "=" )

sleep

loop until inkey = chr( 27 )

sleep
end
'===============================================================================
'===============================================================================
'Compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string

dim as string map = ""
dim as string zeros = string( 8 , "0" )
dim as string n1 , s1
dim as ubyte v1 , v2 , v3 , v4
dim as ubyte h1 , h2
dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
for a as longint = 1 to len( chrs ) step 1

n1 = right( zeros + bin( *ubp ) , 8 )

v1 = val( "&B" + mid( n1 , 1 , 2 ) )
v2 = val( "&B" + mid( n1 , 3 , 2 ) )
v3 = val( "&B" + mid( n1 , 5 , 2 ) )
v4 = val( "&B" + mid( n1 , 7 , 2 ) )

h1 = 0
if v1 > 1 then v1-= 2 : h1+= 8
if v1 > 0 then v1-= 1 : h1+= 4

if v2 > 1 then v2-= 2 : h1+= 2
if v2 > 0 then v2-= 1 : h1+= 1

h2 = 0
if v3 > 1 then v3-= 2 : h2+= 8
if v3 > 0 then v3-= 1 : h2+= 4

if v4 > 1 then v4-= 2 : h2+= 2
if v4 > 0 then v4-= 1 : h2+= 1

s1 = bin( h1 )
s1+= right( "0000" + bin( h2 ) , 4 )

map+= mid( s1 , 2 , 1 )
s1 = "1" + mid( s1 , 3 )

*ubp = val( "&B" + s1 )

ubp+= 1

next

if show = 1 then print "c map = " ; len( map ) , map

dim as ubyte count1 = 0
dim as ubyte dec1
dim as string str1
do
str1 = str( len( map ) / 8 )
dec1 = instr( 1 , str1 , "." )
if dec1 <> 0 then map+= "0" : count1+= 1
loop until dec1 = 0

dim as string final = chr( count1 ) + chrs
final+= "END"
for a as longint = 1 to len( map ) step 8
final+= chr( val( "&B" + mid( map , a , 8 ) ) )
next

return final

end function
'===============================================================================
'===============================================================================
'Decompress
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string

dim as ubyte count1 = chrs[0] : chrs = mid( chrs , 2 )

dim as longint place = instr( 1 , chrs , "END" ) - 1
dim as string mp = mid( chrs , place + 4 )
chrs = left( chrs , place )

dim as string map = ""
dim as string n1
dim as ubyte ptr ubp1 = cptr( ubyte ptr , strptr( mp ) )
for a as longint = 1 to len( mp ) step 1
n1 = right( "00000000" + bin( *ubp1 ) , 8 ) : ubp1+= 1
map+= n1
next
map = left( map , len( map ) - count1 )

place = 1
dim as ubyte ptr ubp2 = cptr( ubyte ptr , strptr( chrs ) )
for a as longint = 1 to len( chrs ) step 1
n1 = bin( *ubp2 )
n1 = left( n1 , 1 ) + mid( map , place , 1 ) + mid( n1 , 2 )
place+= 1

'Need to solve for h1 and h2 to restore the data
*ubp2 = val( "&B"  + n1 )

ubp2+= 1
next

if show = 1 then print "d map = " ; len( map ) , map
if show = 1 then print string( 80  , "=" )

return chrs

end function
'===============================================================================
'===============================================================================
'Get file into string
'===============================================================================
'===============================================================================
Function get_file( file as string ) as string

dim as string file_data = ""

if FileExists( file ) then

'\+= 92 /+= 47
for a as longint = len( file ) - 1 to 0 step -1
if file[ a ] = 92 or file[ a ] = 47 then file_name+= mid( file , a + 2 ) : exit for
next

Dim As UByte Ptr inBuffer
Dim As longint FSize
Dim As Integer FF

FF+= FreeFile()
If Open( file For Binary Access Read As #FF) <> 0 Then
Print "Unable to open file for input"
End 2
End If

FSize = LOF( FF )
inBuffer = Allocate( FSize )
Get #FF, ,  *inBuffer , FSize
Close #FF

file_data+= string( Fsize , 0 )
For n As longint = 0 To Fsize - 1
file_data[ n ]+= inbuffer[ n ]
Next n

Deallocate(inBuffer)

end if

return file_data

End function
'===============================================================================
'===============================================================================
'Get filename
'===============================================================================
'===============================================================================
sub getfilename()
dim ofn as OPENFILENAME
dim filename as zstring * MAX_PATH+1

with ofn
.lStructSize                = sizeof( OPENFILENAME )
.hwndOwner                       = hWnd
.hInstance                       = GetModuleHandle( NULL )
.lpstrFilter                = strptr( !"All Files, (*.*)\0*.*\0\0" )
.lpstrCustomFilter        = NULL
.nMaxCustFilter        = 0
.nFilterIndex                = 1
.lpstrFile                       = @filename
.nMaxFile                       = sizeof( filename )
.lpstrFileTitle               = NULL
.nMaxFileTitle               = 0
.lpstrInitialDir       = NULL
'.lpstrTitle                       = @"File Open Test"
.lpstrTitle                       = @"File to Compress/Decompress"
.Flags                               = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset               = 0
.nFileExtension               = 0
.lpstrDefExt               = NULL
.lCustData                       = 0
.lpfnHook                       = NULL
.lpTemplateName               = NULL
end with

if( GetOpenFileName( @ofn )= FALSE ) then
file= ""
return
else
file = filename
extension = ""
for b as ubyte= len( file ) to 1 step - 1
if mid( file , b , 1 ) <> "." then extension= mid( file , b , 1 ) + extension else exit for
next
end if

end sub

``````