abbrowse.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: AbBrowse.pas 3.05                           *}
{*********************************************************}
{* ABBREVIA: Base Browser Component                      *}
{*********************************************************}

unit AbBrowse;

{$I AbDefine.inc}

interface

uses
  SysUtils, Classes,
  AbBase,
  AbUtils,
  AbExcept,
  AbArcTyp,
{$IFDEF MSWINDOWS}
  AbCabTyp,
{$ENDIF}
  AbZipTyp,
  AbTarTyp,
  AbGzTyp;

type
  TAbMeterLink = class(TAbBaseComponent)
    public
      procedure DoProgress(Progress : Byte); virtual; abstract;
      procedure Reset; virtual; abstract;
  end;

  TAbBaseBrowser = class(TAbBaseComponent)
  public
    FArchive : TAbArchive;
  protected {private}
    FSpanningThreshold : Longint;
    FItemProgressMeter : TAbMeterLink;
    FArchiveProgressMeter : TAbMeterLink;
    FBaseDirectory : string;
    FFileName : string;
    FLogFile : string;
    FLogging : Boolean;
    FOnArchiveProgress : TAbArchiveProgressEvent;
    FOnArchiveItemProgress : TAbArchiveItemProgressEvent;
    FOnChange : TNotifyEvent;
    FOnConfirmProcessItem : TAbArchiveItemConfirmEvent;
    FOnLoad : TAbArchiveEvent;
    FOnProcessItemFailure : TAbArchiveItemFailureEvent;
    FOnRequestImage : TAbRequestImageEvent;
    FTempDirectory : string;

    { detected compression type }
    FArchiveType       : TAbArchiveType;
    FForceType             : Boolean;

  protected {private methods}
    function  GetCount : Integer;
    function  GetSpanned : Boolean;
    function  GetStatus : TAbArchiveStatus;
    procedure ResetMeters; virtual;                                    {!!.04}
    procedure SetCompressionType(const Value: TAbArchiveType);
    procedure SetBaseDirectory(const Value : string);
    procedure SetSpanningThreshold(Value : Longint);
    procedure SetLogFile(const Value : string);
    procedure SetLogging(Value : Boolean);
    procedure SetTempDirectory(const Value : string);

    procedure Loaded; override;
    procedure Notification(Component: TComponent;
                           Operation: TOperation); override;

  protected {virtual methods}
    procedure DoArchiveItemProgress(Sender : TObject;
                                    Item : TAbArchiveItem;
                                    Progress : Byte;
                                    var Abort : Boolean); virtual;
    procedure DoArchiveProgress(Sender : TObject;
                                Progress : Byte;
                                var Abort : Boolean); virtual;
    procedure DoChange; virtual;
    procedure DoConfirmProcessItem(Sender : TObject;
                                   Item : TAbArchiveItem;
                                   ProcessType : TAbProcessType;
                                   var Confirm : Boolean); virtual;
    procedure DoLoad(Sender : TObject); virtual;
    procedure DoProcessItemFailure(Sender : TObject;
                                    Item : TAbArchiveItem;
                                    ProcessType : TAbProcessType;
                                    ErrorClass : TAbErrorClass;
                                    ErrorCode : Integer); virtual;
    procedure SetOnRequestImage(Value : TAbRequestImageEvent); virtual;
    procedure InitArchive; virtual;

    {This method must be defined in descendent classes}
    procedure SetFileName(const aFileName : string); virtual; abstract;


  protected {properties}
    property Archive : TAbArchive
      read FArchive;
    property ArchiveProgressMeter : TAbMeterLink
      read  FArchiveProgressMeter
      write FArchiveProgressMeter;
    property BaseDirectory : string
      read  FBaseDirectory
      write SetBaseDirectory;
    property FileName : string
      read  FFileName
      write SetFileName;
    property SpanningThreshold : Longint
      read  FSpanningThreshold
      write SetSpanningThreshold
      default 0;
    property ItemProgressMeter : TAbMeterLink
      read  FItemProgressMeter
      write FItemProgressMeter;
    property LogFile : string
      read  FLogFile
      write SetLogFile;
    property Logging : Boolean
      read  FLogging
      write SetLogging
      default False;
    property Spanned : Boolean
      read GetSpanned;
    property TempDirectory : string
      read  FTempDirectory
      write SetTempDirectory;



  protected {events}
    property OnArchiveProgress : TAbArchiveProgressEvent
      read FOnArchiveProgress
      write FOnArchiveProgress;
    property OnArchiveItemProgress : TAbArchiveItemProgressEvent
      read FOnArchiveItemProgress
      write FOnArchiveItemProgress;
    property OnConfirmProcessItem : TAbArchiveItemConfirmEvent
      read FOnConfirmProcessItem
      write FOnConfirmProcessItem;
    property OnProcessItemFailure : TAbArchiveItemFailureEvent
      read FOnProcessItemFailure
      write FOnProcessItemFailure;
    property OnRequestImage : TAbRequestImageEvent
      read FOnRequestImage
      write SetOnRequestImage;

  public {methods}
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

    procedure ClearTags;
      {Clear all tags from the archive}
    function FindItem(aItem : TAbArchiveItem) : Integer;
    function FindFile(const aFileName : string) : Integer;
    procedure TagItems(const FileMask : string);
      {tag all items that match the mask}
    procedure UnTagItems(const FileMask : string);
      {clear tags for all items that match the mask}
    procedure CloseArchive;
      {closes the archive by setting FileName to ''}
    procedure OpenArchive(const aFileName : string);
      {opens the archive}

  public {properties}
    property Count : Integer
      read GetCount;
    property Status : TAbArchiveStatus
      read GetStatus;

    property ArchiveType : TAbArchiveType
      read FArchiveType
      write SetCompressionType
      default atUnknown;

    property ForceType : Boolean
      read FForceType
      write FForceType
      default False;

  public {events}
    property OnChange : TNotifyEvent
      read FOnChange
      write FOnChange;
    property OnLoad : TAbArchiveEvent
      read FOnLoad
      write FOnLoad;
  end;

function AbDetermineArcType(const FN : string; AssertType : TAbArchiveType) : TAbArchiveType;

implementation

uses
  AbConst;

{ TAbBaseBrowser implementation ======================================= }

{ -------------------------------------------------------------------------- }
constructor TAbBaseBrowser.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF TrialRun}
  _TR2_;
  {$ENDIF}
  FLogFile := '';
  FLogging := False;
  FSpanningThreshold := 0;

  FArchiveType := atUnknown;
  FForceType       := False;
end;
{ -------------------------------------------------------------------------- }
destructor TAbBaseBrowser.Destroy;
begin
  FArchive.Free;
  FArchive := nil;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.ClearTags;
  {Clear all tags from the archive}
begin
  if Assigned(FArchive) then
    FArchive.ClearTags
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.CloseArchive;
  {closes the archive by setting FileName to ''}
begin
  if FFileName <> '' then
    FileName := '';
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.DoArchiveItemProgress(Sender : TObject;
                                               Item : TAbArchiveItem;
                                               Progress : Byte;
                                               var Abort : Boolean);
begin
  Abort := False;
  if Assigned(FItemProgressMeter) then
    FItemProgressMeter.DoProgress(Progress);
  if Assigned(FOnArchiveItemProgress) then
    FOnArchiveItemProgress(Self, Item, Progress, Abort);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.DoArchiveProgress(Sender : TObject;
                                           Progress : Byte;
                                           var Abort : Boolean);
begin
  Abort := False;
  if Assigned(FArchiveProgressMeter) then
    FArchiveProgressMeter.DoProgress(Progress);
  if Assigned(FOnArchiveProgress) then
    FOnArchiveProgress(Self, Progress, Abort);
end;