lasarus_compotents/Abbrevia/source/AbCabExt.pas

(* ***** 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: AbCabExt.pas                                *}
{*********************************************************}
{* ABBREVIA: Cabinet file extractor component            *}
{*********************************************************}

unit AbCabExt;

{$I AbDefine.inc}

interface

uses
  Classes,
  AbCBrows, 
  AbArcTyp;

type
  TAbCustomCabExtractor = class(TAbCustomCabBrowser)
  protected {private}
    FExtractOptions : TAbExtractOptions;
    FOnConfirmOverwrite : TAbConfirmOverwriteEvent;

    procedure DoConfirmOverwrite(var Name : string;
                                 var Confirm : Boolean);
    procedure InitArchive;
      override;
    procedure SetExtractOptions( Value : TAbExtractOptions );

  protected {properties}
    property ExtractOptions : TAbExtractOptions
      read  FExtractOptions
      write SetExtractOptions
      default AbDefExtractOptions;
    property OnConfirmOverwrite : TAbConfirmOverwriteEvent
      read  FOnConfirmOverwrite
      write FOnConfirmOverwrite;

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

    procedure ExtractAt(Index : Integer; const NewName : string);
    procedure ExtractFiles(const FileMask : string);
    procedure ExtractFilesEx(const FileMask, ExclusionMask : string);
    procedure ExtractTaggedItems;
  end;

  {$IFDEF HasPlatformsAttribute}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$ENDIF}
  TAbCabExtractor = class(TAbCustomCabExtractor)
  published
    property ArchiveProgressMeter;
    property BaseDirectory;
    property CabSize;
    property CurrentCab;
    property ExtractOptions;
    property FolderCount;
    property HasNext;
    property HasPrev;
    property ItemProgressMeter;
    property OnArchiveProgress;
    property OnArchiveItemProgress;
    property OnChange;
    property OnConfirmOverwrite;
    property OnConfirmProcessItem;
    property OnLoad;
    property OnProcessItemFailure;
    property OnRequestImage;
    property SetID;
    property TempDirectory;
    property Version;
    property FileName; {must be after OnLoad}
  end;
  {.Z+}


implementation

uses
  AbExcept;

{ TAbCustomCabExtractor ==================================================== }
constructor TAbCustomCabExtractor.Create(AOwner : TComponent);
begin
  inherited Create( AOwner );
  ExtractOptions := AbDefExtractOptions;
end;
{ -------------------------------------------------------------------------- }
destructor TAbCustomCabExtractor.Destroy;
begin
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.DoConfirmOverwrite
                                     (var Name : string;
                                      var Confirm : Boolean);
begin
  if Assigned(FOnConfirmOverwrite) then
    FOnConfirmOverwrite(Name, Confirm);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.ExtractAt(Index : Integer;
                                          const NewName : string);
  {extract a file from the archive that match the index}
begin
  if Assigned( CabArchive ) then
    CabArchive.ExtractAt( Index, NewName )
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.ExtractFiles(const FileMask : string);
  {Extract files from the cabinet matching the filemask}
begin
  if Assigned( CabArchive ) then
    CabArchive.ExtractFiles( FileMask )
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.ExtractFilesEx(const FileMask, ExclusionMask : string);
  {Extract files from the cabinet matching the FileMask, exluding those
   matching ExclusionMask}
begin
  if Assigned( CabArchive ) then
    CabArchive.ExtractFilesEx( FileMask, ExclusionMask )
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.ExtractTaggedItems;
  {Extract items in the archive that have been tagged}
begin
  if Assigned( CabArchive ) then
    CabArchive.ExtractTaggedItems
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.InitArchive;
  {Archive now points to the Cab file, update all Archive's properties...}
begin
  inherited InitArchive;
  if Assigned( CabArchive ) then begin
    {poperties}
    CabArchive.ExtractOptions     := FExtractOptions;
    {events}
    CabArchive.OnConfirmOverwrite := DoConfirmOverwrite;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabExtractor.SetExtractOptions( Value : TAbExtractOptions );
begin
  FExtractOptions := Value;
  if Assigned( FArchive ) then
    FArchive.ExtractOptions := Value;
end;
{ -------------------------------------------------------------------------- }

end.