rsvk/Component/ArchiveHeadersUnit.pas

451 lines
12 KiB
Plaintext

unit ArchiveHeadersUnit;
{-------------------------------------------------------------------------------
Archive Headers Unit
--------------------
reSource v2.6
Copyright (C) 1998-2001 Victor Kasenda / gruv
http://go.to/gruv
email: vickas@singnet.com.sg
Notes:
The archive contains multiple segments.
Each segment has its own header.
TArchiveHeader: The parent header the other headers derive from. Defines
what procedures the header should have and override.
Can be used as an abstract base class.
TResourceArchiveHeader: Every Resource archive has the resource signature
TDataBlockHeader: Every data block in the archive has a DataBlockHeader
TCentralFileHeader, TCentralDirEndHeader:
These make up the CentralDir. The archive may have many CentralFileHeaders.
The order these headers appear in the archive file is such as they appear
above. Read ArcStruc.txt for more details about the headers.
Every header has a signature. Override GetSignature to return the signature for
the particular header type.
Signatures are for verifying that the data currently being read is of the correct
type.
Remember to update XXXX_SIZE if any header changes. The size is 4 (signature) + any data
in bytes.
-------------------------------------------------------------------------------}
(**) interface (**)
uses Classes, Sysutils, ShellAPI, ArchiveFileUnit;
{Signatures}
const
RESOURCE_ARCHIVE_SIGNATURE = $4B565352; {RSVK}
DATA_HEADER_SIGNATURE = $41544144; {DATA}
CENTRAL_FILE_HEADER_SIGNATURE = $53484643; {CFHS}
END_OF_CENTRAL_DIRECTORY_SIGNATURE = $52444345; {ECDR}
{Header size = Signature (4) + data}
const
DATA_HEADER_SIZE = 20;
RESOURCE_ARCHIVE_HEADER_SIZE = 4;
type
{Exceptions}
ESignatureWrong = class(Exception)
public
constructor Create;
end;
TArchiveHeader = class
private
signature: longint;
procedure CheckSignature(ArchiveFile: TArchiveFile); overload;
procedure CheckSignature(Stream: TStream); overload;
protected
function GetSignature: longint; virtual;
procedure Read(ArchiveFile: TArchiveFile); virtual;
procedure Write(ArchiveFile: TArchiveFile); virtual;
procedure ReadStream(Stream: TStream); virtual;
procedure WriteStream(Stream: TStream); virtual;
public
constructor Create;
procedure ReadFromFile(ArchiveFile: TArchiveFile);
procedure WriteToFile(ArchiveFile: TArchiveFile);
{Stream Support}
procedure ReadFromStream(Stream: TStream);
procedure WriteToStream(Stream: TStream);
end;
TResourceArchiveHeader = class(TArchiveHeader)
public
function GetSignature: longint; override;
end;
TDataBlockHeader = class(TArchiveHeader)
protected
function GetSignature: longint; override;
procedure Read(ArchiveFile: TArchiveFile); override;
procedure Write(ArchiveFile: TArchiveFile); override;
public
crc32: longword;
compressed_size: longint;
first_sym_index: longint;
virtual_char_index: longint;
end;
TCentralFileHeader = class(TArchiveHeader)
private
function GetTimeStr: string;
function GetShellSmallIconIndex: integer;
function GetShellTypeName: string;
published
protected
FShellSmallIconIndex: integer;
FShellTypeName: string;
FTimeStr: string;
function GetSignature: longint; override;
procedure Read(ArchiveFile: TArchiveFile); override;
procedure Write(ArchiveFile: TArchiveFile); override;
procedure FillShellInfo; // for getting FShellTypeName and FTimeStr
public
compressed_size: longint;
uncompressed_size: longint;
num_blocks: longint;
data_offset: longint;
// attributes
time: longint;
attr: longint;
filename: string;
folder: string;
{---- not saved in file, used in file listing ----}
deleted: boolean; // flag for delete
Property TimeStr: string read GetTimeStr; // to get the time in a string format
property ShellSmallIconIndex: integer read GetShellSmallIconIndex;
property ShellTypeName: string read GetShellTypeName;
constructor Create;
end;
TCentralDirEndHeader = class(TArchiveHeader)
protected
function GetSignature: longint; override;
procedure Read(ArchiveFile: TArchiveFile); override;
procedure Write(ArchiveFile: TArchiveFile); override;
public
block_size: integer;
central_file_header_offset: integer;
end;
function GetArchiveHeader(ArchiveFile: TArchiveFile): TArchiveHeader;
(**) implementation (**)
uses ErrorUnit, StructsUnit;
constructor ESignatureWrong.Create;
begin
inherited Create('Wrong Signature. Archive could be corrupted.');
end;
{-------------------------------------------------------------------------------
GetArchiveHeader
----------------
Gets the archive header according to the next signature
Desc:
Will read in the signature, determine the header type and return the
appropriate archive header.
Notes:
Only support 2 header types: CentralFileHeader and CentralDirEndHeader
It is only used for reading these two headers.
-------------------------------------------------------------------------------}
function GetArchiveHeader(ArchiveFile: TArchiveFile): TArchiveHeader;
var
signature: longint;
ArchiveHeader: TArchiveHeader;
begin
ArchiveFile.ReadLongint(signature);
case (signature) of
CENTRAL_FILE_HEADER_SIGNATURE: ArchiveHeader := TCentralFileHeader.Create;
END_OF_CENTRAL_DIRECTORY_SIGNATURE: ArchiveHeader := TCentralDirEndHeader.Create;
else
raise ESignatureWrong.Create;
end;
ArchiveHeader.Read(ArchiveFile);
result := ArchiveHeader;
end;
(*******************************************************************************
TArchiveHeader
*******************************************************************************)
constructor TArchiveHeader.Create;
begin
inherited Create;
signature := GetSignature;
end;
{-------------------------------------------------------------------------------
Read/Write/GetSignature
-----------------------
the default read/write for ArchiveHeader does nothing
similarly, the default signature is zero
Notes:
Read/Write is supposed to read/write the data to the file
ReadFromFile/WriteToFile reads/writes the signature and data
-------------------------------------------------------------------------------}
procedure TArchiveHeader.Read(ArchiveFile: TArchiveFile);
begin
end;
procedure TArchiveHeader.Write(ArchiveFile: TArchiveFile);
begin
end;
procedure TArchiveHeader.ReadStream(Stream: TStream);
begin
end;
procedure TArchiveHeader.WriteStream(Stream: TStream);
begin
end;
function TArchiveHeader.GetSignature: longint;
begin
result := 0;
end;
{-------------------------------------------------------------------------------
CheckSignature
--------------
reads in the signature and checks if it is correct.
Desc:
will raise the exception ESignatureWrong if the signature is wrong
-------------------------------------------------------------------------------}
procedure TArchiveHeader.CheckSignature(ArchiveFile: TArchiveFile);
var
n: longint;
begin
// read in and check the signature first
ArchiveFile.ReadLongint(n);
if (n <> signature) then
begin
raise ESignatureWrong.Create;
end;
end;
procedure TArchiveHeader.CheckSignature(Stream: TStream);
var
n: longint;
begin
// read in and check the signature first
Stream.ReadBuffer(n, Sizeof(n));
if (n <> signature) then
begin
raise ESignatureWrong.Create;
end;
end;
{-------------------------------------------------------------------------------
ReadFromFile/WriteToFile
------------------------
reads/writes the header with its signature to the file
IN Assertion: ArchiveFile has been seeked to the location to read/write.
-------------------------------------------------------------------------------}
procedure TArchiveHeader.ReadFromFile(ArchiveFile: TArchiveFile);
begin
CheckSignature(ArchiveFile);
Read(ArchiveFile);
end;
procedure TArchiveHeader.WriteToFile(ArchiveFile: TArchiveFile);
begin
// write out the signature first
ArchiveFile.WriteLongint(signature);
Write(ArchiveFile);
end;
procedure TArchiveHeader.ReadFromStream(Stream: TStream);
begin
CheckSignature(Stream);
ReadStream(Stream);
end;
procedure TArchiveHeader.WriteToStream(Stream: TStream);
begin
// write out the signature first
Stream.WriteBuffer(signature, Sizeof(signature));
WriteStream(Stream);
end;
(*******************************************************************************
TResourceArchiveHeader
*******************************************************************************)
function TResourceArchiveHeader.GetSignature: longint;
begin
result := RESOURCE_ARCHIVE_SIGNATURE;
end;
(*******************************************************************************
TDataBlockHeader
*******************************************************************************)
function TDataBlockHeader.GetSignature: longint;
begin
result := DATA_HEADER_SIGNATURE;
end;
procedure TDataBlockHeader.Read(ArchiveFile: TArchiveFile);
begin
with ArchiveFile do
begin
ReadData(crc32);
ReadData(compressed_size);
ReadData(first_sym_index);
ReadData(virtual_char_index);
end;
end;
procedure TDataBlockHeader.Write(ArchiveFile: TArchiveFile);
begin
with ArchiveFile do
begin
WriteData(crc32);
WriteData(compressed_size);
WriteData(first_sym_index);
WriteData(virtual_char_index);
end;
end;
(*******************************************************************************
TCentralFileHeader
*******************************************************************************)
constructor TCentralFileHeader.Create;
begin
inherited Create;
//info_cached := false;
FTimeStr := '?';
FShellSmallIconIndex := -1; // only retrieve these data when they are needed
FShellTypeName := '?';
end;
procedure TCentralFileHeader.FillShellInfo;
var
FileInfo: TSHFileInfo;
begin
SHGetFileInfo(PChar(filename),
0,
FileInfo,
SizeOf(FileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON or SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
FShellSmallIconIndex := FileInfo.iIcon;
FShellTypeName := FileInfo.szTypeName;
end;
function TCentralFileHeader.GetShellSmallIconIndex: integer;
begin
if FShellSmallIconIndex = -1 then
FillShellInfo;
result := FShellSmallIconIndex;
end;
function TCentralFileHeader.GetShellTypeName: string;
begin
if FShellTypeName = '?' then
FillShellInfo;
result := FShellTypeName;
end;
function TCentralFileHeader.GetSignature: longint;
begin
result := CENTRAL_FILE_HEADER_SIGNATURE;
end;
function TCentralFileHeader.GetTimeStr: string;
begin
if FTimeStr = '?' then
begin
FTimeStr := DateTimeToStr(FileDateToDateTime(time));
end;
result := FTimeStr;
end;
procedure TCentralFileHeader.Read(ArchiveFile: TArchiveFile);
var
s: string;
begin
with ArchiveFile do
begin
ReadLongint(compressed_size);
ReadLongint(uncompressed_size);
ReadLongint(num_blocks);
ReadLongint(data_offset);
ReadLongint(time);
ReadLongint(attr);
end;
// filename variable name clash, so must read outside with block
// split filename and path
ArchiveFile.ReadString(s);
folder := ExtractFilePath(s);
filename := ExtractFileName(s);
// not saved
deleted := false;
end;
procedure TCentralFileHeader.Write(ArchiveFile: TArchiveFile);
begin
with ArchiveFile do
begin
WriteLongint(compressed_size);
WriteLongint(uncompressed_size);
WriteLongint(num_blocks);
WriteLongint(data_offset);
WriteLongint(time);
WriteLongint(attr);
end;
ArchiveFile.WriteString(folder + filename);
end;
(*******************************************************************************
TCentralDirEndHeader
*******************************************************************************)
function TCentralDirEndHeader.GetSignature: longint;
begin
result := END_OF_CENTRAL_DIRECTORY_SIGNATURE;
end;
procedure TCentralDirEndHeader.Read(ArchiveFile: TArchiveFile);
begin
With ArchiveFile do
begin
ReadLongint(block_size);
ReadLongint(central_file_header_offset);
end;
end;
procedure TCentralDirEndHeader.Write(ArchiveFile: TArchiveFile);
begin
With ArchiveFile do
begin
WriteLongint(block_size);
WriteLongint(central_file_header_offset);
end;
end;
end.