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