программа архиватор на Delphi

unit UCompressFile;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ComCtrls;
 
type
  TFCompressFile = class(TForm)
    EditFile: TEdit;
    cmdCompress: TButton;
    lblFile: TLabel;
    SbFile: TSpeedButton;
    OpenDialog: TOpenDialog;
    cmbLevel: TComboBox;
    lblLevel: TLabel;
    cmdUncompress: TButton;
    procedure cmdCompressClick(Sender: TObject);
    procedure SbFileClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmdUncompressClick(Sender: TObject);
  private
    { Private declarations }
    gsExePath : string;
  public
    { Public declarations }
  end;
 
var
  FCompressFile: TFCompressFile;
 
implementation
 
{$R *.dfm}
 
uses UtilityPasZlib;
 
procedure TFCompressFile.SbFileClick(Sender: TObject);
var
 sPath: string;
begin
 with OpenDialog do
  begin
   DefaultExt:='';
   Options:=[ofFileMustExist];
   sPath:=ExtractFilePath(EditFile.Text);
   if sPath=''
   then sPath:=gsExePath;
   InitialDir:=sPath;
   FileName:='';
   if Execute
   then
    begin
     if UpperCase(gsExePath)=UpperCase(ExtractFilePath(FileName))
     then EditFile.Text:=ExtractFileName(FileName)
     else EditFile.Text:=FileName;
    end;
  end;
end;
 
procedure TFCompressFile.FormCreate(Sender: TObject);
begin
 gsExePath:=ExtractFilePath(Application.ExeName);
end;
 
function CutExt(s: string): string;
begin
 Result:=Copy(s,1,length(s)-length(ExtractFileExt(s)));
end;
 
procedure TFCompressFile.cmdCompressClick(Sender: TObject);
var
 sFilename: string;
 Level: TCompLevel;
begin
 Screen.Cursor:=crHourGlass;
 Level:=clDefault;
 try
  sFilename:=trim(EditFile.Text);
  if sFilename<>''
  then
   begin
    if cmbLevel.Text='Fastest'
    then Level:=clNone
    else
     if cmbLevel.Text='Max'
     then Level:=clMax;
    CompressFile(sFilename,sFilename+'.zip',Level);
    ShowMessage('File successfully compressed!');
   end;
 finally
  Screen.Cursor:=crDefault;
 end;
end;
 
procedure TFCompressFile.cmdUncompressClick(Sender: TObject);
var
 sFilename, sDestFile: string;
begin
 Screen.Cursor:=crHourGlass;
 try
  sFilename:=trim(EditFile.Text);
  if sFilename<>''
  then
   begin
    sDestFile:=sFilename;
    if UpperCase(ExtractFileExt(sFileName))<>'.ZIP'
    then
     begin
      sDestFile:=sFilename;
      sFilename:=sDestFile+'.zip';
     end
    else sDestFile:=CutExt(sFilename);
    UnCompressFile(sFilename,sDestFile);
    ShowMessage('File successfully uncompressed!');    
   end;
 finally
  Screen.Cursor := crDefault;
 end;
end;
 
end.

unit fmProcessU;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Gauges, ExtCtrls;
 
type
  TfmProcess = class(TForm)
    ggProcess: TGauge;
    ggRatio: TGauge;
    bbCabcel: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    lbProcessInfo: TLabel;
    procedure bbCabcelClick(Sender: TObject);
  private
    { Private declarations }
    Continue:Boolean;
  public
    { Public declarations }
    Function ShowProcess(OrigSize, OrigPos, Comp:Integer):Boolean;
    Procedure Compress(OldFileName, NewFileName:String);
    Procedure DeCompress(OldFileName, NewFileName:String);
  end;
 
var
  fmProcess: TfmProcess;
 
implementation
 
uses DeCompressorU;
 
{$R *.DFM}
 
Procedure TfmProcess.Compress(OldFileName, NewFileName:String);
Begin
  lbProcessInfo.Caption:='Сжатие файла "'+OldFileName+'"';
  Show;
 
  Continue:=True;
  CompressFile(OldFileName, NewFileName);
  Sleep(1000);
  Hide;
End;
 
Procedure TfmProcess.DeCompress(OldFileName, NewFileName:String);
Begin
  lbProcessInfo.Caption:='Распаковка файла "'+OldFileName+'"';
  Show;
 
  Continue:=True;
  DeCompressFile(OldFileName, NewFileName);
  Sleep(1000);
  Hide;
End;
 
Function TfmProcess.ShowProcess(OrigSize, OrigPos, Comp:Integer):Boolean;
Begin
  ggProcess.MaxValue:=OrigSize;
  ggProcess.Progress:=OrigPos;
 
//  ggRatio.MaxValue:=OrigSize;
  ggRatio.MaxValue:=OrigPos;
  ggRatio.Progress:=Comp;
 
  Result:=Continue;
  Application.ProcessMessages;
End;
 
procedure TfmProcess.bbCabcelClick(Sender: TObject);
begin
  Continue:=False;
  Application.ProcessMessages;
 
  Application.MessageBox('Процесс прерван пользователем', 'Отмена', MB_ICONINFORMATION Or MB_OK);
  Hide;
end;
 
end.