unit zipmasterfunc;

{
[ZipMasterFunc] [1.1]
Delphi 2005
January 2007

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[IMTDocument.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2007 Martin Holmes
and the University of Victoria Computing and Media Centre. The code was
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
Written by Martin Holmes, January 2007.

This unit is just a convenient location to keep other components related
to zip package creation (TZipMaster, a save dialog box, and some labels
with UI messages). The form itself is never shown. When a zip operation
takes place, a progress form is shown (udlgZipProgress, in zipprogress).

This unit is based on code I originally wrote for the TZipForge commercial
component, which can't be used in OS projects. TZipMaster is OS (Lesser GNU).
Code in handlers is based on simple demo code from the TZipMaster docs.
  
Dependencies:

JEDI Code Library (JCL): Project JEDI Team
zipprogress
TZipMaster (http://www.delphizip.org)
TntUnicodeComponents (Troy Wolbrink)

}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TntForms, zipprogress, ZipMstr, TntDialogs, StdCtrls, TntStdCtrls,
  TntSysUtils, jclUnicode, TntClasses;

type
  TufrmZipMasterFunc = class(TTntForm)
    umsgOpenZipFile: TTntLabel;
    umsgFailedToCreateZipFile: TTntLabel;
    udlgSaveZip: TTntSaveDialog;
    Archiver: TZipMaster;
    procedure ArchiverTotalProgress(Sender: TObject; TotalSize: Int64;
      PerCent: Integer);
    procedure ArchiverItemProgress(Sender: TObject; Item: string;
      TotalSize: Cardinal; PerCent: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    OperationCompleted: Boolean;
    function ZipFiles(TheFiles: TTntStringList; ZipFileName: WideString): Boolean;
  end;

var
  ufrmZipMasterFunc: TufrmZipMasterFunc;

implementation

{$R *.DFM}

procedure TufrmZipMasterFunc.ArchiverItemProgress(Sender: TObject; Item: string;
  TotalSize: Cardinal; PerCent: Integer);
begin
  if PerCent = 0 then	// reduces flashing
    udlgZipProgress.ulbFile.Caption := Item;
	udlgZipProgress.uprogFile.Position := PerCent;
  Application.ProcessMessages;
end;

procedure TufrmZipMasterFunc.ArchiverTotalProgress(Sender: TObject;
  TotalSize: Int64; PerCent: Integer);
begin
  if PerCent >= 0 then		// when complete shows -1
    udlgZipProgress.uprogOverall.Position := PerCent;
  if udlgZipProgress.bCancel then
    begin
      OperationCompleted := False;
      Archiver.Cancel;
      udlgZipProgress.Hide;
    end;
  Application.ProcessMessages;
end;

function TufrmZipMasterFunc.ZipFiles(TheFiles: TTntStringList;
  ZipFileName: WideString): Boolean;
begin
  Result := False;
  OperationCompleted := True;
  udlgZipProgress.bCancel := False;
  udlgZipProgress.Show;
  try
    Application.ProcessMessages;
    try
      if TheFiles.Count > 0 then
        begin
          Archiver.ZipFileName := ZipFileName;
//Next line is a bugfix for 1.4.0.2
          if WidefileExists(ZipFileName) then
            Archiver.EraseFile(ZipFileName, htdAllowUndo);
          Archiver.AddOptions := [];
          Archiver.RootDir := '';
          Archiver.FSpecArgs.Assign(TheFiles);
          Archiver.Add;
        end;

      Result := OperationCompleted;
    finally
      udlgZipProgress.Hide;
    end;
  except
  end;
end;

end.