Lazarus - исходники консольного архиватора

Posted 8 ноября, 2011 - 05:58 by Алексей Яковлев
0

Используя библиотеку ZLib написал вот такой простой архиватор-разархиватор.

Исходник иприлагаю:

 

program zz;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp,zlibfunc
  { you can add units after this };
 
type
 
  { z }
 
  z = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
{ z }
 
procedure z.DoRun;
var here:string;
begin
  if ParamCount>2 then begin
  if ParamStr(1)='d' then CompressDirectory(Paramstr(2),true,Paramstr(3));
  if ParamStr(1)='f' then CompressFile(Paramstr(2),Paramstr(3));
  if ParamStr(1)='er' then DecompressFile(Paramstr(2),Paramstr(3),true,true);
  if ParamStr(1)='ea' then DecompressFile(Paramstr(2),Paramstr(3),true,false);
  end
  else
  begin
    if ParamCount>1 then begin
        here:=ExtractFilePath(Paramstr(0));
  if Paramstr(1)='here' then DecompressFile(Paramstr(2),here,true,false);
      end else begin
    writeln('Usage: zz d Directory Archive');
    writeln('Usage: zz f File Archive');
    writeln('Usage: zz er Archive Target-Relative');
    writeln('Usage: zz ea Archive Target-Absolute');
    writeln('Press Enter to continue');
    readln;
      end;
  end;
  Terminate;
end;
 
constructor z.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;
 
destructor z.Destroy;
begin
  inherited Destroy;
end;
 
var
  Application: z;
 
{$R *.res}
 
begin
  Application:=z.Create(nil);
  Application.Title:='z';
  Application.Run;
  Application.Free;
end.
 
То есть чтобы запаковать папку DOCS в архив DOCS.ZZ пишем команду:
zz d docs docs.zz
Чтобы запаковать файл FILE.DOC в архив FILE.ZZ пишем
zz f file.doc file.zz
Для извлечения удобнее всего использовать атрибут HERE - здесь:
zz docs.zz here
zz file.zz here