abzipper.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * 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 TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbZipper.pas 3.05                           *}
{*********************************************************}
{* ABBREVIA: Non-visual Component with Zip support       *}
{*********************************************************}

unit AbZipper;

{$I AbDefine.inc}

interface

uses
  SysUtils, Classes,
  AbBrowse, AbZBrows,
  AbBase, AbUtils, AbArcTyp, AbZipTyp, AbTarTyp, AbGzTyp, AbSpanSt;

type
  TAbCustomZipper = class(TAbCustomZipBrowser)
  protected {private}
    FAutoSave               : Boolean;
    FCompressionMethodToUse : TAbZipSupportedMethod;
    FDeflationOption        : TAbZipDeflationOption;
    FDOSMode : Boolean;
    FOnConfirmSave          : TAbArchiveConfirmEvent;
    FOnSave                 : TAbArchiveEvent;
    FOnArchiveSaveProgress  : TAbArchiveProgressEvent;                 {!!.04}
    FArchiveSaveProgressMeter : TAbMeterLink;                          {!!.04}

    FStoreOptions           : TAbStoreOptions;

  protected {methods}
    procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean);
      virtual;
    procedure DoSave(Sender : TObject);
      virtual;
    procedure DoArchiveSaveProgress(Sender : TObject; Progress : Byte;{!!.04}
                                    var Abort : Boolean);             {!!.04}

    procedure InitArchive;
      override;
    procedure SetAutoSave(Value : Boolean);
    procedure SetCompressionMethodToUse(Value : TAbZipSupportedMethod);
    procedure SetDeflationOption(Value : TAbZipDeflationOption);
    procedure SetDOSMode( Value : Boolean );
    procedure SetFileName(const aFileName : string);
      override;
    procedure SetStoreOptions( Value : TAbStoreOptions );
    procedure SetZipfileComment(Value : string);
      override;
    procedure ZipProc(Sender : TObject; Item : TAbArchiveItem;
                      OutStream : TStream);
    procedure ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem;
                                OutStream, InStream : TStream );
    procedure Notification(Component: TComponent;                      {!!.04}
      Operation: TOperation); override;                                {!!.04}
    procedure ResetMeters; override;                                   {!!.04}

  protected {properties}
    property AutoSave : Boolean
      read  FAutoSave
      write SetAutoSave;
    property CompressionMethodToUse : TAbZipSupportedMethod
      read  FCompressionMethodToUse
      write SetCompressionMethodToUse
      default AbDefCompressionMethodToUse;
    property DeflationOption : TAbZipDeflationOption
      read  FDeflationOption
      write SetDeflationOption
      default AbDefDeflationOption;
    property DOSMode : Boolean
      read  FDOSMode
      write SetDOSMode;
    property StoreOptions : TAbStoreOptions
      read  FStoreOptions
      write SetStoreOptions
      default AbDefStoreOptions;
    property ArchiveSaveProgressMeter : TAbMeterLink                   {!!.04}
      read  FArchiveSaveProgressMeter                                  {!!.04}
      write FArchiveSaveProgressMeter;                                 {!!.04}


  protected {events}
    property OnConfirmSave : TAbArchiveConfirmEvent
      read  FOnConfirmSave
      write FOnConfirmSave;
    property OnSave : TAbArchiveEvent
      read  FOnSave
      write FOnSave;
    property OnArchiveSaveProgress : TAbArchiveProgressEvent           {!!.04}
      read FOnArchiveSaveProgress                                      {!!.04}
      write FOnArchiveSaveProgress;                                    {!!.04}

  public {methods}
    constructor Create(AOwner : TComponent);
      override;
    destructor Destroy;
      override;
    procedure AddFiles(const FileMask : string; SearchAttr : Integer);
    procedure AddFilesEx(const FileMask, ExclusionMask : string; SearchAttr : Integer);
    procedure AddFromStream(const NewName : string; FromStream : TStream);
    procedure DeleteAt(Index : Integer);
    procedure DeleteFiles(const FileMask : string);
    procedure DeleteFilesEx(const FileMask, ExclusionMask : string);
    procedure DeleteTaggedItems;
    procedure FreshenFiles(const FileMask : string);
    procedure FreshenFilesEx(const FileMask, ExclusionMask : string);
    procedure FreshenTaggedItems;
    procedure Move(aItem : TAbArchiveItem; NewStoredPath : string);
    procedure Save;
    procedure Replace(aItem : TAbArchiveItem);
  end;

type
  TAbZipper = class(TAbCustomZipper)
  published
    property ArchiveProgressMeter;
    property ArchiveSaveProgressMeter;                                 {!!.04}
    property ItemProgressMeter;
    property AutoSave;
    property BaseDirectory;
    property CompressionMethodToUse;
    property DeflationOption;
    property DOSMode;
    property SpanningThreshold;
    property LogFile;
    property Logging;
    property OnArchiveProgress;
    property OnArchiveSaveProgress;                                    {!!.04}
    property OnArchiveItemProgress;
    property OnChange;
    property OnConfirmProcessItem;
    property OnConfirmSave;
    property OnLoad;
    property OnProcessItemFailure;
    property OnRequestBlankDisk;
    property OnRequestImage;
    property OnRequestLastDisk;
    property OnRequestNthDisk;
    property OnSave;
    property Password;
    property StoreOptions;
    property TempDirectory;
    property Version;
    property FileName; {must be after OnLoad}
  end;

implementation

uses
  AbExcept,
  AbZipPrc;

{ -------------------------------------------------------------------------- }
constructor TAbCustomZipper.Create( AOwner : TComponent );
begin
  inherited Create( AOwner );
  CompressionMethodToUse := AbDefCompressionMethodToUse;
  DeflationOption := AbDefDeflationOption;
  StoreOptions := AbDefStoreOptions;
end;
{ -------------------------------------------------------------------------- }
destructor TAbCustomZipper.Destroy;
begin
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.AddFiles(const FileMask : string; SearchAttr : Integer);
  {Add files to the archive where the disk filespec matches}
begin
  if (ZipArchive <> nil) then
    ZipArchive.AddFiles(FileMask, SearchAttr)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.AddFilesEx(const FileMask, ExclusionMask : string;
  SearchAttr : Integer);
  {Add files that match Filemask except those matching ExclusionMask}
begin
  if (ZipArchive <> nil) then
    ZipArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.AddFromStream(const NewName : string;
                                        FromStream : TStream);
  {Add stream directly to archive}
begin
  if (ZipArchive <> nil) then begin
    FromStream.Position := 0;
    ZipArchive.AddFromStream(NewName, FromStream);
  end else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteFiles(const FileMask : string);
  {delete all files from the archive that match the file mask}
begin
  if (ZipArchive <> nil) then
    ZipArchive.DeleteFiles( FileMask )
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteAt(Index : Integer);
  {delete item at Index}
begin
  if (ZipArchive <> nil) then
    ZipArchive.DeleteAt( Index )
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteFilesEx(const FileMask, ExclusionMask : string);
  {Delete files that match Filemask except those matching ExclusionMask}
begin
  if (ZipArchive <> nil) then
    ZipArchive.DeleteFilesEx(FileMask, ExclusionMask)
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteTaggedItems;
  {delete all tagged items from the archive}
begin
  if (ZipArchive <> nil) then
    ZipArchive.DeleteTaggedItems
  else
    raise EAbNoArchive.Create;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DoConfirmSave(Sender : TObject; var Confirm : Boolean);
begin
  Confirm := True;
  if Assigned(FOnConfirmSave) then
    FOnConfirmSave(Self, Confirm);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DoSave(Sender : TObject);
begin