I modified the outputs , to make it easier to separate 3 bits vals , from 4 bit vals.
s1 = mid(bits,a,4)
if s1 = "0000" then outs1+="100"
if s1 = "0001" then outs1+="101"
if s1 = "0010" then outs1+="110"
if s1 = "0011" then outs1+="111"
if s1 = "0100" then outs1+="1001"
if s1 = "0101" then outs1+="1011"
if s1 = "0110" then outs1+="1101"
if s1 = "0111" then outs1+="0000"
if s1 = "1000" then outs1+="0001"
if s1 = "1001" then outs1+="0010"
if s1 = "1010" then outs1+="0011"
if s1 = "1011" then outs1+="0100"
if s1 = "1100" then outs1+="0101"
if s1 = "1101" then outs1+="0110"
if s1 = "1110" then outs1+="0111"
if s1 = "1111" then outs1+="1100"
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
screen 19
dim as double time1 , time2 , time3 , time4
dim shared as ubyte show = 1 'if doing larger than 8 bytes set show to 0
do
randomize
dim as string s=""
For n As Long = 1 To 8
s+=chr(Int(Rnd*256))'+8)
Next
time1=timer
'begin compress
dim as string comp = s
if show = 0 then
do
dim as longint chk = len(comp) - 1
comp = compress_loop(comp)
if len(comp) >= chk then exit do
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
'cls
'draw string( 0,10) , left(s,100)
'draw string( 0,30) , left(final_out,100)
print string(99,"=")
'print "inp = " ; (s)
print string(99,"=")
'print "out = " ; (final_out)
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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string bits = ""
dim as string zeros = string(64,"0")
dim as ulongint ptr ulp = cptr(ulongint ptr,strptr(chrs))
dim as string n1
for a as longint = 1 to len(chrs) step 8
n1 = zeros + bin(*ulp) : ulp+=1
bits+=right(n1,64)
next
if show = 1 then print "c inp = "; len(bits) , bits
dim as string outs1=""
dim as string s1
for a as longint = 1 to len(bits) step 4
s1 = mid(bits,a,4)
if s1 = "0000" then outs1+="100"
if s1 = "0001" then outs1+="101"
if s1 = "0010" then outs1+="110"
if s1 = "0011" then outs1+="111"
if s1 = "0100" then outs1+="1001"
if s1 = "0101" then outs1+="1011"
if s1 = "0110" then outs1+="1101"
if s1 = "0111" then outs1+="0000"
if s1 = "1000" then outs1+="0001"
if s1 = "1001" then outs1+="0010"
if s1 = "1010" then outs1+="0011"
if s1 = "1011" then outs1+="0100"
if s1 = "1100" then outs1+="0101"
if s1 = "1101" then outs1+="0110"
if s1 = "1110" then outs1+="0111"
if s1 = "1111" then outs1+="1100"
next
if show = 1 then print "c out = "; len(outs1) , outs1
dim as longint count=0
dim as string str1
dim as longint dec1
do
str1=str(len(outs1)/8)
dec1=instr(1,str1,".")
if dec1<>0 then outs1+="0" : count+=1
loop until dec1=0
dim as string final = ""
for a as longint = 1 to len(outs1) step 8
final+=chr(val("&B"+mid(outs1,a,8)))
next
final = chr(count) + final
print "c fin = "; len(final) ' , final
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
dim as longint count = asc(left(chrs,1))
chrs = mid(chrs,2)
dim as string bits = ""
dim as string zeros = string(8,"0")
dim as string n1
for a as longint = 1 to len(chrs) step 1
n1 = zeros + bin( chrs[a-1] )
bits+=right(n1,8)
next
bits = left(bits,len(bits)-count)
if show = 1 then print "d inp = "; len(bits) , bits
return chrs
end function