Fórum Problema com Quick Tips : Compactar e Descompactar com Winrar + Delphi #576741

unit uAutoBackup;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uDescompactar, uCompactar, StdCtrls, Buttons, ComCtrls, CheckLst;

type
  TfrmPrincipal = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EdtCaminhoWinrar: TEdit;
    EdtArquivoOriginal: TEdit;
    EdtDestino: TEdit;
    EdtExtensao: TEdit;
    BtnCaminhoWinrar: TBitBtn;
    BtnArquivoOriginal: TBitBtn;
    BtnDestino: TBitBtn;
    BtnDescompactar: TBitBtn;
    OpenDialog1: TOpenDialog;
    Label5: TLabel;
    EdtCaminhoWinrarCompactar: TEdit;
    BtnCaminhoWinrarCompactar: TBitBtn;
    Label6: TLabel;
    CheckListBox: TCheckListBox;
    BtnCheckListBoxAbrir: TBitBtn;
    BtnCheckListBoxLimpar: TBitBtn;
    Label7: TLabel;
    EdtDestinoCompactar: TEdit;
    BtnDestinoCompactar: TBitBtn;
    BtnCompactar: TBitBtn;
    procedure BtnCaminhoWinrarClick(Sender: TObject);
    procedure BtnArquivoOriginalClick(Sender: TObject);
    procedure BtnDestinoClick(Sender: TObject);
    procedure BtnDescompactarClick(Sender: TObject);
    procedure BtnCaminhoWinrarCompactarClick(Sender: TObject);
    procedure BtnCheckListBoxAbrirClick(Sender: TObject);
    procedure BtnCheckListBoxLimparClick(Sender: TObject);
    procedure BtnDestinoCompactarClick(Sender: TObject);
    procedure BtnCompactarClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    CompactarWinrar: TCompactarWinrar;
  end;

var
  frmPrincipal: TfrmPrincipal;

implementation

{$R *.dfm}

procedure TfrmPrincipal.BtnArquivoOriginalClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  EdtArquivoOriginal.Text := OpenDialog1.FileName;
end;

procedure TfrmPrincipal.BtnCaminhoWinrarClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  EdtCaminhoWinrar.Text := OpenDialog1.FileName;
end;

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.BtnCompactarClick(Sender: TObject);
Var
       CompactarWinrar : TCompactarWinrar;
begin
  Try
      CompactarWinrar := TCompactarWinrar.Create;
       with CompactarWinrar do
       begin

//Acredito que aqui falta algo como "Original := CheckListBox..." Tentei: "Original := CheckListBox.Items;" Mas ele retorna o erro: Incompatible types: 'TStringList' and 'TStrings'

           Destino := EdtDestinoCompactar.Text;
           PathInstalacao := EdtCaminhoWinrarCompactar.Text;
           Compactar;
       end;
       Finally
         FreeAndNil(CompactarWinrar);
       end;

end;

procedure TfrmPrincipal.BtnDescompactarClick(Sender: TObject);
Var
       DescompactarWinrar : TDescompactarWinrar;
begin
  Try
       DescompactarWinrar := TDescompactarWinrar.Create;
       with DescompactarWinrar do
       begin
              ArquivoOriginal := EdtArquivoOriginal.Text;
              Extensao := EdtExtensao.Text;
              PathDestino := EdtDestino.Text;
              PathInstalacao := EdtCaminhoWinrar.Text;
              Descompactar;
       end;
       Finally
         FreeAndNil(DescompactarWinrar);
       end;
end;

procedure TfrmPrincipal.BtnDestinoClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  EdtDestino.Text := OpenDialog1.FileName;
end;

procedure TfrmPrincipal.BtnDestinoCompactarClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  EdtDestinoCompactar.Text := OpenDialog1.FileName;
end;

procedure TfrmPrincipal.FormCreate(Sender: TObject);
begin
  CompactarWinrar := TCompactarWinrar.Create;
end;

procedure TfrmPrincipal.FormDestroy(Sender: TObject);
begin
  CompactarWinrar.Original.Destroy;
  FreeAndNil(CompactarWinrar);
end;

end.

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