abarctyp.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: AbArcTyp.pas 3.05                           *}
{*********************************************************}
{* ABBREVIA: TABArchive, TABArchiveItem classes          *}
{*********************************************************}

{$I AbDefine.inc}

unit AbArcTyp;

interface

uses
  {$IFNDEF Linux}
  Windows,                                                 {!!.03}
  {$ENDIF Linux}
  Classes,
  AbUtils,
  AbDfBase,
  AbDfDec,
  AbDfEnc,
  SysUtils;




{ ===== TAbArchiveItem ====================================================== }
type
  TAbArchiveItem = class(TObject)
  private
    function GetLastModTimeAsDateTime: TDateTime;                        {!!.01}
    procedure SetLastModTimeAsDateTime(const Value: TDateTime);          {!!.01}
  protected {private}
    NextItem          : TAbArchiveItem;
    FAction           : TAbArchiveAction;
    FCompressedSize   : LongInt;
    FCRC32            : Longint;
    FDiskFileName     : string;
    FExternalFileAttributes : Longint;
    FFileName         : string;
    FIsEncrypted      : Boolean;
    FLastModFileTime  : Word;
    FLastModFileDate  : Word;
    FTagged           : Boolean;
    FUncompressedSize : LongInt;

  protected {property methods}
    function GetCompressedSize : LongInt; virtual;
    function GetCRC32 : Longint; virtual;
    function GetDiskPath : string;
    function GetExternalFileAttributes : LongInt; virtual;
    function GetFileName : string; virtual;
    function GetIsEncrypted : Boolean; virtual;
    function GetLastModFileDate : Word; virtual;
    function GetLastModFileTime : Word; virtual;
    function GetStoredPath : string;
    function GetUncompressedSize : LongInt; virtual;
    procedure SetCompressedSize(const Value : LongInt); virtual;
    procedure SetCRC32(const Value : Longint); virtual;
    procedure SetExternalFileAttributes( Value : LongInt ); virtual;
    procedure SetFileName(Value : string); virtual;
    procedure SetIsEncrypted(Value : Boolean); virtual;
    procedure SetLastModFileDate(const Value : Word); virtual;
    procedure SetLastModFileTime(const Value : Word); virtual;
    procedure SetUncompressedSize(const Value : LongInt); virtual;

  public {methods}
    constructor Create;
    destructor Destroy; override;
    function MatchesDiskName(const FileMask : string) : Boolean;
    function MatchesStoredName(const FileMask : string) : Boolean;
    function MatchesStoredNameEx(const FileMask : string) : Boolean;     


  public {properties}
    property Action : TAbArchiveAction
      read FAction
      write FAction;
    property CompressedSize : LongInt
      read GetCompressedSize
      write SetCompressedSize;
    property CRC32 : Longint
      read GetCRC32
      write SetCRC32;
    property DiskFileName : string
      read FDiskFileName
      write FDiskFileName;
    property DiskPath : string
      read GetDiskPath;
    property ExternalFileAttributes : LongInt
      read GetExternalFileAttributes
      write SetExternalFileAttributes;
    property FileName : string
      read GetFileName
      write SetFileName;
    property IsEncrypted : Boolean
      read GetIsEncrypted
      write SetIsEncrypted;
    property LastModFileDate : Word
      read GetLastModFileDate
      write SetLastModFileDate;
    property LastModFileTime : Word
      read GetLastModFileTime
      write SetLastModFileTime;
    property StoredPath : string
      read GetStoredPath;
    property Tagged : Boolean
      read FTagged
      write FTagged;
    property UncompressedSize : LongInt
      read GetUncompressedSize
      write SetUncompressedSize;

    property LastModTimeAsDateTime : TDateTime                           {!!.01}
      read GetLastModTimeAsDateTime                                      {!!.01}
      write SetLastModTimeAsDateTime;                                    {!!.01}
  end;


{ ===== TAbArchiveList ====================================================== }
type
  TAbArchiveList = class
  protected {private}
    FList     : TList;
    HashTable : array[0..1020] of TAbArchiveItem;
  protected {methods}
    function GenerateHash(const S : string) : LongInt;
    function GetCount : Integer;
    procedure SetCount(NewCount : Integer);
    function Get(Index : Integer) : TAbArchiveItem;
    procedure Put(Index : Integer; Item : TAbArchiveItem);
  public {methods}
    constructor Create;
    destructor Destroy; override;
    function Add(Item : Pointer): Integer;
    procedure Clear;
    procedure Delete(Index : Integer);
    function Find(const FN : string) : Integer;
    function IsActiveDupe(const FN : string) : Boolean;
  public {properties}
    property Count : Integer
      read GetCount
      write SetCount;
    property Items[Index : Integer] : TAbArchiveItem
      read Get
      write Put; default;
  end;


{ ===== TAbArchive specific types =========================================== }
type
  TAbStoreOption =
    (soStripDrive, soStripPath, soRemoveDots, soRecurse, soFreshen, soReplace);
  TAbStoreOptions =
    set of TAbStoreOption;

  TAbExtractOption =
    (eoCreateDirs, eoRestorePath);
  TAbExtractOptions =
    set of TAbExtractOption;

  TAbArchiveStatus =
    (asInvalid, asIdle, asBusy);

  TAbArchiveEvent =
    procedure(Sender : TObject) of object;
  TAbArchiveConfirmEvent =
    procedure (Sender : TObject; var Confirm : Boolean) of object;
  TAbArchiveProgressEvent =
    procedure(Sender : TObject; Progress : Byte; var Abort : Boolean) of object;
  TAbArchiveItemEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem) of object;
  TAbArchiveItemConfirmEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem;
      ProcessType : TAbProcessType; var Confirm : Boolean) of object;
  TAbConfirmOverwriteEvent =
    procedure(var Name : string; var Confirm : Boolean) of object;
  TAbArchiveItemFailureEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem;
      ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;
      ErrorCode : Integer) of object;
  TAbArchiveItemExtractEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem;
      const NewName : string) of object;
  TAbArchiveItemExtractToStreamEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem;
      OutStream : TStream) of object;
  TAbArchiveItemTestEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem) of object;
  TAbArchiveItemInsertEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem;
      OutStream : TStream) of object;
  TAbArchiveItemInsertFromStreamEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem;
      OutStream, InStream : TStream) of object;
  TAbArchiveItemProgressEvent =
    procedure(Sender : TObject; Item : TAbArchiveItem; Progress : Byte;
      var Abort : Boolean) of object;
  TAbProgressEvent =
    procedure(Progress : Byte; var Abort : Boolean) of object;
  TAbRequestDiskEvent =
    procedure(Sender : TObject; var Abort : Boolean) of object;
  TAbRequestImageEvent =
    procedure(Sender : TObject; ImageNumber : Integer;
      var ImageName : string; var Abort : Boolean) of object;
  TAbRequestNthDiskEvent =
    procedure(Sender : TObject; DiskNumber : Byte; var Abort : Boolean) of object;


type
  TAbArchiveStreamHelper = class
  protected
    FStream : TStream;
  public
    constructor Create(AStream : TStream);
    procedure ExtractItemData(AStream : TStream); virtual; abstract;
    function FindFirstItem : Boolean; virtual; abstract;
    function FindNextItem : Boolean; virtual; abstract;
    procedure ReadHeader; virtual; abstract;
    procedure ReadTail; virtual; abstract;
    function SeekItem(Index : Integer): Boolean; virtual; abstract;
    procedure WriteArchiveHeader; virtual; abstract;
    procedure WriteArchiveItem(AStream : TStream); virtual; abstract;
    procedure WriteArchiveTail; virtual; abstract;
    function GetItemCount : Integer; virtual; abstract;
  end;


{ ===== TAbArchive ========================================================== }
type
  TAbArchive = class(TObject)
  public
    FStream         : TStream;
    FStatus         : TAbArchiveStatus;

  protected {property variables}
    FArchiveName    : string;
    FAutoSave       : Boolean;
    FBaseDirectory  : string;
    FCurrentItem    : TAbArchiveItem;
    FDOSMode        : Boolean;
    FExtractOptions : TAbExtractOptions;
    FImageNumber    : Word;
    FInStream       : TStream;
    FIsDirty        : Boolean;
    FSpanningThreshold      : Longint;
    FItemList       : TAbArchiveList;
    FLogFile        : string;
    FLogging        : Boolean;
    FLogStream      : TFileStream;
    FMode           : Word;
    FOwnsStream     : Boolean;
    FPadLock        : TAbPadLock;
    FSpanned        : Boolean;
    FStoreOptions   : TAbStoreOptions;
    FTempDir        : string;

  protected {event variables}
    FOnProcessItemFailure  : TAbArchiveItemFailureEvent;
    FOnArchiveProgress     : TAbArchiveProgressEvent;
    FOnArchiveSaveProgress : TAbArchiveProgressEvent;                  {!!.04}
    FOnArchiveItemProgress : TAbArchiveItemProgressEvent;
    FOnConfirmProcessItem  : TAbArchiveItemConfirmEvent;
    FOnConfirmOverwrite    : TAbConfirmOverwriteEvent;
    FOnConfirmSave         : TAbArchiveConfirmEvent;
    FOnLoad                : TAbArchiveEvent;
    FOnProgress            : TAbProgressEvent;
    FOnRequestImage        : TAbRequestImageEvent;
    FOnSave                : TAbArchiveEvent;

  protected {methods}
    procedure CheckValid;
    procedure FreshenAt(Index : Integer);
    function  FreshenRequired(Item : TAbArchiveItem) : Boolean;
    procedure GetFreshenTarget(Item : TAbArchiveItem);
    function  GetItemCount : Integer;
    procedure Init;
    procedure Lock;
    procedure MakeLogEntry(const FN: string; LT : TAbLogType);
    procedure ReplaceAt(Index : Integer);
    procedure SaveIfNeeded(aItem : TAbArchiveItem);
    procedure SetBaseDirectory(Value : string);
    procedure SetLogFile(Value : string);
    procedure SetLogging(Value : Boolean);
    procedure Unlock;

  protected {abstract methods}
    function CreateItem(const FileSpec : string): TAbArchiveItem;
      virtual; abstract;
    procedure ExtractItemAt(Index : Integer; const NewName : string);
      virtual; abstract;
    procedure ExtractItemToStreamAt(Index : Integer; aStream : TStream);
      virtual; abstract;
    procedure LoadArchive;
      virtual; abstract;
    procedure SaveArchive;
      virtual; abstract;
    procedure TestItemAt(Index : Integer);
      virtual; abstract;

  protected {virtual methods}
    procedure DoProcessItemFailure(Item : TAbArchiveItem;
      ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;
      ErrorCode : Integer);
      virtual;
    procedure DoArchiveSaveProgress(Progress : Byte; var Abort : Boolean); {!!.04}
      virtual;                                                             {!!.04}
    procedure DoArchiveProgress(Progress : Byte; var Abort : Boolean);
      virtual;
    procedure DoArchiveItemProgress(Item : TAbArchiveItem; Progress : Byte;
      var Abort : Boolean);
      virtual;
    procedure DoConfirmProcessItem(Item : TAbArchiveItem;
      const ProcessType : TAbProcessType; var Confirm : Boolean);
      virtual;
    procedure DoConfirmSave(var Confirm : Boolean);
      virtual;

    procedure DoLoad;
      virtual;
    procedure DoProgress(Progress : Byte; var Abort : Boolean);
      virtual;
    procedure DoSave;
      virtual;
    function FixName(Value : string) : string;
      virtual;
    function GetSpanningThreshold : Longint;
      virtual;
    procedure SetSpanningThreshold( Value : Longint );
      virtual;

  protected {properties and events}
    property InStream : TStream
      read FInStream;

  public {methods}
    constructor Create(FileName : string; Mode : Word);
      virtual;
    constructor CreateFromStream(aStream : TStream; aArchiveName : string);
    destructor  Destroy;
      override;
    procedure Add(aItem : TAbArchiveItem);
      virtual;
    procedure AddFiles(const FileMask : string; SearchAttr : Integer);
    procedure AddFilesEx(const FileMask, ExclusionMask : string;
      SearchAttr : Integer);
    procedure AddFromStream(const NewName : string; aStream : TStream);
    procedure ClearTags;
    procedure Delete(aItem : TAbArchiveItem);
    procedure DeleteAt(Index : Integer);
    procedure DeleteFiles(const FileMask : string);
    procedure DeleteFilesEx(const FileMask, ExclusionMask : string);
    procedure DeleteTaggedItems;
    procedure Extract(aItem : TAbArchiveItem; const NewName : string);
    procedure ExtractAt(Index : Integer; const NewName : string);
    procedure ExtractFiles(const FileMask : string);
    procedure ExtractFilesEx(const FileMask, ExclusionMask : string);
    procedure ExtractTaggedItems;
    procedure ExtractToStream(const aFileName : string; aStream : TStream);
    function  FindFile(const aFileName : string): Integer;
    function  FindItem(aItem : TAbArchiveItem): Integer;
    procedure Freshen(aItem : TAbArchiveItem);
    procedure FreshenFiles(const FileMask : string);
    procedure FreshenFilesEx(const FileMask, ExclusionMask : string);
    procedure FreshenTaggedItems;
    procedure Load; virtual;
    procedure Move(aItem : TAbArchiveItem; NewStoredPath : string);
      virtual;
    procedure Replace(aItem : TAbArchiveItem);
    procedure Save;
      virtual;
    procedure TagItems(const FileMask : string);
    procedure TestTaggedItems;
    procedure UnTagItems(const FileMask : string);


    procedure DoDeflateProgress(aPercentDone : integer);
      virtual;
    procedure DoInflateProgress(aPercentDone : integer);
      virtual;
    procedure DoSpanningMediaRequest(Sender : TObject; ImageNumber : Integer;
      var ImageName : string; var Abort : Boolean); virtual;
  public {properties}
    property OnProgress : TAbProgressEvent
      read FOnProgress write FOnProgress;
    property ArchiveName : string
      read FArchiveName;
    property AutoSave : Boolean
      read FAutoSave
      write FAutoSave;
    property BaseDirectory : string
      read FBaseDirectory
      write SetBaseDirectory;
    property Count : Integer
      read GetItemCount;
    property DOSMode : Boolean
      read FDOSMode
      write FDOSMode;
    property ExtractOptions : TAbExtractOptions
      read FExtractOptions
      write FExtractOptions;
    property IsDirty : Boolean
      read FIsDirty
      write FIsDirty;
    property ItemList : TAbArchiveList
      read FItemList;
    property LogFile : string
      read FLogFile
      write SetLogFile;
    property Logging : Boolean
      read FLogging
      write SetLogging;
    property Mode : Word
      read FMode;
    property Spanned : Boolean
      read FSpanned;
    property SpanningThreshold : Longint
      read  GetSpanningThreshold
      write SetSpanningThreshold;
    property Status : TAbArchiveStatus
      read FStatus;
    property StoreOptions : TAbStoreOptions
      read FStoreOptions
      write FStoreOptions;
    property TempDirectory : string
      read FTempDir
      write FTempDir;

  public {events}
    property OnProcessItemFailure : TAbArchiveItemFailureEvent
      read FOnProcessItemFailure
      write FOnProcessItemFailure;
    property OnArchiveProgress : TAbArchiveProgressEvent
      read FOnArchiveProgress
      write FOnArchiveProgress;
    property OnArchiveSaveProgress : TAbArchiveProgressEvent           {!!.04}
      read FOnArchiveSaveProgress                                      {!!.04}
      write FOnArchiveSaveProgress;                                    {!!.04}
    property OnArchiveItemProgress : TAbArchiveItemProgressEvent
      read FOnArchiveItemProgress
      write FOnArchiveItemProgress;
    property OnConfirmProcessItem : TAbArchiveItemConfirmEvent
      read FOnConfirmProcessItem
      write FOnConfirmProcessItem;
    property OnConfirmOverwrite : TAbConfirmOverwriteEvent
      read FOnConfirmOverwrite
      write FOnConfirmOverwrite;
    property OnConfirmSave : TAbArchiveConfirmEvent
      read FOnConfirmSave
      write FOnConfirmSave;
    property OnLoad : TAbArchiveEvent
      read FOnLoad
      write FOnLoad;
    property OnRequestImage : TAbRequestImageEvent