Here's the whole program...
It's in FreeBASIC
You need Zlib.dll the the directory with the compiled exe..
I got the Compress_loop() tweaked as much as i can...
The only thing left is inline ASM...
=======================================================
Maybe someone skilled in ASM can help speed it up????
=======================================================
For 1,000,000 bytes input..
It takes between 14 and 20 seconds to do 250 to 300 loops.
It loops until the compressed code , is bigger or equal to the input code..
<pre>
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
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
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 )
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
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
dim shared as longint show = 0
screen 19
dim as double time1 , time2 , time3 , time4
dim as longint loops = 0
do
randomize
dim as longint size
if show = 1 then size = 8
if show = 0 then size = 1000000
dim as string s = ""
s = space( size )
dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( s ) )
For n As ulongint = 0 To size - 1
*ubp = Int( Rnd * 256 ) : ubp+=1
Next
time1=timer
dim as string comp = s
if show = 0 then
loops = 0
do
loops+=1
dim as longint chk = len(comp) - 10
comp = compress_loop(comp)
print
print "c inp = " ; len( comp )
comp = Zlibrary.pack( comp )
print "c out = " ; len( comp )
if len( comp ) >= chk then exit do
if inkey = chr( 27 ) then end
loop
else
for a as longint = 1 to 1 step 1
comp = compress_loop(comp)
next
end if
time2 = timer
time3=timer
dim as string final_out = comp
for a as longint = 1 to 1 step 1
final_out = decompress_loop(final_out)
next
time4 = timer
print
print "Loops = " ; loops
print "input = "; size , "output = " ; len(comp) , "compression ratio "; 100 - ( 100 / ( size / len(comp) ) ) ; "%"
print
print "compress time = "; time2-time1
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
Function compress_loop( chrs as string ) as string
if show = 1 then
print
print "c inp = " ; len(chrs)
end if
dim as ubyte count1 = 0
dim as ubyte dec1
dim as string str1
do
str1 = str( len( chrs ) / 8 )
dec1 = instr( 1 , str1 , "." )
if dec1 <> 0 then chrs+= chr( 0 ) : count1+= 1
loop until dec1 = 0
dim as string bits = ""
dim as string zeros = string( 64 , "0" )
dim as string n1
dim as ulongint ptr ubp1 = cptr( ulongint ptr , strptr( chrs ) )
for a as longint = 1 to len( chrs ) step 8
n1 = zeros + bin( *ubp1 ) : ubp1+= 1
n1 = right( n1 , 64 )
bits+= n1
next
if show = 1 then print "c bin = " ; len( bits ) , bits
dim as ubyte count2 = 0
dim as ubyte dec2
dim as string str2
do
str2 = str( len( bits ) / 6 )
dec2 = instr( 1 , str2 , "." )
if dec2 <> 0 then bits+= "0" : count2+= 1
loop until dec2 = 0
dim as string outs = ""
dim as string * 1 n2 = " "
dim as ubyte ptr n = cptr( ubyte ptr , strptr( n2 ) )
dim as longint ptr p1 , p2 , p3 , p4 , p5
dim as longint v1 , v2 , v3 , v4 , v5
dim as ubyte ptr p = cptr( ubyte ptr , strptr( bits ) )
for a as longint = 1 to len( bits ) step 6
p1 = @v1
*p1 = ( *p - 48 ) * 2 : p+= 1
*p1+= ( *p- 48 ) + 1 : p+= 1
p2 = @v2
*p2 = ( *p - 48 ) * 2 : p+= 1
*p2+= ( *p - 48 ) + 1 : p+= 1
p3 = @v3
*p3 = ( *p - 48 ) * 2 : p+= 1
*p3+= ( *p - 48 ) + 1 : p+= 1
p4 = @v4 : *p4 = ( v1 + v2 ) - 1
p5 = @v5 : *p5 = ( v2 + v3 ) - 1
if *p2 mod 2 = 1 then
*p4+= 8
else
*p5+= 8
end if
*n = ( *p4 shl 4 ) + *p5
outs+= n2
next
if show = 1 then print "c out = " ; len( outs ) , outs
dim as string final = chr( count1 ) + chr( count2 ) + outs
if show = 1 then print "c fin = " ; len( final )
return final
end function
Function decompress_loop( chrs as string ) as string
print
print "d inp = " ; len( chrs )
return chrs
end function
Submit an article or tip