772 lines
29 KiB
ObjectPascal
772 lines
29 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 ***** *)
|
|
|
|
unit _ZipKit;
|
|
|
|
interface
|
|
|
|
uses
|
|
ComObj, Classes, Windows, Abbrevia_TLB, ActiveX, axctrls, AbZipKit, AbArcTyp,
|
|
AbUtils, _ZipItem, _GZipItem, _TarItem, AbZipTyp, AbTarTyp, AbGzTyp,
|
|
AbConst, AbBrowse;
|
|
|
|
type
|
|
{$IFNDEF VER130}{$WARN SYMBOL_PLATFORM OFF}{$ENDIF}
|
|
TZipKit = class(TAutoObject, IConnectionPointContainer, IEnumVariant, IZipKit)
|
|
private
|
|
{private declarations}
|
|
FConnectionPoints : TConnectionPoints;
|
|
FEvents : IZipKitEvents;
|
|
FOwner : TAbZipKit;
|
|
FEnumPos : Integer;
|
|
|
|
{Events for FOwner}
|
|
procedure _OnArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem; Progress : Byte; var Abort : Boolean);
|
|
procedure _OnArchiveProgress(Sender : TObject; Progress : Byte; var Abort : Boolean);
|
|
procedure _OnChange(Sender : TObject);
|
|
procedure _OnConfirmOverwrite(var Name : string; var confirm : Boolean);
|
|
procedure _OnConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem; ProcessType : TAbProcessType; var Confirm : Boolean);
|
|
procedure _OnConfirmSave(Sender : TObject; var Confirm : Boolean);
|
|
procedure _OnLoad(Sender : TObject);
|
|
procedure _OnNeedPassword(Sender : TObject; var NewPassword : AnsiString);
|
|
procedure _OnProcessItemFailure(Sender : TObject; Item : TAbArchiveItem; ProcessType : TAbProcessType; ErrorClass : TAbErrorClass; ErrorCode : Integer);
|
|
procedure _OnRequestBlankDisk(Sender : TObject; var Abort : Boolean);
|
|
procedure _OnRequestImage(Sender : TObject; ImageNumber : Integer; var ImageName : string; var Abort : Boolean);
|
|
procedure _OnRequestLastDisk(Sender : TObject; var Abort : Boolean);
|
|
procedure _OnRequestNthDisk(Sender : TObject; DiskNumber : Byte; var Abort : Boolean);
|
|
procedure _OnSave(Sender : TObject);
|
|
|
|
public
|
|
procedure Initialize; override;
|
|
destructor Destroy; override;
|
|
|
|
protected
|
|
|
|
{IConnectionPointContainer}
|
|
property ConnectionPoints: TConnectionPoints read FConnectionPoints
|
|
implements IConnectionPointContainer;
|
|
procedure EventSinkChanged(const EventSink: IUnknown); override;
|
|
|
|
|
|
{IEnumVariant}
|
|
function Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall;
|
|
function Skip(celt: LongWord): HResult; stdcall;
|
|
function Reset: HResult; stdcall;
|
|
function Clone(out Enum: IEnumVariant): HResult; stdcall;
|
|
|
|
|
|
{IZipKit}
|
|
procedure Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer); safecall;
|
|
procedure AddFromStream(const FileName: WideString; Stream: OleVariant); safecall;
|
|
function Get_AutoSave: WordBool; safecall;
|
|
procedure Set_AutoSave(Value: WordBool); safecall;
|
|
function Get_BaseDirectory: WideString; safecall;
|
|
procedure Set_BaseDirectory(const Value: WideString); safecall;
|
|
procedure ClearTags; safecall;
|
|
function Get_CompressionMethodToUse: TZipSupportMethod; safecall;
|
|
procedure Set_CompressionMethodToUse(Value: TZipSupportMethod); safecall;
|
|
function Get_Count: Integer; safecall;
|
|
function Get_DeflateOption: TZipDeflateOption; safecall;
|
|
procedure Set_DeflateOption(Value: TZipDeflateOption); safecall;
|
|
procedure Delete(const FileMask: WideString; const ExclusionMask: WideString); safecall;
|
|
procedure DeleteAt(Index: Integer); safecall;
|
|
procedure DeleteTaggedItems; safecall;
|
|
function Get_DOSMode: WordBool; safecall;
|
|
procedure Set_DOSMode(Value: WordBool); safecall;
|
|
procedure Extract(const FileMask: WideString; const ExclusionMask: WideString); safecall;
|
|
procedure ExtractAt(Index: Integer; const NewName: WideString); safecall;
|
|
function Get_ExtractOptions: TZipExtractOptions; safecall;
|
|
procedure Set_ExtractOptions(Value: TZipExtractOptions); safecall;
|
|
procedure ExtractTaggedItems; safecall;
|
|
function Get_FileName: WideString; safecall;
|
|
procedure Set_FileName(const Value: WideString); safecall;
|
|
function Find(const FileName: WideString): Integer; safecall;
|
|
procedure Freshen(const FileMask: WideString; const ExclusionMask: WideString); safecall;
|
|
procedure FreshenTaggedItems; safecall;
|
|
function Get_Item(Index: Integer): IDispatch; safecall;
|
|
function Get_LogFile: WideString; safecall;
|
|
procedure Set_LogFile(const Value: WideString); safecall;
|
|
function Get_Logging: WordBool; safecall;
|
|
procedure Set_Logging(Value: WordBool); safecall;
|
|
function Get_Password: WideString; safecall;
|
|
procedure Set_Password(const Value: WideString); safecall;
|
|
function Get_PasswordRetries: Byte; safecall;
|
|
procedure Set_PasswordRetries(Value: Byte); safecall;
|
|
procedure Replace(const FileMask: WideString); safecall;
|
|
procedure Save; safecall;
|
|
function Get_Spanned: WordBool; safecall;
|
|
function Get_SpanningThreshold: Integer; safecall;
|
|
procedure Set_SpanningThreshold(Value: Integer); safecall;
|
|
function Get_Status: TArchiveStatus; safecall;
|
|
function Get_StoreOptions: TStoreOptions; safecall;
|
|
procedure Set_StoreOptions(Value: TStoreOptions); safecall;
|
|
procedure TagItems(const FileMask: WideString); safecall;
|
|
function Get_TempDirectory: WideString; safecall;
|
|
procedure Set_TempDirectory(const Value: WideString); safecall;
|
|
procedure TestTaggedItems; safecall;
|
|
procedure UntagItems(const FileMask: WideString); safecall;
|
|
function Get_ZipFileComment: WideString; safecall;
|
|
procedure Set_ZipFileComment(const Value: WideString); safecall;
|
|
function License(const Key: WideString): WordBool; safecall;
|
|
function Get__NewEnum: IUnknown; safecall;
|
|
function ExtractToStream(const FileName: WideString): OleVariant; safecall;
|
|
function Get_CompressionType: TArchiveType; safecall;
|
|
procedure Set_CompressionType(Value: TArchiveType); safecall;
|
|
|
|
function Get_TarAutoHandle: WordBool; safecall;
|
|
procedure Set_TarAutoHandle(Value: WordBool); safecall;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
uses
|
|
ComServ;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{IConnectionPointContainer}
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.EventSinkChanged(const EventSink: IUnknown);
|
|
begin
|
|
FEvents := EventSink as IZipKitEvents;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
{IEnumVariant}
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Next(celt: LongWord; var rgvar : OleVariant; out pceltFetched: LongWord): HResult; stdcall;
|
|
var
|
|
V : OleVariant;
|
|
I : Integer;
|
|
begin
|
|
Result := S_FALSE;
|
|
try
|
|
if @pceltFetched <> nil then
|
|
pceltFetched := 0;
|
|
for I := 0 to celt - 1 do begin
|
|
if FEnumPos >= FOwner.Count then begin
|
|
FEnumPos := 0;
|
|
Exit;
|
|
end;
|
|
V := Get_Item(FEnumPos);
|
|
PVariantArgList(@rgvar)[I] := TVariantArg(V);
|
|
|
|
{ Prevent COM garbage collection }
|
|
TVarData(V).VType := varEmpty;
|
|
TVarData(V).VInteger := 0;
|
|
|
|
Inc(FEnumPos);
|
|
if @pceltFetched <> nil then
|
|
Inc(pceltFetched);
|
|
end;
|
|
except
|
|
end;
|
|
if (@pceltFetched = nil) or (pceltFetched = celt) then
|
|
Result := S_OK;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Skip(celt: LongWord): HResult;
|
|
begin
|
|
Inc(FEnumPos, celt);
|
|
Result := S_OK;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Reset: HResult;
|
|
begin
|
|
FEnumPos := 0;
|
|
Result := S_OK;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Clone(out Enum: IEnumVariant): HResult;
|
|
begin
|
|
Enum := nil;
|
|
Result := S_OK;
|
|
try
|
|
Enum := Self.Create;
|
|
TZipKit(Enum).FOwner := FOwner;
|
|
except
|
|
Result := E_OUTOFMEMORY;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
{IZipKit}
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Add(const FileMask: WideString; const ExclusionMask: WideString; SearchAttr: Integer);
|
|
begin
|
|
FOwner.AddFilesEx(FileMask, ExclusionMask, SearchAttr);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.AddFromStream(const FileName: WideString; Stream: OleVariant);
|
|
var
|
|
InStream : TMemoryStream;
|
|
Info : array of Byte;
|
|
begin
|
|
Info := nil;
|
|
InStream := TMemoryStream.Create;
|
|
try
|
|
Info := Stream;
|
|
InStream.Write(Info[0], Length(Info));
|
|
InStream.Position := 0;
|
|
FOwner.AddFromStream(FileName, InStream);
|
|
finally
|
|
InStream.Free;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_AutoSave: WordBool;
|
|
begin
|
|
Result := FOwner.AutoSave;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_AutoSave(Value: WordBool);
|
|
begin
|
|
FOwner.AutoSave := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_BaseDirectory: WideString;
|
|
begin
|
|
Result := FOwner.BaseDirectory;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_BaseDirectory(const Value: WideString);
|
|
begin
|
|
FOwner.BaseDirectory := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.ClearTags;
|
|
begin
|
|
FOwner.ClearTags;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_CompressionMethodToUse: TZipSupportMethod;
|
|
begin
|
|
Result := TZipCompressionMethod(FOwner.CompressionMethodToUse);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_CompressionMethodToUse(Value: TZipSupportMethod);
|
|
begin
|
|
FOwner.CompressionMethodToUse := TAbZipSupportedMethod(Value);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_Count: Integer;
|
|
begin
|
|
Result := FOwner.Count;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_DeflateOption: TZipDeflateOption;
|
|
begin
|
|
Result := TZipDeflateOption(FOwner.DeflationOption);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_DeflateOption(Value: TZipDeflateOption);
|
|
begin
|
|
FOwner.DeflationOption := TAbZipDeflationOption(Value);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Delete(const FileMask: WideString; const ExclusionMask: WideString);
|
|
begin
|
|
FOwner.DeleteFilesEx(FileMask, ExclusionMask);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.DeleteAt(Index: Integer);
|
|
begin
|
|
FOwner.DeleteAt(Index);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.DeleteTaggedItems;
|
|
begin
|
|
FOwner.DeleteTaggedItems;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_DOSMode: WordBool;
|
|
begin
|
|
Result := FOwner.DOSMode;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_DOSMode(Value: WordBool);
|
|
begin
|
|
FOwner.DOSMode := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Extract(const FileMask: WideString; const ExclusionMask: WideString);
|
|
begin
|
|
FOwner.ExtractFilesEx(FileMask, ExclusionMask);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.ExtractAt(Index: Integer; const NewName: WideString);
|
|
begin
|
|
FOwner.ExtractAt(Index, NewName);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_ExtractOptions: TZipExtractOptions;
|
|
begin
|
|
Result := 0;
|
|
if TAbExtractOption(eoCreateDirs) in FOwner.ExtractOptions then
|
|
Result := Result + TZipExtractOptions(eoCreateDirs);
|
|
if TAbExtractOption(eoRestorePath) in FOwner.ExtractOptions then
|
|
Result := Result + TZipExtractOptions(eoRestorePath);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_ExtractOptions(Value: TZipExtractOptions);
|
|
var
|
|
TempOptions : TAbExtractOptions;
|
|
begin
|
|
TempOptions := [];
|
|
if (Value or Abbrevia_TLB.eoCreateDirs) = Value then
|
|
Include(TempOptions, AbArcTyp.eoCreateDirs);
|
|
if (Value or Abbrevia_TLB.eoRestorePath) = Value then
|
|
Include(TempOptions, AbArcTyp.eoRestorePath);
|
|
FOwner.ExtractOptions := TempOptions
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.ExtractTaggedItems;
|
|
begin
|
|
FOwner.ExtractTaggedItems;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_FileName: WideString;
|
|
begin
|
|
Result := FOwner.FileName;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_FileName(const Value: WideString);
|
|
begin
|
|
FOwner.FileName := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Find(const FileName: WideString): Integer;
|
|
begin
|
|
Result := FOwner.FindFile(FileName);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Freshen(const FileMask: WideString; const ExclusionMask: WideString);
|
|
begin
|
|
FOwner.FreshenFilesEx(FileMask, ExclusionMask);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.FreshenTaggedItems;
|
|
begin
|
|
FOwner.FreshenTaggedItems;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_Item(Index: Integer): IDispatch;
|
|
begin
|
|
Result := TZipItem.Create(FOwner.Items[Index], FOwner);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_LogFile: WideString;
|
|
begin
|
|
Result := FOwner.LogFile;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_LogFile(const Value: WideString);
|
|
begin
|
|
FOwner.LogFile := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_Logging: WordBool;
|
|
begin
|
|
Result := FOwner.Logging;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_Logging(Value: WordBool);
|
|
begin
|
|
FOwner.Logging := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_Password: WideString;
|
|
begin
|
|
Result := WideString(FOwner.Password);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_Password(const Value: WideString);
|
|
begin
|
|
FOwner.Password := AnsiString(Value);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_PasswordRetries: Byte;
|
|
begin
|
|
Result := FOwner.PasswordRetries;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_PasswordRetries(Value: Byte);
|
|
begin
|
|
FOwner.PasswordRetries := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Replace(const FileMask: WideString);
|
|
begin
|
|
FOwner.Replace(FOwner.Items[FOwner.FindFile(FileMask)]);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Save;
|
|
begin
|
|
FOwner.Save;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_Spanned: WordBool;
|
|
begin
|
|
Result := FOwner.Spanned;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_SpanningThreshold: Integer;
|
|
begin
|
|
Result := FOwner.SpanningThreshold;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_SpanningThreshold(Value: Integer);
|
|
begin
|
|
FOwner.SpanningThreshold := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_Status: TArchiveStatus;
|
|
begin
|
|
Result := TArchiveStatus(FOwner.Status);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_StoreOptions: TStoreOptions;
|
|
begin
|
|
Result := 0;
|
|
if TAbStoreOption(soStripDrive) in FOwner.StoreOptions then
|
|
Result := Result + TStoreOptions(soStripDrive);
|
|
if TAbStoreOption(soStripPath) in FOwner.StoreOptions then
|
|
Result := Result + TStoreOptions(soStripPath);
|
|
if TAbStoreOption(soRemoveDots) in FOwner.StoreOptions then
|
|
Result := Result + TStoreOptions(soRemoveDots);
|
|
if TAbStoreOption(soRecurse) in FOwner.StoreOptions then
|
|
Result := Result + TStoreOptions(soRecurse);
|
|
if TAbStoreOption(soFreshen) in FOwner.StoreOptions then
|
|
Result := Result + TStoreOptions(soFreshen);
|
|
if TAbStoreOption(soReplace) in FOwner.StoreOptions then
|
|
Result := Result + TStoreOptions(soReplace);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_StoreOptions(Value: TStoreOptions);
|
|
var
|
|
TempOptions : TAbStoreOptions;
|
|
begin
|
|
TempOptions := [];
|
|
if (Value or Abbrevia_TLB.soStripDrive) = Value then
|
|
Include(TempOptions, AbArcTyp.soStripDrive);
|
|
if (Value or Abbrevia_TLB.soStripPath) = Value then
|
|
Include(TempOptions, AbArcTyp.soStripPath);
|
|
if (Value or Abbrevia_TLB.soRemoveDots) = Value then
|
|
Include(TempOptions, AbArcTyp.soRemoveDots);
|
|
if (Value or Abbrevia_TLB.soRecurse) = Value then
|
|
Include(TempOptions, AbArcTyp.soRecurse);
|
|
if (Value or Abbrevia_TLB.soFreshen) = Value then
|
|
Include(TempOptions, AbArcTyp.soFreshen);
|
|
if (Value or Abbrevia_TLB.soReplace) = Value then
|
|
Include(TempOptions, AbArcTyp.soReplace);
|
|
FOwner.StoreOptions := TempOptions
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.TagItems(const FileMask: WideString);
|
|
begin
|
|
FOwner.TagItems(FileMask);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_TempDirectory: WideString;
|
|
begin
|
|
Result := FOwner.TempDirectory;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_TempDirectory(const Value: WideString);
|
|
begin
|
|
FOwner.TempDirectory := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.TestTaggedItems;
|
|
begin
|
|
FOwner.TestTaggedItems;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.UntagItems(const FileMask: WideString);
|
|
begin
|
|
FOwner.UnTagItems(FileMask);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_ZipFileComment: WideString;
|
|
begin
|
|
Result := WideString(FOwner.ZipFileComment);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_ZipFileComment(const Value: WideString);
|
|
begin
|
|
FOwner.ZipfileComment := AnsiString(Value);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.License(const Key: WideString): WordBool;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get__NewEnum: IUnknown;
|
|
begin
|
|
Result := Self;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.ExtractToStream(const FileName: WideString): OleVariant;
|
|
var
|
|
Stream : TMemoryStream;
|
|
Info : array of Byte;
|
|
begin
|
|
Stream := TMemoryStream.Create;
|
|
try
|
|
FOwner.ExtractToStream(FileName, Stream);
|
|
Stream.Position := 0;
|
|
SetLength(Info, Stream.Size);
|
|
Stream.Read(Info[0], Stream.Size);
|
|
Result := Info;
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_CompressionType: TArchiveType;
|
|
begin
|
|
Result := TArchiveType((FOwner as TAbBaseBrowser).ArchiveType);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_CompressionType(Value: TArchiveType);
|
|
begin
|
|
(FOwner as TAbBaseBrowser).ArchiveType := TAbArchiveType(ord(Value));
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
function TZipKit.Get_TarAutoHandle: WordBool;
|
|
begin
|
|
Result := FOwner.TarAutoHandle;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Set_TarAutoHandle(Value: WordBool);
|
|
begin
|
|
FOwner.TarAutoHandle := Value;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
{TZipKit Events}
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnArchiveItemProgress(Sender : TObject; Item : TAbArchiveItem;
|
|
Progress : Byte; var Abort : Boolean);
|
|
var
|
|
FAbort : WordBool;
|
|
begin
|
|
FAbort := Abort;
|
|
if Assigned(FEvents) then begin
|
|
if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then
|
|
FEvents.OnArchiveItemProgress(TZipItem.Create(TAbZipItem(Item), FOwner),
|
|
Progress, FAbort)
|
|
else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then
|
|
FEvents.OnArchiveItemProgress(TTarItem.Create(TAbTarItem(Item), FOwner),
|
|
Progress, FAbort)
|
|
else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then
|
|
FEvents.OnArchiveItemProgress(TGZipItem.Create(TAbGZipItem(Item), FOwner),
|
|
Progress, FAbort);
|
|
end;
|
|
Abort := FAbort;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnArchiveProgress(Sender : TObject; Progress : Byte;
|
|
var Abort : Boolean);
|
|
var
|
|
FAbort : WordBool;
|
|
begin
|
|
FAbort := Abort;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnArchiveProgress(Progress, FAbort);
|
|
Abort := FAbort;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnChange(Sender : TObject);
|
|
begin
|
|
if Assigned(FEvents) then
|
|
FEvents.OnChange;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnConfirmOverwrite(var Name : string; var confirm : Boolean);
|
|
var
|
|
FConfirm : WordBool;
|
|
FName : WideString;
|
|
begin
|
|
FConfirm := Confirm;
|
|
FName := Name;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnConfirmOverwrite(FName, FConfirm);
|
|
Name := FName;
|
|
Confirm := FConfirm;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnConfirmProcessItem(Sender : TObject; Item : TAbArchiveItem;
|
|
ProcessType : TAbProcessType; var Confirm : Boolean);
|
|
var
|
|
FConfirm : WordBool;
|
|
begin
|
|
FConfirm := Confirm;
|
|
if Assigned(FEvents) then begin
|
|
if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then
|
|
FEvents.OnConfirmProcessItem(TZipItem.Create(TAbZipItem(Item), FOwner),
|
|
TProcessType(ProcessType), FConfirm)
|
|
else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then
|
|
FEvents.OnConfirmProcessItem(TTarItem.Create(TAbTarItem(Item), FOwner),
|
|
TProcessType(ProcessType), FConfirm)
|
|
else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then
|
|
FEvents.OnConfirmProcessItem(TGZipItem.Create(TAbGZipItem(Item), FOwner),
|
|
TProcessType(ProcessType), FConfirm);
|
|
end;
|
|
Confirm := FConfirm
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnConfirmSave(Sender : TObject; var Confirm : Boolean);
|
|
var
|
|
FConfirm : WordBool;
|
|
begin
|
|
FConfirm := Confirm;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnConfirmSave(FConfirm);
|
|
Confirm := FConfirm;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnLoad(Sender : TObject);
|
|
begin
|
|
if Assigned(FEvents) then
|
|
FEvents.OnLoad;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnNeedPassword(Sender : TObject; var NewPassword : AnsiString);
|
|
var
|
|
FNewPassword : WideString;
|
|
begin
|
|
FNewPassword := WideString(NewPassword);
|
|
if Assigned(FEvents) then
|
|
FEvents.OnNeedPassword(FNewPassword);
|
|
NewPassword := AnsiString(FNewPassword);
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnProcessItemFailure(Sender : TObject; Item : TAbArchiveItem;
|
|
ProcessType : TAbProcessType; ErrorClass : TAbErrorClass;
|
|
ErrorCode : Integer);
|
|
begin
|
|
if Assigned(FEvents) then begin
|
|
if ((FOwner as TAbBaseBrowser).ArchiveType = atZip) then
|
|
FEvents.OnProcessItemFailure(TZipItem.Create(TAbZipItem(Item), FOwner),
|
|
TProcessType(ProcessType), TErrorClass(ErrorClass),
|
|
TErrorCode(ErrorCode), AbStrRes(ErrorCode))
|
|
else if ((FOwner as TAbBaseBrowser).ArchiveType = atTar) then
|
|
FEvents.OnProcessItemFailure(TTarItem.Create(TAbTarItem(Item), FOwner),
|
|
TProcessType(ProcessType), TErrorClass(ErrorClass),
|
|
TErrorCode(ErrorCode),AbStrRes(ErrorCode))
|
|
else if ((FOwner as TAbBaseBrowser).ArchiveType = atGZip) then
|
|
FEvents.OnProcessItemFailure(TGZipItem.Create(TAbGZipItem(Item), FOwner),
|
|
TProcessType(ProcessType), TErrorClass(ErrorClass),
|
|
TErrorCode(ErrorCode),AbStrRes(ErrorCode));
|
|
end;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnRequestBlankDisk(Sender : TObject; var Abort : Boolean);
|
|
var
|
|
FAbort : WordBool;
|
|
begin
|
|
FAbort := Abort;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnRequestBlankDisk(FAbort);
|
|
Abort := FAbort;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnRequestImage(Sender : TObject; ImageNumber : Integer; var ImageName : string; var Abort : Boolean);
|
|
var
|
|
FImageName : WideString;
|
|
FAbort : WordBool;
|
|
begin
|
|
FImageName := ImageName;
|
|
FAbort := Abort;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnRequestImage(ImageNumber, FImageName, FAbort);
|
|
Abort := FAbort;
|
|
ImageName := FImageName;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnRequestLastDisk(Sender : TObject; var Abort : Boolean);
|
|
var
|
|
FAbort : WordBool;
|
|
begin
|
|
FAbort := Abort;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnRequestLastDisk(FAbort);
|
|
Abort := FAbort;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnRequestNthDisk(Sender : TObject; DiskNumber : Byte; var Abort : Boolean);
|
|
var
|
|
FAbort : WordBool;
|
|
begin
|
|
FAbort := Abort;
|
|
if Assigned(FEvents) then
|
|
FEvents.OnRequestNthDisk(DiskNumber, FAbort);
|
|
Abort := FAbort;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit._OnSave(Sender : TObject);
|
|
begin
|
|
if Assigned(FEvents) then
|
|
FEvents.OnSave;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
procedure TZipKit.Initialize;
|
|
begin
|
|
inherited Initialize;
|
|
FConnectionPoints := TConnectionPoints.Create(Self);
|
|
if AutoFactory.EventTypeInfo <> nil then
|
|
FConnectionPoints.CreateConnectionPoint(AutoFactory.EventIID,
|
|
ckSingle, EventConnect);
|
|
FOwner := AbZipKit.TAbZipKit.Create(nil);
|
|
FOwner.OnArchiveItemProgress := _OnArchiveItemProgress;
|
|
FOwner.OnArchiveProgress := _OnArchiveProgress;
|
|
FOwner.OnChange := _OnChange;
|
|
FOwner.OnConfirmOverwrite := _OnConfirmOverwrite;
|
|
FOwner.OnConfirmProcessItem := _OnConfirmProcessItem;
|
|
FOwner.OnConfirmSave := _OnConfirmSave;
|
|
FOwner.OnLoad := _OnLoad;
|
|
FOwner.OnNeedPassword := _OnNeedPassword;
|
|
FOwner.OnProcessItemFailure := _OnProcessItemFailure;
|
|
FOwner.OnRequestBlankDisk := _OnRequestBlankDisk;
|
|
FOwner.OnRequestImage := _OnRequestImage;
|
|
FOwner.OnRequestLastDisk := _OnRequestLastDisk;
|
|
FOwner.OnRequestNthDisk := _OnRequestNthDisk;
|
|
FOwner.OnSave := _OnSave;
|
|
FEnumPos := 0;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
destructor TZipKit.Destroy;
|
|
begin
|
|
FOwner.Free;
|
|
inherited Destroy;
|
|
end;
|
|
{------------------------------------------------------------------------------}
|
|
|
|
initialization
|
|
TAutoObjectFactory.Create(ComServer, TZipKit, Class_ZipKit, ciMultiInstance, tmBoth);
|
|
|
|
|
|
end.
|