576 lines
20 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: AbZipper.pas *}
{*********************************************************}
{* ABBREVIA: Non-visual Component with Zip support *}
{*********************************************************}
unit AbZipper;
{$I AbDefine.inc}
interface
uses
Classes,
AbBrowse, AbZBrows, AbArcTyp, AbZipTyp;
type
TAbCustomZipper = class(TAbCustomZipBrowser)
protected {private}
FAutoSave : Boolean;
FCompressionMethodToUse : TAbZipSupportedMethod;
FDeflationOption : TAbZipDeflationOption;
FDOSMode : Boolean;
FOnConfirmSave : TAbArchiveConfirmEvent;
FOnSave : TAbArchiveEvent;
FOnArchiveSaveProgress : TAbArchiveProgressEvent;
FArchiveSaveProgressMeter : IAbProgressMeter;
FStoreOptions : TAbStoreOptions;
protected {methods}
procedure DoConfirmSave(Sender : TObject; var Confirm : Boolean);
virtual;
procedure DoSave(Sender : TObject);
virtual;
procedure DoArchiveSaveProgress(Sender : TObject; Progress : Byte;
var Abort : Boolean);
procedure InitArchive;
override;
procedure SetAutoSave(Value : Boolean);
procedure SetCompressionMethodToUse(Value : TAbZipSupportedMethod);
procedure SetDeflationOption(Value : TAbZipDeflationOption);
procedure SetDOSMode( Value : Boolean );
procedure SetFileName(const aFileName : string);
override;
procedure SetStoreOptions( Value : TAbStoreOptions );
procedure SetArchiveSaveProgressMeter(const Value: IAbProgressMeter);
procedure SetZipfileComment(const Value : AnsiString);
override;
procedure ZipProc(Sender : TObject; Item : TAbArchiveItem;
OutStream : TStream);
procedure ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem;
OutStream, InStream : TStream );
procedure Notification(Component: TComponent;
Operation: TOperation); override;
procedure ResetMeters; override;
protected {properties}
property AutoSave : Boolean
read FAutoSave
write SetAutoSave;
property CompressionMethodToUse : TAbZipSupportedMethod
read FCompressionMethodToUse
write SetCompressionMethodToUse
default AbDefCompressionMethodToUse;
property DeflationOption : TAbZipDeflationOption
read FDeflationOption
write SetDeflationOption
default AbDefDeflationOption;
property DOSMode : Boolean
read FDOSMode
write SetDOSMode;
property StoreOptions : TAbStoreOptions
read FStoreOptions
write SetStoreOptions
default AbDefStoreOptions;
property ArchiveSaveProgressMeter : IAbProgressMeter
read FArchiveSaveProgressMeter
write SetArchiveSaveProgressMeter;
protected {events}
property OnConfirmSave : TAbArchiveConfirmEvent
read FOnConfirmSave
write FOnConfirmSave;
property OnSave : TAbArchiveEvent
read FOnSave
write FOnSave;
property OnArchiveSaveProgress : TAbArchiveProgressEvent
read FOnArchiveSaveProgress
write FOnArchiveSaveProgress;
public {methods}
constructor Create(AOwner : TComponent);
override;
destructor Destroy;
override;
procedure AddFiles(const FileMask : string; SearchAttr : Integer);
procedure AddFilesEx(const FileMask, ExclusionMask : string; SearchAttr : Integer);
procedure AddFromStream(const NewName : string; FromStream : TStream);
procedure DeleteAt(Index : Integer);
procedure DeleteFiles(const FileMask : string);
procedure DeleteFilesEx(const FileMask, ExclusionMask : string);
procedure DeleteTaggedItems;
procedure FreshenFiles(const FileMask : string);
procedure FreshenFilesEx(const FileMask, ExclusionMask : string);
procedure FreshenTaggedItems;
procedure Move(aItem : TAbArchiveItem; const NewStoredPath : string);
procedure Save;
procedure Replace(aItem : TAbArchiveItem);
end;
type
TAbZipper = class(TAbCustomZipper)
published
property ArchiveProgressMeter;
property ArchiveSaveProgressMeter;
property ItemProgressMeter;
property AutoSave;
property BaseDirectory;
property CompressionMethodToUse;
property DeflationOption;
property DOSMode;
property SpanningThreshold;
property LogFile;
property Logging;
property OnArchiveProgress;
property OnArchiveSaveProgress;
property OnArchiveItemProgress;
property OnChange;
property OnConfirmProcessItem;
property OnConfirmSave;
property OnLoad;
property OnProcessItemFailure;
property OnRequestBlankDisk;
property OnRequestImage;
property OnRequestLastDisk;
property OnRequestNthDisk;
property OnSave;
property Password;
property StoreOptions;
property TempDirectory;
property Version;
property FileName; {must be after OnLoad}
end;
implementation
uses
SysUtils, AbUtils, AbTarTyp, AbGzTyp, AbBzip2Typ, AbExcept, AbZipPrc;
{ -------------------------------------------------------------------------- }
constructor TAbCustomZipper.Create( AOwner : TComponent );
begin
inherited Create( AOwner );
CompressionMethodToUse := AbDefCompressionMethodToUse;
DeflationOption := AbDefDeflationOption;
StoreOptions := AbDefStoreOptions;
end;
{ -------------------------------------------------------------------------- }
destructor TAbCustomZipper.Destroy;
begin
inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.AddFiles(const FileMask : string; SearchAttr : Integer);
{Add files to the archive where the disk filespec matches}
begin
if (FArchive <> nil) then
FArchive.AddFiles(FileMask, SearchAttr)
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.AddFilesEx(const FileMask, ExclusionMask : string;
SearchAttr : Integer);
{Add files that match Filemask except those matching ExclusionMask}
begin
if (FArchive <> nil) then
FArchive.AddFilesEx(FileMask, ExclusionMask, SearchAttr)
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.AddFromStream(const NewName : string;
FromStream : TStream);
{Add stream directly to archive}
begin
if (FArchive <> nil) then begin
FromStream.Position := 0;
FArchive.AddFromStream(NewName, FromStream);
end else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteFiles(const FileMask : string);
{delete all files from the archive that match the file mask}
begin
if (FArchive <> nil) then
FArchive.DeleteFiles( FileMask )
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteAt(Index : Integer);
{delete item at Index}
begin
if (FArchive <> nil) then
FArchive.DeleteAt( Index )
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteFilesEx(const FileMask, ExclusionMask : string);
{Delete files that match Filemask except those matching ExclusionMask}
begin
if (FArchive <> nil) then
FArchive.DeleteFilesEx(FileMask, ExclusionMask)
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DeleteTaggedItems;
{delete all tagged items from the archive}
begin
if (FArchive <> nil) then
FArchive.DeleteTaggedItems
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DoConfirmSave(Sender : TObject; var Confirm : Boolean);
begin
Confirm := True;
if Assigned(FOnConfirmSave) then
FOnConfirmSave(Self, Confirm);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DoSave(Sender : TObject);
begin
if Assigned(FOnSave) then
FOnSave(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.FreshenFiles(const FileMask : string);
{freshen all items that match the file mask}
begin
if (FArchive <> nil) then
FArchive.FreshenFiles( FileMask )
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.FreshenFilesEx(const FileMask, ExclusionMask : string);
{freshen all items matching FileMask except those matching ExclusionMask}
begin
if (FArchive <> nil) then
FArchive.FreshenFilesEx( FileMask, ExclusionMask )
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.FreshenTaggedItems;
{freshen all tagged items}
begin
if (FArchive <> nil) then
FArchive.FreshenTaggedItems
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.InitArchive;
begin
inherited InitArchive;
if FArchive <> nil then begin
{properties}
FArchive.AutoSave := FAutoSave;
FArchive.DOSMode := FDOSMode;
FArchive.StoreOptions := FStoreOptions;
{events}
FArchive.OnArchiveSaveProgress := DoArchiveSaveProgress;
FArchive.OnConfirmSave := DoConfirmSave;
FArchive.OnSave := DoSave;
end;
if (FArchive is TAbZipArchive) then begin
{properties}
TAbZipArchive(FArchive).CompressionMethodToUse := FCompressionMethodToUse;
TAbZipArchive(FArchive).DeflationOption := FDeflationOption;
{events}
TAbZipArchive(FArchive).OnRequestBlankDisk := OnRequestBlankDisk;
TAbZipArchive(FArchive).InsertHelper := ZipProc;
TAbZipArchive(FArchive).InsertFromStreamHelper := ZipFromStreamProc;
end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.Move(aItem : TAbArchiveItem; const NewStoredPath : string);
{renames the item}
begin
if (FArchive <> nil) then
FArchive.Move(aItem, NewStoredPath)
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.Replace(aItem : TAbArchiveItem);
{replace the item}
begin
if (FArchive <> nil) then
FArchive.Replace( aItem )
else
raise EAbNoArchive.Create;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.Save;
begin
if (FArchive <> nil) then begin
FArchive.Save;
DoChange;
end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetAutoSave(Value : Boolean);
begin
FAutoSave := Value;
if (FArchive <> nil) then
FArchive.AutoSave := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetCompressionMethodToUse(
Value : TAbZipSupportedMethod);
begin
FCompressionMethodToUse := Value;
if (FArchive is TAbZipArchive) then
TAbZipArchive(FArchive).CompressionMethodToUse := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetDeflationOption(Value : TAbZipDeflationOption);
begin
FDeflationOption := Value;
if (FArchive is TAbZipArchive) then
TAbZipArchive(FArchive).DeflationOption := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetDOSMode(Value : Boolean);
begin
FDOSMode := Value;
if (FArchive <> nil) then
FArchive.DOSMode := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetFileName(const aFileName : string);
var
ArcType : TAbArchiveType;
begin
FFileName := aFileName;
if (csDesigning in ComponentState) then
Exit;
if Assigned(FArchive) then
begin
FArchive.Save;
FreeAndNil(FArchive);
end;
ArcType := ArchiveType;
if (FileName <> '') then
if FileExists(FileName) then begin { open it }
if not ForceType then
ArcType := AbDetermineArcType(FileName, atUnknown);
case ArcType of
atZip, atSpannedZip, atSelfExtZip : begin
FArchive := TAbZipArchive.Create(FileName, fmOpenRead or fmShareDenyNone);
InitArchive;
end;
atTar : begin
FArchive := TAbTarArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);
inherited InitArchive;
end;
atGZip : begin
FArchive := TAbGzipArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);
TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbGzipArchive(FArchive).IsGzippedTar := False;
inherited InitArchive;
end;
atGZippedTar : begin
FArchive := TAbGzipArchive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);
TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbGzipArchive(FArchive).IsGzippedTar := True;
inherited InitArchive;
end;
atBzip2 : begin
FArchive := TAbBzip2Archive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);
TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbBzip2Archive(FArchive).IsBzippedTar := False;
inherited InitArchive;
end;
atBzippedTar : begin
FArchive := TAbBzip2Archive.Create(FileName, fmOpenReadWrite or fmShareDenyNone);
TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbBzip2Archive(FArchive).IsBzippedTar := True;
inherited InitArchive;
end;
else
raise EAbUnhandledType.Create;
end {case};
FArchive.Load;
FArchiveType := ArcType;
end else begin { file doesn't exist, so create a new one }
if not ForceType then
ArcType := AbDetermineArcType(FileName, atUnknown);
case ArcType of
atZip : begin
FArchive := TAbZipArchive.Create(FileName, fmCreate);
InitArchive;
end;
atTar : begin
FArchive := TAbTarArchive.Create(FileName, fmCreate or fmShareDenyNone);
inherited InitArchive;
end;
atGZip : begin
FArchive := TAbGzipArchive.Create(FileName, fmCreate or fmShareDenyNone);
TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbGzipArchive(FArchive).IsGzippedTar := False;
inherited InitArchive;
end;
atGZippedTar : begin
FArchive := TAbGzipArchive.Create(FileName, fmCreate or fmShareDenyNone);
TAbGzipArchive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbGzipArchive(FArchive).IsGzippedTar := True;
inherited InitArchive;
end;
atBzip2 : begin
FArchive := TAbBzip2Archive.Create(FileName, fmCreate or fmShareDenyNone);
TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbBzip2Archive(FArchive).IsBzippedTar := False;
inherited InitArchive;
end;
atBzippedTar : begin
FArchive := TAbBzip2Archive.Create(FileName, fmCreate or fmShareDenyNone);
TAbBzip2Archive(FArchive).TarAutoHandle := FTarAutoHandle;
TAbBzip2Archive(FArchive).IsBzippedTar := True;
inherited InitArchive;
end;
else
raise EAbUnhandledType.Create;
end {case};
FArchiveType := ArcType;
end;
DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetStoreOptions(Value : TAbStoreOptions);
begin
FStoreOptions := Value;
if (FArchive <> nil) then
FArchive.StoreOptions := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetArchiveSaveProgressMeter(const Value: IAbProgressMeter);
begin
ReferenceInterface(FArchiveSaveProgressMeter, opRemove);
FArchiveSaveProgressMeter := Value;
ReferenceInterface(FArchiveSaveProgressMeter, opInsert);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.SetZipfileComment(const Value : AnsiString);
begin
if (FArchive is TAbZipArchive) then
TAbZipArchive(FArchive).ZipfileComment := Value
else
raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.ZipProc(Sender : TObject; Item : TAbArchiveItem;
OutStream : TStream);
begin
AbZip(TAbZipArchive(Sender), TAbZipItem(Item), OutStream);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.ZipFromStreamProc(Sender : TObject; Item : TAbArchiveItem;
OutStream, InStream : TStream);
begin
if Assigned(InStream) then
AbZipFromStream(TAbZipArchive(Sender), TAbZipItem(Item),
OutStream, InStream)
else
raise EAbZipNoInsertion.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.DoArchiveSaveProgress(Sender : TObject;
Progress : Byte;
var Abort : Boolean);
begin
Abort := False;
if Assigned(FArchiveSaveProgressMeter) then
FArchiveSaveProgressMeter.DoProgress(Progress);
if Assigned(FOnArchiveSaveProgress) then
FOnArchiveSaveProgress(Self, Progress, Abort);
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.Notification(Component: TComponent;
Operation: TOperation);
begin
inherited Notification(Component, Operation);
if (Operation = opRemove) then
if Assigned(ArchiveSaveProgressMeter) and Component.IsImplementorOf(ArchiveSaveProgressMeter) then
ArchiveSaveProgressMeter := nil
end;
{ -------------------------------------------------------------------------- }
procedure TAbCustomZipper.ResetMeters;
begin
inherited ResetMeters;
if Assigned(FArchiveSaveProgressMeter) then
FArchiveSaveProgressMeter.Reset;
end;
{ -------------------------------------------------------------------------- }
end.