Compactação de arquivos com a classe TZipFile

Compactação de arquivos com a classe TZipFile

  dezembro 30, 2019    Ana Paula Novello

---

Agora vai uma classe que foi integrada no delphi para poder trabalhar com compactação de arquivos sem a necessidade de componente de terceiros.

Com esta classe podemos compactar, descompactar, abrir e fechar um arquivo ".zip"

Vamos testar a classe TZipFile. Antes de qualquer coisa declare a System.Zip nas uses do Form.

Em nosso exemplo vamos fazer o compactar/descompactar de vários arquivos que iremos selecionar pelo próprio sistema. 

Vamos utilizar:

O TForm ira ficar mais ou menos semelhante a este

Para poder selecionar vários arquivos no TOpenDialog temos a configuração propriedade >> Options >> ofAllowMultiSelect colocamos "True".

Abaixo um controle para habilitar os botões para não precisar fazer validação de preenchimento na hora do compactamento

procedure TFSistema.ControlesEnabled;
begin
  sbArquivoZip.Enabled := lbListagem.Count > 0;
  BtnCompactar.Enabled := sbArquivoZip.Enabled and (Trim(EditArquivoZip.Text) <> EmptyStr);
  BtnDescompactar.Enabled := sbArquivoZip.Enabled;
end;

Para adicionar/remover os aquivos para serem utilizados vamos colocar o código: 

procedure TFSistema.BtnProcurarClick(Sender: TObject);
var
  lDirectory: string;
begin
  if OpenDialog.Execute then begin {Adicionar na listagem}
    for lDirectory in OpenDialog.Files do
      lbListagem.Items.Add(lDirectory);
    ControlesEnabled;
  end;
end;

procedure TFSistema.BtnRemoverClick(Sender: TObject);
begin
  lbListagem.Items.Delete(lbListagem.ItemIndex); {Remover da listagem}
  ControlesEnabled;
end;

Para selecionar o caminho e o nome do arquivo que será salvo (arquivo compactado);

procedure TFSistema.sbArquivoZipClick(Sender: TObject);
begin
  SaveDialog.InitialDir := GetCurrentDir;
  if SaveDialog.Execute then
    EditArquivoZip.Text := SaveDialog.FileName;
  ControlesEnabled;
end;

No componente TSaveDialog vamos mudar as propriedades;

• DefaultExt = 'zip'
• FileName = 'ArquivosNovo'
• Filter = 'Arquivo ZIP|*.zip'

Vamos fazer um evento que irá mostrar as porcentagens de quanto falta a finalização da compactação:

procedure TFSistema.OnProgress(Sender: TObject; FileName: string; Header: TZipHeader; Position: Int64);
var
  lPercentualArquivo, lPercentualGeral: Real;
begin
  Application.ProcessMessages;
  lbArquivosUtilizados.Caption := ExtractFileName(FileName);

  lPercentualArquivo := Position / Header.UncompressedSize * 100;
  lbArquivo.Caption := FormatFloat('#.## %', lPercentualArquivo);
  pbTempoArquivo.Position := Trunc(lPercentualArquivo);


  lPercentualGeral := (FBytesConcluido + Position) / FBytesTotal * 100;
  lbTempoAproximado.Caption := FormatFloat('#.## %', lPercentualGeral);
  pbTempoAproximado.Position := Trunc(lPercentualGeral);
end;

A variável lbArquivosUtilizados erá mostrar o nome dos aquivos já compactados e o Status "pbTempoAproximado" mostra o quanto dele foi compactado.

Já o label "lbArquivo" esta recebendo o percentual total que esta sendo compactado e o "pbTempoArquivo" mostra através do StatusBar a mesma informação.

Em segundo lugar, será necessário também declarar duas variáveis de classe: uma para armazenar o tamanho de todos os arquivos e outra para manter a quantidade de bytes já processados. 

  private
    { Private declarations }
    FBytesTotal, FBytesConcluido: Cardinal;

Agora vamos calcular a quantidade total de arquivos que será compactados;

function TFSistema.QuantidadeTotal: integer;
var
  lArquivo: string;
begin
  Result := 0;
  for lArquivo in lbListagem.Items do
    Result := Result + TamanhoArquivo(lArquivo);
end;

E um que ira verificar o tamanho dos arquivos;

function TFSistema.TamanhoArquivo(const AArquivo: string): integer;
var
  lStream: TFileStream;
begin
  lStream := TFileStream.Create(AArquivo, fmOpenRead);
  try
    Result := lStream.Size;
  finally
    lStream.Free;
  end;
end;

Agora vamos para o código de compactação, primeiro passo e verificar se contem arquivo para compactar, coloquei um checkBox também para decidir se irá abrir novamente apos a compactação ou não.
Utilizaremos um laço de repetição for para poder passar em todos os arquivos adicionados no ListBox e adicionamos no lZipFile.Add. Isto fará com que de para adicionar mais de um arquivo ao mesmo tempo.

procedure TFSistema.BtnCompactarClick(Sender: TObject);
var
  lZipFile: TZipFile;
  lArquivo: string;
begin
  FBytesConcluido := 0;
  FBytesTotal := QuantidadeTotal;
  lZipFile := TZipFile.Create;
  try
    lZipFile.Open(SaveDialog.FileName, zmWrite);
    lZipFile.OnProgress := OnProgress;
    for lArquivo in lbListagem.Items do begin
      lZipFile.Add(lArquivo);
      FBytesConcluido := FBytesConcluido + lZipFile.FileInfo[Pred(lZipFile.FileCount)].UncompressedSize;
    end;
    if FileExists(SaveDialog.FileName) then begin
      MessageDlg('Processo concluído!', mtInformation, [mbOK], 0);
      if chAbrirAposCompactacao.Checked then
        ShellExecute(0, nil, PChar(SaveDialog.FileName), nil,  nil, SW_SHOWNORMAL);
    end;
  finally
    lZipFile.Free;
  end;
end;

Para ter o descompactamento do arquivo temos o código a seguir, coloquei um código bem simples reaproveitando os campos a cima

procedure TFSistema.BtnDescompactarClick(Sender: TObject);
var
  lUnZipper: TZipFile;
begin
  if OpenDialog.Execute then begin {Adicionar na listagem}
    lUnZipper := TZipFile.Create;
    try
      lUnZipper.Open(OpenDialog.FileName, zmRead);
      lUnZipper.ExtractAll(ExtractFilePath(EditArquivoZip.Text));
      lUnZipper.Close;
    finally
      FreeAndNil(lUnZipper);
    end;
  end;
end;

Exemplo: Download do exemplo