lasarus_compotents/Abbrevia/source/AbCabKit.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: AbCabKit.PAS                                *}
{*********************************************************}
{* ABBREVIA: Cabinet file builder/extractor component    *}
{*********************************************************}

unit AbCabKit;

{$I AbDefine.inc}

interface

uses
  Classes, AbArcTyp,
  AbCabMak;

type
  TAbCustomCabKit = class(TAbCustomMakeCab)
  protected {private}
    FExtractOptions : TAbExtractOptions;
    FOnConfirmOverwrite : TAbConfirmOverwriteEvent;

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


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

  protected {events}
    property OnConfirmOverwrite : TAbConfirmOverwriteEvent
      read  FOnConfirmOverwrite
      write FOnConfirmOverwrite;

  public {methods}
    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}
  TAbCabKit = class(TAbCustomCabKit)
  published
    property ArchiveProgressMeter;
    property BaseDirectory;
    property CabSize;
    property CompressionType;
    property CurrentCab;
    property ExtractOptions;
    property FolderCount;
    property FolderThreshold;
    property HasNext;
    property HasPrev;
    property ItemProgressMeter;
    property OnArchiveProgress;
    property OnArchiveItemProgress;
    property OnChange;
    property OnConfirmOverwrite;
    property OnConfirmProcessItem;
    property OnLoad;
    property OnProcessItemFailure;
    property OnRequestImage;
    property OnSave;
    property SetID;
    property SpanningThreshold;
    property TempDirectory;
    property Version;
    property FileName; {must be after OnLoad}
  end;


implementation

uses
  SysUtils,
  AbExcept,
  AbCabTyp,
  AbCBrows;

{ TAbCustomCabKit ==================================================== }
constructor TAbCustomCabKit.Create(AOwner : TComponent);
begin
  inherited Create( AOwner );
  ExtractOptions := AbDefExtractOptions;
end;
{ -------------------------------------------------------------------------- }
destructor TAbCustomCabKit.Destroy;
begin
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabKit.DoConfirmOverwrite(var Name : string;
                                             var Confirm : Boolean);
begin
  if Assigned(FOnConfirmOverwrite) then
    FOnConfirmOverwrite(Name, Confirm);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabKit.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 TAbCustomCabKit.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 TAbCustomCabKit.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 TAbCustomCabKit.ExtractTaggedItems;
  {Extract items in the archive that have been tagged}
begin
  if Assigned(CabArchive) then
    CabArchive.ExtractTaggedItems
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabKit.InitArchive;
begin
  inherited InitArchive;
  if Assigned( CabArchive ) then begin
    {poperties}
    CabArchive.ExtractOptions     := FExtractOptions;
    {events}
    CabArchive.OnConfirmOverwrite := DoConfirmOverwrite;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabKit.SetExtractOptions( Value : TAbExtractOptions );
begin
  FExtractOptions := Value;
  if Assigned( FArchive ) then
    FArchive.ExtractOptions := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomCabKit.SetFileName(const aFileName : string);
  {Create or open the specified cabinet file}
begin
  FFilename := aFileName;
  if csDesigning in ComponentState then
    Exit;
  if Assigned(FArchive) then begin
    FArchive.Free;
    FArchive := nil;
  end;
  if (aFileName <> '') then begin
    if (aFileName <> '') and FileExists(aFilename) then
      FArchive := TAbCabArchive.Create(aFileName, fmOpenRead)
    else
      FArchive := TAbCabArchive.Create(aFileName, fmOpenWrite);
    InitArchive;
    FArchive.Load;
  end;
  DoChange;
end;
{ -------------------------------------------------------------------------- }

end.