Compressão de Arquivos

unit CompressaoArquivos;

interface

uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, ACBrMail, types, ACBrBase, ExtCtrls,
      Vcl.Imaging.pngimage, System.Zip,JvZlibMultiple, System.Zip2;

type ICompressao= Interface
      ['{79A8CCDC-2F8C-48CD-8B5F-5146876DBC4B}']
      function GetTamanhoArquivos(Path: string): integer;
      procedure EventoOnProgress(Sender: TObject; FileName: string; Header: TZipHeader; Position: Int64);
End;

Type TCompressao = class(TInterfacedObject, ICompressao)
     private
    FZipFile: TZipFile;
    FrPgrBar: TProgressbar;
    {Private declaration}
     protected
     {Protected declaration}
     public
     {Public declaration declaration}
     property ZipFile: TZipFile read FZipFile write FZipFile;
     procedure EventoOnProgress(Sender: TObject; FileName: string; Header: TZipHeader; Position: Int64);
     property  PgrBar : TProgressbar read FrPgrBar write FrPgrBar;
     constructor Create(aNomearquivoZip,arquivo: string;aTPrgBar: TprogressBar); (*Metodos do Constructor*)
     function GetTamanhoArquivos(Path: string): integer;
     procedure BeforeDestruction; override;
     destructor Destroy; override;

     published
     {Protected declaration}
     end;

implementation

{ TCompressao }

procedure TCompressao.BeforeDestruction;
begin
  inherited BeforeDestruction;

end;

constructor TCompressao.Create(aNomearquivoZip,arquivo: string;aTPrgBar: TprogressBar);
  var ZipProgress: TZipProgressEvent;
begin
    ZipFile:= TZipFile.Create;
  try
    FrPgrBar := Tprogressbar.Create(Nil);
    ZipFile.OnProgress := EventoOnProgress;
    self.FrPgrBar:= aTPrgBar;
    FrPgrBar.Max := 1;
    ZipFile.ZipDirectoryContents(aNomearquivoZip,arquivo);

  finally
    ZipFile.DisposeOf;

    //FrPgrBar.DisposeOf;
  end;
end;

destructor TCompressao.Destroy;
begin

  inherited;
end;

procedure TCompressao.EventoOnProgress(Sender: TObject; FileName: string; Header: TZipHeader; Position: Int64);
begin
 Application.ProcessMessages;
 FrPgrBar.Position := trunc(Position / Header.UncompressedSize * 100);

end;

function TCompressao.GetTamanhoArquivos(Path: string): integer;
{Retorna o tamanho de um diretório}
var
SR : TSearchRec;
rc : Integer;
Tamanho : Integer;
begin
Tamanho := 0;
rc := FindFirst(Path+'\*.*', faDirectory, SR);
if rc = 0 then
begin
while rc = 0 do
begin
if (SR.Name = '.') or (SR.Name = '..') then
else
if (SR.Attr and faDirectory) <> 0 then
begin
Tamanho := Tamanho + GetTamanhoArquivos(Path+SR.Name);
end
else
begin
Tamanho := Tamanho + SR.Size;
end;
rc := FindNext(SR);
end;
FindClose(SR);
end;
result := Tamanho;
end;

end.