Compress-Decompress algrithms

Development Platform:

Delphi

ZipMstr.pas：Code Content

unit ZipMstr;
(* TZipMaster VCL by Chris Vleghert and Eric W. Engler
e-mail: englere@abraxis.com
www: http://www.geocities.com/SiliconValley/Network/2114
v1.70 by Russell Peters August 2, 2002.
*)
//{$DEFINE NO_SPAN}
//{$DEFINE NO_SFX}
{$INCLUDE ZipVers.inc}
{$IFDEF VER140}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
interface
uses
Forms, WinTypes, WinProcs, SysUtils, Classes, Messages, Dialogs, Controls,
ZipDLL, UnzDLL, ZCallBck, ZipMsg, ShellApi, Graphics, Buttons, StdCtrls,
FileCtrl;
const
ZIPMASTERVERSION: string = '1.70';
ZIPMASTERBUILD: string = '1.7.0.5';
Min_ZipDll_Vers: integer = 170;
Min_UnzDll_Vers: integer = 170;
{$IFDEF VERD2D3}
type
LargeInt = Comp;
type
pLargeInt = ^Comp;
type
LongWord = Cardinal;
const
mrNoToAll = mrNo + 1;
{$ENDIF}
{$IFDEF VERD4+}
type
LargeInt = Int64;
type
pLargeInt = ^Int64;
{$ENDIF}
//------------------------------------------------------------------------
type
ProgressType = (NewFile, ProgressUpdate, EndOfBatch, TotalFiles2Process,
TotalSize2Process);
AddOptsEnum = (AddDirNames, AddRecurseDirs, AddMove, AddFreshen, AddUpdate,
AddZipTime, AddForceDOS, AddHiddenFiles, AddArchiveOnly, AddResetArchive,
AddEncrypt, AddSeparateDirs, AddVolume, AddFromDate, AddDiskSpan, AddDiskSpanErase);
AddOpts = set of AddOptsEnum;
// When changing this enum also change the pointer array in the function AddSuffix,
// and the initialisation of ZipMaster. Also keep assGIF as first and assEXE as last value.
AddStoreSuffixEnum = (assGIF, assPNG, assZ, assZIP, assZOO, assARC,
assLZH, assARJ, assTAZ, assTGZ, assLHA, assRAR,
assACE, assCAB, assGZ, assGZIP, assJAR, assEXE);
AddStoreExts = set of AddStoreSuffixEnum;
ExtrOptsEnum = (ExtrDirNames, ExtrOverWrite, ExtrFreshen, ExtrUpdate, ExtrTest);
ExtrOpts = set of ExtrOptsEnum;
SFXOptsEnum = (SFXAskCmdLine, SFXAskFiles, SFXAutoRun, SFXHideOverWriteBox, SFXCheckSize, SFXNoSuccessMsg);
SFXOpts = set of SFXOptsEnum;
OvrOpts = (OvrConfirm, OvrAlways, OvrNever);
CodePageOpts = (cpAuto, cpNone, cpOEM);
CodePageDirection = (cpdOEM2ISO, cpdISO2OEM);
DeleteOpts = (htdFinal, htdAllowUndo);
UnZipSkipTypes = (stOnFreshen, stNoOverwrite, stFileExists, stBadPassword, stNoEncryptionDLL,
stCompressionUnknown, stUnknownZipHost, stZipFileFormatWrong, stGeneralExtractError);
ZipDiskStatusEnum = (zdsEmpty, zdsHasFiles, zdsPreviousDisk, zdsSameFileName, zdsNotEnoughSpace);
TZipDiskStatus = set of ZipDiskStatusEnum;
TZipDiskAction = (zdaOk, zdaErase, zdaReject, zdaCancel);
type
ZipDirEntry = packed record // fixed part size = 42
MadeByVersion: Byte;
HostVersionNo: Byte;
Version: Word;
Flag: Word;
CompressionMethod: Word;
DateTime: Integer; // Time: Word; Date: Word; }
CRC32: Integer;
CompressedSize: Integer;
UncompressedSize: Integer;
FileNameLength: Word;
ExtraFieldLength: Word;
FileCommentLen: Word;
StartOnDisk: Word;
IntFileAttrib: Word;
ExtFileAttrib: LongWord;
RelOffLocalHdr: LongWord;
FileName: string; // variable size
FileComment: string; // variable size
Encrypted: Boolean;
ExtraData: pChar; // New v1.6, used in CopyZippedFiles()
end;
pZipDirEntry = ^ZipDirEntry;
type
ZipEndOfCentral = packed record //Fixed part size : 22 bytes
HeaderSig: LongWord; //(4) hex=06054B50
ThisDiskNo: Word; //(2)This disk's number
CentralDiskNo: Word; //(2)Disk number central dir start
CentralEntries: Word; //(2)Number of central dir entries on this disk
TotalEntries: Word; //(2)Number of entries in central dir
CentralSize: LongWord; //(4)Size of central directory
CentralOffSet: LongWord; //(4)offsett of central dir on 1st disk
ZipCommentLen: Word; //(2)
// not used as part of this record structure:
// ZipComment
end;
type
ZipRenameRec = record
Source: string;
Dest: string;
DateTime: Integer;
end;
pZipRenameRec = ^ZipRenameRec;
type
EZipMaster = class(Exception)
public
FDisplayMsg: Boolean; // We do not always want to see a message after an exception.
// We also save the Resource ID in case the resource is not linked in the application.
FResIdent: Integer;
constructor CreateResDisp(const Ident: Integer; const Display: Boolean);
constructor CreateResDisk(const Ident: Integer; const DiskNo: Integer);
constructor CreateResDrive(const Ident: Integer; const Drive: string);
constructor CreateResFile(const Ident: Integer; const File1, File2: string);
end;
TPasswordButton = (pwbOk, pwbCancel, pwbCancelAll, pwbAbort);
TPasswordButtons = set of TPasswordButton;
TProgressEvent = procedure(Sender: TObject; ProgrType: ProgressType; Filename: string; FileSize: Integer) of object;
TMessageEvent = procedure(Sender: TObject; ErrCode: Integer; Message: string) of object;
TSetNewNameEvent = procedure(Sender: TObject; var OldFileName: string; var IsChanged: Boolean) of object;
TNewNameEvent = procedure(Sender: TObject; SeqNo: Integer; ZipEntry: ZipDirEntry) of object;
TPasswordErrorEvent = procedure(Sender: TObject; IsZipAction: Boolean; var NewPassword: string; ForFile: string; var RepeatCount: LongWord; var Action: TPasswordButton) of object;
TCRC32ErrorEvent = procedure(Sender: TObject; ForFile: string; FoundCRC, ExpectedCRC: LongWord; var DoExtract: Boolean) of object;
TExtractOverwriteEvent = procedure(Sender: TObject; ForFile: string; IsOlder: Boolean; var DoOverwrite: Boolean; DirIndex: Integer) of object;
TExtractSkippedEvent = procedure(Sender: TObject; ForFile: string; SkipType: UnZipSkipTypes; ExtError: Integer) of object;
TCopyZipOverwriteEvent = procedure(Sender: TObject; ForFile: string; var DoOverwrite: Boolean) of object;
TGetNextDiskEvent = procedure(Sender: TObject; DiskSeqNo, DiskTotal: Integer; Drive: string; var AbortAction: Boolean) of object;
TStatusDiskEvent = procedure(Sender: TObject; PreviousDisk: Integer; PreviousFile: string; Status: TZipDiskStatus; var Action: TZipDiskAction) of object;
TFileCommentEvent = procedure(Sender: TObject; ForFile: string; var FileComment: string; var IsChanged: Boolean) of object;
TZipStream = class(TMemoryStream)
public
constructor Create;
destructor Destroy; override;
procedure SetPointer(Ptr: Pointer; Size: Integer); virtual;
end;
TZipMaster = class(TComponent)
private
// fields of published properties
FAddCompLevel: Integer;
fAddOptions: AddOpts;
FAddStoreSuffixes: AddStoreExts;
{ Private versions of property variables }
fCancel: Boolean;
FDirOnlyCount: Integer;
fErrCode: Integer;
fFullErrCode: Integer;
fHandle: HWND;
FIsSpanned: Boolean;
fMessage: string;
fVerbose: Boolean;
fTrace: Boolean;
fZipContents: TList;
fExtrBaseDir: string;
fZipBusy: Boolean;
fUnzBusy: Boolean;
FExtrOptions: ExtrOpts;
FFSpecArgs: TStrings;
FZipFileName: string;
FSuccessCnt: Integer;
FPassword: ShortString;
FEncrypt: Boolean;
FSFXOffset: Integer;
FDLLDirectory: string;
FUnattended: Boolean;
AutoExeViaAdd: Boolean;
FVolumeName: string;
FSizeOfDisk: LargeInt; { Int64 or Comp }
FDiskFree: LargeInt;
FFreeOnDisk: LargeInt;
FDiskSerial: Integer;
FDrive: string;
FHowToDelete: DeleteOpts;
FTotalSizeToProcess: Cardinal;
FDiskNr: Integer;
FTotalDisks: Integer;
FFileSize: Integer;
FRealFileSize: Cardinal;
FWrongZipStruct: Boolean;
FInFileName: string;
FInFileHandle: Integer;
FOutFileHandle: Integer;
FVersionMadeBy1: Integer;
FVersionMadeBy0: Integer;
FDateStamp: Integer; { DOS formatted date/time - use Delphi's
FileDateToDateTime function to give you TDateTime format.}
fFromDate: TDate;
FTempDir: string;
FShowProgress: Boolean;
FFreeOnDisk1: Integer;
FMaxVolumeSize: Integer;
FMinFreeVolSize: Integer;
FCodePage: CodePageOpts;
FZipEOC: Integer; // End-Of-Central-Dir location
FZipSOC: Integer; // Start-Of-Central-Dir location
FZipComment: string;
FVersionInfo: string;
FZipStream: TZipStream;
FPasswordReqCount: LongWord;
GAssignPassword: Boolean;
GModalResult: TModalResult;
FFSpecArgsExcl: TStrings;
FUseDirOnlyEntries: Boolean;
FRootDir: string;
FCurWaitCount: Integer;
FSaveCursor: TCursor;
// Dll related variables
fMinZipDllVer: integer; // new 1.70
fMinUnzDllVer: integer; // new 1.70
{ Main call to execute a ZIP add or Delete. This call returns the
number of files that were sucessfully operated on. }
ZipDllExec: function(ZipRec: pZipParms): DWord; stdcall;
GetZipDllVersion: function: DWord; stdcall;
ZipDllHandle: HWND;
{ Main call to execute a ZIP add or Delete. This call returns the
number of files that were sucessfully operated on. }
UnzDllExec: function(UnZipRec: pUnZipParms): DWord; stdcall;
GetUnzDllVersion: function: DWord; stdcall;
UnzDllHandle: HWND;
ZipParms: pZipParms; { declare an instance of ZipParms 1 or 2 }
UnZipParms: pUnZipParms; { declare an instance of UnZipParms 2 }
{ Event variables }
FOnDirUpdate: TNotifyEvent;
FOnProgress: TProgressEvent;
FOnMessage: TMessageEvent;
FOnSetNewName: TSetNewNameEvent;
FOnNewName: TNewNameEvent;
FOnPasswordError: TPasswordErrorEvent;
FOnCRC32Error: TCRC32ErrorEvent;
FOnExtractOverwrite: TExtractOverwriteEvent;
FOnExtractSkipped: TExtractSkippedEvent;
FOnCopyZipOverwrite: TCopyZipOverwriteEvent;
FOnFileComment: TFileCommentEvent;
{$IFNDEF NO_SPAN}
fConfirmErase: Boolean;
FDiskWritten: Integer;
FDriveNr: Integer;
FFormatErase: Boolean; // New 1.70
FInteger: Integer;
FNewDisk: Boolean;
FOnGetNextDisk: TGetNextDiskEvent;
FOnStatusDisk: TStatusDiskEvent;
FOutFileName: string;
FZipDiskAction: TZipDiskAction;
FZipDiskStatus: TZipDiskStatus;
{$ENDIF}
{$IFNDEF NO_SFX}
FSFXCaption: string; // dflt='Self-extracting Archive'
FSFXCommandLine: string; // dflt=''
FSFXDefaultDir: string; // dflt=''
FSFXIcon: TIcon;
FSFXMessage: string;
FSFXOptions: SFXOpts;
FSFXOverWriteMode: OvrOpts; // ovrConfirm (others: ovrAlways, ovrNever)
FSFXPath: string;
FJumpValue: array[#0..#255] of Integer;
{$ENDIF}
{ Property get/set functions }
function GetCount: Integer;
procedure SetFSpecArgs(Value: TStrings);
procedure SetFileName(Value: string);
function GetZipVers: Integer;
function GetUnzVers: Integer;
procedure SetDLLDirectory(Value: string);
procedure SetVersionInfo(Value: string);
function GetZipComment: string;
procedure SetZipComment(zComment: string);
procedure SetPasswordReqCount(Value: LongWord);
procedure SetFSpecArgsExcl(Value: TStrings);
{ Private "helper" functions }
function Load_ZipDll(var autoload: boolean): integer; // new 1.70
function Load_UnzDll(var autoload: boolean): integer; // new 1.70
procedure SetMinZipDllVers(Value: integer); // New 1.70
procedure SetMinUnzDllVers(Value: integer); // New 1.70
function GetDirEntry(idx: integer): ZipDirEntry; // New 1.70
function GetZipDllPath(handle: cardinal): string; // New 1.70
function GetUnzDllPath(handle: cardinal): string; // New 1.70
procedure FreeZipDirEntryRecords;
procedure SetZipSwitches(var NameOfZipFile: string; zpVersion: Integer);
procedure SetUnZipSwitches(var NameOfZipFile: string; uzpVersion: Integer);
procedure ShowExceptionError(const ZMExcept: EZipMaster);
function LoadZipStr(Ident: Integer; DefaultStr: string): string;
function ConvCodePage(Source: string; Direction: CodePageDirection): string;
function IsDiskPresent: Boolean;
function CheckIfLastDisk(var EOC: ZipEndOfCentral; DoExcept: Boolean): Boolean;
function ReplaceForwardSlash(aStr: string): string;
function CopyBuffer(InFile, OutFile, ReadLen: Integer): Integer;
procedure WriteJoin(Buffer: pChar; BufferSize, DSErrIdent: Integer);
procedure GetNewDisk(DiskSeq: Integer);
procedure DiskFreeAndSize(Action: Integer);
procedure AddSuffix(const SufOption: AddStoreSuffixEnum; var sStr: string; sPos: Integer);
procedure ExtExtract(UseStream: Integer; MemStream: TMemoryStream);
procedure ExtAdd(UseStream: Integer; StrFileDate, StrFileAttr: DWORD; MemStream: TMemoryStream);
procedure SetDeleteSwitches;
procedure StartWaitCursor;
procedure StopWaitCursor;
procedure TraceMessage(Msg: string);
// procedure DoOnMessage(Sender: TObject; ErrCode: Integer; Message: string); // New 1.70
{$IFNDEF NO_SPAN}
function CheckForDisk: Integer;
procedure ClearFloppy(dir: string); // New 1.70
function IsRightDisk(drt: Integer): Boolean;
function MakeString(Buffer: pChar; Size: Integer): string;
procedure RWJoinData(Buffer: pChar; ReadLen, DSErrIdent: Integer);
procedure RWSplitData(Buffer: pChar; ReadLen, ZSErrVal: Integer);
procedure WriteSplit(Buffer: pChar; Len: Integer; MinSize: Integer);
function ZipFormat: Integer; // New 1.70
{$ENDIF}
{$IFNDEF NO_SFX}
function IsInstallShield(const fh: THandle): Boolean;
function ReplaceIcon(SFXFile, SFXSize: Integer): Integer;
function RWCentralDir(OutFile: Integer; EOC: ZipEndOfCentral; OffsetChange: Integer): Integer;
procedure SetSFXIcon(aIcon: TIcon);
{$ENDIF}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public Properties (run-time only) }
property Handle: HWND read fHandle write fHandle;
property ErrCode: Integer read fErrCode write fErrCode;
property Message: string read fMessage write fMessage;
property ZipContents: TList read FZipContents;
property Cancel: Boolean read fCancel write fCancel;
property ZipBusy: Boolean read fZipBusy;
property UnzBusy: Boolean read fUnzBusy;
property Count: Integer read GetCount;
property SuccessCnt: Integer read FSuccessCnt;
property ZipVers: Integer read GetZipVers;
property UnzVers: Integer read GetUnzVers;
property SFXOffset: Integer read FSFXOffset;
property ZipSOC: Integer read FZipSOC default 0;
property ZipEOC: Integer read FZipEOC default 0;
property IsSpanned: Boolean read FIsSpanned default False;
property ZipFileSize: Cardinal read FRealFileSize default 0;
property FullErrCode: Integer read FFullErrCode;
property TotalSizeToProcess: Cardinal read FTotalSizeToProcess;
property ZipComment: string read GetZipComment write SetZipComment;
property ZipStream: TZipStream read FZipStream;
property DirOnlyCount: Integer read FDirOnlyCount default 0;
{ Public Methods }
{ NOTE: Test is an sub-option of extract }
procedure Add;
procedure Delete;
procedure Extract;
procedure List;
// load dll - return version
function Load_Zip_Dll: integer;
function Load_Unz_Dll: integer;
procedure Unload_Zip_Dll;
procedure Unload_Unz_Dll;
procedure AbortDlls;
function CopyFile(const InFileName, OutFileName: string): Integer;
function EraseFile(const Fname: string; How: DeleteOpts): Integer;
function GetAddPassword: string;
function GetExtrPassword: string;
function AppendSlash(sDir: string): string;
{ New in v1.6 }
function Rename(RenameList: TList; DateTime: Integer): Integer;
function ExtractFileToStream(Filename: string): TZipStream;
function AddStreamToStream(InStream: TMemoryStream): TZipStream;
{$IFDEF VERD4+}
function ExtractStreamToStream(InStream: TMemoryStream; OutSize: LongWord = 32768): TZipStream;
procedure AddStreamToFile(Filename: string = ''; FileDate: DWord = 0; FileAttr: DWord = 0);
function MakeTempFileName(Prefix: string = 'zip'; Extension: string = '.zip'): string;
procedure ShowZipMessage(Ident: Integer; UserStr: string = '');
{$ELSE}
procedure AddStreamToFile(Filename: string; FileDate, FileAttr: Dword);
function ExtractStreamToStream(InStream: TMemoryStream; OutSize: Longword): TZipStream;
function MakeTempFileName(Prefix, Extension: string): string;
procedure ShowZipMessage(Ident: Integer; UserStr: string);
{$ENDIF}
function GetPassword(DialogCaption, MsgTxt: string; pwb: TPasswordButtons; var ResultStr: string): TPasswordButton;
function CopyZippedFiles(DestZipMaster: TZipMaster; DeleteFromSource: boolean; OverwriteDest: OvrOpts): Integer;
property DirEntry[idx: integer]: ZipDirEntry read GetDirEntry; // New 1.70
function FullVersionString: string; // New 1.70
{$IFNDEF NO_SPAN}
function ReadSpan(InFileName: string; var OutFilePath: string): Integer;
function WriteSpan(InFileName, OutFileName: string): Integer;
{$ENDIF}
{$IFNDEF NO_SFX}
function ConvertSFX: Integer;
function ConvertZIP: Integer;
function IsZipSFX(const SFXExeName: string): Integer;
{$ENDIF}
published
{ Public properties that also show on Object Inspector }
property Verbose: Boolean read FVerbose
write FVerbose;
property Trace: Boolean read FTrace
write FTrace;
property AddCompLevel: Integer read FAddCompLevel
write FAddCompLevel;
property AddOptions: AddOpts read FAddOptions
write fAddOptions;
property AddFrom: TDate read fFromDate write fFromDate;
property ExtrBaseDir: string read FExtrBaseDir
write FExtrBaseDir;
property ExtrOptions: ExtrOpts read FExtrOptions
write FExtrOptions;
property FSpecArgs: TStrings read FFSpecArgs
write SetFSpecArgs;
property Unattended: Boolean read FUnattended
write FUnattended;
{ At runtime: every time the filename is assigned a value,
the ZipDir will automatically be read. }
property ZipFileName: string read FZipFileName
write SetFileName;
property Password: ShortString read FPassword
write FPassword;
property DLLDirectory: string read FDLLDirectory
write SetDLLDirectory;
property MinZipDllVers: integer read fMinZipDllVer
write SetMinZipDllVers; // default Min_ZipDll_Vers; // new 1.70
property MinUnzDllVers: integer read fMinUnzDllVer
write SetMinUnzDllVers; // default Min_UnzDll_Vers; // new 1.70
property TempDir: string read FTempDir
write FTempDir;
property CodePage: CodePageOpts read FCodePage
write FCodePage default cpAuto;
property HowToDelete: DeleteOpts read FHowToDelete
write FHowToDelete default htdAllowUndo;
{ New in 1.52k }
property VersionInfo: string read FVersionInfo
write SetVersionInfo;
{ New in v1.6 }
property AddStoreSuffixes: AddStoreExts read FAddStoreSuffixes
write FAddStoreSuffixes;
property PasswordReqCount: LongWord read FPasswordReqCount
write SetPasswordReqCount default 1;
property FSpecArgsExcl: TStrings read FFSpecArgsExcl
write SetFSpecArgsExcl;
property UseDirOnlyEntries: Boolean read FUseDirOnlyEntries
write FUseDirOnlyEntries default False;
property RootDir: string read FRootDir
write fRootDir;
{ Events }
property OnDirUpdate: TNotifyEvent read FOnDirUpdate
write FOnDirUpdate;
property OnProgress: TProgressEvent read FOnProgress
write FOnProgress;
property OnMessage: TMessageEvent read fOnMessage write fOnMessage;
{ New in v1.6 }
property OnSetNewName: TSetNewNameEvent read FOnSetNewName
write FOnSetNewName;
property OnNewName: TNewNameEvent read FOnNewName
write FOnNewName;
property OnCRC32Error: TCRC32ErrorEvent read FOnCRC32Error
write FOnCRC32Error;
property OnPasswordError: TPasswordErrorEvent read FOnPasswordError
write FOnPasswordError;
property OnExtractOverwrite: TExtractOverwriteEvent read FOnExtractOverwrite
write FOnExtractOverwrite;
property OnExtractSkipped: TExtractSkippedEvent read FOnExtractSkipped
write FOnExtractSkipped;
property OnCopyZipOverwrite: TCopyZipOverwriteEvent read FOnCopyZipOverwrite
write FOnCopyZipOverwrite;
property OnFileComment: TFileCommentEvent read FOnFileComment
write FOnFileComment;
{$IFNDEF NO_SPAN}
property ConfirmErase: Boolean read fConfirmErase write fConfirmErase default True;
property FormatErase: Boolean read FFormatErase write FFormatErase default False;
property KeepFreeOnDisk1: Integer read FFreeOnDisk1 write FFreeOnDisk1;
property MaxVolumeSize: Integer read FMaxVolumeSize write FMaxVolumesize default 0;
property MinFreeVolumeSize: Integer read FMinFreeVolSize write FMinFreeVolSize default 65536;
property OnGetNextDisk: TGetNextDiskEvent read FOnGetNextDisk write FOnGetNextDisk;
property OnStatusDisk: TStatusDiskEvent read FOnStatusDisk write FOnStatusDisk;
{$ENDIF}
{$IFNDEF NO_SFX}
property SFXCaption: string read FSFXCaption write FSFXCaption;
property SFXCommandLine: string read FSFXCommandLine write FSFXCommandLine;
property SFXDefaultDir: string read FSFXDefaultDir write FSFXDefaultDir;
property SFXIcon: TIcon read FSFXIcon write SetSFXIcon;
property SFXMessage: string read FSFXMessage write FSFXMessage;
property SFXOptions: SfxOpts read FSFXOptions write FSFXOptions default [SFXCheckSize];
property SFXOverWriteMode: OvrOpts read FSFXOverWriteMode write FSFXOverWriteMode;
property SFXPath: string read FSFXPath write FSFXPath;
{$ENDIF}
end;
function PathConcat(path, extra: string): string;
procedure Register;
implementation
uses ZipStructs;
{$R ZipMstr.Res}
const { these are stored in reverse order }
LocalFileHeaderSig = $04034B50; { 'PK'34 (in file: 504b0304) }
CentralFileHeaderSig = $02014B50; { 'PK'12 }
EndCentralDirSig = $06054B50; { 'PK'56 }
ExtLocalSig = $08074B50; { 'PK'78 }
BufSize = 8192; // Keep under 12K to avoid Winsock problems on Win95.
// If chunks are too large, the Winsock stack can
// lose bytes being sent or received.
FlopBufSize = 65536;
RESOURCE_ERROR: string = 'ZipMsgXX.res is probably not linked to the executable' + #10 + 'Missing String ID is: ';
ZIPVERSION = 170;
UNZIPVERSION = 170;
type
TBuffer = array[0..BufSize - 1] of Byte;
pBuffer = ^TBuffer;
{ Define the functions that are not part of the TZipMaster class. }
{ The callback function must NOT be a member of a class. }
{ We use the same callback function for ZIP and UNZIP. }
function ZCallback(ZCallBackRec: pZCallBackStruct): LongBool; stdcall; export; forward;
type
TPasswordDlg = class(TForm)
private
PwBtn: array[0..3] of TBitBtn;
PwdEdit: TEdit;
PwdTxt: TLabel;
public
constructor CreateNew2(Owner: TComponent; pwb: TPasswordButtons); virtual;
destructor Destroy; override;
function ShowModalPwdDlg(DlgCaption, MsgTxt: string): string; virtual;
end;
type
MDZipData = record // MyDirZipData
Diskstart: Word; // The disk number where this file begins
RelOffLocal: LongWord; // offset from the start of the first disk
FileNameLen: Word; // length of current filename
FileName: array[0..254] of Char; // Array of current filename
CRC32: LongWord;
ComprSize: LongWord;
UnComprSize: LongWord;
DateTime: Integer;
end;
pMZipData = ^MDZipData;
TMZipDataList = class(TList)
private
function GetItems(Index: integer): pMZipData;
public
constructor Create(TotalEntries: integer);
destructor Destroy; override;
property Items[Index: integer]: pMZipData read GetItems;
function IndexOf(fname: string): integer;
end;
// ==================================================================
{$IFDEF VER90} // if Delphi 2
function AnsiStrPos(S1, S2: pChar): pChar;
begin
Result := StrPos(S1, S2); // not will not work with MBCS
end;
function AnsiStrIComp(S1, S2: pChar): Integer;
begin
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, S1, -1, S2, -1) - 2;
end;
function AnsiPos(const Substr, S: string): Integer;
begin
Result := Pos(Substr, S);
end;
{$ENDIF}
// ---------------------------- ZipDataList --------------------------------
function TMZipDataList.GetItems(Index: integer): pMZipData;
begin
if Index >= Count then
raise Exception.CreateFmt('Index (%d) outside range 1..%d',
[Index, Count - 1]);
Result := inherited Items[Index];
end;
constructor TMZipDataList.Create(TotalEntries: integer);
var
i: Integer; MDZDp: pMZipData;
begin
inherited Create;
Capacity := TotalEntries;
for i := 1 to TotalEntries do
begin
New(MDZDp);
MDZDp^.FileName := '';
Add(MDZDp);
end;
end;
destructor TMZipDataList.Destroy;
var
i: Integer; MDZDp: pMZipData;
begin
if Count > 0 then
begin
for i := (Count - 1) downto 0 do
begin
MDZDp := Items[i];
if Assigned(MDZDp) then // dispose of the memory pointed-to by this entry
Dispose(MDZDp);
Delete(i); // delete the TList pointer itself
end;
end;
inherited Destroy;
end;
function TMZipDataList.IndexOf(fname: string): integer;
var
MDZDp: pMZipData;
begin
for Result := 0 to (Count - 1) do
begin
MDZDp := Items[Result];
if CompareText(fname, MDZDp^.FileName) = 0 then // case insensitive compare
break;
end;
// Should not happen, but maybe in a bad archive...
if Result = Count then
raise EZipMaster.CreateResDisp(DS_EntryLost, True);
end;
//----------------------------------------------------------------------------
{ Dennis Passmore (Compuserve: 71640,2464) contributed the idea of passing an
instance handle to the DLL, and, in turn, getting it back from the callback.
This lets us referance variables in the TZipMaster class from within the
callback function. Way to go Dennis! }
function ZCallback(ZCallBackRec: PZCallBackStruct): LongBool; stdcall; export;
var
Msg, OldFileName, pwd, FileComment: string;
IsChanged, DoExtract, DoOverwrite: Boolean;
RptCount: LongWord;
Action: TPasswordButton;
begin
with ZCallBackRec^, (TObject(Caller) as TZipMaster) do
begin
Msg := ReplaceForwardSlash(TrimRight(FileNameOrMsg));
case ActionCode of
1: { progress type 1 = starting any ZIP operation on a new file }
if Assigned(FOnProgress) then
FOnProgress(Caller, NewFile, Msg, FileSize);
2: { progress type 2 = increment bar }
if Assigned(FOnProgress) then
FOnProgress(Caller, ProgressUpdate, '', FileSize);
3: { end of a batch of 1 or more files }
if Assigned(FOnProgress) then
FOnProgress(Caller, EndOfBatch, '', 0);
4: { a routine status message }
begin
Message := Msg;
if ErrorCode <> 0 then // W'll always keep the last ErrorCode
begin
ErrCode := Integer(Char(ErrorCode and $FF));
fFullErrCode := ErrorCode;
end;
if Assigned(OnMessage) then
OnMessage(Caller, ErrorCode, Msg);
end;
5: { total number of files to process }
if Assigned(OnProgress) then
OnProgress(Caller, TotalFiles2Process, '', FileSize);
6: { total size of all files to be processed }
begin
FTotalSizeToProcess := FileSize;
if Assigned(FOnProgress) then
FOnProgress(Caller, TotalSize2Process, '', FileSize);
end;
7: { new in v1.60, request for a new path+name just before zipping or extracting }
if Assigned(FOnSetNewName) then
begin
OldFileName := Msg;
IsChanged := False;
FOnSetNewName(Caller, OldFileName, IsChanged);
if IsChanged then
begin
StrPLCopy(FileNameOrMsg, OldFileName, 512);
ErrorCode := 1;
end
else
ErrorCode := 0;
end;
8: { New or other password needed during Extract() }
begin
pwd := '';
RptCount := FileSize;
Action := pwbOk;
GAssignPassword := False;
if Assigned(FOnPasswordError) then
begin
GModalResult := mrNone;
FOnPasswordError(Caller, IsOperationZip, pwd, Msg, RptCount, Action);
if Action <> pwbOk then
pwd := '';
if Action = pwbCancelAll then
GModalResult := mrNoToAll;
if Action = pwbAbort then
GModalResult := mrAbort;
end
else
if (ErrorCode and $01) <> 0 then
pwd := GetAddPassword()
else
pwd := GetExtrPassword();
if pwd <> '' then
begin
StrPLCopy(FileNameOrMsg, pwd, PWLEN);
ErrorCode := 1;
end
else
begin
RptCount := 0;
ErrorCode := 0;
end;
if RptCount > 15 then
FileSize := 15
else
FileSize := RptCount;
if GModalResult = mrNoToAll then // Cancel all
ActionCode := 0;
if GModalResult = mrAbort then // Abort
Cancel := True;
GAssignPassword := True;
end;
9: { CRC32 error, (default action is extract/test the file) }
begin
DoExtract := true; // This was default for versions <1.6
if Assigned(FOnCRC32Error) then
FOnCRC32Error(Caller, Msg, ErrorCode, FileSize, DoExtract);
ErrorCode := Integer(DoExtract);
{ This will let the Dll know it should send some warnings }
if not Assigned(FOnCRC32Error) then
ErrorCode := 2;
end;
10: { Extract(UnZip) Overwrite ask }
if Assigned(FOnExtractOverwrite) then
begin
DoOverwrite := Boolean(FileSize);
FOnExtractOverwrite(Caller, Msg, (ErrorCode and $10000) = $10000, DoOverwrite, ErrorCode and $FFFF);
FileSize := Integer(DoOverwrite);
end;
11: { Extract(UnZip) and Skipped }
begin
if ErrorCode <> 0 then
begin
ErrCode := Integer(Char(ErrorCode and $FF));
FFullErrCode := ErrorCode;
end;
if Assigned(FOnExtractSkipped) then
//FOnExtractSkipped( Caller, Msg, UnZipSkipTypes(FileSize), ErrorCode );
FOnExtractSkipped(Caller, Msg, UnZipSkipTypes((FileSize and $FF) - 1), ErrorCode);
end;
12: { Add(Zip) FileComments. v1.60L }
if Assigned(FOnFileComment) then
begin
FileComment := FileNameOrMsg[256];
IsChanged := False;
FOnFileComment(Caller, Msg, FileComment, IsChanged);
if IsChanged and (FileComment <> '') then
StrPLCopy(FileNameOrMsg, FileComment, 511)
else
FileNameOrMsg[0] := #0;
ErrorCode := Integer(IsChanged);
FileSize := Length(FileComment);
if FileSize > 511 then
FileSize := 511;
end;
13: { Stream2Stream extract. v1.60M }
begin
try
FZipStream.SetSize(FileSize);
except
ErrorCode := 1;
FileSize := 0;
end;
if ErrorCode <> 1 then
FileSize := Integer(FZipStream.Memory);
end;
end; {end case }
{ If you return TRUE, then the DLL will abort it's current
batch job as soon as it can. }
Result := Cancel;
end; { end with }
Application.ProcessMessages;
end;
{ Implementation of TZipMaster class member functions }
{-----------------------------------------------------}
constructor TZipMaster.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fZipContents := TList.Create;
FFSpecArgs := TStringList.Create;
FFSpecArgsExcl := TStringList.Create; { New in v1.6 }
fHandle := Application.Handle;
ZipParms {.zp1} := nil;
UnZipParms := nil;
FZipFileName := '';
FPassword := '';
FPasswordReqCount := 1; { New in v1.6 }
FEncrypt := False;
FSuccessCnt := 0;
FAddCompLevel := 9; { dflt to tightest compression }
FDLLDirectory := '';
AutoExeViaAdd := False;
FUnattended := False;
FRealFileSize := 0;
FSFXOffset := 0;
FZipSOC := 0;
FFreeOnDisk1 := 0; { Don't leave any freespace on disk 1. }
FMaxVolumeSize := 0; { Use the maximum disk size. }
FMinFreeVolSize := 65536; { Reject disks with less free bytes than... }
FCodePage := cpAuto;
FIsSpanned := False;
FZipComment := '';
HowToDelete := htdAllowUndo;
FAddStoreSuffixes := [assGIF, assPNG, assZ, assZIP, assZOO, assARC, assLZH, assARJ, assTAZ, assTGZ, assLHA, assRAR, assACE, assCAB, assGZ, assGZIP, assJAR];
FZipStream := TZipStream.Create;
FUseDirOnlyEntries := False;
FDirOnlyCount := 0;
FVersionInfo := ZIPMASTERVERSION;
FCurWaitCount := 0;
ZipDllHandle := 0;
UnzDllHandle := 0;
fMinZipDllVer := Min_ZipDll_Vers; // new 1.70
fMinUnzDllVer := Min_UnzDll_Vers; // new 1.70
{$IFNDEF NO_SPAN}
fFormatErase := False;
fConfirmErase := True;
{$ENDIF}
{$IFNDEF NO_SFX}
FSFXIcon := TIcon.Create; { New in v1.6 }
FSFXOverWriteMode := ovrConfirm;
FSFXCaption := 'Self-extracting Archive';
FSFXDefaultDir := '';
FSFXCommandLine := '';
FSFXOptions := [SFXCheckSize]; { Select this opt by default. }
FSFXPath := 'ZipSFX.bin';
{$ENDIF}
end;
destructor TZipMaster.Destroy;
begin
Unload_Zip_Dll;
Unload_Unz_Dll;
FZipStream.Free;
FreeZipDirEntryRecords;
fZipContents.Free;
FFSpecArgsExcl.Free;
FFSpecArgs.Free;
{$IFNDEF NO_SPAN}
{$ENDIF}
{$IFNDEF NO_SFX}
FSFXIcon.Free;
{$ENDIF}
inherited Destroy;
end;
function TPasswordDlg.ShowModalPwdDlg(DlgCaption, MsgTxt: string): string;
begin
Caption := DlgCaption;
PwdTxt.Caption := MsgTxt;
ShowModal();
if ModalResult = mrOk then
Result := PwdEdit.Text
else
Result := '';
end;
constructor TPasswordDlg.CreateNew2(Owner: TComponent; pwb: TPasswordButtons);
var
BtnCnt, Btns, i, k: Integer;
begin
inherited CreateNew(Owner{$IFDEF VERD4+}, 0{$ENDIF});
// Convert Button Set to a bitfield
BtnCnt := 1; // We need at least the Ok button
Btns := 1;
if pwbCancel in pwb then
begin
Inc(BtnCnt);
Btns := Btns or 2;
end;
if pwbCancelAll in pwb then
begin
Inc(BtnCnt);
Btns := Btns or 4;
end;
if pwbAbort in pwb then
begin
Inc(BtnCnt);
Btns := Btns or 8;
end;
Parent := Self;
Width := 124 * BtnCnt + 35;
Height := 137;
Font.Name := 'Arial';
Font.Height := -12;
Font.Style := Font.Style + [fsBold];
BorderStyle := bsDialog;
Position := poScreenCenter;
PwdTxt := TLabel.Create(Self);
PwdTxt.Parent := Self;
PwdTxt.Left := 20;
PwdTxt.Top := 8;
PwdTxt.Width := 297;
PwdTxt.Height := 18;
PwdTxt.AutoSize := False;
PwdEdit := TEdit.Create(Self);
PwdEdit.Parent := Self;
PwdEdit.Left := 20;
PwdEdit.Top := 40;
PwdEdit.Width := 124 * BtnCnt - 10;
PwdEdit.PasswordChar := '*';
PwdEdit.MaxLength := PWLEN;
for i := 1 to 3 do
PwBtn[i] := nil;
k := 0;
for i := 1 to 8 do
begin
if (i = 3) or ((i > 4) and (i < 8)) then
Continue;
if (Btns and i) = 0 then
Continue;
PwBtn[k] := TBitBtn.Create(Self);
PwBtn[k].Parent := Self;
PwBtn[k].Top := 72;
PwBtn[k].Height := 28;
PwBtn[k].Width := 114;
PwBtn[k].Left := 20 + 124 * k;
case i of
1: PwBtn[k].Kind := bkOk;
2: PwBtn[k].Kind := bkCancel;
4: PwBtn[k].Kind := bkNo;
8: PwBtn[k].Kind := bkAbort;
end;
if i = 4 then
PwBtn[k].ModalResult := mrNoToAll;
case i of
1: PwBtn[k].Caption := LoadStr(PW_Ok);
2: PwBtn[k].Caption := LoadStr(PW_Cancel);
4: PwBtn[k].Caption := LoadStr(PW_CancelAll);
8: PwBtn[k].Caption := LoadStr(PW_Abort);
end;
Inc(k);
end;
end;
destructor TPasswordDlg.Destroy;
var
i: Integer;
begin
for i := 0 to 3 do
PwBtn[i].Free;
PwdEdit.Free;
PwdTxt.Free;
inherited Destroy;
end;
// defaults if old resource used
function LoadZipMsg(Ident: Integer): string;
begin
case Ident of
LZ_OldZipDll: Result := 'Old Dll from ';
LU_OldUnzDll: Result := 'Old Dll from ';
SF_NOSFXSupport: Result := 'SFX not supported';
DS_NoDiskSpan: Result := 'Span not supported';
else
Result := RESOURCE_ERROR + IntToStr(Ident);
end;
end;
procedure TZipMaster.ShowZipMessage(Ident: Integer; UserStr: string);
var
Msg: string;
begin
// Msg := LoadZipStr(Ident, RESOURCE_ERROR + IntToStr(Ident)) + UserStr;
Msg := LoadStr(Ident);
if Msg = '' then
Msg := LoadZipMsg(Ident);
Msg := Msg + UserStr;
Message := Msg;
ErrCode := Ident;
if FUnattended = False then
ShowMessage(Msg);
if Assigned(OnMessage) then
OnMessage(Self, 0, Msg); // No ErrCode here else w'll get a msg from the application
end;
function TZipMaster.LoadZipStr(Ident: Integer; DefaultStr: string): string;
begin
Result := LoadStr(Ident);
if Result = '' then
Result := DefaultStr;
end;
procedure TZipMaster.TraceMessage(Msg: string);
begin
if Trace and Assigned(OnMessage) then
OnMessage(Self, 0, Msg); // No ErrCode here else w'll get a msg from the application
end;
//---------------------------------------------------------------------------
// Somewhat different from ShowZipMessage() because the loading of the resource
// string is already done in the constructor of the exception class.
procedure TZipMaster.ShowExceptionError(const ZMExcept: EZipMaster);
begin
if (ZMExcept.FDisplayMsg = True) and (Unattended = False) then
ShowMessage(ZMExcept.Message);
ErrCode := ZMExcept.FResIdent;
Message := ZMExcept.Message;
if Assigned(OnMessage) then
OnMessage(Self, 0, ZMExcept.Message);
end;
{ Convert filename (and file comment string) into "internal" charset (ISO).
* This function assumes that Zip entry filenames are coded in OEM (IBM DOS)
* codepage when made on:
* -> DOS (this includes 16-bit Windows 3.1) (FS_FAT_ 0 )
* -> OS/2 (FS_HPFS_ 6 )
* -> Win95/WinNT with Nico Mak's WinZip (FS_NTFS_ 11 && hostver == "5.0" 50)
*
* All other ports are assumed to code zip entry filenames in ISO 8859-1.
*
* NOTE: Norton Zip v1.0 sets the host byte incorrectly. In this case you need
* to set the CodePage property manually to cpOEM to force the conversion.
}
function TZipMaster.ConvCodePage(Source: string; Direction: CodePageDirection): string;
const
FS_FAT: Integer = 0;
FS_HPFS: Integer = 6;
FS_NTFS: Integer = 11;
var
i: Integer;
begin
SetLength(Result, Length(Source));
if ((FCodePage = cpAuto) and (FVersionMadeBy1 = FS_FAT) or (FVersionMadeBy1 = FS_HPFS)
or ((FVersionMadeBy1 = FS_NTFS) and (FVersionMadeBy0 = 50))) or (FCodePage = cpOEM) then
begin
for i := 1 to Length(Source) do
if Char(Source[i]) < Char($80) then
Result[i] := Source[i]
else
if Direction = cpdOEM2ISO then
OemToCharBuff(@Source[i], @Result[i], 1)
else
CharToOemBuff(@Source[i], @Result[i], 1)
end
else
Result := Source;
end;
{ We'll normally have a TStringList value, since TStrings itself is an
abstract class. }
procedure TZipMaster.SetFSpecArgs(Value: TStrings);
begin
FFSpecArgs.Assign(Value);
end;
procedure TZipMaster.SetFSpecArgsExcl(Value: TStrings);
begin
FFSpecArgsExcl.Assign(Value);
end;
procedure TZipMaster.SetFilename(Value: string);
begin
FZipFileName := Value;
if not (csDesigning in ComponentState) then
List; { automatically build a new TLIST of contents in "ZipContents" }
end;
// NOTE: we will allow a dir to be specified that doesn't exist,
// since this is not the only way to locate the DLLs.
procedure TZipMaster.SetDLLDirectory(Value: string);
var
ValLen: Integer;
begin
if Value <> FDLLDirectory then
begin
ValLen := Length(Value);
// if there is a trailing in dirname, cut it off:
if ValLen > 0 then
if Value[ValLen] = '' then
SetLength(Value, ValLen - 1); // shorten the dirname by one
FDLLDirectory := Value;
end;
end;
function TZipMaster.GetCount: Integer;
begin
if ZipFileName <> '' then
Result := ZipContents.Count
else
Result := 0;
end;
// We do not want that this can be changed, but we do want to see it in the OI.
procedure TZipMaster.SetVersionInfo(Value: string);
begin
end;
procedure TZipMaster.SetPasswordReqCount(Value: LongWord);
begin
if Value <> FPasswordReqCount then
begin
if Value > 15 then
Value := 15;
FPasswordReqCount := Value;
end;
end;
function TZipMaster.GetZipComment: string;
begin
Result := ConvCodePage(FZipComment, cpdOEM2ISO);
end;
procedure TZipMaster.SetZipComment(zComment: string);
var
EOC: ZipEndOfCentral;
len: Integer;
CommentBuf: pChar;
Fatal: Boolean;
begin
FInFileHandle := -1;
Fatal := False;
CommentBuf := nil;
try
{ ============================ Changed by Jim Turner =========================}
if Length(zComment) = 0 then
FZipComment := ''
else
FZipComment := ConvCodePage(zComment, cpdISO2OEM);
if Length(ZipFileName) = 0 then
raise EZipMaster.CreateResDisp(GE_NoZipSpecified {DS_NoInFile}, True);
len := Length(FZipComment);
GetMem(CommentBuf, len + 1);
StrPLCopy(CommentBuf, zComment, len + 1);
FInFileHandle := FileOpen(ZipFileName, fmShareDenyWrite or fmOpenReadWrite);
if FInFileHandle <> -1 then // RP 1.60 -2
begin
{ if FInFileHandle = -1 then
raise EZipMaster.CreateResDisp(DS_FileOpen, True);}
if FileSeek(FInFileHandle, FZipEOC, 0) = -1 then
raise EZipMaster.CreateResDisp(DS_FailedSeek, True);
if (FileRead(FInFileHandle, EOC, SizeOf(EOC)) <> SizeOf(EOC)) or (EOC.HeaderSig <> EndCentralDirSig) then
raise EZipMaster.CreateResDisp(DS_EOCBadRead, True);
EOC.ZipCommentLen := len;
if FileSeek(FInFileHandle, -SizeOf(EOC), 1) = -1 then
raise EZipMaster.CreateResDisp(DS_FailedSeek, True);
Fatal := True;
if FileWrite(FInFileHandle, EOC, SizeOf(EOC)) <> SizeOf(EOC) then
raise EZipMaster.CreateResDisp(DS_EOCBadWrite, True);
if FileWrite(FInFileHandle, CommentBuf^, len) <> len then
raise EZipMaster.CreateResDisp(DS_NoWrite, True);
Fatal := False;
// if SetEOF fails we get garbage at the end of the file, not nice but
// also not important.
SetEndOfFile(FInFileHandle);
end; // RP -2
except
on ews: EZipMaster do
begin
ShowExceptionError(ews);
FZipComment := '';
end;
on EOutOfMemory do
begin
ShowZipMessage(GE_NoMem, '');
FZipComment := '';
end;
end;
FreeMem(CommentBuf);
if FInFileHandle <> -1 then
FileClose(FInFileHandle);
if Fatal then // Try to read the zipfile, maybe it still works.
List();
end;
{ Empty fZipContents and free the storage used for dir entries }
procedure TZipMaster.FreeZipDirEntryRecords;
var
i: Integer;
begin
if ZipContents.Count = 0 then
Exit;
for i := (ZipContents.Count - 1) downto 0 do
begin
if Assigned(ZipContents[i]) then
begin
StrDispose(pZipDirEntry(ZipContents[i]).ExtraData);
// dispose of the memory pointed-to by this entry
Dispose(pZipDirEntry(ZipContents[i]));
end;
ZipContents.Delete(i); // delete the TList pointer itself
end; { end for }
// The caller will free the FZipContents TList itself, if needed
end;
procedure TZipMaster.StartWaitCursor;
begin
if FCurWaitCount = 0 then
begin
FSaveCursor := Screen.Cursor;
Screen.Cursor := crHourglass;
end;
Inc(FCurWaitCount);
end;
procedure TZipMaster.StopWaitCursor;
begin
if FCurWaitCount > 0 then
begin
Dec(FCurWaitCount);
if FCurWaitCount = 0 then
Screen.Cursor := FSaveCursor;
end;
end;
{ New in v1.50: We are now looking at the Central zip Dir, instead of
the local zip dir. This change was needed so we could support
Disk-Spanning, where the dir for the whole disk set is on the last disk.}
{ The List method reads thru all entries in the central Zip directory.
This is triggered by an assignment to the ZipFilename, or by calling
this method directly. }
procedure TZipMaster.List; { all work is local - no DLL calls }
var
pzd: pZipDirEntry;
EOC: ZipEndOfCentral;
CEH: ZipCentralHeader;
OffsetDiff: Integer;
Name: string;
i, LiE: Integer;
begin
LiE := 0;
if (csDesigning in ComponentState) then
Exit; { can't do LIST at design time }
{ zero out any previous entries }
FreeZipDirEntryRecords;
FRealFileSize := 0;
FZipSOC := 0;
FSFXOffset := 0; // must be before the following "if"
FZipComment := '';
OffsetDiff := 0;
FIsSpanned := False;
FDirOnlyCount := 0;
if not FileExists(FZipFileName) then
begin
{ let user's program know there's no entries }
if Assigned(FOnDirUpdate) then
FOnDirUpdate(Self);
Exit; { don't complain - this may intentionally be a new zip file }
end;
try
StartWaitCursor;
try
FInFileName := FZipFileName;
FDrive := ExtractFileDrive(ExpandFileName(FInFileName)) + '';
if not IsDiskPresent then // Not present, raise an exception!
raise EZipMaster.CreateResDrive(DS_DriveNoMount, FDrive);
CheckIfLastDisk(EOC, True); // Not last, w'll get an exception!
// The function CheckIfLastDisk read the EOC record, and set some
// global values such as FFileSize. It also opens the zipfile
// and left it's open handle in: FInFileHandle
FTotalDisks := EOC.ThisDiskNo; // Needed in case GetNewDisk is called.
// This could also be set to True if it's the first and only disk.
if EOC.ThisDiskNo > 0 then
FIsSpanned := True;
// Do we have to request for a previous disk first?
if EOC.ThisDiskNo <> EOC.CentralDiskNo then
begin
GetNewDisk(EOC.CentralDiskNo);
FFileSize := FileSeek(FInFileHandle, 0, 2); //v1.52i
OffsetDiff := EOC.CentralOffset; //v1.52i
end
else //v1.52i
// Due to the fact that v1.3 and v1.4x programs do not change the archives
// EOC and CEH records in case of a SFX conversion (and back) we have to
// make this extra check.
OffsetDiff := Longword(FFileSize) - EOC.CentralSize - SizeOf(EOC) - EOC.ZipCommentLen;
FZipSOC := OffsetDiff; // save the location of the Start Of Central dir
FSFXOffset := FFileSize; // initialize this - we will reduce it later
if FFileSize = 22 then
FSFXOffset := 0;
FWrongZipStruct := False;
if EOC.CentralOffset <> Longword(OffsetDiff) then
begin
FWrongZipStruct := True; // We need this in the ConvertXxx functions.
ShowZipMessage(LI_WrongZipStruct, '');
end;
// Now we can go to the start of the Central directory.
if FileSeek(FInFileHandle, OffsetDiff, 0) = -1 then
raise EZipMaster.CreateResDisp(LI_ReadZipError, True);
// Read every entry: The central header and save the information.
for i := 0 to (EOC.TotalEntries - 1) do
begin
// Read a central header entry for 1 file
while FileRead(FInFileHandle, CEH, SizeOf(CEH)) <> SizeOf(CEH) do //v1.52i
begin
// It's possible that we have the central header split up.
if FDiskNr >= EOC.ThisDiskNo then
raise EZipMaster.CreateResDisp(DS_CEHBadRead, True);
// We need the next disk with central header info.
GetNewDisk(FDiskNr + 1);
end;
//validate the signature of the central header entry
if CEH.HeaderSig <> CentralFileHeaderSig then
raise EZipMaster.CreateResDisp(DS_CEHWrongSig, True);
// Now the filename
SetLength(Name, CEH.FileNameLen);
if FileRead(FInFileHandle, Name[1], CEH.FileNameLen) <> CEH.FileNameLen then
raise EZipMaster.CreateResDisp(DS_CENameLen, True);
// Save version info globally for use by codepage translation routine
FVersionMadeBy0 := CEH.VersionMadeBy0;
FVersionMadeBy1 := CEH.VersionMadeBy1;
Name := ConvCodePage(Name, cpdOEM2ISO);
// Create a new ZipDirEntry pointer.
New(pzd); // These will be deleted in: FreeZipDirEntryRecords.
// Copy the needed file info from the central header.
CopyMemory(pzd, @CEH.VersionMadeBy0, 42);
pzd^.FileName := ReplaceForwardSlash(Name);
pzd^.Encrypted := (pzd^.Flag and 1) > 0;
// Read the extra data if present new v1.6
if pzd^.ExtraFieldLength > 0 then
begin
pzd^.ExtraData := StrAlloc(CEH.ExtraLen + 1);
if FileRead(FInFileHandle, pzd^.ExtraData[0], CEH.ExtraLen) <> CEH.ExtraLen then // v1.60m
raise EZipMaster.CreateResDisp(LI_ReadZipError, True);
end
else
pzd^.ExtraData := nil;
// Read the FileComment, if present, and save.
if CEH.FileComLen > 0 then
begin
// get the file comment
SetLength(pzd^.FileComment, CEH.FileComLen);
if FileRead(FInFileHandle, pzd^.FileComment[1], CEH.FileComLen) <> CEH.FileComLen then
raise EZipMaster.CreateResDisp(DS_CECommentLen, True);
pzd^.FileComment := ConvCodePage(pzd^.FileComment, cpdOEM2ISO);
end;
if FUseDirOnlyEntries or (ExtractFileName(pzd^.FileName) <> '') then
begin // Add it to our contents tabel.
ZipContents.Add(pzd);
// Notify user, when needed, of the next entry in the ZipDir.
if Assigned(FOnNewName) then
FOnNewName(self, i + 1, pzd^);
end
else
begin
Inc(FDirOnlyCount);
StrDispose(pzd^.ExtraData);
Dispose(pzd);
end;
// Calculate the earliest Local Header start
if Longword(FSFXOffset) > CEH.RelOffLocal then
FSFXOffset := CEH.RelOffLocal;
end;
FTotalDisks := EOC.ThisDiskNo; // We need this when we are going to extract.
except
on ezl: EZipMaster do // Catch all Zip List specific errors.
begin
ShowExceptionError(ezl);
LiE := 1;
end;
on EOutOfMemory do
begin
ShowZipMessage(GE_NoMem, '');
LiE := 1;
end;
on E: Exception do
begin
// the error message of an unknown error is displayed ...
ShowZipMessage(LI_ErrorUnknown, E.Message);
LiE := 1;
end;
end;
finally
StopWaitCursor;
if FInFileHandle <> -1 then
FileClose(FInFileHandle);
if LiE = 1 then
begin
FZipFileName := '';
FSFXOffset := 0;
end
else
FSFXOffset := FSFXOffset + (OffsetDiff - Integer(EOC.CentralOffset)); // Correct the offset for v1.3 and 1.4x
// Let the user's program know we just refreshed the zip dir contents.
if Assigned(FOnDirUpdate) then
FOnDirUpdate(Self);
end;
end;
// Add a new suffix to the suffix string if contained in the set 'FAddStoreSuffixes'
procedure TZipMaster.AddSuffix(const SufOption: AddStoreSuffixEnum; var sStr: string; sPos: Integer);
const
SuffixStrings: array[0..17, 0..3] of Char = ('gif', 'png', 'z', 'zip', 'zoo', 'arc', 'lzh', 'arj', 'taz', 'tgz', 'lha', 'rar', 'ace', 'cab', 'gz', 'gzip', 'jar', 'exe');
begin
if SufOption in fAddStoreSuffixes then
sStr := sStr + '.' + string(SuffixStrings[sPos]) + ':';
end;
procedure TZipMaster.SetZipSwitches(var NameOfZipFile: string; zpVersion: Integer);
var
i: Integer;
SufStr, Dts: string;
pExFiles: pExcludedFileSpec;
begin
with ZipParms^ do
begin
if Length(FZipComment) <> 0 then
begin
fArchComment := StrAlloc(Length(FZipComment) + 1);
StrPLCopy(fArchComment, FZipComment, Length(FZipComment) + 1);
end;
if AddArchiveOnly in fAddOptions then
fArchiveFilesOnly := 1;
if AddResetArchive in fAddOptions then
fResetArchiveBit := 1;
if (FFSpecArgsExcl.Count <> 0) then
begin
fTotExFileSpecs := FFSpecArgsExcl.Count;
fExFiles := AllocMem(SizeOf(ExcludedFileSpec) * FFSpecArgsExcl.Count);
for i := 0 to (fFSpecArgsExcl.Count - 1) do
begin
pExFiles := fExFiles;
Inc(pExFiles, i);
pExFiles.fFileSpec := StrAlloc(Length(fFSpecArgsExcl[i]) + 1);
StrPLCopy(pExFiles.fFileSpec, fFSpecArgsExcl[i], Length(fFSpecArgsExcl[i]) + 1);
end;
end;
// New in v 1.6M Dll 1.6017, used when Add Move is choosen.
if FHowToDelete = htdAllowUndo then
fHowToMove := True;
if FCodePage = cpOEM then
fWantedCodePage := 2;
end; { end with }
if (Length(FTempDir) <> 0) then
begin
ZipParms.fTempPath := StrAlloc(Length(FTempDir) + 1);
StrPLCopy(ZipParms.fTempPath, FTempDir, Length(FTempDir) + 1);
end;
with ZipParms^ do
begin
Version := zpVersion; //ZIPVERSION; // version we expect the DLL to be
Caller := Self; // point to our VCL instance; returned in callback
fQuiet := True; { we'll report errors upon notification in our callback }
{ So, we don't want the DLL to issue error dialogs }
ZCallbackFunc := ZCallback; // pass addr of function to be called from DLL
fJunkSFX := False; { if True, convert input .EXE file to .ZIP }
SufStr := '';
for i := 0 to Integer(assEXE) do
AddSuffix(AddStoreSuffixEnum(i), SufStr, i);
if Length(SufStr) <> 0 then
begin
System.Delete(SufStr, Length(SufStr), 1);
pSuffix := StrAlloc(Length(SufStr) + 1);
StrPLCopy(pSuffix, SufStr, Length(SufStr) + 1);
end;
// fComprSpecial := False; { if True, try to compr already compressed files }
fSystem := False; { if True, include system and hidden files }
if AddVolume in fAddOptions then
fVolume := True { if True, include volume label from root dir }
else
fVolume := False;
fExtra := False; { if True, include extended file attributes-NOT SUPTED }
fDate := AddFromDate in fAddOptions; { if True, exclude files earlier than specified date }
{ Date := '100592'; }{ Date to include files after; only used if fDate=TRUE }
dts:=FormatDateTime('mm dd yy',fFromDate);
for i:=0 to 7 do
Date[i]:=dts[i+1];
fLevel := FAddCompLevel; { Compression level (0 - 9, 0=none and 9=best) }
fCRLF_LF := False; { if True, translate text file CRLF to LF (if dest Unix)}
fGrow := True; { if True, Allow appending to a zip file (-g)}
fDeleteEntries := False; { distinguish bet. Add and Delete }
if fTrace then
fTraceEnabled := True
else
fTraceEnabled := False;
if fVerbose then
fVerboseEnabled := True
else
fVerboseEnabled := False;
if (fTraceEnabled and not fVerbose) then
fVerboseEnabled := True; { if tracing, we want verbose also }
if FUnattended then
Handle := 0
else
Handle := fHandle;
if AddForceDOS in fAddOptions then
fForce := True { convert all filenames to 8x3 format }
else
fForce := False;
if AddZipTime in fAddOptions then
fLatestTime := True { make zipfile's timestamp same as newest file }
else
fLatestTime := False;
if AddMove in fAddOptions then
fMove := True { dangerous, beware! }
else
fMove := False;
if AddFreshen in fAddOptions then
fFreshen := True
else
fFreshen := False;
if AddUpdate in fAddOptions then
fUpdate := True
else
fUpdate := False;
if (fFreshen and fUpdate) then
fFreshen := False; { Update has precedence over freshen }
if AddEncrypt in fAddOptions then
fEncrypt := True { DLL will prompt for password }
else
fEncrypt := False;
{ NOTE: if user wants recursion, then he probably also wants
AddDirNames, but we won't demand it. }
if AddRecurseDirs in fAddOptions then
fRecurse := True
else
fRecurse := False;
if AddHiddenFiles in fAddOptions then
fSystem := True
else
fSystem := False;
if AddSeparateDirs in fAddOptions then
fNoDirEntries := False { do make separate dirname entries - and also
include dirnames with filenames }
else
fNoDirEntries := True; { normal zip file - dirnames only stored
with filenames }
if AddDirNames in fAddOptions then
fJunkDir := False { we want dirnames with filenames }
else
fJunkDir := True; { don't store dirnames with filenames }
pZipFN := StrAlloc(Length(NameOfZipFile) + 1); { allocate room for null terminated string }
StrPLCopy(pZipFN, NameOfZipFile, Length(NameOfZipFile) + 1); { name of zip file }
if Length(FPassword) > 0 then
begin
pZipPassword := StrAlloc(Length(FPassword) + 1); { allocate room for null terminated string }
StrPLCopy(pZipPassword, FPassword, PWLEN + 1); { password for encryption/decryption }
end;
end; {end else with do }
end;
procedure TZipMaster.SetDeleteSwitches; { override "add" behavior assumed by SetZipSwitches: }
begin
with ZipParms^ do
begin
fDeleteEntries := True;
fGrow := False;
fJunkDir := False;
fMove := False;
fFreshen := False;
fUpdate := False;
fRecurse := False; // bug fix per Angus Johnson
fEncrypt := False; // you don't need the pwd to delete a file
end;
end;
procedure TZipMaster.SetUnZipSwitches(var NameOfZipFile: string; uzpVersion: Integer);
begin
with UnZipParms^ do
begin
Version := uzpVersion; //UNZIPVERSION; // version we expect the DLL to be
Caller := Self; // point to our VCL instance; returned in callback
fQuiet := True; { we'll report errors upon notification in our callback }
{ So, we don't want the DLL to issue error dialogs }
ZCallbackFunc := ZCallback; // pass addr of function to be called from DLL
if fTrace then
fTraceEnabled := True
else
fTraceEnabled := False;
if fVerbose then
fVerboseEnabled := True
else
fVerboseEnabled := False;
if (fTraceEnabled and not fVerboseEnabled) then
fVerboseEnabled := True; { if tracing, we want verbose also }
if FUnattended then
Handle := 0
else
Handle := fHandle; // used for dialogs (like the pwd dialogs)
fQuiet := True; { no DLL error reporting }
fComments := False; { zipfile comments - not supported }
fConvert := False; { ascii/EBCDIC conversion - not supported }
if ExtrDirNames in fExtrOptions then
fDirectories := True
else
fDirectories := False;
if ExtrOverWrite in fExtrOptions then
fOverwrite := True
else
fOverwrite := False;
if ExtrFreshen in fExtrOptions then
fFreshen := True
else
fFreshen := False;
if ExtrUpdate in fExtrOptions then
fUpdate := True
else
fUpdate := False;
if fFreshen and fUpdate then
fFreshen := False; { Update has precedence over freshen }
if ExtrTest in fExtrOptions then
fTest := True
else
fTest := False;
{ allocate room for null terminated string }
pZipFN := StrAlloc(Length(NameOfZipFile) + 1);
StrPLCopy(pZipFN, NameOfZipFile, Length(NameOfZipFile) + 1); { name of zip file }
UnZipParms.fPwdReqCount := FPasswordReqCount;
// We have to be carefull doing an unattended Extract when a password is needed
// for some file in the archive. We set it to an unlikely password, this way
// encrypted files won't be extracted.
// From verion 1.60 and up the event OnPasswordError is called in this case.
pZipPassword := StrAlloc(Length(FPassword) + 1); // Allocate room for null terminated string.
StrPLCopy(pZipPassword, FPassword, Length(FPassword) + 1); // Password for encryption/decryption.
end; { end with }
end;
function TZipMaster.GetAddPassword: string;
var
p1, p2: string;
begin
p2 := '';
if FUnattended then
ShowZipMessage(PW_UnatAddPWMiss, '')
else
begin
if (GetPassword(LoadZipStr(PW_Caption, RESOURCE_ERROR), LoadStr(PW_MessageEnter), [pwbCancel], p1) = pwbOk) and (p1 <> '') then
begin
if (GetPassword(LoadZipStr(PW_Caption, RESOURCE_ERROR), LoadStr(PW_MessageConfirm), [pwbCancel], p2) = pwbOk) and (p2 <> '') then
begin
if AnsiCompareStr(p1, p2) <> 0 then
begin
ShowZipMessage(GE_WrongPassword, '');
p2 := '';
end
else
if GAssignPassword then
FPassword := p2;
end;
end;
end;
Result := p2;
end;
// Same as GetAddPassword, but does NOT verify
function TZipMaster.GetExtrPassword: string;
var
p1: string;
begin
p1 := '';
if FUnattended then
ShowZipMessage(PW_UnatExtPWMiss, '')
else
if (GetPassword(LoadZipStr(PW_Caption, RESOURCE_ERROR), LoadStr(PW_MessageEnter), [pwbCancel, pwbCancelAll], p1) = pwbOk) and (p1 <> '') then
if GAssignPassword then
FPassword := p1;
Result := p1;
end;
function TZipMaster.GetPassword(DialogCaption, MsgTxt: string; pwb: TPasswordButtons; var ResultStr: string): TPasswordButton;
var
Pdlg: TPasswordDlg;
begin
Pdlg := TPasswordDlg.CreateNew2(Self, pwb);
ResultStr := Pdlg.ShowModalPwdDlg(DialogCaption, MsgTxt);
GModalResult := Pdlg.ModalResult;
Pdlg.Free;
case GModalResult of
mrOk: Result := pwbOk;
mrCancel: Result := pwbCancel;
mrNoToAll: Result := pwbCancelAll;
else
Result := pwbAbort;
end;
end;
procedure TZipMaster.Add;
begin
ExtAdd(0, 0, 0, nil);
end;
//---------------------------------------------------------------------------
// FileAttr are set to 0 as default.
// FileAttr can be one or a logical combination of the following types:
// FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, FILE_ATTRIBUTE_READONLY, FILE_ATTRIBUTE_SYSTEM.
// FileName is as default an empty string.
// FileDate is default the system date.
// EWE: I think 'Filename' is the name you want to use in the zip file to
// store the contents of the stream under.
procedure TZipMaster.AddStreamToFile(Filename: string; FileDate, FileAttr: DWORD);
var
st: TSystemTime;
ft: TFileTime;
FatDate, FatTime: Word;
begin
TraceMessage('AddStreamToFile, fname=' + Filename); // qqq
if Length(Filename) > 0 then
begin
FFSpecArgs.Clear();
FFSpecArgs.Append(FileName);
end;
if FileDate = 0 then
begin
GetLocalTime(st);
SystemTimeToFileTime(st, ft);
FileTimeToDosDateTime(ft, FatDate, FatTime);
FileDate := (DWORD(FatDate) shl 16) + FatTime;
end;
// Check if wildcards are set.
if FFSpecArgs.Count > 0 then
begin
if (AnsiPos(FFSpecArgs.Strings[0], '*') > 0) or (AnsiPos(FFSpecArgs.Strings[0], '?') > 0) then
ShowZipMessage(AD_InvalidName, '')
else
ExtAdd(1, FileDate, FileAttr, nil);
end
else
ShowZipMessage(AD_NothingToZip, '');
end;
//---------------------------------------------------------------------------
function TZipMaster.AddStreamToStream(InStream: TMemoryStream): TZipStream;
begin
if InStream = FZipStream then
begin
ShowZipMessage(AD_InIsOutStream, '');
Result := nil;
Exit;
end;
if InStream.Size > 0 then
begin
FZipStream.SetSize(InStream.Size + 6);
// Call the extended Add procedure:
ExtAdd(2, 0, 0, InStream);
// The size of the output stream is reset by the dll in ZipParms2 in fOutStreamSize.
// Also the size is 6 bytes more than the actual output size because:
// - the first two bytes are used as flag, STORED=0 or DEFLATED=8.
// - the next four bytes are set to the calculated CRC value.
// The size is reset from Inputsize +6 to the actual data size +6.
// (you do not have to set the size yourself, in fact it won't be taken into account.
// The start of the stream is set to the actual data start.
if FSuccessCnt = 1 then
FZipStream.Position := 6
else
FZipStream.SetSize(0);
end
else
ShowZipMessage(AD_NothingToZip, '');
Result := FZipStream;
end;
//---------------------------------------------------------------------------
// UseStream = 0 ==> Add file to zip archive file.
// UseStream = 1 ==> Add stream to zip archive file.
// UseStream = 2 ==> Add stream to another (zipped) stream.
procedure TZipMaster.ExtAdd(UseStream: Integer; StrFileDate, StrFileAttr: DWORD; MemStream: TMemoryStream);
var
i, DLLVers: Integer;
{$IFNDEF NO_SPAN}
drt: Integer;
{$ENDIF}
{$IFNDEF NO_SFX}
SFXResult: Integer;
{$ENDIF}
AutoLoad: Boolean;
TmpZipName: string;
pFDS: pFileData;
pExFiles: pExcludedFileSpec;
len, b, p, RootLen: Integer;
rdir: string;
begin
FSuccessCnt := 0;
if (UseStream = 0) and (fFSpecArgs.Count = 0) then
begin
ShowZipMessage(AD_NothingToZip, '');
Exit;
end;
{$IFDEF NO_SPAN}
if (AddDiskSpanErase in FAddOptions) or (AddDiskSpan in FAddOptions) then
begin
ShowZipMessage(DS_NODISKSPAN, '');
Exit;
end;
{$ENDIF}
{ We must allow a zipfile to be specified that doesn't already exist,
so don't check here for existance. }
if (UseStream < 2) and (FZipFileName = '') then { make sure we have a zip filename }
begin
ShowZipMessage(GE_NoZipSpecified, '');
Exit;
end;
// We can not do an Unattended Add if we don't have a password.
if FUnattended and (AddEncrypt in FAddOptions) and (FPassword = '') then
begin
ShowZipMessage(AD_UnattPassword, '');
Exit
end;
// If we are using disk spanning, first create a temporary file
if (UseStream < 2) and (AddDiskSpan in FAddOptions) or (AddDiskSpanErase in FAddOptions) then
begin
{$IFDEF NO_SPAN}
ShowZipMessage(DS_NoDiskSpan, '');
exit;
{$ELSE}
// We can't do this type of Add() on a spanned archive.
if (AddFreshen in FAddOptions) or (AddUpdate in FAddOptions) then
begin
ShowZipMessage(AD_NoFreshenUpdate, '');
Exit;
end;
// We can't make a spanned SFX archive
if (UpperCase(ExtractFileExt(FZipFileName)) = '.EXE') then
begin
ShowZipMessage(DS_NoSFXSpan, '');
Exit;
end;
TmpZipName := MakeTempFileName('', '');
if FVerbose and Assigned(FOnMessage) then
FOnMessage(Self, 0, 'Temporary zipfile: ' + TmpZipName);
{$ENDIF}
end
else
TmpZipName := FZipFileName; // not spanned - create the outfile directly
{ Make sure we can't get back in here while work is going on }
if fZipBusy then
Exit;
if (UseStream < 2) and (Uppercase(ExtractFileExt(FZipFileName)) = '.EXE')
and (FSFXOffset = 0) and not FileExists(FZipFileName) then
begin
{$IFDEF NO_SFX}
ShowZipMessage(SF_NOSFXSUPPORT, '');
exit;
{$ELSE}
try
{ This is the first "add" operation following creation of a new
.EXE archive. We need to add the SFX code now, before we add
the files. }
AutoExeViaAdd := True;
SFXResult := ConvertSFX;
AutoExeViaAdd := False;
if SFXResult <> 0 then
raise EZipMaster.CreateResDisk(AD_AutoSFXWrong, SFXResult);
except
on ews: EZipMaster do // All SFX creation errors will be caught and returned in this one message.
begin
ShowExceptionError(ews);
Exit;
end;
end;
{$ENDIF}
end;
DLLVers := Load_ZipDll(AutoLoad);
if DLLVers = 0 then
exit; // could not load valid dll
fZipBusy := True;
Cancel := False;
try
try
ZipParms := AllocMem(SizeOf(ZipParms2));
SetZipSwitches(TmpZipName, DLLVers);
with ZipParms^ do
begin
if UseStream = 1 then
begin
fUseInStream := True;
fInStream := FZipStream.Memory;
fInStreamSize := FZipStream.Size;
fStrFileAttr := StrFileAttr;
fStrFileDate := StrFileDate;
end;
if UseStream = 2 then
begin
fUseOutStream := True;
fOutStream := FZipStream.Memory;
fOutStreamSize := MemStream.Size + 6;
fUseInStream := True;
fInStream := MemStream.Memory;
fInStreamSize := MemStream.Size;
end;
fFDS := AllocMem(SizeOf(FileData) * FFSpecArgs.Count);
for i := 0 to (fFSpecArgs.Count - 1) do
begin
len := Length(FFSpecArgs.Strings[i]);
p := 1;
pFDS := fFDS;
Inc(pFDS, i);
// Added to version 1.60L to support recursion and encryption on a FFileSpec basis.
// Regardless of what AddRecurseDirs is set to, a '>' will force recursion, and a '|' will stop recursion.
pFDS.fRecurse := Word(fRecurse); // Set default
if Copy(FFSpecArgs.Strings[i], 1, 1) = '>' then
begin
pFDS.fRecurse := $FFFF;
Inc(p);
end;
if Copy(FFSpecArgs.Strings[i], 1, 1) = '|' then
begin
pFDS.fRecurse := 0;
Inc(p);
end;
// Also it is possible to specify a password after the FFileSpec, separated by a '<'
// If there is no other text after the '<' then, an existing password, is temporarily canceled.
pFDS.fEncrypt := LongWord(fEncrypt); // Set default
if Length(pZipPassword) > 0 then // v1.60L
begin
pFDS.fPassword := StrAlloc(Length(pZipPassword) + 1);
StrLCopy(pFDS.fPassword, pZipPassword, Length(pZipPassword));
end;
b := AnsiPos('<', FFSpecArgs.Strings[i]);
if b <> 0 then
begin // Found...
pFDS.fEncrypt := $FFFF; // the new default, but...
StrDispose(pFDS.fPassword);
pFDS.fPassword := nil;
if Copy(FFSpecArgs.Strings[i], b + 1, 1) = '' then
pFDS.fEncrypt := 0 // No password, so cancel for this FFspecArg
else
begin
pFDS.fPassword := StrAlloc(len - b + 1);
StrPLCopy(pFDS.fPassword, Copy(FFSpecArgs.Strings[i], b + 1, len - b), len - b + 1);
len := b - 1;
end;
end;
// And to set the RootDir, possibly later with override per FSpecArg v1.70
if RootDir <> '' then
begin
rdir := ExpandFileName(fRootDir); // allow relative root
RootLen := Length(rdir);
pFDS.fRootDir := StrAlloc(RootLen + 1);
StrPLCopy(pFDS.fRootDir, rdir, RootLen + 1);
end;
pFDS.fFileSpec := StrAlloc(len - p + 2);
StrPLCopy(pFDS.fFileSpec, Copy(FFSpecArgs.Strings[i], p, len - p + 1), len - p + 2);
end;
fSeven := 7;
end; { end with }
ZipParms.argc := fSpecArgs.Count;
{ pass in a ptr to parms }
fSuccessCnt := ZipDLLExec(ZipParms);
// If Add was successful and we want spanning, copy the
// temporary file to the destination.
if (UseStream < 2) and (fSuccessCnt > 0) and
((AddDiskSpan in FAddOptions) or (AddDiskSpanErase in FAddOptions)) then
{$IFDEF NO_SPAN}
raise EZipMaster.CreateResDisp(DS_NODISKSPAN, true);
{$ELSE}
begin
// write the temp zipfile to the right target:
if WriteSpan(TmpZipName, FZipFileName) = 0 then
begin // Change the zipfilename when needed 1.52N, 1.60N
drt := GetDriveType(pChar(FDrive));
if (drt = DRIVE_FIXED) or (drt = DRIVE_REMOTE) then
FZipFilename := Copy(FZipFileName, 1, Length(FZipFileName) - Length(ExtractFileExt(FZipFileName))) +
Copy(IntToStr(1001 + FDiskNr), 2, 3) + ExtractFileExt(FZipFileName);
end
else
fSuccessCnt := 0; // error occurred during write span
DeleteFile(TmpZipName);
end;
{$ENDIF}
if (UseStream = 2) and (FSuccessCnt = 1) then
FZipStream.SetSize(ZipParms.fOutStreamSize);
except
ShowZipMessage(GE_FatalZip, '');
end;
finally
fFSpecArgs.Clear;
fFSpecArgsExcl.Clear;
with ZipParms^ do
begin
{ Free the memory for the zipfilename and parameters }
{ we know we had a filename, so we'll dispose it's space }
StrDispose(pZipFN);
StrDispose(pZipPassword);
StrDispose(pSuffix);
pZipPassword := nil; // v1.60L
StrDispose(fTempPath);
StrDispose(fArchComment);
for i := (Argc - 1) downto 0 do
begin
pFDS := fFDS;
Inc(pFDS, i);
StrDispose(pFDS.fFileSpec);
StrDispose(pFDS.fPassword); // v1.60L
StrDispose(pFDS.fRootDir); // v1.60L
end;
FreeMem(fFDS);
for i := (fTotExFileSpecs - 1) downto 0 do
begin
pExFiles := fExFiles;
Inc(pExFiles, i);
StrDispose(pExFiles.fFileSpec);
end;
FreeMem(fExFiles);
end;
FreeMem(ZipParms);
ZipParms := nil;
end; {end try finally }
if AutoLoad then
Unload_Zip_Dll;
Cancel := False;
fZipBusy := False;
if fSuccessCnt > 0 then
List(); { Update the Zip Directory by calling List method }
end;
procedure TZipMaster.Delete;
var
i, DLLVers: Integer;
AutoLoad: Boolean;
pFDS: pFileData;
EOC: ZipEndOfCentral;
pExFiles: pExcludedFileSpec;
begin
FSuccessCnt := 0;
if fFSpecArgs.Count = 0 then
begin
ShowZipMessage(DL_NothingToDel, '');
Exit;
end;
if not FileExists(FZipFileName) then
begin
ShowZipMessage(GE_NoZipSpecified, '');
Exit;
end;
// new 1.7 - stop delete from spanned
CheckIfLastDisk(EOC, true);
FileClose(fInFileHandle); // only needed to test it
if (IsSpanned) then
raise EZipMaster.CreateResDisp(DL_NoDelOnSpan, true);
{ Make sure we can't get back in here while work is going on }
if fZipBusy then
Exit;
fZipBusy := True; { delete uses the ZIPDLL, so it shares the FZipBusy flag }
Cancel := False;
if ZipDllHandle = 0 then
begin
AutoLoad := True; // user's program didn't load the DLL
Load_Zip_Dll; // load it
end
else
AutoLoad := False; // user's pgm did load the DLL, so let him unload it
if ZipDllHandle = 0 then
begin
fZipBusy := False;
Exit; // load failed - error msg was shown to user
end;
DLLVers := ZipVers;
if DLLVers < 170 then
begin
ShowZipMessage(LZ_OldZipDll, GetZipDllPath(ZipDllHandle));
exit;
end;
try
try
ZipParms := AllocMem(SizeOf(ZipParms2));
SetZipSwitches(fZipFileName, DLLVers);
SetDeleteSwitches;
with ZipParms^ do
begin
fFDS := AllocMem(SizeOf(FileData) * FFSpecArgs.Count);
for i := 0 to (fFSpecArgs.Count - 1) do
begin
pFDS := fFDS;
Inc(pFDS, i);
pFDS.fFileSpec := StrAlloc(Length(fFSpecArgs[i]) + 1);
StrPLCopy(pFDS.fFileSpec, fFSpecArgs[i], Length(fFSpecArgs[i]) + 1);
end;
Argc := fSpecArgs.Count;
fSeven := 7;
end; { end with }
{ pass in a ptr to parms }
fSuccessCnt := ZipDLLExec(ZipParms);
except
ShowZipMessage(GE_FatalZip, '');
end;
finally
fFSpecArgs.Clear;
fFSpecArgsExcl.Clear;
with ZipParms^ do
begin
StrDispose(pZipFN);
StrDispose(pZipPassword);
StrDispose(pSuffix);
StrDispose(fTempPath);
StrDispose(fArchComment);
for i := (Argc - 1) downto 0 do
begin
pFDS := fFDS;
Inc(pFDS, i);
StrDispose(pFDS.fFileSpec);
end;
FreeMem(fFDS);
for i := (fTotExFileSpecs - 1) downto 0 do
begin
pExFiles := fExFiles;
Inc(pExFiles, i);
StrDispose(pExFiles.fFileSpec);
end;
FreeMem(fExFiles);
end;
FreeMem(ZipParms);
ZipParms := nil;
end;
if AutoLoad then
Unload_Zip_Dll;
fZipBusy := False;
Cancel := False;
if fSuccessCnt > 0 then
List; { Update the Zip Directory by calling List method }
end;
constructor TZipStream.Create;
begin
inherited Create;
Clear();
end;
destructor TZipStream.Destroy;
begin
inherited Destroy;
end;
procedure TZipStream.SetPointer(Ptr: Pointer; Size: Integer);
begin
inherited SetPointer(Ptr, Size);
end;
function TZipMaster.ExtractFileToStream(FileName: string): TZipStream;
begin
// Use FileName if set, if not expect the filename in the FFSpecArgs.
if FileName <> '' then
begin
FFSpecArgs.Clear();
FFSpecArgs.Add(FileName);
end;
FZipStream.Clear();
ExtExtract(1, nil);
if FSuccessCnt <> 1 then
Result := nil
else
Result := FZipStream;
end;
function TZipMaster.ExtractStreamToStream(InStream: TMemoryStream; OutSize: Longword): TZipStream;
begin
if InStream = FZipStream then
begin
ShowZipMessage(AD_InIsOutStream, '');
Result := nil;
Exit;
end;
FZipStream.Clear();
FZipStream.SetSize(OutSize);
ExtExtract(2, InStream);
if FSuccessCnt <> 1 then
Result := nil
else
Result := FZipStream;
end;
procedure TZipMaster.Extract();
begin
ExtExtract(0, nil);
end;
// UseStream = 0 ==> Extract file from zip archive file.
// UseStream = 1 ==> Extract stream from zip archive file.
// UseStream = 2 ==> Extract (zipped) stream from another stream.
procedure TZipMaster.ExtExtract(UseStream: Integer; MemStream: TMemoryStream);
var
i, UnzDLLVers: Integer;
OldPRC: Integer;
AutoLoad: Boolean;
TmpZipName: string;
pUFDS: pUnzFileData;
{$IFNDEF NO_SPAN}
NewName: array[0..512] of Char;
{$ENDIF}
begin
FSuccessCnt := 0;
OldPRC := FPasswordReqCount;
if (UseStream < 2) and (not FileExists(FZipFileName)) then
begin
ShowZipMessage(GE_NoZipSpecified, '');
Exit;
end;
{ Make sure we can't get back in here while work is going on }
if fUnzBusy then
Exit;
// We have to be carefull doing an unattended Extract when a password is needed
// for some file in the archive.
if FUnattended and (FPassword = '') and not Assigned(FOnPasswordError) then
begin
FPasswordReqCount := 0;
ShowZipMessage(EX_UnAttPassword, '');
end;
Cancel := False;
fUnzBusy := True;
// We do a check if we need UnSpanning first, this depends on
// The number of the disk the EOC record was found on. ( provided by List() )
// If we have a spanned set consisting of only one disk we don't use ReadSpan().
if FTotalDisks <> 0 then
begin
{$IFDEF NO_SPAN}
fUnzBusy := False;
ShowZipMessage(DS_NODISKSPAN, '');
exit;
{$ELSE}
if FTempDir = '' then
begin
GetTempPath(MAX_PATH, NewName);
TmpZipName := NewName;
end
else
TmpZipName := AppendSlash(FTempDir);
if ReadSpan(FZipFileName, TmpZipName) <> 0 then
begin
fUnzBusy := False;
{ if AutoLoad then
Unload_Unz_Dll(); }
Exit;
end;
// We returned without an error, now TmpZipName contains a real name.
{$ENDIF}
end
else
TmpZipName := FZipFileName;
UnzDLLVers := Load_UnzDll(AutoLoad);
if UnzDllVers = 0 then
begin
FUnzBusy := false;
exit; // could not load valid DLL
end;
// UnzDLLVers := UnzVers;
try
try
UnZipParms := AllocMem(SizeOf(UnZipParms2));
SetUnZipSwitches(TmpZipName, UnzDLLVers);
with UnzipParms^ do
begin
if ExtrBaseDir <> '' then
begin
fExtractDir := StrAlloc(Length(fExtrBaseDir) + 1);
StrPLCopy(fExtractDir, fExtrBaseDir, Length(fExtrBaseDir));
end
else
fExtractDir := nil;
fUFDS := AllocMem(SizeOf(UnzFileData) * FFSpecArgs.Count);
for i := 0 to (fFSpecArgs.Count - 1) do
begin
pUFDS := fUFDS;
Inc(pUFDS, i);
pUFDS.fFileSpec := StrAlloc(Length(fFSpecArgs[i]) + 1);
StrPLCopy(pUFDS.fFileSpec, fFSpecArgs[i], Length(fFSpecArgs[i]) + 1);
end;
fArgc := FFSpecArgs.Count;
if UseStream = 1 then
begin
for i := 0 to Count - 1 do { Find the wanted file in the ZipDirEntry list. }
begin
with ZipDirEntry(ZipContents[i]^) do
begin
if AnsiStrIComp(pChar(FFSpecArgs.Strings[0]), pChar(FileName)) = 0 then { Found? }
begin
FZipStream.SetSize(UncompressedSize);
fUseOutStream := True;
fOutStream := FZipStream.Memory;
fOutStreamSize := UncompressedSize;
fArgc := 1;
Break;
end;
end;
end;
end;
if UseStream = 2 then
begin
fUseInStream := True;
fInStream := MemStream.Memory;
fInStreamSize := MemStream.Size;
fUseOutStream := True;
fOutStream := FZipStream.Memory;
fOutStreamSize := FZipStream.Size;
end;
fSeven := 7;
end;
{ Argc is now the no. of filespecs we want extracted }
if (UseStream = 0) or ((UseStream > 0) and UnZipParms {.up2}.fUseOutStream) then
fSuccessCnt := UnzDLLExec(Pointer(UnZipParms {.up1}));
{ Remove from memory if stream is not Ok. }
if (UseStream > 0) and (FSuccessCnt <> 1) then
FZipStream.Clear();
{ If UnSpanned we still have this temporary file hanging around. }
if FTotalDisks > 0 then
DeleteFile(TmpZipName);
except
ShowZipMessage(EX_FatalUnZip, '');
end;
finally
fFSpecArgs.Clear;
with UnZipParms^ do
begin
StrDispose(pZipFN);
StrDispose(pZipPassword);
if (fExtractDir <> nil) then
StrDispose(fExtractDir);
for i := (fArgc - 1) downto 0 do
begin
pUFDS := fUFDS;
Inc(pUFDS, i);
StrDispose(pUFDS.fFileSpec);
end;
FreeMem(fUFDS);
end;
FreeMem(UnZipParms);
UnZipParms := nil;
end;
if FUnattended and (FPassword = '') and not Assigned(FOnPasswordError) then
FPasswordReqCount := OldPRC;
if AutoLoad then
Unload_Unz_Dll;
Cancel := False;
fUnzBusy := False;
{ no need to call the List method; contents unchanged }
end;
//---------------------------------------------------------------------------
// Returns 0 if good copy, or a negative error code.
function TZipMaster.CopyFile(const InFileName, OutFileName: string): Integer;
const
SE_CreateError = -1; { Error in open or creation of OutFile. }
SE_OpenReadError = -3; { Error in open or Seek of InFile. }
SE_SetDateError = -4; { Error setting date/time of OutFile. }
SE_GeneralError = -9;
var
InFile, OutFile, InSize, OutSize: Integer;
begin
InSize := -1;
OutSize := -1;
Result := SE_OpenReadError;
FShowProgress := False;
if not FileExists(InFileName) then
Exit;
StartWaitCursor;
InFile := FileOpen(InFileName, fmOpenRead or fmShareDenyWrite);
if InFile <> -1 then
begin
if FileExists(OutFileName) then
EraseFile(OutFileName, FHowToDelete);
OutFile := FileCreate(OutFileName);
if OutFile <> -1 then
begin
Result := CopyBuffer(InFile, OutFile, -1);
if (Result = 0) and (FileSetDate(OutFile, FileGetDate(InFile)) <> 0) then
Result := SE_SetDateError;
OutSize := FileSeek(OutFile, 0, 2);
FileClose(OutFile);
end
else
Result := SE_CreateError;
InSize := FileSeek(InFile, 0, 2);
FileClose(InFile);
end;
// An extra check if the filesizes are the same.
if (Result = 0) and ((InSize = -1) or (OutSize = -1) or (InSize <> OutSize)) then
Result := SE_GeneralError;
// Don't leave a corrupted outfile lying around. (SetDateError is not fatal!)
if (Result <> 0) and (Result <> SE_SetDateError) then
DeleteFile(OutFileName);
StopWaitCursor;
end;
{ Delete a file and put it in the recyclebin on demand. }
function TZipMaster.EraseFile(const Fname: string; How: DeleteOpts): Integer;
var
SHF: TSHFileOpStruct;
DelFileName: string;
begin
// If we do not have a full path then FOF_ALLOWUNDO does not work!?
DelFileName := Fname;
if ExtractFilePath(Fname) = '' then
DelFileName := GetCurrentDir() + '' + Fname;
Result := -1;
// We need to be able to 'Delete' without getting an error
// if the file does not exists as in ReadSpan() can occur.
if not FileExists(DelFileName) then
Exit;
with SHF do
begin
Wnd := Application.Handle;
wFunc := FO_DELETE;
pFrom := pChar(DelFileName + #0);
pTo := nil;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
if How = htdAllowUndo then
fFlags := fFlags or FOF_ALLOWUNDO;
end;
Result := SHFileOperation(SHF);
end;
// Make a temporary filename like: C:...zipxxxx.zip
// Prefix and extension are default: 'zip' and '.zip'
function TZipMaster.MakeTempFileName(Prefix, Extension: string): string;
var
Buffer: pChar;
len: DWORD;
begin
Buffer := nil;
if Prefix = '' then
Prefix := 'zip';
if Extension = '' then
Extension := '.zip';
try
if Length(FTempDir) = 0 then // Get the system temp dir
begin
// 1. The path specified by the TMP environment variable.
// 2. The path specified by the TEMP environment variable, if TMP is not defined.
// 3. The current directory, if both TMP and TEMP are not defined.
len := GetTempPath(0, Buffer);
GetMem(Buffer, len + 12);
GetTempPath(len, Buffer);
end
else // Use Temp dir provided by ZipMaster
begin
FTempDir := AppendSlash(FTempDir);
GetMem(Buffer, Length(FTempDir) + 13);
StrPLCopy(Buffer, FTempDir, Length(FTempDir) + 1);
end;
if GetTempFileName(Buffer, pChar(Prefix), 0, Buffer) <> 0 then
begin
DeleteFile(Buffer); // Needed because GetTempFileName creates the file also.
Result := ChangeFileExt(Buffer, Extension); // And finally change the extension.
end;
finally
FreeMem(Buffer);
end;
end;
function TZipMaster.CopyBuffer(InFile, OutFile, ReadLen: Integer): Integer;
const
SE_CopyError = -2; // Write error or no memory during copy.
var
SizeR, ToRead: Integer;
Buffer: pBuffer;
begin
// both files are already open
Result := 0;
ToRead := BufSize;
Buffer := nil;
try
New(Buffer);
repeat
if ReadLen >= 0 then
begin
ToRead := ReadLen;
if BufSize < ReadLen then
ToRead := BufSize;
end;
SizeR := FileRead(InFile, Buffer^, ToRead);
if FileWrite(OutFile, Buffer^, SizeR) <> SizeR then
begin
Result := SE_CopyError;
Break;
end;
if Assigned(FOnProgress) and FShowProgress then
FOnProgress(Self, ProgressUpdate, '', SizeR);
if ReadLen > 0 then
Dec(ReadLen, SizeR);
Application.ProcessMessages; // Mostly for winsock.
until ((ReadLen = 0) or (SizeR <> ToRead));
except
Result := SE_CopyError;
end;
if Buffer <> nil then
Dispose(Buffer);
// leave both files open
end;
//---------------------------------------------------------------------------
// Function to find the EOC record at the end of the archive (on the last disk.)
// We can get a return value( true::Found, false::Not Found ) or an exception if not found.
function TZipMaster.CheckIfLastDisk(var EOC: ZipEndOfCentral; DoExcept: boolean): boolean;
var
Sig: Cardinal;
DiskNo, Size, i, j: Integer;
ShowGarbageMsg: Boolean;
First: Boolean;
ZipBuf: pChar;
begin
FZipComment := '';
First := False;
DiskNo := 0;
ZipBuf := nil;
FZipEOC := 0;
// Open the input archive, presumably the last disk.
FInFileHandle := FileOpen(FInFileName, fmShareDenyWrite or fmOpenRead);
if FInFileHandle = -1 then
begin
if DoExcept = True then
raise EZipMaster.CreateResDisp(DS_NoInFile, True);
ShowZipMessage(DS_FileOpen, '');
Result := False;
Exit;
end;
// Get the volume number if it's disk from a set.
if Pos('PKBACK# ', FVolumeName) = 1 then
DiskNo := StrToIntDef(Copy(FVolumeName, 9, 3), 0);
// First a check for the first disk of a spanned archive,
// could also be the last so we don't issue a warning yet.
if (FileRead(FInFileHandle, Sig, 4) = 4) and (Sig = ExtLocalSig) and
(FileRead(FInFileHandle, Sig, 4) = 4) and (Sig = LocalFileHeaderSig) then
begin
First := True;
FIsSpanned := True;
end;
// Next we do a check at the end of the file to speed things up if
// there isn't a Zip archive comment.
FFileSize := FileSeek(FInFileHandle, -SizeOf(EOC), 2);
if FFileSize <> -1 then
begin
Inc(FFileSize, SizeOf(EOC)); // Save the archive size as a side effect.
FRealFileSize := FFileSize; // There could follow a correction on FFileSize.
if (FileRead(FInFileHandle, EOC, SizeOf(EOC)) = SizeOf(EOC)) and
(EOC.HeaderSig = EndCentralDirSig) then
begin
FZipEOC := FFileSize - SizeOf(EOC);
Result := True;
Exit;
end;
end;
// Now we try to find the EOC record within the last 65535 + sizeof( EOC ) bytes
// of this file because we don't know the Zip archive comment length at this time.
try
Size := 65535 + SizeOf(EOC);
if FFileSize < Size then
Size := FFileSize;
GetMem(ZipBuf, Size + 1);
if FileSeek(FInFileHandle, -Size, 2) = -1 then
raise EZipMaster.CreateResDisp(DS_FailedSeek, True);
if not (FileRead(FInFileHandle, ZipBuf^, Size) = Size) then
raise EZipMaster.CreateResDisp(DS_EOCBadRead, True);
for i := Size - SizeOf(EOC) - 1 downto 0 do
if (ZipBuf[i] = 'P') and (ZipBuf[i + 1] = 'K') and (ZipBuf[i + 2] = #$05) and (ZipBuf[i + 3] = #$06) then
begin
FZipEOC := FFileSize - Size + i;
Move(ZipBuf[i], EOC, SizeOf(EOC)); // Copy from our buffer to the EOC record.
// Check if we really are at the end of the file, if not correct the filesize
// and give a warning. (It should be an error but we are nice.)
if not (i + SizeOf(EOC) + EOC.ZipCommentLen - Size = 0) then
begin
Inc(FFileSize, i + SizeOf(EOC) + Integer(EOC.ZipCommentLen) - Size);
// Now we need a check for WinZip Self Extractor which makes SFX files which
// allmost always have garbage at the end (Zero filled at 512 byte boundary!)
// In this special case 'we' don't give a warning.
ShowGarbageMsg := True;
if (FRealFileSize - Cardinal(FFileSize) < 512) and ((FRealFileSize mod 512) = 0) then
begin
j := i + SizeOf(EOC) + EOC.ZipCommentLen;
while (ZipBuf[j] = #0) and (j <= Size) do
Inc(j);
if j = Size + 1 then
ShowGarbageMsg := False;
end;
if ShowGarbageMsg then
ShowZipMessage(LI_GarbageAtEOF, '');
end;
// If we have ZipComment: Save it, must be after Garbage check because a #0 is set!
if not (EOC.ZipCommentLen = 0) then
begin
ZipBuf[i + SizeOf(EOC) + EOC.ZipCommentLen] := #0;
FZipComment := ZipBuf + i + SizeOf(EOC); // No codepage translation yet, wait for CEH read.
end;
FreeMem(ZipBuf);
Result := True;
Exit;
end;
FreeMem(ZipBuf);
except
FreeMem(ZipBuf);
if DoExcept = True then
raise;
end;
if DoExcept = True then
begin
if (First = False) and (DiskNo <> 0) then
raise EZipMaster.CreateResDisk(DS_NotLastInSet, DiskNo);
if First = True then
if DiskNo = 1 then
raise EZipMaster.CreateResDisp(DS_FirstInSet, True)
else
raise EZipMaster.CreateResDisp(DS_FirstFileOnHD, True)
else
raise EZipMaster.CreateResDisp(DS_NoValidZip, True);
end;
Result := False;
end;
// concat path
function PathConcat(path, extra: string): string;
var
pathLst: char; pathLen: integer;
begin
pathLen := Length(path);
Result := path;
if pathLen > 0 then
begin
pathLst := path[pathLen];
if (pathLst <> ':') and (Length(extra) > 0) then
begin
if (extra[1] = '') = (pathLst = '') then
begin
if pathLst = '' then
Result := Copy(path, 1, pathLen - 1) // remove trailing
else
Result := path + ''; // append trailing
end;
end;
end;
Result := Result + extra;
end;
// returns version - checks valid
function TZipMaster.Load_ZipDll(var autoload: boolean): integer; // New 1.70
begin
autoload := false;
if ZipDllHandle = 0 then
begin
Result := Load_Zip_Dll;
autoload := Result <> 0;
end
else
Result := GetZipDllVersion;
if Result < MinZipDllVers then
begin
ShowZipMessage(LZ_OldZipDll, GetZipDllPath(ZipDllHandle));
Unload_Zip_Dll;
Result := 0;
autoload := false;