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