home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
CHFLZ100.ZIP
/
CHIEFLZ.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-05
|
111KB
|
3,672 lines
{
CHIEFLZ UNIT/DLL, by Dr A Olowofoyeku (the African Chief);
internet: laa12@cc.keele.ac.uk
http://ourworld.compuserve.com/homepages/African_Chief/chief.htm
Version 1.00.
USES the original LZSSUNIT source, as amended by the Chief,
and Chris J Rankin. Ported to Win32 (Delphi 2.0) by Chris Rankin.
// -----------------------------------------------------------//
* 16-bit ASM functions converted to 32-bit ASM by Chris J Rankin
* Win32 (Delphi 2.0) code: added by Chris J Rankin
Package assembled together: 5th September 1996.
The routines in this package are already being used in some famous
programs!
}
{----------------------------------------------------------------------}
{to compile to a DLL in Delphi you need to rename this with the
extension .DPR}
{$I LZDefine.inc} {// defines various things, including "aDLL" //}
{$ifDef aDLL}
Library ChiefLZ;
Uses
{$ifdef Win32}
ShareMem, // Because the library exports functions that have
// long-string results/parameters, we need to use
// the ShareMem unit. All apps that use this library
// *must also use ShareMem* - Put DelphiMM.dll on the
// Path too ...
Windows,
LZSS32,
LZ_Const,
LZ_DLL,
{$else Win32}
LZSS16,
{$ifdef Windows}
{$ifdef DPMI}
WinAPI,
{$else DPMI}
WinProcs,
{$endif DPMI}
{$endif Windows}
{$endif Win32}
{$ifDef Delphi}
SysUtils,
{$else Delphi}
WinDos,
Strings,
{$endif Delphi}
ChfTypes,
ChfUtils;
{$else aDLL}
Unit ChiefLZ;
{$endif aDLL}
{------------------------------------------------------------}
{$ifNDef aDLL}
interface
uses
{$ifdef Delphi}
SysUtils,
{$endif}
ChfTypes;
{$endif aDLL}
Const ChiefLZVersionNumber = 100; { version 1.00 }
{$ifdef Win32} Var
{$else} Const
{$endif} MyLZMarker:Char = '~'; {last char in filenames created automatically}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{Pascal object encapsulating the functionality of
this unit - CANNOT BE EXPORTED BY DLL}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifndef aDLL}
Type
LZObj={$ifdef Delphi}Class{$else Delphi}Object{$Endif Delphi}
Constructor {$ifdef Delphi} Create
{$else} Init
{$endif}(Const InfName, OutFName:String);
{you can init with source and target file names,
or with blanks - so set the source and target file names
later
}
Destructor {$ifdef Delphi} Destroy; override
{$else} Done; virtual
{$endif};
{$ifndef Delphi}
Procedure SetInputName(Const aName: String);
{set source file name; absolutely necessary}
Procedure SetOutputName(Const aName: String);
{set target file name = if empty, then a default one
will be used}
Procedure SetReportProc(const aProc: TLZReportProc);
{point to procedure to report progress}
Procedure SetQuestionProc(const aProc: TLZQuestionFunc);
{point to function to ask question if the target file exists
already - if nothing is set, then existing target files will
be overwritten automatically}
{$endif}
Function Compress: Longint; virtual;
{compress the source file >> target file }
Function Decompress: Longint; virtual;
{decompress the source file >> target file}
private
{$ifdef Delphi}
FQuestionProc: TLZQuestionFunc;
FReportProc : TLZReportProc;
fInputName,
fOutputName : StrType;
function GetIsInited: boolean;
public
property QuestionProc: TLZQuestionFunc read FQuestionProc
write FQuestionProc;
property ReportProc: TLZReportProc read FReportProc
write FReportProc;
property IsInited: boolean read GetIsInited;
property InputName: StrType read FInputName write FInputName;
property OutputName: StrType read FOutputName write FOutputName;
{$else Delphi}
IsInited : boolean;
QuestionProc: TLZQuestionFunc;
ReportProc : TLZReportProc;
InputName,
OutputName : StrType;
{$endif Delphi}
End{LZOBJ};
{$endif aDLL}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{exported INTERFACE functions}
{$ifNDef aDLL}
Function LZCompress(const {$ifdef Win32} Source, Dest: string
{$else} aSource, aDest: PChar
{$endif};
LZQuestion: TLZQuestionFunc;
aProc: TLZReportProc):LongInt;
{ This Function is used for compression.
Source = Source file name
Dest = target file name
LZQuestion = procedural type to ask for overwrite permission
aProc = procedural type to return progress information
}
Function LZDecompress({$ifdef Win32} Source, Dest: string
{$else} const aSource, aDest: PChar
{$endif};
LZQuestion: TLZQuestionFunc;
aProc: TLZReportProc):LongInt;
{ This functione is used for decompression.
Source = Source file name
Dest = target file name
LZQuestion = procedural type to ask for overwrite permission
aProc = procedural type to return progress information
}
Function IsChiefLZFile(const fName: {$ifdef Win32} string
{$else} PChar
{$endif} ): boolean;
{is this an LZ file compressed with this unit?}
Function LZArchive(const fSpec, ArchName: {$ifdef Win32} string
{$else} PChar
{$endif};
LZRecurseDirs: TLZRecurse;
aProc: TLZReportProc): LongInt;
{archive all the files matching "fSpec" into archive "ArchName";
fSpec = a filespec (e.g., "*.PAS", or a filename containing a list
of files to be archived - in which case, use "/F=<listfilename>" as
the fSpec.
LZRecurseDirs = whether to recurse into subdirectories for matching
files
}
Function LZDearchive(ArchName: {$ifdef Win32} string
{$else} PChar
{$endif};
{$ifdef Win32} DefDir: string
{$else} const aDefDir: PChar
{$endif};
LZQuestion: TLZQuestionFunc;
aProc: TLZReportProc;
aRename: TLZRenameFunc): LongInt;
{De-Arc a ChiefLZ archive}
Function IsChiefLZArchive(const fName: {$ifdef Win32} string
{$else} PChar
{$endif} ): boolean;
{is this an LZ archive file compressed with this unit?}
Function GetChiefLZFileName{$ifdef Win32}(const fName: string): string;
{$else} (fName, Dest: PChar): boolean;
{$endif}
{if LZ file, then return name (in dest, if not Win32) - else return
fname (in dest, if not Win32) }
Function GetChiefLZFileSize(fName: {$ifdef Win32} string
{$else} PChar
{$endif}): LongInt;
{if LZ file then return uncompressed size - else
return actual filesize. On error, Win32 throws exception; Win16 returns -1 }
function GetChiefLZArchiveInfo(const ArchName: {$ifdef Win32} string
{$else Win32} PChar
{$endif Win32};
var Header: TChiefLZArchiveHeader): boolean;
{ if LZ-Archive then this function returns True, with the header info
in Header. Otherwise the function returns False }
Function GetChiefLZArchiveSize(const ArchName: {$ifdef Win32} string
{$else Win32} PChar
{$endif Win32}): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
{ If ArchName is LZArchive, returns sum of uncompressed file-sizes in archive.
If not LZArchive then returns size of file ArchName }
Function LZCompressEx(const {$ifdef Win32} Name: string
{$else} aName: PChar
{$endif};
ReplaceQuestion: TLZQuestionFunc;
aProc: TLZReportProc): LongInt;
{compress the file aName, and use the filename,
with the last character replaced by a '~' as the output file
If target file exists, and autoreplace=false then the
function exits and returns -100 else the target file
will be overwritten
}
Function LZDecompressEx({$ifdef Win32} Name: string
{$else} aName: PChar
{$endif};
ReplaceQuestion: TLZQuestionFunc;
aProc: TLZReportProc): LongInt;
{decompress the file aName, obtaining the output name from
the header automatically
If target file exists, and autoreplace=false then the
function exits and returns -100 else the target file
will be overwritten
}
function GetFullLZName(Const X : TChiefLZArchiveHeader;
Index: Integer): String;
{for internal use}
{$endif aDLL}
{////////////////////////////////////////////////////}
{$ifNDef aDLL}
implementation
uses
ChfUtils,
{$ifdef Win32}
LZSS32, Windows, LZ_Const
{$else Win32}
LZSS16, { All 16-bit code }
{$ifdef Windows}
WinProcs { Win16 }
{$ifndef Delphi}
,WinDos, Strings { TPW / BPW }
{$endif Delphi}
{$else Windows}
Dos, Strings { TP / BP }
{$endif Windows}
{$endif Win32};
{$endif aDLL}
{$ifdef Win32}
{
These constants taken from SysUtils.inc ...
}
{$ifdef Ver90}
const SInOutError = 65416;
const SFileNotFound = 65417;
const SEndOfFile = 65421;
{$else Ver90}
These constants may have changed; Check SysUtils.inc ... or scan
the String Resource Table from 0-65535 looking for keywords ...
{$endif Ver90}
{$endif Win32}
const ChiefLZSig = 'aChiefM#';
const NulFileDate = 2162688; { 01/01/1980 12:00a }
{////////////////////////////////////////////////////}
{//// my header to identify LZ file///}
Type
PLZHeader = ^TLZHeader;
TLZHeader = Packed Record
fName: TLZFileStr; {filename}
uSize: LongInt; {uncompressed size}
cSize: LongInt; {compressed size}
fTime: LongInt; {time/date stamp}
Version: TLZVerStr;
Signature: String[8]; {the identification header}
end;
Type
TLZBigFileRec= packed Record
{is it a directory}
IsBigDir: Boolean;
{its directory ID}
BigDirID: Word;
{its parent directory ID}
BigParentDir: Word;
{is it compressed?}
BigCompressed: Boolean;
{any version information?}
BigFileVersion: TLZVerStr;
{compressed sizes}
BigSizes: LongInt;
{uncompressed sizes}
uBigSizes:LongInt;
{date/time stamps}
BigTimes: LongInt;
{file names}
BigNames: TLZPathStr
end;
PLZArchiveFiles = ^TLZArchiveFiles;
TLZArchiveFiles = Array[1..MaxChiefLZArchiveSize] of TLZBigFileRec;
Const
MySigStr = #4+^M+'ChfLZ'+#5#6#8;
MyLZSignature :String[Length(MySigStr)]= MySigStr;
Const
CopyBufSize=32000;
Type
PBufType=^TBufType;
TBufType=array[1..CopyBufSize] of byte;
{////////////////////////////////////////////////////}
Type {don't want to use collections because of other versions of TPascal}
PLZDirArray=^TLZDirArray;
TLZDirArray = array[0..MaxChiefLZDirectories] of {$ifdef Win32} string
{$else Win32} PString
{$endif Win32};
{////////////////////////////////////////////////////}
Var
buf : PBufType;
jR : PLZArchiveFiles;
jR2 : PChiefLZArchiveHeader;
{
This global variable contains a long-string field in Delphi 2; it must
therefore be initialised if ChiefLZ is to be made into a DLL ...
(This is a problem with Delphi v2.00 - v2.01 seems to have fixed this)
}
BlankRec: TLZReportRec {$ifdef Win32} = () {$endif Win32};
{/////////////////////////////////////////////////////////}
var aRead, aWrite: Longint;
var LZReportProc: TLZReportProc {$ifdef Win32} = nil {$endif Win32};
{
This global variable ensures that MyReadProc() calls LZReportProc()
only during compression, and that MyWriteProc() calls LZReportProc()
only during decompression. This is done by setting Decompressing
to the appropriate value immediately before calling LZEncode() or
LZDecode().
}
var Decompressing: Boolean;
{/////////////////////////////////////////////////////////}
var InFile, OutFile: file;
{/////////////////////////////////////////////////////////}
{$ifdef Win32}
{
These are Win32-specific functions that cannot be moved into the more
general ChfUtils due to their dependance on types defined in ChfTypes
}
function GetTempChiefFileName: string;
var
RetBuf: PChar;
begin
GetMem(RetBuf, MAX_PATH);
try
if (GetTempPath(MAX_PATH, RetBuf) = 0) or
(GetTempFileName(RetBuf,'CHF',0,RetBuf) = 0) then
RaiseError(EChiefLZError,SNoTempFileName);
SetString(Result,RetBuf,StrLen(RetBuf))
finally
FreeMem(RetBuf, MAX_PATH)
end
end;
function GetFoundFileName(const Search: TSearchRec): string;
begin
if Length(Search.Name) >= SizeOf(TLZFileStr) then
Result := string(Search.FindData.cAlternateFileName)
else
Result := Search.Name // Take long filename (if short enough)
end; // else take short filename
{$else Win32}
function GetTempChiefFileName(const FName: PChar): boolean; assembler;
asm
{
Create a temporary file- FName must specify a path + '\', with enough
room afterwards to append 12 characters.
}
PUSH DS
LDS DX, FName
MOV AH, $5A
MOV CX, faArchive
{$ifdef Windows}
CALL DOS3Call
{$else Windows}
INT $21
{$endif Windows}
POP DS
JC @Fail
{
The file handle refers to an OPEN file; close it so we can open it
the Pascal way ...
}
MOV BX, AX
MOV AH, $3E
{$ifdef Windows}
CALL DOS3Call
{$else Windows}
INT $21
{$endif Windows}
{
Return True if successful, False otherwise ...
}
@Fail:
{$ifdef Delphi}
DB $0F, $93, $C0 (* setnc al *)
{$else Delphi}
MOV AL, False
JC @End
INC AX
@End:
{$endif Delphi}
end;
{$endif Win32}
{/////////////////////////////////////////////////////////}
{///// is this an LZ compressed file using this unit? ////}
Function IsMyLZFile(Var InFile:file; Var f:TLZHeader):boolean;
var
OldPos: LongInt;
NumRead: Integer;
begin
OldPos := FilePos(InFile);
Seek(InFile,0);
BlockRead(InFile, f, SizeOf(f), NumRead);
IsMyLZFile := (NumRead = SizeOf(f))
and (Length(f.FName) <> 0)
and (f.Signature = ChiefLZSig);
Seek(InFile,OldPos)
end;
{/////////////////////////////////////////////////////////}
{////: normal file copy if not LZ file}
const LZ_UNKNOWN_LENGTH = -1;
type TReporting = (doReportOnRead, doReportOnWrite);
Function MyFCopy(var InFile, OutFile: file;
const CopyLength: LongInt;
const doReport: TReporting): LongInt;
{$ifndef Win32} far; {$endif}
Var
p: PBufType;
{
Turn the enumerated type doReport into a Boolean:
doReportOnRead -> False
doReportOnWrite -> True
Decompression routines will call MyFCopy() using doReportOnWrite,
whereas Compression routines will call using doReportOnRead
}
var
ReportingOnWrite: Boolean absolute doReport;
{$ifdef Win32}
NumRead:integer;
BRead: integer;
{$else}
BRead: word;
NumRead:word;
NumWrit:word;
{$endif}
{$ifndef Delphi}
Result: LongInt;
{$endif}
begin
{$IFDEF Debug}
if CopyLength < LZ_UNKNOWN_LENGTH then
{$ifdef Win32}
raise EChiefLZDebug.Create('Negative copy-length passed to MyFCopy')
at AddrOfCaller
{$else Win32}
RunErrorMessageAt('Negative copy-length passed to MyFCopy',
AddrOfCaller)
{$endif Win32};
{$ENDIF}
Result := 0;
New(p);
{$ifdef Win32}
try {finally}
{$else Win32}
if p = nil then
begin
{$ifndef Delphi}
MyFCopy := 0;
{$endif}
Exit { ERROR !!! Failed Memory Allocation! }
end;
{$endif Win32}
repeat
if CopyLength <> LZ_UNKNOWN_LENGTH then
BRead := Min(CopyLength-Result, SizeOf(p^))
else
BRead := SizeOf(p^);
BlockRead(InFile, p^, BRead, NumRead);
{compressing - return number of bytes read}
if Assigned(LZReportProc) and not ReportingOnWrite then
LZReportProc(BlankRec, NumRead);
{
If CopyLength <> LZ_UNKNOWN_LENGTH, we know how many bytes we EXPECT
to be able to read from this file. If BRead <> NumRead, then the
file must be corrupt ...
}
{$ifdef Win32}
if (CopyLength <> LZ_UNKNOWN_LENGTH) and (BRead <> NumRead) then
RaiseIOError(SEndOfFile,100); { Will exit via `finally...end' }
{$endif}
{
This is the EOF condition for when we DON'T know how long the copy is ...
}
if NumRead = 0 then
break;
{
Without the NumWrit parameter, BlockWrite will cause an IO-Error if the disc
doesn't have room for SizeOf(p) bytes. This is good in Win32, as an exception
will then be raised.
}
BlockWrite(OutFile,p^,NumRead {$ifndef Win32}, NumWrit {$endif});
{
If Win32 version gets this far, then all NumRead chars must have
been written ...
}
inc(Result, {$ifdef Win32} NumRead {$else} NumWrit {$endif});
{de-compressing - return number of bytes written}
if Assigned(LZReportProc) and ReportingOnWrite then
LZReportProc(BlankRec, {$ifdef Win32} NumRead {$else} NumWrit {$endif})
until {$ifndef Win32} (NumWrit<>NumRead) or {$endif}
( (CopyLength <> LZ_UNKNOWN_LENGTH) and
(Result >= CopyLength) );
{$ifndef Delphi}
MyFCopy := Result;
{$endif}
{$ifdef Win32}
finally
{$endif}
Dispose(p);
{$ifdef Win32}
end;
{$endif}
end;
{/////////////////////////////////////////////////////////}
Function MyReadProc(var ReadBuf): TLZSSWord; {$ifndef Win32} far; {$endif}
{to read from files}
{$ifndef Delphi}
var
Result: TLZSSWord;
{$endif}
Begin
BlockRead(InFile, ReadBuf, LZRWBufSize, Result);
Inc(aRead, Result);
{compressing - return bytes read}
if Assigned(LZReportProc) and not Decompressing then
LZReportProc(BlankRec, Result);
{$ifndef Delphi}
MyReadProc := Result
{$endif}
End; { MyReadProc }
{/////////////////////////////////////////////////////////}
Function MyWriteProc(var WriteBuf; Count: TLZSSWord): TLZSSWord;
{$ifndef Win32} far; {$endif Win32}
{$ifndef Delphi}
var
Result: TLZSSWord;
{$endif}
{to write to files}
Begin
BlockWrite(OutFile, WriteBuf, Count, Result);
Inc(aWrite, Result);
{de-compressing - return bytes written}
if Assigned(LZReportProc) and Decompressing then
LZReportProc(BlankRec, Result);
{$ifndef Delphi}
MyWriteProc := Result
{$endif}
End; { MyWriteProc }
{/////////////////////////////////////////////////////////}
Function GetDirIndex(aDir: TLZPathStr; Const DirList: PLZDirArray;
Const Max: TLZSSWord): LongInt;
{find the index of a directory within an array}
Var
i: TLZSSWord;
begin
{$ifndef Win32}
aDir := UpperCase(aDir);
{$endif Win32}
for i := 0 to Max do
if {$ifdef Win32} AnsiCompareText(aDir, DirList^[i]) = 0
{$else Win32} aDir = DirList^[i]^
{$endif Win32} then
begin
GetDirIndex := i;
Exit
end;
GetDirIndex := -1
end;
{/////////////////////////////////////////////////////////}
function CreatePath(Path: TLZPathStr): Integer;
{Iteratively create a directory path}
var
i: Integer;
NewDir: TLZPathStr;
{$ifndef Delphi}
{$ifdef Windows}
P: array[0..79] of Char;
{$endif Windows}
Result: Integer;
{$endif Delphi}
begin
{$ifdef Delphi}
Path := ExpandFileName(Path);
{$else Delphi}
{$ifdef Windows}
FileExpand(P, Str2PChar(Path));
Path := StrPas(p);
{$else Windows}
Path := FExpand(Path);
{$endif Windows}
{$endif Delphi}
i := 3;
Result := 0;
repeat
repeat
Inc(i)
until (i > Length(Path)) or (Path[i] = '\');
NewDir := Copy(Path,1,i-1);
if not DirectoryExists(NewDir) then
begin
MkDir(NewDir); { Win32 throws an exception and exits... }
{$ifndef Win32} { We shall catch and handle this }
If IOResult <> 0 then { exception in the calling function. }
begin
CreatePath := -1;
Exit
end;
{$endif Win32}
Inc(Result)
end
until i > Length(Path);
{$ifndef Delphi}
CreatePath := Result;
{$endif}
end;
{/////////////////////////////////////////////////////////}
function GetFullLZName(const X: TChiefLZArchiveHeader;
Index: Integer): string;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32}; {$endif aDLL}
{$ifndef Delphi}
var
Result: string;
{$endif}
begin
Result := '';
repeat
with X.Files[Index] do
begin
Result := Names + '\' + Result;
if not IsDir then
Index := DirID
else
Index := ParentDir
end
until Index = 0;
{$ifdef Win32}
SetLength(Result, Pred(Length(Result)));
{$else Win32}
Dec(Result[0]);
{$endif Win32}
{$ifndef Delphi}
GetFullLZName := Result;
{$endif Delphi}
end;
Function GetFileVersion({$ifdef Win32} Const
{$endif} fName: String): TLZVerStr;
{$ifndef DPMI}
{$ifdef TPW}
Var
Result: TLZVerStr;
{$endif TPW}
{$endif DPMI}
Begin
{$ifdef DPMI}
GetFileVersion := '0'
{$else DPMI}
{$ifdef Windows}
{$ifdef Win32}
Result := FileVersionInfo(fName, 'FileVersion');
{$else Win32}
Result := FileVersionInfo(Str2PChar(fName), 'FileVersion');
{$endif Win32}
if Length(Result) = 0 then
GetFileVersion := '0'
{$ifndef Delphi}
else
GetFileVersion := Result
{$endif Delphi}
{$else Windows}
GetFileVersion := '0'
{$endif Windows}
{$endif DPMI}
End;
{/////////////////////////////////////////////////////////}
function GetLZMarkedName(const FName: string): string;
var
i: Integer;
Ext: TLZExtStr;
begin
Ext := ExtractFileExt(FName);
i := Length(Ext);
if i < 2 then { Ext is either '' or '.' }
Ext := '.' + MyLZMarker
else
Ext[i] := MyLZMarker;
GetLZMarkedName := ChangeFileExt(FName, Ext)
end;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{
These are the LZ functions exported from the unit
}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function IsChiefLZArchive(const fName: {$ifdef Win32} string
{$else} PChar
{$endif} ):boolean;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
f:file;
NumRead: TLZSSWord;
{$ifndef Win32}
OldFMode: byte;
{$endif}
Hed : TLZArchiveHeader;
Begin
IsChiefLZArchive := False;
if {$ifdef Win32} Length(fName)
{$else} StrLen(fName)
{$endif} = 0 then
Exit;
{$ifdef Win32}
AssignFile(f, fName);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
{$I-} { However, share access is FILE_SHARE_READ }
Reset(f, 1);
{$I+}
if IOResult = 0 then
begin
BlockRead(f, Hed, SizeOf(Hed), NumRead); // No IO-Error; uses NumRead
CloseFile(f);
IsChiefLZArchive := (NumRead = SizeOf(Hed)) and
(Hed.Signature = MyLZSignature) and
(Hed.Count <> 0)
// If haven't read SizeOf(Hed) bytes, CAN'T be LZ Archive
end
{$else}
Assign(f, StrPas(fName));
OldFMode := FileMode;
{
Open file: we need Read-access, don't need Write-access and *INSIST*
that no one else can write to it (i.e. corrupt it) until we're done.
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(f,1);
FileMode := OldFMode;
if IOResult = 0 then
begin
BlockRead(f, Hed, SizeOf(Hed), NumRead);
Close(f);
IsChiefLZArchive := (NumRead = SizeOf(Hed)) and
(Hed.Signature = MyLZSignature) and
(Hed.Count <> 0)
end
{$endif}
end;
{/////////////////////////////////////////////////////////}
{$ifdef Win32}
Function GetChiefLZFileName(const fName: string): string;
{$ifdef aDLL} stdcall; {$endif aDLL}
var
f: file;
h: TLZHeader;
begin
AssignFile(f, fName);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(f,1); { However, share access is FILE_SHARE_READ }
try
if IsMyLZFile(f,h) then
SetString(Result, PChar(@h.fName[1]), Length(h.fName))
else
Result := fName
finally
CloseFile(f)
end
end;
{$else}
Function GetChiefLZFileName(fName, Dest:PChar):boolean;
{$ifdef aDLL} export; {$endif aDLL}
Var
h:TLZHeader;
f:file;
{$ifndef Delphi}
Result:boolean;
{$endif}
OldFMode:byte;
Begin
GetChiefLZFileName := false;
StrCopy(Dest, fName); {return filename}
Assign(f, StrPas(fName));
OldFMode := FileMode;
{
Open file: we need Read-access, don't need Write access, and *INSIST*
that no one else can write to it (i.e. corrupt it) until we're done.
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(f,1);
FileMode := OldFMode;
if IOResult=0 then
begin
Result := IsMyLZfile(f,h);
Close(f); { Reset() OK, so Close() must succeed }
{$ifndef Delphi}
GetChiefLZFileName := Result;
{$endif Delphi}
if Result then
StrPCopy(Dest, h.fName);
end
end;
{$endif}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function GetChiefLZFileSize(fName: {$ifdef Win32} string
{$else} PChar
{$endif}):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
h:TLZHeader;
f:file;
{$ifndef Win32}
OldFMode:byte;
{$endif}
Begin
{$ifdef Win32}
AssignFile(f,fName);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(f,1); { However, share access is FILE_SHARE_READ }
try
if IsMyLZFile(f,h) then
Result := h.uSize
else
Result := FileSize(f)
finally
CloseFile(f)
end;
{$else}
GetChiefLZFileSize := -1{error};
Assign(f, StrPas(fName));
OldFMode := FileMode;
{
Open file: we need Read-access, don't need Write-access and *INSIST*
that no one else can write to it (i.e. corrupt it) until we're done.
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(f,1);
FileMode := OldFMode;
if IOResult=0 then
begin
if IsMyLZFile(f,h) then
GetChiefLZFileSize := h.uSize {uncompressed size}
else
GetChiefLZFileSize := FileSize(f); {actual size}
Close(f); { Reset() OK, so Close() cannot fail }
end;
{$endif}
end;
{/////////////////////////////////////////////////////////}
function GetChiefLZArchiveInfo(const ArchName: {$ifdef Win32} string
{$else Win32} PChar
{$endif Win32};
var Header: TChiefLZArchiveHeader): boolean;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
var
f : file;
Hed : TLZArchiveHeader;
{$ifndef Win32}
OldFMode: byte;
{$endif Win32}
begin
{$ifdef Win32}
Result := IsChiefLZArchive(ArchName);
if Result then
begin
AssignFile(f,ArchName);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(f,1); { However, share access is FILE_SHARE_READ }
try
BlockRead(f, Hed, SizeOf(Hed)); {read archive header}
Header.Count := Hed.Count;
BlockRead(f, Header.Files[1], SizeOf(TLZFileRec)*Hed.Count)
finally
CloseFile(f)
end
end
{$else Win32}
GetChiefLZArchiveInfo := False;
If IsChiefLZArchive(ArchName) then
begin
Assign(f, StrPas(ArchName));
OldFMode := FileMode;
{
Open file: we need Read-access, don't need Write-access and *INSIST*
that no one can write to it (i.e. corrupt it) until we're done ...
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(f, 1);
FileMode := OldFMode;
if IOResult=0 then
begin
BlockRead(f, Hed, SizeOf(Hed)); {read archive header}
If IOResult=0 then
begin
Header.Count := Hed.Count;
BlockRead(f, Header.Files[1], SizeOf(TLZFileRec)*Hed.Count);
if IOResult=0 then
GetChiefLZArchiveInfo := True;
Close(f) { If successful open, Close() MUST succeed here }
end
end
end
{$endif Win32}
End;
{/////////////////////////////////////////////////////////}
Function GetChiefLZArchiveSize(const ArchName: {$ifdef Win32} string
{$else Win32} PChar
{$endif Win32}): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
{get uncompressed size of archive}
Var
X: PChiefLZArchiveHeader;
i: Longint;
{$ifndef Delphi}
Result: LongInt;
{$endif Delphi}
Begin
New(X);
{$ifdef Win32}
try { finally }
{$endif Win32}
if not GetChiefLZArchiveInfo(ArchName, X^) then
GetChiefLZArchiveSize := FSize({$ifdef Win32} ArchName
{$else Win32} StrPas(ArchName)
{$endif Win32})
else
begin
Result := 0;
with X^ do
for i := 1 to Count do
Inc(Result, Files[i].uSizes);
{$ifndef Delphi}
GetChiefLZArchiveSize := Result
{$endif Delphi}
end;
{$ifdef Win32}
finally
{$endif Win32}
Dispose(X)
{$ifdef Win32}
end
{$endif Win32}
End;
{/////////////////////////////////////////////////////////}
Function LZCompress(const {$ifdef Win32} Source, Dest: string
{$else} aSource, aDest: pChar
{$endif};
LZQuestion :TLZQuestionFunc;
aProc:TLZReportProc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
{$ifndef Win32}
OldFMode : byte;
Source,
Dest : String;
{$endif}
f : TLZHeader;
RepRec: TLZReportRec;
hT : LongInt;
Begin
{$ifDef aDLL}
If IsLZInitialized then
{$ifdef Win32}
RaiseError(EChiefLZDLL,SBusyChief);
{$else}
begin
LZCompress := -20; {already busy}
Exit
end;
{$endif}
{$endif aDLL}
aRead := 0;
aWrite:= 0;
if not LZInit then
{$ifdef Win32}
RaiseError(EChiefLZError,SInitFailed);
{$else}
begin
LZCompress := -10; {unable to init}
Exit
end;
{$endif}
{$ifdef Win32}
try { finally }
{$endif}
{$ifdef Win32}
if (Length(Source)=0) or (Length(Dest)=0) then
RaiseError(EChiefLZCompress,SInvalidParams);
if AnsiCompareText(Source, Dest) = 0 then
RaiseErrorStr(EChiefLZCompress,SSameFileName,Source);
{$else}
Source := StrPas(aSource);
Dest := StrPas(aDest);
If (Length(Source)=0) or (Length(Dest)=0) or
(Uppercase(Source)=Uppercase(Dest))
then
begin
LZCompress := -11; {same source and target}
LZDone;
Exit
end
{$endif};
hT := sFTime(Source);
{||| does target file exist already? ||||}
If FileExists(Dest) then
begin
With RepRec do
begin {details of Source}
Names := Source;
Sizes := fSize(Source);
uSizes := Sizes;
Times := hT;
FileVersion := GetFileVersion(Source);
end;
if Assigned(LZQuestion) then
if LZQuestion(RepRec, Dest) <> LZYes then
begin
LZCompress := -100; {target exists - don't overwrite}
{$ifndef Win32}
LZDone;
{$endif}
Exit
end
end
else
With RepRec do
begin
Names := Source;
Times := ht;
uSizes := FSize(Source);
Sizes := -1;
FileVersion := GetFileVersion(Source);
end;
BlankRec := RepRec;
{$ifdef Win32}
AssignFile(InFile, Source);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(InFile,1); { However, share access is FILE_SHARE_READ }
try { finally }
AssignFile(OutFile, Dest);
Rewrite(OutFile,1);
try { finally }
If Assigned(aProc) then aProc(RepRec, -1);
LZReportProc := aProc;
if IsMyLZFile(InFile, f) then
LZCompress := MyFCopy(InFile,OutFile,
LZ_UNKNOWN_LENGTH,doReportOnRead)
else {already compressed: just copy}
begin
FillChar(f, SizeOf(f), 0);
with f do
begin
fName := ExtractFileName(Source);
fTime := hT;
Signature := ChiefLZSig;
uSize := RepRec.USizes{FileSize(InFile)};
Version := RepRec.FileVersion;
end;
BlockWrite(OutFile, f, SizeOf(f)); {write header}
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
Height := 0;
MatchPos := 0;
MatchLen := 0;
LastLen := 0;
FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
FillChar(CodeBuf, SizeOf(CodeBuf), 0);
Decompressing := False;
LZEncode;
{go back and rewrite header}
f.cSize := aWrite;
Seek(OutFile,0);
BlockWrite(OutFile, f, SizeOf(f)); {write header}
LZCompress := aWrite+SizeOf(TLZHeader)
end
finally
FileSetDate(TFileRec(OutFile).Handle, f.fTime);
CloseFile(OutFile);
if Assigned(aProc) then
begin
RepRec.Names := '';
aProc(RepRec, -2)
end
end
finally
CloseFile(InFile)
end
finally
LZDone
end
{$else}
Assign(InFile, Source);
OldFMode := FileMode;
{
Open file: we need Read-access, don't need Write-access and *INSIST*
that no one else can write to it (i.e. corrupt it) 'til we're done ...
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(InFile, 1);
FileMode := OldFMode;
if IOResult<>0 then
LZCompress := -2
else begin
Assign(OutFile, Dest);
Rewrite(OutFile, 1);
if IOResult<>0 then
LZCompress := -3
else begin
If Assigned(aProc) then aProc(RepRec, -1);
LZReportProc := aProc;
If IsMyLZFile(InFile, f) then
LZCompress := MyFCopy(InFile,OutFile,LZ_UNKNOWN_LENGTH,doReportOnRead)
else {already compressed: just copy}
begin
FillChar(f, SizeOf(f), 0);
With f do
begin
fName := ExtractFileName(Source);
fTime := hT;
uSize := FileSize(InFile);
Signature := ChiefLZSig;
Version := RepRec.FileVersion;
end;
BlockWrite(OutFile, f, SizeOf(f)); {write header}
if IOResult <> 0 then
LZCompress := -4
else
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
Height := 0;
MatchPos := 0;
MatchLen := 0;
LastLen := 0;
FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
FillChar(CodeBuf, SizeOf(CodeBuf), 0);
Decompressing := False;
LZEncode;
{go back and rewrite header}
f.cSize := aWrite;
Seek(Outfile, 0);if IOResult<>0 then;
BlockWrite(OutFile, f, SizeOf(f)); {write header}
LZCompress := aWrite+SizeOf(TLZHeader)
end
end;
if Assigned(aProc) then
begin
RepRec.Names := '';
aProc(RepRec, -2)
end;
{ set date/time stamp }
{$ifdef Delphi}
FileSetDate(TFileRec(OutFile).Handle, f.fTime);
{$else}
SetFTime(OutFile, f.fTime);
{$endif}
Close(OutFile);if IOResult<>0 then;
end; { IOResult = 0 }
Close(InFile);if IOResult<>0 then;
end; { IOResult = 0 }
LZDone
{$endif}
End; { LZCompress }
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZDecompress({$ifdef Win32} Source, Dest: string
{$else} const aSource, aDest: PChar
{$endif};
LZQuestion: TLZQuestionFunc;
aProc: TLZReportProc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
f : TLZHeader;
hT : LongInt;
RepRec: TLZReportRec;
IsComp: Boolean;
{$ifndef Win32}
Source,
UpSource,
Dest : TLZPathStr;
OldFMode: Byte;
LZReply : TLZReply;
{$endif}
p : {$ifdef Win32} string;
{$else} array[0..79] of Char;
{$endif}
Begin
{$ifDef aDLL}
If IsLZInitialized then
{$ifdef Win32}
RaiseError(EChiefLZDLL,SBusyChief);
{$else}
begin
LZDecompress := -20; {already busy}
Exit
end
{$endif};
{$endif aDLL}
aRead := 0;
aWrite:=0;
if not LZInit then
{$ifdef Win32}
RaiseError(EChiefLZError,SInitFailed);
{$else}
begin
LZDecompress := -10; {unable to init}
Exit
end;
{$endif}
{$ifdef Win32}
try { finally }
if (Length(Source)=0) or (Length(Dest)=0) then
RaiseError(EChiefLZCompress,SInvalidParams);
Source := ExpandFileName(Source);
Dest := ExpandFileName(Dest);
{
Do case-insensitive comparison of full pathnames ...
}
if AnsiCompareText(Source, Dest) = 0 then
RaiseErrorStr(EChiefLZCompress,SSameFileName,Source);
{$else}
Source := StrPas(aSource);
UpSource := Uppercase(Source);
Dest := StrPas(aDest);
If (Length(Source)=0) or (Length(Dest)=0)
or (UpSource=Uppercase(Dest))
then
LZDecompress := -11
else begin
{$endif}
{see if source file exists}
{$ifdef Win32}
p := '';
{$else}
p[0] := #0;
{$endif}
If Not FileExists(Source) then {look for name ending with MyLZMarker}
begin
Source := GetLZMarkedName(Source);
{
Win32 will raise the correct exception automatically when
GetChiefLZFileName() attempts to open Source ...
}
{$ifdef Win32}
p := GetChiefLZFileName(Source);
if AnsiCompareText(ExtractFileName(p),
ExtractFileName(Source)) <> 0 then
RaiseErrorStr(EChiefLZCompress,SWrongCompressedFile,p);
{$else}
If Not FileExists(Source) then {source file not found}
begin
LZDecompress := -12;
LZDone;
Exit
end;
GetChiefLZFileName(Str2PChar(Source), p); {read header}
If (ExtractFileName(Uppercase(StrPas(p)))
<> ExtractFileName(UpSource)) {wrong uncompressed file}
then begin
LZDecompress := -3; {wrong file}
LZDone;
Exit
end;
{$endif}
end;
{not FileExists}
{||||||||}
hT := sFTime(Source);
{$ifdef Win32}
AssignFile(InFile, Source);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(InFile, 1); { However, share access is FILE_SHARE_READ }
try { finally }
{$else Win32}
Assign(InFile, Source);
OldFMode := FileMode;
FileMode := (fmOpenRead or fmShareDenyWrite); {using these constants causes problems!}
Reset(InFile, 1); { Only if file is already open for }
FileMode := OldFMode; { *writing* to by another process. }
{ If a write happens during decomression }
if IOResult <> 0 then { then the decompressed file is worthless}
LZDecompress := -12 {can't open source}
else begin
{$endif Win32}
IsComp := IsMyLZFile(InFile, f);
{||| does target file exist already? ||||}
If FileExists(Dest) then begin
with RepRec do
If IsComp then
begin {send details of Source(compressed) file}
Names := {AddBackSlash(ExtractFilePath(Source))+}f.fName{Source};
Sizes := f.cSize;
uSizes := f.uSize;
Times := f.fTime;
FileVersion := f.Version;
end
else begin
Names := Source;
Sizes := FileSize(InFile);
uSizes := Sizes;
Times := hT;
FileVersion := GetFileVersion(Source);
end;
if Assigned(LZQuestion) then { and send name of existing target file}
{$ifdef Win32}
case LZQuestion(RepRec, Dest) of
LZNo: begin
LZDecompress := -100; {target exists - don't overwrite}
Exit
end;
LZQuit: Abort { Raises a silent-exception... Fast-track exit }
end { out of entire application unless caught... :-) }
{$else Win32}
begin
LZReply := LZQuestion(RepRec, Dest);
if LZReply <> LZYes then
begin
if LZReply = LZNo then
LZDecompress := -100 { Exit nicely ... }
else
LZDecompress := -150; { ABORT!!!!!!! }
Close(InFile); { Reset() successful; Close() cannot fail }
LZDone;
Exit
end
end
{$endif Win32}
End;
{report on target file}
With RepRec do begin
Names := Dest;
If IsComp then begin
Sizes := f.cSize;
uSizes := f.uSize;
Times := f.fTime;
FileVersion := f.Version;
end else begin
Sizes := fSize(Source);
uSizes := Sizes;
Times := hT;
FileVersion := '0';
end;
end;
BlankRec := RepRec;
{$ifdef Win32}
AssignFile(OutFile, Dest);
Rewrite(OutFile, 1);
try { finally }
{//////////}
if Assigned(aProc) then aProc(RepRec, -1);
LZReportProc := aProc;
{//////////}
if not IsComp then
begin {normal copy}
f.fTime := hT{lFTime(InFile)};
LZDecompress := MyFCopy(InFile,OutFile,
LZ_UNKNOWN_LENGTH,doReportOnWrite)
end
else
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
FillChar(BinaryTree^.TextBuf, SizeOf(TLZTextBuf), 0);
Seek(InFile, SizeOf(TLZHeader));
Decompressing := True;
LZDecode;
LZDecompress := aWrite
end
finally
{ set date/time stamp }
FileSetDate(TFileRec(OutFile).Handle, f.fTime);
CloseFile(OutFile);
if Assigned(aProc) then
begin
RepRec.Names := '';
aProc(RepRec, -2)
end
end
finally
CloseFile(InFile)
end
finally
LZDone
end;
{$else}
Assign(OutFile, Dest);
Rewrite(OutFile, 1);
if IOResult <> 0 then
LZDecompress := -13 {can't open target}
else begin
{//////////}
if Assigned(aProc) then aProc(RepRec, -1);
LZReportProc := aProc;
{//////////}
if not IsComp{IsMyLZFile(InFile, f)} then
begin {normal copy}
f.fTime := hT{lFTime(InFile)};
LZDecompress := MyFCopy(InFile,OutFile,
LZ_UNKNOWN_LENGTH,doReportOnWrite)
end
{//////////}
else
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
FillChar(BinaryTree^.TextBuf, SizeOf(TLZTextBuf), 0);
Seek(InFile, SizeOf(TLZHeader));
Decompressing := True;
LZDecode;
LZDecompress := aWrite
end;
{ set date/time stamp }
{$ifdef Delphi}
FileSetDate(TFileRec(OutFile).Handle, f.fTime);
{$else}
SetFTime(OutFile, f.fTime);
{$endif}
Close(OutFile);if IOResult<>0 then;
if Assigned(aProc) then
begin
RepRec.Names := '';
aProc(RepRec, -2)
end
end; { IOResult = 0 }
Close(InFile); if IOResult<>0 then;
end { IOResult = 0 }
end;
LZDone
{$endif}
End; { LZDecompress }
{/////////////////////////////////////////////////////////}
Function IsChiefLZFile(const fName: {$ifdef Win32} string
{$else} PChar
{$endif}):boolean;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
h:TLZHeader;
f:file;
{$ifndef Win32}
OldFMode: byte;
{$endif}
Begin
{$ifdef Win32}
AssignFile(f, fName);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(f,1); { However, share access is FILE_SHARE_READ }
try
Result := IsMyLZFile(f,h)
finally
CloseFile(f)
end
{$else}
IsChiefLZFile := False;
Assign(f, StrPas(fName));
OldFMode := FileMode;
{
Open file: we need Read-access, don't need Write-access and *INSIST*
that no one else can write to it (i.e. corrupt it) 'til we're done ...
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(f,1);
FileMode := OldFMode;
if IOResult=0 then
begin
IsChiefLZFile := IsMyLZFile(f,h);
Close(f) { ReadOnly Reset() succeeded; Close() MUST succeed }
end
{$endif}
end;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function ArchiveSquash(Var InFile, OutFile: file;
Const aProc: TLZReportProc):LongInt;
Begin
ArchiveSquash := -1;
if IsLZInitialized then
begin
Seek(InFile, 0);{$ifndef Win32} if IOResult<>0 then; {$endif}
LZReportProc := aProc;
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
Height := 0;
MatchPos := 0;
MatchLen := 0;
LastLen := 0;
aWrite := 0;
FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
FillChar(CodeBuf, SizeOf(CodeBuf), 0);
Decompressing := False;
LZEncode;
ArchiveSquash := aWrite
end; {IsLZInitialized}
End; { ArchiveSquash }
{/////////////////////////////////////////////////////////}
Function IsFileInDir({$ifdef Delphi} const {$endif} fSpec:String):Boolean;
Var
{$ifdef Windows}
Dir:TSearchRec;
{$else}
Dir:SearchRec;
{$endif Windows}
Begin
{$ifdef Delphi}
Result := (FindFirst(fSpec, faAnyFile-faDirectory-faVolumeID, Dir)=0);
if Result then
SysUtils.FindClose(Dir);
{$else Delphi}
{$ifdef Windows}
FindFirst(Str2PChar(fSpec), faAnyFile-faDirectory-faVolumeID, Dir);
{$else Windows}
FindFirst(fSpec,AnyFile-Directory-VolumeID, Dir);
{$endif Windows}
IsFileInDir := (DosError = 0)
{$endif Delphi}
End;
{//////////////////////////////////////////}
Procedure InitReportRec(Var RepRec:TLZReportRec; Const X:TLZBigFileRec);
Begin
With RepRec, X do
begin
Names := BigNames;
Sizes := BigSizes;
uSizes:= uBigSizes;
Times := BigTimes;
FileVersion := BigFileVersion;
IsDir := IsBigDir
end
End;
{/////////////////////////////////////////////////////////}
Function LZArchive(const fSpec, ArchName: {$ifdef Win32} string
{$else} PChar
{$endif};
LZRecurseDirs: TLZRecurse;
aProc: TLZReportProc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
type
PDirTimes = ^TDirTimes;
TDirTimes = array[1..MaxChiefLZDirectories] of LongInt;
Const
{$ifdef Windows}
faFiles = faReadOnly+faSysFile+faHidden+faArchive+0;
faDirs = faSysFile+faHidden+faDirectory+0;
{$else Windows}
faFiles = ReadOnly+SysFile+Hidden+Archive+0;
faDirs = SysFile+Hidden+Directory+0;
{$endif Windows}
VAR
{$ifdef Windows}
Dir: TSearchRec;
{$else Windows}
Dir: SearchRec;
{$endif Windows}
{$ifndef Win32}
OldFMode : byte;
Temp : TLZPathStr;
l, LZTot : LongInt;
{$endif Win32}
Path,
s1, s2 : TLZPathStr;
fSpecName : TLZPathStr;
i : LongInt;
t : Text;
UseFile : boolean;
Hed : TLZArchiveHeader;
FoundName : TLZPathStr;
MemRec,
DirCount,
DirCountEx : TLZSSWord;
DirArray : PLZDirArray;
DirTimes : PDirTimes;
PIndex : LongInt;
NewPIndex : LongInt;
RepRec : TLZReportRec;
begin
{$ifdef aDLL}
if IsLZInitialized then
{$ifdef Win32}
RaiseError(EChiefLZDLL,SBusyChief);
{$else}
begin
LZArchive := -20; {busy}
Exit
end
{$endif};
{$endif aDLL}
if not LZInit then
{$ifdef Win32}
RaiseError(EChiefLZError,SInitFailed);
{$else}
begin
LZArchive := -10; {init error}
Exit
end;
{$endif}
{$ifdef Win32}
try { finally }
{$endif}
s1:= {$ifdef Win32} fSpec
{$else} StrPas(fSpec)
{$endif};
s2:= {$ifdef Win32} ExpandFileName(ArchName)
{$else} StrPas(ArchName)
{$endif};
{are we reading from a file?}
UseFile := False;
i := Pos('/F=', Uppercase(s1));
If i > 0 then
begin
Delete(s1, 1, i+2);
UseFile := True;
LZRecurseDirs := LZNoRecurse
end;
if (Length(s1)=0) or (Length(s2)=0) then
{$ifdef Win32}
RaiseError(EChiefLZError,SInvalidParams);
{$else}
begin
LZDone;
Exit
end;
{$endif}
{$ifdef Win32}
s1 := ExpandFileName(s1);
if AnsiCompareText(s1,s2) = 0 then
RaiseErrorStr(EChiefLZArchive,SSameFileName,s1);
AssignFile(OutFile, s2);
Rewrite(OutFile, 1);
try { finally }
Result := 0;
New(jR);
try { finally }
Hed.Count := 0;
DirCount := 0;
{ get the filenames for the archive }
if UseFile then { - use a LIST file }
begin
Path := '';
AssignFile(t, s1);
Reset(t);
try { finally }
while not EOF(t) do
begin
Readln(t,s1);
if (Length(s1)<>0) and
(AnsiCompareText(s1,s2) <> 0) and
FileExists(s1) then
begin
{$IFDEF Debug}
if Hed.Count > MaxChiefLZArchiveSize then
raise EChiefLZDebug.Create('Too many archive files');
{$ENDIF}
if Hed.Count >= MaxChiefLZArchiveSize then
break;
inc(Hed.Count);
with jr^[Hed.Count] do
begin
IsBigDir := False;
BigDirID := 0;
BigCompressed := True;
uBigSizes := fSize(s1);
BigTimes := sfTime(s1);
BigFileVersion := GetFileVersion(s1);
BigNames := s1
end
end {s1 <> s2}
end; {not EOF(t)}
if Hed.Count = 0 then
RaiseError(EChiefLZArchive, SNoValidFileName)
finally
CloseFile(t)
end
end
{
We do not have a LIST file, so find filespecs ...
}
else
begin
Path := ExtractFilePath(s1);
fSpecName := ExtractFileName(s1);
New(DirArray);
try {finally}
DirArray^[0] := Path;
if LZRecurseDirs <> LZNoRecurse then
{
`Recurse' through subdirectories for files matching the given mask.
There are 2 levels of recursion - full recursion and immediate-subdirs...
}
begin
New(DirTimes);
try {finally}
i := 0;
repeat
if (LZRecurseDirs <> LZNoRecurse) and
(FindFirst(DirArray^[i]+'*', faDirs, Dir) = 0) then
try {finally}
repeat
if Dir.Attr and faDirectory <> 0 then
begin
FoundName := GetFoundFileName(Dir);
if (FoundName <> '.') and
(FoundName <> '..') then
begin
{$IFDEF Debug}
if DirCount > MaxChiefLZDirectories then
raise EChiefLZDebug.Create('DirArray^ bounds exceeded');
{$ENDIF}
if DirCount >= MaxChiefLZDirectories then
break;
inc(DirCount);
DirArray^[DirCount] :=
DirArray^[i]+FoundName+'\';
DirTimes^[DirCount] := Dir.Time
end
end
until FindNext(Dir) <> 0
finally
SysUtils.FindClose(Dir)
end;
if i = 0 then
begin
Inc(i);
{
Turn directory-recursion off - have only looked in
immediate subdirectories ...
}
if LZRecurseDirs = LZRecurseOnce then
Dec(LZRecurseDirs)
end
else if not IsFileInDir(DirArray^[i]+fSpecName) then
begin
DirArray^[i] := ''; { Destroy string ... }
Move(DirArray^[i+1],
DirArray^[i],
(DirCount-i)*SizeOf(DirArray^[0]));
Move(DirTimes^[i+1],
DirTimes^[i],
(DirCount-i)*SizeOf(DirTimes^[1]));
{
I think I'm messing too deeply with long strings here... If I am correct,
then I need to set the element DirArray[DirCount] to be an empty string
WITHOUT TAMPERING WITH THE REFERENCE COUNTS !!! I.e. the element must be
typecast to a pointer and set to nil...
}
Pointer(DirArray[DirCount]) := nil;
Dec(DirCount)
end
else
begin
Inc(Hed.Count);
with jr^[Hed.Count] do
begin
IsBigDir := True;
BigDirID := i;
BigTimes := DirTimes^[i];
{
These two fields irrelevant for directories ...
}
BigSizes := 0;
uBigSizes := 0;
{}
BigFileVersion := '-';
BigNames := RemoveBackSlash(DirArray^[i])
end;
Inc(i)
end
until i > DirCount
finally
Dispose(DirTimes)
end;
{
Find the parents for each directory ...
}
DirCountEx := DirCount;
for i := 1 to DirCount do
begin
{
Search for a hole in the directory structure ...
}
FoundName :=
ExtractFilePath(RemoveBackSlash(DirArray^[i]));
PIndex := GetDirIndex(FoundName,DirArray,DirCountEx);
{
If such a hole exists, we must store headers for all the missing
directories between Path and FoundName WORKING FORWARDS, or we'll
give some of the directories the wrong parents ...
}
if PIndex < 0 then
begin
PIndex := 0;
s1 := Path;
repeat
s1 := FirstDirectoryBetween(s1,FoundName);
NewPIndex := GetDirIndex(s1,DirArray,DirCountEx);
if NewPIndex < 0 then
begin
{
Do we have room for another directory ... ?
}
{$IFDEF Debug}
if DirCountEx > MaxChiefLZDirectories then
raise EChiefLZDebug.Create('Too many ChiefLZ directories.');
{$ENDIF}
if DirCountEx >= MaxChiefLZDirectories then
Break;
inc(DirCountEx);
DirArray^[DirCountEx] := s1;
inc(Hed.Count);
with jr^[Hed.Count] do
begin
BigNames := RemoveBackSlash(s1);
BigTimes := NulFileDate;
IsBigDir := True;
BigDirID := DirCountEx;
BigParentDir := PIndex;
{
These fields irrelevant for directories ...
}
BigSizes := 0;
uBigSizes := 0;
{}
BigFileVersion := '-'
end;
NewPIndex := DirCountEx
end;
PIndex := NewPIndex
until Length(s1) = Length(FoundName)
end; {PIndex < 0}
{
Now we're sure it exists, store Parent-index for directory i ...
}
jr^[i].BigParentDir := PIndex
end { 1 <= i <= DirCount }
end; { LZRecurseDirs }
{
Look through the directory list (only the ones with files in!) and
create an archive of files from them. Note that DirArray^[0] is
the Path directory ...
}
for i := 0 to DirCount do
if FindFirst(DirArray^[i]+fSpecName, faFiles, Dir) = 0 then
try { finally }
repeat
s1 := DirArray^[i] + GetFoundFileName(Dir);
{$IFDEF Debug}
{ Did not put faDirectory in Attr mask, so
**shouldn't** see any directories ... }
if Dir.Attr and faDirectory <> 0 then
raise EChiefLZDebug.Create('Found directory when expecting file');
{$ENDIF}
{
Check that we are not trying to archive the output file ...
}
if AnsiCompareText(s1,s2) <> 0 then
begin
{$IFDEF Debug}
if Hed.Count > MaxChiefLZArchiveSize then
raise EChiefLZDebug.Create('Max archive size exceeded.');
{$ENDIF}
if Hed.Count >= MaxChiefLZArchiveSize then
Break;
inc(Hed.Count);
with jr^[Hed.Count] do
begin
IsBigDir := False;
BigDirID := i;
BigCompressed := True;
uBigSizes := Dir.Size;
BigSizes := Dir.Size;
BigTimes := Dir.Time;
BigNames := s1;
BigFileVersion := GetFileVersion(s1);
end
end
until FindNext(Dir) <> 0
finally
SysUtils.FindClose(Dir)
end
finally
Dispose(DirArray)
end
end;
Hed.Signature := MyLZSignature;
MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);
{fix the header}
GetMem(jr2, MemRec);
try { finally }
FillChar(jr2^, MemRec, 0);
jr2^.Count := Hed.Count;
for i := 1 to Hed.Count do
with jr2^.Files[i], jr^[i] do
begin
IsDir := IsBigDir;
DirID := BigDirID;
ParentDir := BigParentDir;
Compressed := BigCompressed;
Sizes := BigSizes;
uSizes := uBigSizes;
Times := BigTimes;
FileVersion := BigFileVersion;
Names := ExtractFileName(BigNames)
end;
{ write the header }
BlockWrite(OutFile, Hed.Signature, SizeOf(Hed.Signature));
{main header}
BlockWrite(OutFile, jr2^, MemRec); {file headers}
{ loop through each file }
for i := 1+DirCount to Hed.Count do
with jr^[i] do
begin
AssignFile(InFile,BigNames);
InitReportRec(RepRec, jr^[i]);
BlankRec := RepRec;
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
{$I-} { However, share access is FILE_SHARE_READ }
Reset(InFile, 1);
{$I+}
if IOResult <> 0 then { Exception block generates }
with jr2^.Files[i] do { false compiler warning ... }
begin { Handle error using IOResult }
Sizes := 0;
uSizes := 0;
Compressed := False;
Continue
end;
try { finally }
{ report procedure }
inc(Result);
if Assigned(aProc) then aProc(RepRec,-1);
LZReportProc := aProc;
with jr2^.Files[i] do
if IsChiefLZFile(BigNames) or
IsChiefLZArchive(BigNames) then
{ Just copy (compressed) file into archive ... }
begin
Sizes := MyFCopy(InFile,OutFile,
LZ_UNKNOWN_LENGTH,doReportOnRead);
Compressed := False
end
else
{ Compress the file into the archive ... }
Sizes := ArchiveSquash(InFile, OutFile, aProc)
finally
CloseFile(InFile);
if Assigned(aProc) then
begin
RepRec.Names := '';
aProc(RepRec,-2)
end
end
end; { 1+DirCount <= i <= Count }
{ write header again }
Seek(OutFile, SizeOf(Hed.Signature));
BlockWrite(OutFile, jr2^, MemRec); {file headers}
finally
FreeMem(jr2, MemRec)
end
finally
Dispose(jr)
end
finally
CloseFile(OutFile)
end
finally
LZDone
end;
{$else}
{find path to add to filenames}
Path := '';
if not UseFile then
Path := ExtractFilePath(s1);
if Length(Path) = 0 then
GetDir(0, Path);
Path := AddBackSlash(Uppercase(Path));
if Length(ExtractFilePath(s2)) = 0 then
Insert(AddBackSlash(GetCurrentDir),s2,1);
if Length(ExtractFilePath(s1)) = 0 then
Insert(Path,s1,1);
s2 := Uppercase(s2);
{s1=filespec; s2=archive file}
if Uppercase(s1) <> s2
then begin
Assign(OutFile, s2);
Rewrite(OutFile, 1);
If IOResult<>0 then
LZArchive := -11 {write error}
else begin
New(jR);
if jr = nil then
{
Error condition ... ???
}
else begin
LZArchive := 0; {no file}
Hed.Count := 0;
DirCount := 0;
{get the file names for the archive}
If UseFile then BEGIN {using a LIST file}
Assign(t, s1);
Reset(t);
If IOResult<>0 then begin
LZArchive := -13; {LIST file does not exist}
Dispose(jr);
Close(OutFile); if IOResult<>0 then;
LZDone;
Exit
end;
While not EOF(t) do begin
Readln(t, s1);
s1 := Uppercase(s1);
if (IOResult=0) and (Length(s1)>0)
and (s1 <> s2)
and FileExists(s1) then
begin
{$IFDEF Debug}
if Hed.Count > MaxChiefLZArchiveSize then
RunErrorMessage('Max ChiefLZ archive size exceeded.');
{$ENDIF}
if Hed.Count >= MaxChiefLZArchiveSize then
Break;
inc(Hed.Count);
with jr^[Hed.Count] do
begin
IsBigDir := False;
BigDirID := 0;
BigCompressed := True;
uBigSizes := fSize(s1);
BigTimes := sfTime(s1);
BigNames := s1;
BigFileVersion := GetFileVersion(s1);
end
end {s1<>s2}
end; {while not eof(t)}
Close(t);if IOResult<>0 then;
if (Hed.Count = 0) then begin {no file}
LZArchive := -14; {no valid file in LIST file}
Dispose(jr);
Close(OutFile); if IOResult<>0 then;
LZDone;
Exit
end;
END
{
We do not have a LIST file, so find fileSpecs ...
}
else
begin
fSpecName := ExtractFileName(s1);
New(DirArray);
if DirArray <> nil then
begin
DirCountEx := 0;
DirArray^[0] := @Path; { REMEMBER - Path is NOT on the Heap! }
if LZRecurseDirs <> LZNoRecurse then
{
`Recurse' through subdirectories for files matching the given mask.
There are 2 levels of recursion - full recursion and immediate-subdirs...
}
begin
New(DirTimes);
if DirTimes <> nil then
begin
i := 0;
repeat
if LZRecurseDirs <> LZNoRecurse then
begin
{$ifdef Delphi}
if FindFirst(DirArray^[i]^+'*.*',faDirs,Dir) = 0 then
begin
{$else}
{$ifdef Windows}
Temp := DirArray^[i]^+'*.*';
FindFirst(Str2PChar(Temp),faDirs,Dir);
{$else Windows}
FindFirst(DirArray^[i]^+'*.*',faDirs,Dir);
{$endif Windows}
if DosError = 0 then
{$endif}
repeat
{$ifdef TPW}
FoundName := StrPas(Dir.Name);
{$endif TPW}
if (Dir.Attr and {$ifdef Windows} faDirectory
{$else} Directory
{$endif} <> 0) and
{$ifdef TPW}
(FoundName <> '.') and (FoundName <> '..')
{$else TPW}
(Dir.Name <> '.') and (Dir.Name <> '..')
{$Endif TPW}
then
begin
{$IFDEF Debug}
if DirCount > MaxChiefLZDirectories then
RunErrorMessage('DirArray^ bounds exceeded.');
{$ENDIF}
if DirCount >= MaxChiefLZDirectories then
break;
inc(DirCount);
{
writeln(DirCount,'=',Dir.Name);
}
DirTimes^[DirCount] := Dir.Time;
{$ifdef TPW}
DirArray^[DirCount] := NewString(DirArray^[i]^+FoundName+'\');
{$else TPW}
DirArray^[DirCount] := NewString(DirArray^[i]^+Dir.Name+'\');
{$endif TPW}
if DirArray^[DirCount] = nil then
{
Error condition ...
};
end;
{$ifdef Delphi}
until FindNext(Dir) <> 0;
SysUtils.FindClose(Dir)
end;
{$else}
FindNext(Dir)
until DosError <> 0;
{$endif}
end;
if i = 0 then
begin
Inc(i);
{
Turn directory-recursion off - have only looked in
immediate subdirectories ...
}
if LZRecurseDirs = LZRecurseOnce then
Dec(LZRecurseDirs)
end
else if not IsFileInDir(DirArray^[i]^+fSpecName) then
begin
DisposeString(DirArray^[i]);
Move(DirArray^[i+1],DirArray^[i],
(DirCount-i)*SizeOf(PString));
Move(DirTimes^[i+1],DirTimes^[i],
(DirCount-i)*SizeOf(LongInt));
DirArray^[DirCount] := nil;
Dec(DirCount)
end
else
begin
Inc(Hed.Count);
with jr^[Hed.Count] do
begin
IsBigDir := True;
BigDirID := i;
BigCompressed := False;
uBigSizes := 0;
BigSizes := 0;
BigTimes := DirTimes^[i];
BigFileVersion := '-';
BigNames := RemoveBackSlash(DirArray^[i]^)
end;
Inc(i)
end;
until i > DirCount;
Dispose(DirTimes)
end; {DirTimes <> nil}
{
Find the parents for each directory ...
}
DirCountEx := DirCount;
for i := 1 to DirCount do
begin
{
Search for a hole in the directory structure ...
}
FoundName := ExtractFilePath(RemoveBackSlash(DirArray^[i]^));
PIndex := GetDirIndex(FoundName, DirArray, DirCountEx);
{
If such a hole exists, we must store headers for all the missing
directories between Path and FoundName WORKING FORWARDS, or we'll
give some of the directories the wrong parents ...
}
if PIndex < 0 then
begin
PIndex := 0;
s1 := Path;
repeat
s1 := FirstDirectoryBetween(s1,FoundName);
NewPIndex := GetDirIndex(s1,DirArray,DirCountEx);
if NewPIndex < 0 then
begin
{
Do we have room for another directory ... ?
}
{$IFDEF Debug}
if DirCountEx > MaxChiefLZDirectories then
RunErrorMessage('Too many ChiefLZ directories.');
{$ENDIF}
if DirCountEx >= MaxChiefLZDirectories then
Break;
inc(DirCountEx);
DirArray^[DirCountEx] := NewString(s1);
inc(Hed.Count);
with jr^[Hed.Count] do
begin
BigNames := RemoveBackSlash(s1);
BigTimes := NulFileDate;
IsBigDir := True;
BigDirID := DirCountEx;
BigParentDir := PIndex;
BigSizes := 0;
uBigSizes := 0;
BigFileVersion := '-';
end;
NewPIndex := DirCountEx
end;
PIndex := NewPIndex
until Length(s1) = Length(FoundName)
end; { PIndex < 0 }
{
Now we're sure it exists, store Parent-index for directory i ...
}
jr^[i].BigParentDir := PIndex
end { 1 <= i <= DirCount }
end; { LZRecurseDirs }
{
Look through the directory list and create an archive of files from them...
Note that DirArray[0]^ is the Path directory ...
}
for i := 0 to DirCount do
begin
{$ifdef Delphi}
if FindFirst(DirArray^[i]^+fSpecName,faFiles,Dir) = 0 then
{$else Delphi}
{$ifdef Windows}
Temp := DirArray^[i]^+fSpecName;
FindFirst(Str2PChar(Temp),faFiles,Dir);
{$else Windows}
FindFirst(DirArray^[i]^+fSpecName,faFiles,Dir);
{$endif Windows}
if DosError = 0 then
{$endif Delphi}
repeat
{$ifdef TPW}
s1 := DirArray^[i]^+StrPas(Dir.Name);
{$else TPW}
s1 := DirArray^[i]^+Dir.Name;
{$endif TPW}
{$IFDEF Debug}
{ Did not put faDirectory in Attr mask, so *shouldn't*
see any directories ... }
if Dir.Attr and {$ifdef Windows} faDirectory
{$else} Directory
{$endif} <> 0 then
RunErrorMessage('Found directory when expecting file');
{$ENDIF}
{
Check that we are not trying to archive the output file ...
}
if Uppercase(s1) <> s2 then
begin
{$IFDEF Debug}
if Hed.Count > MaxChiefLZArchiveSize then
RunErrorMessage('Max archive size exceeded');
{$ENDIF}
if Hed.Count >= MaxChiefLZArchiveSize then
Break;
inc(Hed.Count);
with jr^[Hed.Count] do
begin
IsBigDir := False;
BigDirID := i;
BigCompressed := True;
uBigSizes := Dir.Size;
BigSizes := Dir.Size;
BigTimes := Dir.Time;
BigNames := s1;
BigFileVersion := GetFileVersion(s1);
end
end;
{$ifdef Delphi}
until FindNext(Dir) <> 0;
SysUtils.FindClose(Dir);
{$else Delphi}
FindNext(Dir);
until DosError <> 0;
{$endif Delphi}
end;
for i := 1 to DirCountEx do
DisposeString(DirArray^[i]);
Dispose(DirArray)
end; { DirArray <> nil }
end; { NOT UseFile }
Hed.Signature := MyLZSignature;
MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);
{fix the header}
GetMem(jr2, MemRec);
if jr2 = nil then
{
Error condition ...???
};
FillChar(jr2^, MemRec, #0);
jr2^.Count := Hed.Count;
for i := 1 to Hed.Count do
with jr2^.Files[i], jr^[i] do
begin
IsDir := IsBigDir;
DirID := BigDirID;
ParentDir := BigParentDir;
Compressed := BigCompressed;
Sizes := BigSizes;
uSizes := uBigSizes;
Times := BigTimes;
FileVersion := BigFileVersion;
Names := ExtractFileName(BigNames);
end;
{write the header}
BlockWrite(OutFile, Hed.Signature, SizeOf(Hed.Signature)); {main header}
BlockWrite(OutFile, jr2^, MemRec); {file headers}
If IOResult<>0 then
LZArchive := -12 {header write error}
else begin
LZArchive := -13; {other write error}
LZTot := 0;
{loop through each file}
for i := 1+DirCount to Hed.Count do
with jr^[i] do
begin
InitReportRec(RepRec, jr^[i]);
BlankRec := RepRec;
Assign(InFile, BigNames);
OldFMode := FileMode;
{
This choice of FileMode will cause Reset() to fail unless LZArchive
has *EXCLUSIVE WRITE-ACCESS* to the file. This is what we want, as
otherwise the file might change midway through the archive process.
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(InFile, 1);
FileMode := OldFMode;
if IOResult <> 0 then
with jr2^.Files[i] do
begin { Could not open file- insert nul }
Sizes := 0; { entry into the LZ-Archive. }
uSizes := 0;
Compressed := False;
Continue
end;
{report procedure }
if Assigned(aProc) then aProc(RepRec, -1);
inc(LZTot);
LZReportProc := aProc;
with jr2^.Files[i] do
begin
if (IsChiefLZArchive(Str2PChar(BigNames)))
or (IsChiefLZFile(Str2PChar(BigNames))) then
begin
l := MyFCopy(InFile,OutFile,
LZ_UNKNOWN_LENGTH,doReportOnRead);
Compressed := False
end
else
l := ArchiveSquash(InFile, OutFile, aProc);
Sizes := l
end{with jr2^};
Close(InFile);if IOResult<>0 then;
if Assigned(aPRoc) then
begin
RepRec.Names := '';
aProc(RepRec, -2)
end
end; {With jr^, DirCount+1 <= i <= Count}
LZArchive := LZTot;
{rewrite header again}
Seek(OutFile, SizeOf(Hed.Signature));
BlockWrite(OutFile, jr2^, MemRec); {file headers}
end;
FreeMem(jr2, MemRec);
Dispose(jr);
end; { jr <> nil }
Close(OutFile);if IOResult<>0 then;
end; { IOResult = 0 }
end; { Uppercase(s1) = s2 }
LZDone;
{$endif}
End;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZDearchive(ArchName: {$ifdef Win32} string
{$else} PChar
{$endif};
{$ifdef Win32} DefDir: string
{$else} const aDefDir: PChar
{$endif};
LZQuestion: TLZQuestionFunc;
aProc: TLZReportProc;
aRename: TLZRenameFunc):LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
{
Local function to determine user's request ...
}
function UserRequestsRename(var FName: TLZPathStr): boolean;
var
Path,
TempName: string;
{$ifndef Delphi}
Result: boolean;
{$endif}
begin
if not Assigned(aRename) then
UserRequestsRename := False
else
begin
TempName := FName;
Path := ExtractFilePath(TempName);
repeat
Result := aRename(TempName);
if not Result then
{$ifdef Delphi}
Exit;
{$else}
begin
UserRequestsRename := false;
Exit
end;
{$endif}
if Length(ExtractFilePath(TempName)) = 0 then
Insert(Path,TempName,1)
{$ifdef Delphi}
else
TempName := ExpandFileName(TempName)
{$endif}
until not FileExists(TempName);
FName := TempName;
{$ifndef Delphi}
UserRequestsRename := Result
{$endif}
end
end;
VAR
SrcFile,
DestFile:file;
TempFile:file;
LZFilePos: LongInt;
f : TLZHeader;
RepRec : TLZReportRec;
BigMemRec,
MemRec : TLZSSWord;
Hed : TLZArchiveHeader;
i : Integer;
{$ifdef Win32}
TempName: string;
{$else}
BRead : Integer;
OldFMode: byte;
Total : LongInt;
TempName,
DefDir,Source: string[128];
{$endif}
DirArray: PLZDirArray;
DirCount: Integer;
begin
{$ifdef aDLL}
if IsLZInitialized then
{$ifdef Win32}
RaiseError(EChiefLZDLL,SBusyChief);
{$else}
begin
LZDearchive := -20; {busy}
Exit
end;
{$endif}
{$endif aDLL}
if not IsChiefLZArchive(ArchName) then
{$ifdef Win32}
RaiseErrorStr(EChiefLZArchive,SInvalidArchive,ArchName);
{$else}
begin
LZDearchive := -30; {bad archive}
Exit
end;
{$endif}
{$ifdef Win32}
{target directory}
if Length(DefDir) = 0 then
GetDir(0,DefDir) // This directory MUST exist!
else
begin
DefDir := ExpandFileName(DefDir);
if not DirectoryExists(DefDir) then
try
MkDir(DefDir)
except
RaiseErrorStr(EChiefLZArchive,SBadDirectory,DefDir)
end // Delphi will never return from RaiseErrorStr()
end;
DefDir := AddBackSlash(DefDir);
{source file}
ArchName := ExpandFileName(ArchName);
AssignFile(SrcFile, ArchName);
FileMode := fmOpenRead; { Win32 only allows 0 <= FileMode <= 2 }
Reset(SrcFile, 1); { However, share access is FILE_SHARE_READ }
try { finally }
BlockRead(SrcFile, Hed, SizeOf(Hed));
Result := Hed.Count;
MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);
BigMemRec := SizeOf(TLZBigFileRec)*Hed.Count;
GetMem(jr, BigMemRec);
try { except }
Initialize(jr^[1], Hed.Count); { jr^ contains long strings...!!! }
try { finally }
GetMem(jr2, MemRec);
try { finally }
BlockRead(SrcFile, jr2^.Files[1], MemRec-SizeOf(TLZCount));
jr2^.Count := Hed.Count;
New(DirArray);
try { finally }
DirCount := 0;
DirArray^[0] := DefDir;
try { except }
for i := 1 to Hed.Count do
with jr^[i], jr2^.Files[i] do
begin
{
IMPORTANT POINT: This algorithm depends on having all of the directory entries
listed BEFORE the file entries in the archive header ...
}
if IsDir then
begin
inc(DirCount);
BigNames := DefDir + GetFullLZName(jr2^,i);
CreatePath(BigNames);
{ report directory creation using archive entry info }
if Assigned(aProc) then
begin
InitReportRec(RepRec, jr^[i]);
aProc(RepRec, -1);
RepRec.Names := '';
aProc(RepRec, -2)
end;
DirArray^[i] := BigNames + '\'
end
else
BigNames := DirArray^[DirID] + Names;
IsBigDir := IsDir;
BigDirID := DirID;
BigParentDir := ParentDir;
BigCompressed := Compressed;
BigSizes := Sizes;
uBigSizes := uSizes;
BigTimes := Times;
BigFileVersion := FileVersion
end {with jr^}
except
on EInOutError do
RaiseErrorStr(EChiefLZArchive,SBadDirectory,DirArray^[DirCount])
end
finally
Dispose(DirArray)
end
finally
FreeMem(jr2, MemRec)
end;
New(Buf);
try { finally }
LZFilePos := FilePos(SrcFile);
{ temp file }
TempName := GetTempChiefFileName; { This call CREATES a file on disc ... }
AssignFile(TempFile, TempName); { ... and this links the file to a Pascal var }
{
If premature EOF, archive is corrupt... This will trigger
an exception - handled (and re-raised) below.
}
for i := 1+DirCount to Hed.Count do
with jr^[i] do
begin {normal file - try to extract}
InitReportRec(RepRec, jr^[i]); {stuff inside the archive}
BlankRec := RepRec;
{
This file was STORED compressed; just copy it out ...
}
if not BigCompressed then
begin
{
... ensuring this stored LZ file will not overwrite SrcFile ...
}
if ( (AnsiCompareText(ArchName,BigNames)<>0)
or UserRequestsRename(BigNames) ) then
{
...AND checking that the file doesn't already exist ...
}
if FileExists(BigNames) and Assigned(LZQuestion) then
case LZQuestion(RepRec,BigNames) of
LZQuit: begin
LZDearchive := Pred(i);
Break { User requests Abort!! }
end;
{
Now the mundane matters - copy out the stored file ...
}
LZYes: begin
AssignFile(DestFile, BigNames);
Rewrite(DestFile,1);
try { finally }
if Assigned(aProc) then
aProc(RepRec,-1);
LZReportProc := aProc;
MyFCopy(SrcFile,DestFile,
BigSizes,doReportOnWrite)
finally
CloseFile(DestFile);
if Assigned(aProc) then
aProc(RepRec,-2)
end
end
end
end
{
This file was compressed into the archive- it needs expanding ...
}
else
begin
Rewrite(TempFile,1); // (Re?)open the temp file ... (wiping contents)
try { finally }
{ write header ... }
with f do
begin
Signature := ChiefLZSig;
fName := ExtractFileName(BigNames);
uSize := uBigSizes;
cSize := BigSizes;
fTime := BigTimes;
Version := BigFileVersion
end;
BlockWrite(TempFile, f, SizeOf(f));
(*
j := 0;
repeat
BRead := Min(BigSizes-j, SizeOf(Buf^));
{ If the file is shorter than it should be, raise IO-Exception }
BlockRead(SrcFile, Buf^, BRead);
{ If the output disc runs out of space, raise IO-Exception }
BlockWrite(TempFile, Buf^, BRead);
inc(j, BRead)
until (j >= BigSizes);
*)
LZReportProc := nil;
MyFCopy(SrcFile, TempFile, BigSizes, doReportOnWrite)
finally
CloseFile(TempFile)
end;
{ decompress the temporary file ... }
try
LZDecompress(TempName,BigNames,LZQuestion,aProc)
except
on EAbort do { Catch silent exception... }
begin { -Stop dearchiving files NOW! }
LZDearchive := Pred(i);
Break
end
end
end;
{ goto location of next file in archive ... }
inc(LZFilePos, BigSizes);
Seek(SrcFile, LZFilePos)
end; { 1+DirCount <= i <= Count }
Erase(TempFile) // Delete the temporary file ...
finally
Dispose(Buf)
end
finally
Finalize(jr^[1], Hed.Count); // jr^ contains long strings ...!
FreeMem(jr, BigMemRec)
end
except
on E: EInOutError do // Re-raise the exception as something
begin // more obvious.
if E.ErrorCode = 100 then // `Read beyond EOF'
RaiseErrorStr(EChiefLZArchive,SCorruptArchive,ArchName);
raise // Different IO-Error, so re-raise it to next handler
end
end
finally
CloseFile(SrcFile)
end
{$else}
{target directory}
DefDir := StrPas(aDefDir);
if Length(DefDir) = 0 then
GetDir(0, DefDir) { This directory MUST exist! }
else if not DirectoryExists(DefDir) then
begin
MkDir(DefDir);
If IOResult <> 0 then
begin
LZDearchive := -31; {bad directory}
Exit
end
end;
DefDir := AddBackSlash(DefDir);
TempName := StrPas(ArchName);
Source := ExtractFilePath(TempName);
TempName := ExtractFileName(TempName);
if Length(Source)=0 then
GetDir(0, Source);
Source := AddBackSlash(Source) + TempName;
LZDearchive := -1; {open error}
Assign(SrcFile, Source{StrPas(ArchName)});
OldFMode := FileMode;
{
Open archive file: we require Read-access, don't need Write-access,
and *INSIST* that no one else can write to it (i.e. corrupt it)
until we're done ...
}
FileMode := (fmOpenRead or fmShareDenyWrite);
Reset(SrcFile, 1);
FileMode := OldFMode;
If IOResult = 0 then
begin
LZDearchive := -2; {open error}
BlockRead(SrcFile, Hed, SizeOf(Hed));
if IOResult = 0 then
begin
MemRec := SizeOf(TLZFileRec)*Hed.Count + SizeOf(TLZCount);
BigMemRec := SizeOf(TLZBigFileRec)*Hed.Count;
GetMem(jr, BigMemRec);
if jr = nil then
{
Error condition ...
}
else begin
GetMem(jr2, MemRec);
if jr2 <> nil then
begin
{error reading header}
BlockRead(SrcFile, jr2^.Files[1], MemRec-SizeOf(TLZCount));
if IOResult<>0 then begin
Close(SrcFile); { Reset() Ok; hence Close() must succeed. }
FreeMem(jr2, MemRec);
FreeMem(jr, BigMemRec);
Exit
end;
jr2^.Count := Hed.Count;
DirCount := 0;
New(DirArray);
if DirArray <> nil then
begin
DirArray^[0] := @DefDir; { This string is NOT on the heap!!! }
for i := 1 to Hed.Count do
with jr^[i], jr2^.Files[i] do
begin
if IsDir then
begin
Inc(DirCount);
BigNames := DefDir + GetFullLZName(jr2^,i);
DirArray^[i] := NewString(BigNames+'\')
end
else
BigNames := DirArray^[DirID]^ + Names;
IsBigDir := IsDir;
BigDirId := DirID;
BigParentDir := ParentDir;
BigCompressed := Compressed;
BigSizes := Sizes;
uBigSizes := uSizes;
BigTimes := Times;
BigFileVersion := FileVersion
end{with jr^[i]};
for i := 1 to DirCount do
DisposeString(DirArray^[i]);
Dispose(DirArray);
end; {DirArray<>nil}
FreeMem(jr2, MemRec)
end; {jr2<>nil}
{
This code placed here to help reduce the amount of clean-up that must be
done in case of an error.
}
for i := 1 to DirCount do
begin
if CreatePath(jr^[i].BigNames) < 0 then
begin
LZDearchive := -31;
FreeMem(jr, BigMemRec);
Close(SrcFile); { Reset() Ok; hence Close() must succeed. }
Exit
end;
if Assigned(aProc) then
{ report directory-creation using archive-entry information }
begin
InitReportRec(RepRec, jr^[i]);
aProc(RepRec, -1);
RepRec.Names := '';
aProc(RepRec, -2)
end
end;
LZFilePos := FilePos(SrcFile);
New(Buf);
if Buf = nil then
{
Error condition ...???
}
else begin
{error processing file}
LZDearchive := 0;
{temp file}
{
Str2PChar() works by appending #0 to string, and then returning address
of string[1].
}
TempName := DefDir;
if not GetTempChiefFileName(Str2PChar(TempName)) then
TempName := DefDir + 'CHF$$$.$$$'
else
TempName[0] := chr(StrLen(@TempName[1])); { adjust length byte }
Assign(TempFile, TempName);
for i := DirCount+1 to Hed.Count do
with jr^[i] do
begin {normal file - try to extract}
InitReportRec(RepRec, jr^[i]); { stuff inside the archive }
BlankRec := RepRec;
{
This file was STORED compressed; just copy it out ...
}
if not BigCompressed then
begin
{
... ensuring this stored LZ file will not overwrite SrcFile ...
}
if ( (Uppercase(Source) <> Uppercase(BigNames)) or
UserRequestsRename(BigNames) ) then
{
...AND checking that the file doesn't already exist ...
}
if FileExists(BigNames) and Assigned(LZQuestion) then
case LZQuestion(RepRec,BigNames) of
LZQuit: begin
LZDearchive := Pred(i); { User requested Abort! }
Break
end;
{
Now the mundane matters - copy out the stored file ...
}
LZYes : begin
Assign(DestFile, BigNames);
Rewrite(DestFile, 1);
if IOResult=0 then begin
LZReportProc := aProc;
if Assigned(aProc) then aProc(RepRec, -1);
MyFCopy(SrcFile,DestFile,
BigSizes,doReportOnWrite);
Close(DestFile);
if IOResult<>0 then;
if Assigned(aProc) then
begin
RepRec.Names := '';
aProc(RepRec, -2)
end
end
end
end
end
else begin (* Is compressed ... *)
Rewrite(TempFile, 1);
If IOResult <> 0 then begin
LZDearchive := -200; {big error}
Break
end;
{write header}
With f do begin
fName := ExtractFileName(BigNames);
Signature := ChiefLZSig;
uSize := uBigSizes;
cSize := BigSizes;
fTime := BigTimes;
Version := BigFileVersion;
end;
BlockWrite(TempFile, f, SizeOf(f)); {write header}
If IOResult <> 0 then begin
Close(TempFile); { No possible error; no buffered IO, Rewrite() OK. }
Break
end;
Total := 0;
repeat
BRead := Min(BigSizes-Total, SizeOf(Buf^));
{ If the file is shorter than it should be, IO-Error }
BlockRead(SrcFile, Buf^, BRead);
if IOResult = 0 then
begin
{ If the output disc runs out of space, IO-Error }
BlockWrite(TempFile, Buf^, BRead);
if IOResult = 0 then
begin
inc(Total, BRead);
Continue
end
end;
{ Error-handling: clean-up code ... }
Close(TempFile); if IOResult <> 0 then;
Close(SrcFile); { Reset() Ok; hence Close() must succeed. }
FreeMem(jr, BigMemRec);
Dispose(Buf);
Exit
until (Total >= BigSizes);
Close(TempFile); if IOResult<>0 then;
{decompress the temporary file}
if LZDecompress(Str2PChar(TempName),Str2PChar(BigNames),
LZQuestion,aProc) = -150 then
begin { User requested Abort !! }
Erase(TempFile); if IOResult <> 0 then;
LZDearchive := Pred(i);
Break
end
end;
LZDearchive := i;
{goto location of next file in archive}
Inc(LZFilePos, BigSizes);
Seek(SrcFile, LZFilePos);
If IOResult <> 0 then
Break;
Erase(TempFile);if IOResult<>0 then;
end; { DirCount+1 <= i <= Count) }
Dispose(Buf);
end; { Buf <> nil }
FreeMem(jr, BigMemRec);
end; { jr <> nil ... }
end; { IOResult = 0 after BlockRead(SrcFile,... }
Close(SrcFile); { Reset() Ok; hence Close() must succeed. }
end; { IOResult = 0 after Reset(SrcFile,1) }
{$endif}
End;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZCompressEx(const {$ifdef Win32} Name: string
{$else} aName: PChar
{$endif};
ReplaceQuestion:TLZQuestionFunc;
aProc:TLZReportProc): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
{$ifndef Win32}
Name: string;
{$endif}
NewName: string;
Begin
{$ifndef Win32}
Name := StrPas(aName);
{$endif}
NewName := GetLZMarkedName(Name);
LZCompressEx := LZCompress({$ifdef Win32} Name, NewName,
{$else} aName, Str2PChar(NewName),
{$endif} ReplaceQuestion, aProc);
End;
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
Function LZDecompressEx({$ifdef Win32} Name: string
{$else} aName: PChar
{$endif};
ReplaceQuestion:TLZQuestionFunc;
aProc:TLZReportProc): LongInt;
{$ifdef aDLL} {$ifdef Win32} stdcall
{$else Win32} export
{$endif Win32};
{$endif aDLL}
Var
s2:string;
{$ifndef Win32}
s: string;
Name: string;
{$endif}
OutName: {$ifdef Win32} string;
{$else} array[0..79] of Char;
{$endif}
IsHeaderRead: boolean;
Begin
{$ifdef Win32}
LZDecompressEx := 0;
{$else}
LZDecompressEx := -100;
Name := StrPas(aName);
{$endif}
if Length(Name) <> 0 then
begin
IsHeaderRead := false;
{see if source file exists}
If Not FileExists(Name) then {look for name ending with MyLZMarker}
begin
{$ifdef Win32}
s2 := Name;
{$else}
s2 := Uppercase(Name);
{$endif}
Name := GetLZMarkedName(Name);
{
If Win32, then GetChiefLZFileName() will throw the correct exception when
it tries to open Name. No need to do it manually.
}
{$ifndef Win32}
if not FileExists(Name) then {source file not found}
Exit;
aName := Str2PChar(Name);
{$endif}
{$ifdef Win32}
OutName := GetChiefLZFileName(Name); { read header ... }
if AnsiCompareText( ExtractFileName(OutName),
ExtractFileName(s2) ) <> 0 then
RaiseErrorStr(EChiefLZCompress,SWrongCompressedFile,OutName)
{$else}
GetChiefLZFileName(aName, OutName);
s := Uppercase(StrPas(OutName));
If ExtractFileName(s)<>ExtractFileName(s2) {wrong uncompressed file}
then
begin
LZDecompressEx := -2; {wrong file}
Exit
end
{$endif};
IsHeaderRead := True
end;
{not FileExists}
{$ifdef Win32}
if not IsHeaderRead then
OutName := GetChiefLZFileName(Name);
if Length(OutName) > 0 then
begin
{check for same source and target}
OutName := ExtractFileName(OutName);
Name := ExpandFileName(Name);
if AnsiCompareText(ExtractFileName(Name),OutName) = 0 then
RaiseErrorStr(EChiefLZCompress,SSameFileName,Name);
Insert(ExtractFilePath(Name),OutName,1);
LZDecompressEx := LZDecompress(Name, OutName, ReplaceQuestion, aProc)
end
{$else Win32}
if not IsHeaderRead then
GetChiefLZFileName(aName, OutName);
if StrLen(OutName) > 0 then begin
s := ExtractFileName(StrPas(OutName)); {get just file name}
s2 := ExtractFilePath(Name); {does source file have path?}
If Length(s2) = 0 then
GetDir(0, s2); {if not, use current directory}
s2 := AddBackSlash(s2); {add '\'}
Insert(s2,s,1); {target file}
{check for same source and target}
If Length(ExtractFilePath(Name)) = 0 then
Insert(s2,Name,1);
If Uppercase(Name)=Uppercase(s) then
LZDecompressEx := -3 {same source & target}
else
LZDecompressEx := LZDecompress(aName,Str2PChar(s),ReplaceQuestion,aProc)
end; { StrLen(OutName) > 0 }
{$endif Win32}
end; { Length(Name) <> 0 }
End;
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{/// implementation of LZ object /////////////////}
{////////////////////////////////////////////////////}
{////// CANNOT BE USED BY .DLL ////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifndef aDLL}
Constructor LZObj.{$ifdef Delphi} Create {$else} Init {$endif};
Begin
{$ifndef Win32} { Delphi 2.0 automatically zeros new objects }
ReportProc := Nil;
QuestionProc := Nil;
{$ifdef Delphi}
FInputName[0] := #0;
FOutputName[0] := #0;
{$else}
IsInited := False;
InputName[0] := #0;
OutputName[0] := #0;
{$endif}
{$endif}
{$ifdef Delphi}
{$ifDef Win32}
FInputName := InFName;
FOutputName := OutFName;
{$else Win32}
StrPCopy(FInputName, InFName);
StrPCopy(FOutputName, OutFName);
{$Endif Win32}
{$else}
SetInputName(InFName);
SetOutputName(OutFName);
{$endif}
End;
{////////////////////////////////////////////////////}
Destructor LZObj.{$ifdef Delphi} Destroy {$else} Done {$endif};
Begin
{$ifdef Win32}
SetLength(FInputName,0);
SetLength(FOutputName,0);
{$else}
{$ifdef Delphi}
FInputName[0] := #0;
FOutputName[0] := #0;
{$else}
IsInited := False;
InputName[0] := #0;
OutputName[0] := #0;
{$endif}
{$endif}
{$ifdef Delphi}
FReportProc := Nil;
FQuestionProc := Nil;
{$else}
ReportProc := Nil;
QuestionProc := Nil;
{$endif}
End;
{////////////////////////////////////////////////////}
{$ifdef Delphi}
Function LZObj.GetIsInited: boolean;
begin
{$ifdef Win32}
GetIsInited := Length(FInputName) > 0;
{$else}
GetIsInited := StrLen(FInputName) > 0;
{$endif}
end;
{////////////////////////////////////////////////////}
{$else}
Procedure LZObj.SetInputName;
Begin
If Length(aName)>0 then IsInited := True;
StrPCopy(InputName, aName);
End;
{////////////////////////////////////////////////////}
Procedure LZObj.SetOutputName;
Begin
StrPCopy(OutputName, aName);
End;
{$endif}
{////////////////////////////////////////////////////}
Function LZObj.Compress:Longint;
Begin
if not IsInited then
Compress := -100
else if {$ifdef Win32} Length(FOutputName)
{$else} StrLen(OutputName)
{$endif} > 0 then
Compress := LZCompress(InputName, OutputName, QuestionProc, ReportProc)
else
Compress := LZCompressEx(InputName, QuestionProc, ReportProc)
End;
{////////////////////////////////////////////////////}
Function LZObj.Decompress:Longint;
Begin
if not IsInited then
Decompress := -100
else if {$ifdef Win32} Length(FOutputName)
{$else} StrLen(OutputName)
{$endif} > 0 then
Decompress := LZDeCompress(InputName, OutputName, QuestionProc, ReportProc)
else
Decompress := LZDeCompressEx(InputName, QuestionProc, ReportProc)
End;
{////////////////////////////////////////////////////}
{$ifndef Delphi}
Procedure LZObj.SetReportProc;
Begin
ReportProc := aProc;
End;
{////////////////////////////////////////////////////}
Procedure LZObj.SetQuestionProc;
Begin
QuestionProc := aProc;
End;
{$endif Delphi}
{$endif aDLL}
{/////////////////////////////////////////////////////////}
{$IFNDEF Win32}
Function HeapFunc(Size: Word): Integer; far; assembler;
Asm
MOV AX, 1
End; { HeapFunc }
{$ENDIF}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{////////////////////////////////////////////////////}
{$ifdef aDLL}
{
Procedural interface to allow MyLZMarker to be modified if a DLL.
Utterly redundant if NOT DLL, since MyLZMarker is published in the
interface and we WANT to grant read/write access.
}
function GetLZMarkerChar: Char; {$ifdef Win32} stdcall {$else} export {$endif};
begin
GetLZMarkerChar := MyLZMarker
end;
procedure SetLZMarkerChar(const NewChar: Char);
{$ifdef Win32} stdcall {$else} export {$endif};
begin
MyLZMarker := NewChar
end;
function ChiefLZDLLVersion: Integer;
{$ifdef Win32} stdcall {$else} export {$endif Win32};
begin
ChiefLZDLLVersion := ChiefLZVersionNumber
end;
Exports
LZCompress index 1 {$ifdef Win32} name 'LZCompress' {$endif},
LZDecompress index 2 {$ifdef Win32} name 'LZDecompress' {$endif},
IsChiefLZFile index 3 {$ifdef Win32} name 'IsChiefLZFile' {$endif},
LZArchive index 4 {$ifdef Win32} name 'LZArchive' {$endif},
LZDearchive index 5 {$ifdef Win32} name 'LZDearchive' {$endif},
IsChiefLZArchive index 6 {$ifdef Win32} name 'IsChiefLZArchive' {$endif},
GetChiefLZFileName index 7 {$ifdef Win32} name 'GetChiefLZFileName' {$endif},
GetChiefLZFileSize index 8 {$ifdef Win32} name 'GetChiefLZFileSize' {$endif},
GetChiefLZArchiveInfo index 9 {$ifdef Win32} name 'GetChiefLZArchiveInfo' {$endif},
LZCompressEx index 10 {$ifdef Win32} name 'LZCompressEx' {$endif},
LZDeCompressEx index 11 {$ifdef Win32} name 'LZDecompressEx' {$endif},
GetLZMarkerChar index 12 {$ifdef Win32} name 'GetLZMarkerChar' {$endif},
SetLZMarkerChar index 13 {$ifdef Win32} name 'SetLZMarkerChar' {$endif},
GetFullLZName index 14 {$ifdef Win32} name 'GetFullLZName' {$endif},
ChiefLZDLLVersion index 15 {$ifdef Win32} name 'ChiefLZDLLVersion' {$endif},
GetChiefLZArchiveSize index 16 {$ifdef Win32} name 'GetChiefLZArchiveSize' {$endif};
{$endif aDLL}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{/////////////////////////////////////////////////////////}
{$ifdef Win32}
{
Delphi 2.00 does some VERY nasty things to DLLs if:
(a) You include an initialisation section (even an empty one)
and
(b) You declare an uninitialised Global string variable; either
on its own or as part of a record.
I have therefore tried to work around this by pre-initialising as
many of the global variables as possible (in the 32-bit code). Note
that BlankRec contains a field called Name, which is a long-string
in the Delphi 2 version !!!
}
{$ifdef aDLL}
begin { <<< Crash And Burn warning !!!! }
{$else aDLL} { Must have NO uninitialised global long-string vars!! }
initialization
{$endif aDLL}
{$else Win32}
Begin
{
These variables can be initialised here in the 16-bit version ...
}
HeapError := @HeapFunc; { Specific to 16-bit code }
FillChar(BlankRec, SizeOf(BlankRec), 0);
LZReportProc := Nil;
{$endif Win32}
Decompressing :=False;
{
These variables MUST be initialised here ...
}
LZReadProc := MyReadProc;
LZWriteProc := MyWriteProc
End.