Dodicat

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

Dodicat

Post by newby12 »

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

Locked