283 lines
9.4 KiB
ObjectPascal
283 lines
9.4 KiB
ObjectPascal
(* ***** 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: ABUnzper.pas *}
|
|
{*********************************************************}
|
|
{* ABBREVIA: Non-visual Component with UnZip support *}
|
|
{*********************************************************}
|
|
|
|
unit AbUnzper;
|
|
|
|
{$I AbDefine.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
AbZBrows, AbArcTyp, AbZipTyp;
|
|
|
|
type
|
|
TAbCustomUnZipper = class(TAbCustomZipBrowser)
|
|
protected {private}
|
|
FExtractOptions : TAbExtractOptions;
|
|
FOnConfirmOverwrite : TAbConfirmOverwriteEvent;
|
|
FOnNeedPassword : TAbNeedPasswordEvent;
|
|
FPasswordRetries : Byte;
|
|
|
|
protected {methods}
|
|
procedure DoConfirmOverwrite(var Name : string;
|
|
var Confirm : Boolean);
|
|
virtual;
|
|
procedure DoNeedPassword(Sender : TObject;
|
|
var NewPassword : AnsiString);
|
|
virtual;
|
|
procedure InitArchive; override;
|
|
procedure SetExtractOptions(Value : TAbExtractOptions);
|
|
procedure SetPasswordRetries(Value : Byte);
|
|
procedure UnzipProc(Sender : TObject; Item : TAbArchiveItem;
|
|
const NewName : string );
|
|
procedure UnzipToStreamProc(Sender : TObject; Item : TAbArchiveItem;
|
|
OutStream : TStream);
|
|
procedure TestItemProc(Sender : TObject; Item : TAbArchiveItem);
|
|
|
|
procedure SetFileName(const aFileName : string);
|
|
override;
|
|
|
|
protected {properties}
|
|
property ExtractOptions : TAbExtractOptions
|
|
read FExtractOptions
|
|
write SetExtractOptions
|
|
default AbDefExtractOptions;
|
|
property OnConfirmOverwrite : TAbConfirmOverwriteEvent
|
|
read FOnConfirmOverwrite
|
|
write FOnConfirmOverwrite;
|
|
property OnNeedPassword : TAbNeedPasswordEvent
|
|
read FOnNeedPassword
|
|
write FOnNeedPassword;
|
|
property PasswordRetries : Byte
|
|
read FPasswordRetries
|
|
write SetPasswordRetries
|
|
default AbDefPasswordRetries;
|
|
|
|
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 ExtractToStream(const aFileName : string; ToStream : TStream);
|
|
procedure ExtractTaggedItems;
|
|
procedure TestTaggedItems;
|
|
end;
|
|
|
|
TAbUnZipper = class(TAbCustomUnZipper)
|
|
published
|
|
property ArchiveProgressMeter;
|
|
property ItemProgressMeter;
|
|
property BaseDirectory;
|
|
property ExtractOptions;
|
|
property LogFile;
|
|
property Logging;
|
|
property OnArchiveProgress;
|
|
property OnArchiveItemProgress;
|
|
property OnChange;
|
|
property OnConfirmOverwrite;
|
|
property OnConfirmProcessItem;
|
|
property OnLoad;
|
|
property OnNeedPassword;
|
|
property OnRequestImage;
|
|
property OnProcessItemFailure;
|
|
property OnRequestLastDisk;
|
|
property OnRequestNthDisk;
|
|
property Password;
|
|
property PasswordRetries;
|
|
property TempDirectory;
|
|
property Version;
|
|
property FileName; {must be after OnLoad}
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
AbUtils,
|
|
AbExcept,
|
|
AbUnzPrc;
|
|
|
|
{ -------------------------------------------------------------------------- }
|
|
constructor TAbCustomUnZipper.Create( AOwner : TComponent );
|
|
begin
|
|
inherited Create(AOwner);
|
|
ExtractOptions := AbDefExtractOptions;
|
|
PasswordRetries := AbDefPasswordRetries;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
destructor TAbCustomUnZipper.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.DoConfirmOverwrite(var Name : string;
|
|
var Confirm : Boolean);
|
|
begin
|
|
Confirm := True;
|
|
if Assigned(FOnConfirmOverwrite) then
|
|
FOnConfirmOverwrite( Name, Confirm );
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.DoNeedPassword(Sender : TObject;
|
|
var NewPassword : AnsiString);
|
|
begin
|
|
if Assigned(FOnNeedPassword) then begin
|
|
FOnNeedPassword(Self, NewPassword);
|
|
Password := NewPassword;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.ExtractAt(Index : Integer; const NewName : string);
|
|
{extract a file from the archive that match the index}
|
|
begin
|
|
if (FArchive <> nil) then
|
|
FArchive.ExtractAt(Index, NewName)
|
|
else
|
|
raise EAbNoArchive.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.ExtractFiles(const FileMask : string);
|
|
{extract all files from the archive that match the mask}
|
|
begin
|
|
if (FArchive <> nil) then
|
|
FArchive.ExtractFiles( FileMask )
|
|
else
|
|
raise EAbNoArchive.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.ExtractFilesEx(const FileMask, ExclusionMask : string);
|
|
{extract files matching FileMask except those matching ExclusionMask}
|
|
begin
|
|
if (FArchive <> nil) then
|
|
FArchive.ExtractFilesEx(FileMask, ExclusionMask)
|
|
else
|
|
raise EAbNoArchive.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.ExtractToStream(const aFileName : string;
|
|
ToStream : TStream);
|
|
begin
|
|
if (FArchive <> nil) then
|
|
FArchive.ExtractToStream(aFileName, ToStream)
|
|
else
|
|
raise EAbNoArchive.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.ExtractTaggedItems;
|
|
{extract all tagged items from the archive}
|
|
begin
|
|
if (FArchive <> nil) then
|
|
FArchive.ExtractTaggedItems
|
|
else
|
|
raise EAbNoArchive.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.InitArchive;
|
|
begin
|
|
inherited InitArchive;
|
|
if FArchive <> nil then begin
|
|
FArchive.ExtractOptions := FExtractOptions;
|
|
FArchive.OnConfirmOverwrite := DoConfirmOverwrite;
|
|
end;
|
|
if FArchive is TAbZipArchive then begin
|
|
TAbZipArchive(FArchive).PasswordRetries := FPasswordRetries;
|
|
TAbZipArchive(FArchive).OnNeedPassword := DoNeedPassword;
|
|
TAbZipArchive(FArchive).TestHelper := TestItemProc;
|
|
TAbZipArchive(FArchive).ExtractHelper := UnzipProc;
|
|
TAbZipArchive(FArchive).ExtractToStreamHelper := UnzipToStreamProc;
|
|
end;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.SetExtractOptions(Value : TAbExtractOptions);
|
|
begin
|
|
FExtractOptions := Value;
|
|
if (FArchive <> nil) then
|
|
FArchive.ExtractOptions := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.SetPasswordRetries(Value : Byte);
|
|
begin
|
|
FPasswordRetries := Value;
|
|
if FArchive is TAbZipArchive then
|
|
TAbZipArchive(FArchive).PasswordRetries := Value;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.TestTaggedItems;
|
|
{Test specified items}
|
|
begin
|
|
if (FArchive <> nil) then
|
|
FArchive.TestTaggedItems
|
|
else
|
|
raise EAbNoArchive.Create;
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.UnzipProc(Sender : TObject;
|
|
Item : TAbArchiveItem;
|
|
const NewName : string);
|
|
begin
|
|
AbUnzip( TAbZipArchive(Sender), TAbZipItem(Item), NewName);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.UnzipToStreamProc(Sender : TObject;
|
|
Item : TAbArchiveItem;
|
|
OutStream : TStream);
|
|
begin
|
|
AbUnzipToStream(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
procedure TAbCustomUnZipper.TestItemProc(Sender : TObject;
|
|
Item : TAbArchiveItem);
|
|
begin
|
|
AbTestZipItem(TAbZipArchive(Sender), TAbZipItem(Item));
|
|
end;
|
|
{ -------------------------------------------------------------------------- }
|
|
|
|
procedure TAbCustomUnZipper.SetFileName(const aFileName: string);
|
|
begin
|
|
if aFileName <> '' then
|
|
begin
|
|
if not FileExists(aFileName) then
|
|
raise EAbFileNotFound.Create;
|
|
if AbFileGetSize(aFileName) <= 0 then
|
|
raise EAbBadStream.Create;
|
|
end;
|
|
|
|
inherited SetFileName(aFileName);
|
|
end;
|
|
|
|
end.
|
|
|