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

Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Para efetuar o download você precisa estar logado. Clique aqui para efetuar o login
Confirmar voto
0
 (1)  (0)

Veja nesta Quick como compactar um arquivo usando o Winrar.

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

Figura 1: Interface da aplicação

Observação 1 : O Clique dos botões que representam uma pasta e um excluir, tem um código simples, veja abaixo.

Observação 2: Adicionar a unit uCompactar à cláusula uses.

Listagem 1: Código do formulário

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;

Vamos agora criar uma Unit para compactação dos arquivos, salve a mesma com o nome uCompactar. Implementamos ela abaixo:

Listagem 2: Unit uCompactar

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.

Observação 3 : 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.

Listagem 4: Clique do botão 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;

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á.

Um abraço

 
Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Receba nossas novidades
Ficou com alguma dúvida?