Artigos Delphi Quick Tips : Compactar e Descompactar com Winrar + Delphi - Parte II

Olá galera, nesta Quick Tips, irei mostrar agora a parte final onde podemos compactar os arquivos gerando um único arquivo do Winrar.

Organize os componentes e mude o name dos mesmos seguindo a ordem abaixo:

  • EdtCaminhoWinrarCompactar
  • BtnCaminhoWinrarCompactar
  • CheckListBox
  • BtnCheckListBoxAbrir
  • BtnCheckListBoxLimpar
  • EdtDestinoCompactar
  • BtnDestinoCompactar
  • BtnCompactar
Interface da aplicação
Figura 1. Interface da aplicação
Nota. Adicionar a unituCompactar à cláusula uses. O Clique dos botões que representam uma pasta e um excluir, tem um código simples, veja abaixo.
procedure TFrmPrincipal.BtnCaminhoWinrarCompactarClick(Sender: TObject);
begin
if OpenDialog1.Execute then
EdtCaminhoWinrarCompactar.Text := OpenDialog1.FileName;
end;
procedure TFrmPrincipal.BtnCheckListBoxAbrirClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
CompactarWinrar.Original.Add(OpenDialog1.FileName);
CheckListBox.Items.Add(OpenDialog1.FileName);
end;
end;
procedure TFrmPrincipal.BtnCheckListBoxLimparClick(Sender: TObject);
begin
CompactarWinrar.Original.Clear;
CheckListBox.Clear;
end;
procedure TFrmPrincipal.BtnDestinoCompactarClick(Sender: TObject);
begin
if OpenDialog1.Execute then
EdtDestinoCompactar.Text := OpenDialog1.FileName;
end;
Listagem 1. Código do formulário

Vamos agora criar umaUnitpara compactação dos arquivos, salve a mesma com o nomeuCompactar. Implementamos ela abaixo:

unit uCompactar;
interface
uses
Windows, Dialogs, SysUtils, Classes;
Type
TCompactarWinrar = class
private
FPathInstalacao: String;
FDestino: String;
FOriginal: TStringList;
procedure SetDestino(const Value: String);
procedure SetOriginal(const Value: TStringList);
procedure SetPathInstalacao(const Value: String);
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
property PathInstalacao : String read FPathInstalacao write SetPathInstalaca
SetPathInstalacao;
property Original : TStringList read FOriginal write SetOriginal;
property Destino : String read FDestino write SetDestino;
procedure Compactar;
constructor Create;
published
{ published declarations }
end;
implementation
{ TCompactarWinrar }

procedure TCompactarWinrar.Compactar;
Var
cmd, Arquivos : String;
I: Integer;
begin
for I := 0 to Original.Count - 1 do
begin
Arquivos := Arquivos + '"' + Original.Strings[I] + '" ' ;
end;
Cmd := PathInstalacao + ' a "' + Destino + '"' + ' ' + Arquivos;
WinExec( PAnsiChar(AnsiString(Cmd)), SW_HIDE);
Showmessage('Arquivo Compactado com sucesso !!!');
end;

constructor TCompactarWinrar.Create;
begin
Original := TStringList.Create;
end;

procedure TCompactarWinrar.SetDestino(const Value: String);
begin
if DirectoryExists(ExtractFileDir(Value)) then
FDestino := Value
else
raise Exception.Create('Arquivo de Destino não existe ' + #13+
'Arquivo : ' + Value );
end;

procedure TCompactarWinrar.SetOriginal(const Value: TStringList);
begin
FOriginal := Value
end;

procedure TCompactarWinrar.SetPathInstalacao(const Value: String);
begin
FPathInstalacao := Value;
end;

end.
Listagem 2. Unit uCompactar
Nota: Nesta unit podemos observar o código da procedure compactar, nela definimos o comando que o help do Winrar demonstra para compactação.

Para finalizarmos a função do Clique do BtnCompactar.

procedure TFrmPrincipal.BtnCompactarClick(Sender: TObject);
Var
       CompactarWinrar : TCompactarWinrar;
begin
  Try
      CompactarWinrar := TCompactarWinrar.Create;
       with CompactarWinrar do
       begin
           Destino := EdtDestinoCompactar.Text;
           PathInstalacao := EdtCaminhoWinrarCompactar.Text;
           Compactar;
       end;
       Finally
         FreeAndNil(CompactarWinrar);
       end;

end;
Listagem 4. Clique do botão BtnCompactar

Fico por aqui ate à próxima Quick Tip. Quem tiver interesse em incrementar estas funções esteja à vontade, analise o help do Winrar, tem muito mais coisas por lá.