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.