function Binary(byte as integer) as string
dim i, b, power as integer
dim bin as string
b=byte
for i=7 downto 0
power=pow(2,i)
bin=bin+str(b\power)
b=b mod power
next
return bin
end function
function FindRepeatedBytes(str1 as string, str2 as string, maxDistance as integer) as integer
dim pos, curInStr, skip as integer
dim source, find as string
source=str1
find=str2
do
//inStr is a search function which returns 0 if the string to be found does not occur,
//and n+1 if n characters precede its first occurrence
curInStr=inStr(source, find)
if curInStr > 0 then
if curInStr mod 8 = 1 then
pos=skip+curInStr\8+1
end if
skip=skip+ceil(curInStr/8)
source=right(source, len(source)-ceil(curInStr/8)*8)
end if
loop until pos > 0 or curInStr=0
return pos
end function
function Reverse(bytes as string) as string
dim i as integer
dim b, n as string
b=bytes
for i=1 to len(bytes)\8
n=n+right(b, 8)
b=left(b, len(b)-8)
next
return n
end function
function XOR(byte1 as integer, byte2 as string) as integer
dim i, b1, power, result as integer
dim b2 as string
b1=byte1
b2=byte2
for i=7 downto 0
power=pow(2,i)
if str(b1\power) <> left(b2, 1) then
result=result+power
end if
b1=b1 mod power
b2=right(b2, i)
next
return result
end function
dim i, j, byte, position, readPosition, count, offset, length as integer
dim newBytes, compressed, raw as string
dim in, out as binaryStream
dim file as folderItem
dim stop as boolean
file=GetOpenFolderItem("type")
if file <> nil then
in=file.OpenAsBinaryFile(false)
readPosition=in.length-1
while not stop
ProgressBar1.value=in.position/in.length*1000\1
count=0
do
stop=readPosition < 0
if not stop then
in.position=readPosition
byte=in.ReadByte
readPosition=readPosition-1
newBytes=Binary(byte)+newBytes
end if
offset=position+count-2
if not stop then
position=FindRepeatedBytes(raw, newBytes)
count=count+1
end if
loop until position=0 or count > 256 or stop
stop=readPosition < 0
if len(newBytes) > 16 then
if stop then
if position=0 then
count=count-1
newBytes=left(newBytes, 8)
end if
else
readPosition=readPosition+1
count=count-1
newBytes=right(newBytes, len(newBytes)-8)
end if
if length > 0 then
if length <= 8 then
compressed=left(compressed, len(compressed)-length*8)+right(Binary(length-1), 5)+right(compressed, length*8)
else
compressed=left(compressed, len(compressed)-length*8)+"111"+Binary(length-9)+right(compressed, length*8)
end if
length=0
end if
if count=2 and offset < 256 then
compressed=compressed+"01"+Binary(offset)
elseif count=3 and offset < 512 then
compressed=compressed+"100"+right(Binary(offset\256), 1)+Binary(offset mod 256)
elseif count=4 and offset < 1024 then
compressed=compressed+"101"+right(Binary(offset\256), 2)+Binary(offset mod 256)
else
compressed=compressed+"110"+Binary(count-1)+right(Binary(offset\256), 4)+Binary(offset mod 256)
end if
if stop and position=0 then
if length < 264 then
compressed=compressed+Reverse(newBytes)
length=length+1
else
compressed=left(compressed, len(compressed)-length*8)+"111"+Binary(length-9)+right(compressed, length*8)
compressed=compressed+Reverse(newBytes)
length=1
end if
end if
else
if length+count <= 264 then
compressed=compressed+Reverse(newBytes)
length=length+count
else
compressed=left(compressed, len(compressed)-264*8)+"11111111111"+right(compressed, 264*8)
compressed=compressed+Reverse(newBytes)
length=count
end if
end if
raw=left(newBytes+raw, 32768)
newBytes=""
wend
if length > 0 then
if length <= 8 then
compressed=left(compressed, len(compressed)-length*8)+right(Binary(length-1), 5)+right(compressed, length*8)
else
compressed=left(compressed, len(compressed)-length*8)+"111"+Binary(length-9)+right(compressed, length*8)
end if
end if
out=GetFolderItem(file.name+" Compressed").CreateBinaryFile("type")
j=len(compressed) mod 8
out.WriteByte j
for i=7 downto j
newBytes=newBytes+"0"
next
if left(compressed, 1) = "0" then
if j < 4 then
compressed=newBytes+compressed
elseif j=4 then
compressed=left(compressed, 4)+newBytes+right(compressed, len(compressed)-4)
else
compressed=left(compressed, 5)+newBytes+right(compressed, len(compressed)-5)
end if
else
if j=0 then
compressed=newBytes+compressed
elseif j <= 4 then
compressed=left(compressed, j)+newBytes+right(compressed, len(compressed)-j)
else
compressed=left(compressed, 7)+newBytes+right(compressed, len(compressed)-7)
end if
end if
length=len(compressed)\8
for i=1 to length
byte=XOR(byte, left(right(compressed, i*8), 8))
next
byte=byte\128+(byte\64 mod 2)*2+(byte\32 mod 2)*4+(byte\16 mod 2)*8+(byte\8 mod 2)*16+(byte\4 mod 2)*32+(byte\2 mod 2)*64+(byte mod 2)*128
out.WriteByte byte
out.WriteLong in.length
out.WriteLong length+10
for i=1 to length
byte=0
for j=7 downto 0
byte=byte+val(right(compressed,1))*pow(2,j)
compressed=left(compressed, len(compressed)-1)
next
out.WriteByte byte
next
in.close
out.close
end if