519 lines
15 KiB
Plaintext
519 lines
15 KiB
Plaintext
unit ArchiveFileUnit;
|
|
{-------------------------------------------------------------------------------
|
|
Archive File Unit
|
|
-----------------
|
|
reSource v2.6
|
|
Copyright (C) 1998-2001 Victor Kasenda / gruv
|
|
http://go.to/gruv
|
|
email: vickas@singnet.com.sg
|
|
|
|
|
|
|
|
Notes:
|
|
Anything related to the file itself physically.
|
|
Seek/Read/Write
|
|
-------------------------------------------------------------------------------}
|
|
|
|
(**) interface (**)
|
|
uses SysUtils, Classes,
|
|
// resource units
|
|
bit_file_unit, Contnrs;
|
|
|
|
|
|
type
|
|
TArchiveFile = class;
|
|
|
|
|
|
TCentralDir = class(TObjectList)
|
|
private
|
|
ArchiveFile: TArchiveFile;
|
|
central_dir_offset: integer;
|
|
|
|
// info from end of central dir record
|
|
fblock_size: integer;
|
|
|
|
public
|
|
property block_size: integer read fblock_size;
|
|
|
|
constructor Create(_ArchiveFile: TArchiveFile);
|
|
{destructor Destroy; override;}
|
|
|
|
{procedure Clear;
|
|
procedure Delete(Index: Integer);}
|
|
|
|
// read/write from assigned file
|
|
procedure Read;
|
|
procedure Write;
|
|
|
|
procedure WriteToFile(NArchiveFile: TArchiveFile); // write to another archive file
|
|
|
|
function GetCentralDirOffset: integer;
|
|
function SeekToCentralDir: boolean;
|
|
|
|
function FileNameExists(filename: string): boolean;
|
|
end;
|
|
|
|
|
|
TArchiveFile = class(TBitFile)
|
|
private
|
|
protected
|
|
|
|
public
|
|
CentralDir: TCentralDir;
|
|
filename: string;
|
|
|
|
constructor CreateNew(const _filename: string; OpenExisting: boolean);
|
|
//constructor OpenExisting(const _filename: string);
|
|
destructor Destroy; override;
|
|
|
|
procedure ReadString(var s: string);
|
|
procedure ReadLongint(var a: longint);
|
|
procedure ReadLongword(var a: longword);
|
|
procedure WriteString(const s: string);
|
|
procedure WriteLongint(const a: longint);
|
|
procedure WriteLongword(const a: longword);
|
|
// new style function overloading
|
|
procedure ReadData(var a: longint); overload;
|
|
procedure ReadData(var a: longword); overload;
|
|
procedure WriteData(const a: longint); overload;
|
|
procedure WriteData(const a: longword); overload;
|
|
|
|
procedure ReserveSpace(const num_bytes: integer);
|
|
{function IsEmptyArchive: boolean;}
|
|
|
|
// Archive related
|
|
procedure SeekToDataStart;
|
|
end;
|
|
|
|
|
|
procedure ArchiveFileBlockCopy(SourceFile, DestFile: TArchiveFile; size: integer);
|
|
|
|
(**) implementation (**)
|
|
uses StructsUnit, ErrorUnit, ArchiveHeadersUnit;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ArchiveFileBlockCopy
|
|
--------------------
|
|
Works similarly to TStream.CopyFrom but is more efficient in that a bigger
|
|
buffer is used (64kbytes).
|
|
|
|
IN Assertion:
|
|
Buffering has been disabled for both files.
|
|
The files have been seeked to the position to read/write.
|
|
-------------------------------------------------------------------------------}
|
|
procedure ArchiveFileBlockCopy(SourceFile, DestFile: TArchiveFile; size: integer);
|
|
var
|
|
buf: P64kBlock;
|
|
bytes_to_read: integer;
|
|
const
|
|
bufsize = sizeof(T64kBlock);
|
|
begin
|
|
New(buf);
|
|
|
|
while (size > 0) do
|
|
begin
|
|
if (size > bufsize) then
|
|
bytes_to_read := bufsize
|
|
else
|
|
bytes_to_read := size;
|
|
dec(size, bytes_to_read);
|
|
SourceFile.Read(buf^, bytes_to_read);
|
|
DestFile.Write(buf^, bytes_to_read);
|
|
end;
|
|
|
|
Dispose(buf);
|
|
end;
|
|
|
|
|
|
(*******************************************************************************
|
|
TCentralDir
|
|
-----------
|
|
Central Directory class
|
|
*******************************************************************************)
|
|
|
|
constructor TCentralDir.Create(_ArchiveFile: TArchiveFile);
|
|
begin
|
|
inherited Create;
|
|
ArchiveFile := _ArchiveFile;
|
|
central_dir_offset := -1;
|
|
Read;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
GetCentralDirOffset
|
|
Returns the central_dir_offset of it has not been read yet.
|
|
|
|
Desc:
|
|
The central directory offset is stored in the last 4 bytes of the file.
|
|
It is inefficient to keep reading this porition to get the central directory
|
|
offset. So it is cached and stored in central_dir_offset. If it has not
|
|
been read yet, a -1 is assigned.
|
|
-------------------------------------------------------------------------------}
|
|
function TCentralDir.GetCentralDirOffset: integer;
|
|
begin
|
|
if (central_dir_offset = -1) then
|
|
begin
|
|
// the offset has not been read in yet
|
|
// read it in
|
|
// seek to the start of the central directory
|
|
with ArchiveFile do
|
|
begin
|
|
if (Size > 0) then
|
|
begin
|
|
DisableBuf;
|
|
SmartSeek(-4, soFromEnd); // seek to last four bytes
|
|
Read(central_dir_offset, 4); // get main_directory_offset
|
|
EnableBuf;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
result := central_dir_offset;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
SeekToCentralDir
|
|
----------------
|
|
Seeks to the central dir in the archive file.
|
|
returns false if CentralDir does not exist (archive is empty)
|
|
-------------------------------------------------------------------------------}
|
|
function TCentralDir.SeekToCentralDir: boolean;
|
|
begin
|
|
if (GetCentralDirOffset >= 0) then
|
|
begin
|
|
// seek to central directory
|
|
with ArchiveFile do
|
|
begin
|
|
DisableBuf;
|
|
SmartSeek(central_dir_offset, soFromBeginning);
|
|
EnableBuf;
|
|
end;
|
|
result := true;
|
|
end
|
|
else
|
|
result := false;
|
|
end;
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Read
|
|
----
|
|
Reads the CentralDir from the archive file
|
|
-------------------------------------------------------------------------------}
|
|
procedure TCentralDir.Read;
|
|
var
|
|
ArchiveHeader: TArchiveHeader;
|
|
CentralDirEndHeader: TCentralDirEndHeader;
|
|
|
|
begin
|
|
Clear;
|
|
with ArchiveFile do
|
|
begin
|
|
{if not IsEmptyArchive then
|
|
begin}
|
|
if SeekToCentralDir then
|
|
begin
|
|
{GetCentralDirOffset;
|
|
|
|
// seek to central directory
|
|
DisableBuf;
|
|
SmartSeek(central_dir_offset, soFromBeginning);
|
|
EnableBuf;}
|
|
|
|
// read in the central file headers until an end of central dir rec is encountered
|
|
repeat
|
|
ArchiveHeader := GetArchiveHeader(ArchiveFile);
|
|
if (ArchiveHeader is TCentralFileHeader) then
|
|
Add(ArchiveHeader)
|
|
else
|
|
break;
|
|
until false;
|
|
|
|
CentralDirEndHeader := (ArchiveHeader as TCentralDirEndHeader);
|
|
fblock_size := CentralDirEndHeader.block_size;
|
|
CentralDirEndHeader.free;
|
|
end; // SeekToCentralDir
|
|
{end; // if not IsEmptyArchive}
|
|
end; // with Archive File
|
|
end; // procedure
|
|
|
|
{-------------------------------------------------------------------------------
|
|
WriteToFile
|
|
-----------
|
|
|
|
IN Assertion: The file has been seeked to the correct location to write the
|
|
the CentralDir Info.
|
|
|
|
Writes:
|
|
[central file header] ...
|
|
[end of central directory record]
|
|
-------------------------------------------------------------------------------}
|
|
procedure TCentralDir.Write;
|
|
begin
|
|
WriteToFile(ArchiveFile);
|
|
end;
|
|
|
|
procedure TCentralDir.WriteToFile(NArchiveFile: TArchiveFile);
|
|
var
|
|
i: integer; // counter
|
|
CentralFileHeader: TCentralFileHeader;
|
|
CentralDirEndHeader: TCentralDirEndHeader;
|
|
|
|
begin
|
|
// the CentralDirEndHeader will be written last
|
|
CentralDirEndHeader := TCentralDirEndHeader.Create;
|
|
with CentralDirEndHeader do
|
|
begin
|
|
block_size := BlockSize;
|
|
central_file_header_offset := NArchiveFile.Position;
|
|
end;
|
|
|
|
// write [central file header]
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
CentralFileHeader := TCentralFileHeader(items[i]);
|
|
CentralFileHeader.WriteToFile(NArchiveFile);
|
|
end;
|
|
|
|
CentralDirEndHeader.WriteToFile(NArchiveFile);
|
|
CentralDirEndHeader.free;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
FileNameExists
|
|
--------------
|
|
returns true if a CentralFileHeader with the same filename exists
|
|
|
|
Notes:
|
|
Used to check for duplicate file names when a file is to be added to
|
|
the archive.
|
|
|
|
Desc:
|
|
Does a case insensitive comparison of all the entries in CentralDir to look
|
|
for the filename.
|
|
-------------------------------------------------------------------------------}
|
|
function TCentralDir.FileNameExists(filename: string): boolean;
|
|
var
|
|
i: integer; // counter
|
|
CFH: TCentralFileHeader; // entry in CentralDir
|
|
begin
|
|
filename := UpperCase(filename);
|
|
result := false;
|
|
for i := 0 to Count-1 do
|
|
begin
|
|
CFH := Items[i] as TCentralFileHeader;
|
|
if (filename = Uppercase(CFH.filename)) then
|
|
begin
|
|
result := true;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
(*******************************************************************************
|
|
TArchiveFile
|
|
------------
|
|
The Archive file class
|
|
*******************************************************************************)
|
|
|
|
{-------------------------------------------------------------------------------
|
|
CreateNew
|
|
---------
|
|
Creates a new archive with filename.
|
|
|
|
Desc:
|
|
If the file exists, it will be zeroed.
|
|
The Resource archive signature and an empty central directory will be added
|
|
to it to make it a valid archive.
|
|
The CentralDir is read again at the end to obtain its offset.
|
|
-------------------------------------------------------------------------------}
|
|
constructor TArchiveFile.CreateNew(const _filename: string; OpenExisting: boolean);
|
|
var
|
|
RAH: TResourceArchiveHeader;
|
|
begin
|
|
if OpenExisting then
|
|
begin
|
|
inherited Create(_filename, fmOpenRead or fmShareDenyWrite);
|
|
filename := _filename;
|
|
// test the signature to see if it is a valid archive
|
|
RAH := TResourceArchiveHeader.Create;
|
|
RAH.ReadFromFile(Self);
|
|
RAH.Free;
|
|
// create a new central dir and read it from the file
|
|
CentralDir := TCentralDir.Create(Self);
|
|
CentralDir.Read;
|
|
end
|
|
else
|
|
begin
|
|
inherited Create(_filename, fmCreate);
|
|
filename := _filename;
|
|
// write the signature to make it a valid archive
|
|
RAH := TResourceArchiveHeader.Create;
|
|
RAH.WriteToFile(Self);
|
|
RAH.Free;
|
|
// create a new central dir and write it
|
|
CentralDir := TCentralDir.Create(Self);
|
|
CentralDir.Write;
|
|
ResetBuffer;
|
|
CentralDir.Read;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Open
|
|
----
|
|
Opens an existing file of filename.
|
|
|
|
Desc:
|
|
The signature of the file will be checked to ensure it is valid.
|
|
|
|
Notes:
|
|
If the file does not exist an exception will occur.
|
|
-------------------------------------------------------------------------------}
|
|
{constructor TArchiveFile.OpenExisting(const _filename: string);
|
|
var
|
|
RAH: TResourceArchiveHeader;
|
|
begin
|
|
inherited Create(_filename, fmOpenRead or fmShareDenyWrite);
|
|
filename := _filename;
|
|
// test the signature to see if it is a valid archive
|
|
RAH := TResourceArchiveHeader.Create;
|
|
RAH.ReadFromFile(Self);
|
|
RAH.Free;
|
|
// create a new central dir and read it from the file
|
|
CentralDir := TCentralDir.Create(Self);
|
|
CentralDir.Read;
|
|
end;}
|
|
|
|
|
|
{-------------------------------------------------------------------------------
|
|
Destroy
|
|
-------
|
|
Frees up resources allocated by the constructor.
|
|
-------------------------------------------------------------------------------}
|
|
destructor TArchiveFile.Destroy;
|
|
begin
|
|
CentralDir.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{function TArchiveFile.IsEmptyArchive: boolean;
|
|
begin
|
|
// if the file is 0 bytes long, then this is a new or empty archive
|
|
result := (Size = 0);
|
|
end;}
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ReadString
|
|
----------
|
|
|
|
Desc:
|
|
Strings are null terminated
|
|
Read in characters until a null is encountered
|
|
-------------------------------------------------------------------------------}
|
|
procedure TArchiveFile.ReadString(var s: string);
|
|
var
|
|
c: char;
|
|
begin
|
|
repeat
|
|
GetNextByte(byte(c));
|
|
if (c = #0) then break;
|
|
s := s + c;
|
|
until false;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ReadLongInt
|
|
-----------
|
|
Reads in a longinteger from the buffer
|
|
-------------------------------------------------------------------------------}
|
|
procedure TArchiveFile.ReadLongint(var a: longint);
|
|
begin
|
|
ReadBuf(a, sizeof(a));
|
|
end;
|
|
|
|
procedure TArchiveFile.ReadLongword(var a: longword);
|
|
begin
|
|
ReadBuf(a, sizeof(a));
|
|
end;
|
|
|
|
procedure TArchiveFile.ReadData(var a: longint);
|
|
begin
|
|
ReadBuf(a, sizeof(a));
|
|
end;
|
|
|
|
procedure TArchiveFile.ReadData(var a: longword);
|
|
begin
|
|
ReadBuf(a, sizeof(a));
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
WriteString
|
|
-----------
|
|
writes out the string s and a null terminator
|
|
-------------------------------------------------------------------------------}
|
|
procedure TArchiveFile.WriteString(const s: string);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 1 to length(s) do
|
|
WriteByte(byte(s[i]));
|
|
WriteByte(0); // write the string terminator
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
WriteLongInt
|
|
------------
|
|
Writes out the longinteger 'a' to the buffer
|
|
-------------------------------------------------------------------------------}
|
|
procedure TArchiveFile.WriteLongint(const a: longint);
|
|
begin
|
|
WriteBuf(a, sizeof(a));
|
|
end;
|
|
|
|
procedure TArchiveFile.WriteLongword(const a: longword);
|
|
begin
|
|
WriteBuf(a, sizeof(a));
|
|
end;
|
|
|
|
procedure TArchiveFile.WriteData(const a: longint);
|
|
begin
|
|
WriteBuf(a, sizeof(a));
|
|
end;
|
|
|
|
procedure TArchiveFile.WriteData(const a: longword);
|
|
begin
|
|
WriteBuf(a, sizeof(a));
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
ReserveSpace
|
|
------------
|
|
writes out num_bytes of blank data to reserve the space for future use
|
|
-------------------------------------------------------------------------------}
|
|
procedure TArchiveFile.ReserveSpace(const num_bytes: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 1 to num_bytes do
|
|
WriteByte(0);
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
SeekToDataStart
|
|
---------------
|
|
seeks to the start of the data segment of the archive
|
|
|
|
Desc:
|
|
The data segment starts after the archive header (signature)
|
|
Seek to the position after the header
|
|
-------------------------------------------------------------------------------}
|
|
procedure TArchiveFile.SeekToDataStart;
|
|
begin
|
|
SmartSeek(RESOURCE_ARCHIVE_HEADER_SIZE, soFromBeginning);
|
|
end;
|
|
|
|
|
|
|
|
end.
|