Compress files and folders to zip file with Delphi (Tip for 10 )

Visit my Youtube channnels :  Electro_Magic ; Practical Tips  ; Delphi practical school             

This is an example of zipping ( compressing ) files and folders with Delphi using "FWZip" component which can be downloaded from following link :

https://github.com/AlexanderBagel/FWZip

In this video you can see full procedure of this example :

And following is full source of this example :


(code style formatted by http://hilite.me/ )

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FWZipWriter, ExtCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    cmdOpenFoF: TButton;
    cmdClearList: TButton;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    rbFiles: TRadioButton;
    rbFolders: TRadioButton;
    rbSeparate: TRadioButton;
    rboneFile: TRadioButton;
    Label1: TLabel;
    Edit1: TEdit;
    cmdZip: TButton;
    FileOpenDialog1: TFileOpenDialog;
    Splitter1: TSplitter;
    procedure cmdClearListClick(Sender: TObject);
    procedure cmdOpenFoFClick(Sender: TObject);
    procedure rbSeparateClick(Sender: TObject);
    procedure rboneFileClick(Sender: TObject);
    procedure cmdZipClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   LoadedFiles:TStringList;
implementation

{$R *.dfm}

procedure TForm1.cmdClearListClick(Sender: TObject);
begin
ListBox1.Items.Clear;
LoadedFiles.Clear;
end;

procedure TForm1.cmdOpenFoFClick(Sender: TObject);
var
i:Integer;
begin
if rbFiles.Checked=true then
FileOpenDialog1.Options:=FileOpenDialog1.Options-[fdoPickFolders];
if rbFiles.Checked=false then
FileOpenDialog1.Options:=FileOpenDialog1.Options+[fdoPickFolders];

if FileOpenDialog1.Execute then
begin

for I := 0 to FileOpenDialog1.Files.Count - 1 do
begin
ListBox1.Items.Add(ExtractFileName(FileOpenDialog1.Files[i]));
LoadedFiles.Add(FileOpenDialog1.Files[i]);
end;
 Edit1.Text:=ExtractFileName(FileOpenDialog1.FileName);
end;

//now I have to create stringlist to handle full file names
end;

//now looks good, let's test
procedure TForm1.cmdZipClick(Sender: TObject);
var
FName,FNameOfSel,ZippedRoot:WideString;
i:Integer;
S:TStringStream;
PresentFiles:TStringList;
SR:TSearchRec;
Zip:TFWZipWriter;
BuildZipResult:TBuildZipResult;
begin
Screen.Cursor:=crHourGlass;
ZippedRoot:=ExpandFileName(ExtractFileDir(FileOpenDialog1.FileName));

if rbSeparate.Checked=true then
begin

for I := 0 to LoadedFiles.Count - 1 do
begin
Zip:=TFWZipWriter.Create;
Zip.UseUTF8String:=True;
FName:=LoadedFiles[i];
FNameOfSel:=ExtractFileName(FName);

if DirectoryExists(FName)=false then
begin
SetCurrentDir(ZippedRoot+'\');
S:=TStringStream.Create(FName);
S.Position:=0;
Zip.AddStream(FNameOfSel,S);
S.Free;
BuildZipResult:=Zip.BuildZip(ZippedRoot+'\'+FNameOfSel+'.zip');
ForceDirectories(ZippedRoot+'\');
Zip.Free;
end;

if DirectoryExists(FName)=true then
begin
SetCurrentDir(FName);
PresentFiles:=TStringList.Create;
if Zip.AddFolder('..\'+FNameOfSel+'\')=0 then
raise Exception.Create('Error adding data');

if FindFirst(FName+'*.*',faAnyFile,SR)=0 then
repeat
 if (SR.Name='.') or (SR.Name='..') then  Continue;
 PresentFiles.Add('AddFilesAndFolders\'+SR.Name+'=..\..\'+SR.Name);
until FindNext(SR)<>0;
FindClose(SR);
Zip.AddFilesAndFolders(PresentFiles,True);
PresentFiles.Free;
BuildZipResult:=Zip.BuildZip(ZippedRoot+'\'+FNameOfSel+'.zip');
ForceDirectories(ZippedRoot+'\');
Zip.Free;
end;

end;
end;

if rbSeparate.Checked=false then //ups
begin
Zip:=TFWZipWriter.Create;
Zip.UseUTF8String:=True;

for I := 0 to LoadedFiles.Count - 1 do
begin
FName:=LoadedFiles[i];
FNameOfSel:=ExtractFileName(FName);

if DirectoryExists(FName)=false then
begin
SetCurrentDir(ZippedRoot+'\');
S:=TStringStream.Create(FName);
S.Position:=0;
Zip.AddStream(FNameOfSel,S);
S.Free;
ForceDirectories(ZippedRoot+'\');
end;

if DirectoryExists(FName)=true then
begin
SetCurrentDir(FName);
PresentFiles:=TStringList.Create;
if Zip.AddFolder('..\'+FNameOfSel+'\')=0 then
raise Exception.Create('Error adding data');

if FindFirst(FName+'*.*',faAnyFile,SR)=0 then
repeat
 if (SR.Name='.') or (SR.Name='..') then  Continue;
 PresentFiles.Add('AddFilesAndFolders\'+SR.Name+'=..\..\'+SR.Name);
until FindNext(SR)<>0;
FindClose(SR);
Zip.AddFilesAndFolders(PresentFiles,True);
PresentFiles.Free;
ForceDirectories(ZippedRoot+'\');
end;

end;
BuildZipResult:=Zip.BuildZip(ZippedRoot+'\'+Edit1.Text+'.zip');
ForceDirectories(ZippedRoot+'\');
Zip.Free;
end;

Screen.Cursor:=crDefault;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LoadedFiles.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LoadedFiles:=TStringList.Create;  //No No No !!!!
end;

procedure TForm1.rboneFileClick(Sender: TObject);
begin
Edit1.Enabled:=True;
Label1.Enabled:=True;
end;

procedure TForm1.rbSeparateClick(Sender: TObject);
begin
Edit1.Enabled:=False;
Label1.Enabled:=False;
end;

end.

And Form file :

object Form1: TForm1
  Left = 299
  Top = 148
  Caption = 'Compress files and folders'
  ClientHeight = 385
  ClientWidth = 634
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesigned
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 303
    Top = 0
    Height = 385
    Align = alRight
    ExplicitLeft = 321
    ExplicitTop = 156
    ExplicitHeight = 100
  end
  object ListBox1: TListBox
    Left = 306
    Top = 0
    Width = 328
    Height = 385
    Align = alRight
    ItemHeight = 13
    TabOrder = 0
  end
  object cmdOpenFoF: TButton
    Left = 8
    Top = 12
    Width = 173
    Height = 25
    Caption = 'Open file or folder'
    TabOrder = 1
    OnClick = cmdOpenFoFClick
  end
  object cmdClearList: TButton
    Left = 213
    Top = 12
    Width = 75
    Height = 25
    Caption = 'Clear list'
    TabOrder = 2
    OnClick = cmdClearListClick
  end
  object GroupBox1: TGroupBox
    Left = 8
    Top = 51
    Width = 280
    Height = 115
    Caption = 'Open files or folders'
    TabOrder = 3
    object rbFiles: TRadioButton
      Left = 12
      Top = 24
      Width = 113
      Height = 17
      Caption = 'Files'
      Checked = True
      TabOrder = 0
      TabStop = True
    end
    object rbFolders: TRadioButton
      Left = 12
      Top = 60
      Width = 113
      Height = 17
      Caption = 'Folders'
      TabOrder = 1
    end
  end
  object GroupBox2: TGroupBox
    Left = 8
    Top = 177
    Width = 280
    Height = 145
    Caption = 'Zip type selector'
    TabOrder = 4
    object Label1: TLabel
      Left = 12
      Top = 87
      Width = 43
      Height = 13
      Caption = 'Zip name'
      Enabled = False
    end
    object rbSeparate: TRadioButton
      Left = 12
      Top = 24
      Width = 113
      Height = 17
      Caption = 'Separate separate'
      Checked = True
      TabOrder = 0
      TabStop = True
      OnClick = rbSeparateClick
    end
    object rboneFile: TRadioButton
      Left = 12
      Top = 54
      Width = 113
      Height = 17
      Caption = 'Zip in one file'
      TabOrder = 1
      OnClick = rbOneFileClick
    end
    object Edit1: TEdit
      Left = 12
      Top = 103
      Width = 121
      Height = 21
      Enabled = False
      TabOrder = 2
    end
  end
  object cmdZip: TButton
    Left = 8
    Top = 342
    Width = 280
    Height = 25
    Caption = 'Zip'
    TabOrder = 5
    OnClick = cmdZipClick
  end
  object FileOpenDialog1: TFileOpenDialog
    DefaultFolder = '.\'
    FavoriteLinks = <>
    FileTypes = <>
    Options = [fdoAllowMultiSelect]
    Left = 207
    Top = 243
  end
end