program Compress;

Classes,

{$IFDEF MSWINDOWS}Windows, {$ENDIF}

SysUtils, FileBuffer, CompressUnit, Math, ProgressUnit;

Version='2.4.4';

ArcExt='.z';

SignatureSize=3;

Signature: Array [1..4] of Byte=($50, $41, $47, $21);

fpcVersion={$I %FPCVERSION%};

k: Byte;

SignatureOnly, Raw:Boolean;

i: Word;

Time, ArcFileSize, DataFileSize: Cardinal;

InFileName, OutFileName, OutFileName2: String;

Function UpTime: Cardinal;

Result:={$IFDEF MSWINDOWS}{$IFDEF FPC}GetTickCount64{$ELSE}GetTickCount{$ENDIF}

((StrToInt(FormatDateTime('H', Time))*3600+StrToInt(FormatDateTime('N', Time))*60+

StrToInt(FormatDateTime('S', Time)))*1000)+StrToInt(FormatDateTime('Z', Time));

{$ENDIF};

End;

Procedure WriteInfo(Time: Cardinal; ArcSize, FSize: Int64);

sp: Real;

WriteLn;

WriteLn;

If Time<2500 then

WriteLn('Time: '+IntToStr(Time)+' ms.')

Else If (Time>2500)and(Time<120000) then

WriteLn('Time: '+IntToStr(Time div 1000)+' s. '+IntToStr(Time mod 1000)+' ms.')

Else If (Time>=120000)and(Time<3600000) then

WriteLn('Time: '+IntToStr(Time div 60000)+' m. '+IntToStr((Time mod 60000)div 1000)+' s.')

Else

WriteLn('Time: '+IntToStr(Time div 3600000)+' h. '+IntToStr((Time mod 3600000)div 60000)+' m.');

sp:=(FSize/1024)/(Time/1000);

If sp<2500 then

WriteLn('Speed: '+FloatToStr(SimpleRoundTo(sp, -2))+' Kibytes/s')

Else

WriteLn('Speed: '+FloatToStr(SimpleRoundTo(sp/1024, -2))+' Mibytes/s');

WriteLn('Ratio: '+FloatToStr(SimpleRoundTo(((ArcSize/FSize)*1000)/1000, -3)));

If ArcSize<100000 then

WriteLn('Arc Size: '+IntToStr(ArcSize)+' bytes.')

Else If (ArcSize>100000)and(ArcSize<1200000) then

WriteLn('Arc Size: '+IntToStr(ArcSize div 1024)+' Kib.')

Else If (ArcSize>1200000)and(ArcSize<1073741824) then

WriteLn('Arc Size: '+IntToStr(ArcSize div(1024*1024))+' Mib.')

Else If ArcSize>1073741824 then

WriteLn('Arc Size: '+IntToStr(ArcSize div(1024*1024*1024))+' Gib. '+

IntToStr(ArcSize mod(1024*1024*1024)div(1024*1024))+' Mib.');

End;

If (ParamStr(1)='/?')or(ParamStr(1)='') then

Begin

WriteLn('FPC v.'+fpcVersion);

WriteLn('Compress v.'+Version);

WriteLn(ExtractFileName(ParamStr(0))+' c|d InputFile.ext [OutputFile.ext]');

WriteLn(' c compress');

WriteLn(' d decompress');

WriteLn;

WriteLn(' switches:');

WriteLn(' -b VALUE max bits (16 default)');

WriteLn(' -t test mode');

WriteLn(' -o output file name');

WriteLn(' -p without progress bar');

WriteLn(' -r raw mode');

WriteLn(' -s write signature only');

ReadLn;

Halt;

End;

WriteMode:=1;

MaxWordSize:=16;

SignatureOnly:=False;

Raw:=False;

For i:=1 to ParamCount do

Begin

If ParamStr(i)='-b' then

MaxWordSize:=StrToInt(ParamStr(i+1));

If ParamStr(i)='-t' then

WriteMode:=0;

If ParamStr(i)='-o' then

OutFileName:=ParamStr(i+1);

If ParamStr(i)='-p' then

NoProgress:=True;

If ParamStr(i)='-s' then

SignatureOnly:=True;

If ParamStr(i)='-r' then

Raw:=True;

End;

InFileName:=ParamStr(2);

If LowerCase(ParamStr(1))='c' then

Begin

If FileExists(InFileName) then

Begin

WriteLn;

WriteLn('Compressing... '+InFileName);

DataFile:=TFileStream.Create(InFileName, fmOpenRead or fmShareDenyWrite);

AssignFile(DataFile, InFileName);

ReSet(DataFile);

If WriteMode=1 then

Begin

If not Raw then

For i:=1 to SignatureSize do

BitWrite(ArcFile, Signature[i], 8);

OutFileName2:=ExtractFileName(InFileName);

If not Raw then

If not SignatureOnly then

Begin

For i:=1 to Length(OutFileName2) do

BitWrite(ArcFile, Ord(OutFileName2[i]), 8);

BitWrite(ArcFile, $2A, 8);

End;

If OutFileName='' then

OutFileName:=ChangeFileExt(ExtractFileName(InFileName), ArcExt);

ArcFile:=TFileStream.Create(OutFileName, fmCreate);

AssignFile(ArcFile, OutFileName);

ReWrite(ArcFile);

End;

Time:=UpTime;

CompressProc(DataFile, ArcFile);

Time:=UpTime-Time+1;

ArcFileSize:=GetFSize(ArcFile);

DataFileSize:=GetFSize(DataFile);

WriteInfo(Time, ArcFileSize, DataFileSize);

DataFile.Free;

CloseFile(DataFile);

If WriteMode=1 then

ArcFile.Free;

CloseFile(ArcFile);

End;

End;

If LowerCase(ParamStr(1))='d' then

Begin

If Pos(ArcExt, InFileName)=0 then

InFileName:=InFileName+ArcExt;

If FileExists(InFileName) then

Begin

ArcFile:=TFileStream.Create(InFileName, 0);

FSize:=GetFSize(ArcFile);

AssignFile(ArcFile, InFileName);

ReSet(ArcFile);

FSize:=FileSize(ArcFile);

If not Raw then

Begin

k:=0;

For i:=1 to SignatureSize do

If BitRead(ArcFile, 8)=Signature[i] then

Inc(k);

End

Else

k:=SignatureSize;

If k=SignatureSize then

Begin

If not Raw then

If not SignatureOnly then

Begin

OutFileName2:='';

repeat

k:=BitRead(ArcFile, 8);

OutFileName2:=OutFileName2+Chr(k);

Until k=$2A;

Delete(OutFileName2, Length(OutFileName2), 1);

End;

If OutFileName='' then

OutFileName:=OutFileName2;

If WriteMode=1 then

Begin

DataFile:=TFileStream.Create(OutFileName, fmCreate);

AssignFile(DataFile, OutFileName);

ReWrite(DataFile);

End;

DeCompressProc(ArcFile, DataFile);

ArcFile.Free;

CloseFile(ArcFile);

End;

If WriteMode=1 then

DataFile.Free;

CloseFile(DataFile);

End;

End;

If LowerCase(ParamStr(1))='l' then

Begin

If Pos(ArcExt, InFileName)=0 then

InFileName:=InFileName+ArcExt;

If FileExists(InFileName) then

Begin

ArcFile:=TFileStream.Create(InFileName, 0);

FSize:=GetFSize(ArcFile);

AssignFile(ArcFile, InFileName);

ReSet(ArcFile);

FSize:=FileSize(ArcFile);

k:=0;

For i:=1 to SignatureSize do

If BitRead(ArcFile, 8)=Signature[i] then

Inc(k);

If k=SignatureSize then

Begin

OutFileName:='';

Repeat

k:=BitRead(ArcFile, 8);

OutFileName:=OutFileName+Chr(k);

Until k=$2A;

Delete(OutFileName, Length(OutFileName), 1);

WriteLn('File name: '+OutFileName);

End;

ArcFile.Free;

CloseFile(ArcFile);

End;

End;

end.