rs26src.zip from torry.net

Component/ArchiveFileUnit.pas

@@ -0,0 +1,518 @@
+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.

Component/ArchiveHeadersUnit.pas

@@ -0,0 +1,450 @@
+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.

Component/ArchiveManagerUnit.pas

@@ -0,0 +1,947 @@
+unit ArchiveManagerUnit;
+{-------------------------------------------------------------------------------
+Archive Manager
+---------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+  Desc:
+  The archive manager is the engine to operate on the archive file.
+  It defines how the operations add/delete/extract/property change is
+  to be performed.
+  
+  An ArchiveManager is assigned to each archive. Files can be added, deleted
+  and modified from the archive. File attributes can also be changed.
+
+  Notes:
+  The Add procedure chops a file into several smaller blocks and adds them
+  to an archive. If the file to compress is smaller than a block, the file size
+  is used instead.
+
+  To Use:
+  Create the archive manager. One archive manager can operate on only one
+  archive at a time.
+
+
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses Windows, Forms, SysUtils, Classes, Dialogs,
+     {CG}
+     ErrorUnit,
+     BWTCompressUnit, BWTExpandUnit, EDosUnit, ArchiveFileUnit, StructsUnit;
+
+type
+  {Exceptions}
+  EArchiveOpenError = class(Exception)
+    constructor Create;
+  end;
+  EUserCancel = class(Exception);
+  EFileNotExtracted = class(Exception);
+  EFileNothingDone = class(Exception);
+
+  TArchiveManager = class
+  private
+    Expander: TExpander;
+
+    // add properties. set only during add.
+    infile_size: integer;
+
+  protected
+    FOnCentralDirChange: TNotifyEvent;
+    procedure CentralDirChange;
+
+    function GetTempFileName: string;
+
+    procedure StartTempProcessing(var TempFile: TArchiveFile);
+    procedure EndTempProcessing(TempFile: TArchiveFile);
+
+    procedure ShowProgress(a: integer); virtual;
+    procedure ShowStatusMsg(s: string); virtual;
+    procedure AddLog(s: string); virtual; // for debugging. logging operations
+  public
+    ArchiveFile: TArchiveFile; // Contains the Central Dir (List of files in archive)
+    {archive file property}
+    archive_file_folder, archive_file_name, archive_file_full_path: string;
+
+    {------ MUST SET THE FOLLOWING -------------------}
+    {Parameters. Must set before calling any action}
+    TempDir: string; // The temporary dir to use
+    {extract options. set before calling ExtractFile}
+    dest_dir: string;
+    {-------------------------------------------------}
+    use_folder_names: boolean; // folders not implemented. ignore this
+    
+    // used to count number of bytes processed in FSortUnit
+    // Archive manager will reset every file
+    bytes_processed: integer;
+
+    {These events can be assigned}
+    OnShowProgress: TIntEvent; {Progress bar not implemented because of new algo}
+    OnShowStatusMsg: TStrEvent;
+    OnAddLog: TStrEvent;
+    property OnCentralDirChange: TNotifyEvent read FOnCentralDirChange write FOnCentralDirChange;
+
+    {add properties. read only.}
+    property AddFileSize: integer read infile_size;
+
+    constructor Create;
+    destructor Destroy; override;
+
+    {operations}
+    procedure OpenArchive(const new_archive_file_name: string; const create_new_prompt: boolean);
+    procedure CloseArchive;
+    function IsArchiveOpen: boolean;
+    function AddFiles(FileList: TStrings; const infile_dir: string): integer;
+    procedure ExtractList(List: TList;
+            var files_extracted, extracted_size: integer);
+    procedure ExtractListToTemp(List: TList;
+            var files_extracted, extracted_size: integer; var temp_dir: string);
+    procedure DeleteFiles;
+    procedure WriteCentralDir;
+
+    {operations support}
+    procedure CopyData(SourceFile, DestFile: TArchiveFile; SourceCentralDir: TCentralDir);
+    function GetTempDir: string;
+  end;
+
+var
+  Compressor: TCompressor;  // one compressor class use multiple. all memory is allocated upon creation
+
+(**) implementation (**)
+uses ArchiveHeadersUnit;
+
+constructor EArchiveOpenError.Create;
+begin
+  inherited Create('Error opening archive');
+end;
+
+{constructor EUserCancle.Create;
+begin
+  inherited Create('User canceled operation');
+end;}
+
+
+
+constructor TArchiveManager.Create;
+begin
+  inherited Create;
+  dest_dir := '';
+  TempDir := 'c:\';
+  Compressor := TCompressor.Create;
+  Expander := TExpander.Create;
+end;
+
+destructor TArchiveManager.Destroy;
+begin
+  Compressor.Free;
+  Expander.free;
+  inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------
+  CentralDirChange
+  ----------------
+  will call the event handler if it is assigned
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.CentralDirChange;
+begin
+  if Assigned(FOnCentralDirChange) then FOnCentralDirChange(Self);
+end;
+
+procedure TArchiveManager.CloseArchive;
+begin
+  FreeAndNil(ArchiveFile);
+  AddLog('Archive Closed - ' + archive_file_full_path);  
+end;
+
+{-------------------------------------------------------------------------------
+  OpenArchive
+  -----------
+  will open the archive if new_archive_file_name
+  will display a prompt to create a new archive if requested
+
+  will append SRESOURCE_EXT  to the end of the file name if an extension does not exist
+  to prevent a opening of a directory. opening files without extensions is not
+  supported.
+
+  Desc:
+  inits archive_file_name, archive_file_folder, archive_file_full_path
+
+  Notes:
+  The full path of the file should be passed to prevent any dir confusion.
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.OpenArchive(const new_archive_file_name: string; const create_new_prompt: boolean);
+begin
+  archive_file_full_path := ExpandFileName(new_archive_file_name);
+  archive_file_folder := ExtractFilePath(archive_file_full_path);
+  archive_file_name := ExtractFileName(archive_file_full_path);
+
+  // search for the ending 'dot' in the archive_file_name.
+  // if it does not exist, add one to archive_file_full_path and archive_file_name
+  if Pos('.', archive_file_name) = 0 then
+  begin
+    archive_file_full_path := archive_file_full_path + '.';
+    archive_file_name := archive_file_name + '.';
+  end;
+
+  // search for the extension. If it does not exist, add it.
+  if archive_file_name[length(archive_file_name)] = '.' then
+  begin
+    archive_file_full_path := archive_file_full_path + SRESOURCE_EXT;
+    archive_file_name := archive_file_name + SRESOURCE_EXT;
+  end;
+
+
+  // Change to the directory of the archive to open it
+  CHDir(archive_file_folder);
+
+  // Open the archive file.
+  // If the archive does not exist, then create a new one.
+  if FileExists(archive_file_name) then
+    ArchiveFile := TArchiveFile.CreateNew(archive_file_name, true)
+  else
+  begin
+
+    // check if the user really wants a new archive created
+    if create_new_prompt then
+      if (Application.MessageBox(PChar('The archive file ' + archive_file_full_path + ' does not exist. Do you want to create a new file?'),
+            'Create new archive?', MB_YESNOCANCEL) <> IDYES) then raise EUserCancel.Create('Create new archive cancelled');
+
+    ArchiveFile := TArchiveFile.CreateNew(archive_file_name, false);
+  end;
+
+  CentralDirChange;
+
+  AddLog('Archive Opened - ' + archive_file_full_path);
+  AddLog('CentralDir Loaded');
+end;
+
+{-------------------------------------------------------------------------------
+  GetTempFileName
+  ---------------
+
+  Desc:
+  Uses the winows API GetTempFileName. the temporary file will have an 'RS'
+  prefix.
+-------------------------------------------------------------------------------}
+function TArchiveManager.GetTempFileName: string;
+var
+  name: PChar;
+  s: string;
+begin
+  name := StrAlloc(MAX_PATH + 1);
+  Windows.GetTempFileName(PChar(TempDir), 'RSVICTORK', 0, name);
+  s := string(name);
+  StrDispose(name);
+  result := s;
+end;
+
+{-------------------------------------------------------------------------------
+  StartTempProcessing
+  -------------------
+  Creates a new TempFile and seeks to the position to start adding data
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.StartTempProcessing(var TempFile: TArchiveFile);
+begin
+  TempFile := TArchiveFile.CreateNew(GetTempFileName, false);
+  TempFile.SeekToDataStart;
+end;
+
+{-------------------------------------------------------------------------------
+  EndTempProcessing
+  -----------------
+
+  Desc:
+  closes the current archive
+  deletes the archive
+  renames the temp archive to replace the current archive
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.EndTempProcessing(TempFile: TArchiveFile);
+var
+  temp_file_name: string;
+begin
+  // save file names since we are freeing the objects
+  temp_file_name := TempFile.filename;
+  // close TempFile and ArchiveFile to perform file operations
+  TempFile.Free;
+  CloseArchive;
+  // perform operations
+  DeleteFile(archive_file_full_path);
+  RenameFile(temp_file_name, archive_file_full_path);
+  // temp file is now the new archive file
+  OpenArchive(archive_file_full_path, true);
+end;
+
+{-------------------------------------------------------------------------------
+  WriteCentralDir
+  ---------------
+  Rewrites the central dir in memory to the archive file
+  Used when a file property in the archive changes and the CentralDir
+  has to be rewritten to reflect the change.
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.WriteCentralDir;
+var
+  TempFile: TArchiveFile;
+begin
+  StartTempProcessing(TempFile);
+  CopyData(ArchiveFile, TempFile, ArchiveFile.CentralDir);
+  ArchiveFile.CentralDir.WriteToFile(TempFile);
+  AddLog('Write CentralDir OK.');  
+  EndTempProcessing(TempFile);
+  CentralDirChange;
+end;
+
+{-------------------------------------------------------------------------------
+  CopyData
+  --------
+
+  Desc: Copies the data portion from SourceFile to DestFile, using
+        info from CentralDir (the source file's central dir)
+        If no data, the SourceFile and DestFile is seeked to DataStartPos
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.CopyData(SourceFile, DestFile: TArchiveFile; SourceCentralDir: TCentralDir);
+var
+  bytes_to_copy: integer;
+begin
+  bytes_to_copy := SourceCentralDir.GetCentralDirOffset - RESOURCE_ARCHIVE_HEADER_SIZE;
+  DestFile.DisableBuf;
+  SourceFile.SeekToDataStart;
+  DestFile.SeekToDataStart;
+  ArchiveFileBlockCopy(SourceFile, DestFile, bytes_to_copy);
+  DestFile.EnableBuf;
+end;
+
+{-------------------------------------------------------------------------------
+  GetTempDir
+
+  Returns a temporary directory that is empty
+  the temp dir is in the default temp dir
+-------------------------------------------------------------------------------}
+function TArchiveManager.GetTempDir: string;
+var
+  s: string;
+  OK: boolean;
+  i: integer;
+begin
+  i := 0;
+  OK := false;
+  result := '';
+
+  repeat
+    try
+      s := IncludeTrailingBackslash(TempDir) + 'rs' {'This folder is safe to delete if reSource is closed '} + IntToStr(i);
+      MKDir(s);
+      // if we reached here, then the dir has been created with no exception
+      OK := true;
+    except
+      on E: EInOutError do
+      begin
+        {183 - dir exists try again}
+        if (E.ErrorCode <> 183) then
+        begin
+          {5 and other values - drive not ready}
+          ShowError('Cannot create temp directory. ' + IntToStr(E.ErrorCode));
+          raise; // unable to handle. exit and abandon operation.
+        end;
+      end; // EInOutError
+    end;
+    inc(i);
+
+    {really cannot create after 300 attempts, then abandon operation}
+    if i = 300 then
+    begin
+      // ShowError('Temp dir may be full. Tried ' + IntToStr(i) + ' times.');
+      raise EInOutError.Create('Temp dir may be full. Tried ' + IntToStr(i) + ' times.');
+    end;
+  until OK;
+
+  result := s;
+end;
+
+{-------------------------------------------------------------------------------
+  DeleteFiles
+
+  Algo:
+  Basically works with the central file directory
+  - Delete the file headers from the central dir with the deleted flag set.
+  - rebuild a new archive with the new central directory, updating the central
+    dir with the new data offsets.
+  - delete old archive, rename new archive.
+
+  Notes:
+  verbal explanation of how total_data_size is calculated:
+  total_data_size := total_compressed_size + totol_size_of_data_headers
+    - total_size_of_data_headers := DATA_HEADER_SIZE * num_data_blocks
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.DeleteFiles;
+var
+  i: integer;                     // counter
+  CentralFileHeader: TCentralFileHeader;
+  TempFile: TArchiveFile;
+  total_data_size: integer;
+begin
+  with ArchiveFile do
+  begin
+    for i := CentralDir.Count-1 downto 0 do
+    begin
+      CentralFileHeader := TCentralFileHeader(CentralDir[i]);
+      if CentralFileHeader.Deleted then CentralDir.Delete(i);
+    end;
+  end;
+
+  // rebuild archive
+  // data: read from ArchiveFile, write to TempFile
+  StartTempProcessing(TempFile);
+  ArchiveFile.DisableBuf;
+  TempFile.DisableBuf;
+  for i := 0 to ArchiveFile.CentralDir.Count-1 do
+  begin
+    CentralFileHeader := ArchiveFile.CentralDir[i] as TCentralFileHeader;
+    ArchiveFile.Seek(CentralFileHeader.data_offset, soFromBeginning);
+    CentralFileHeader.data_offset := TempFile.Position;
+    total_data_size := CentralFileHeader.compressed_size + DATA_HEADER_SIZE * CentralFileHeader.num_blocks;
+    ArchiveFileBlockCopy(ArchiveFile, TempFile, total_data_size);
+  end;
+
+  // copy over the central dir
+  TempFile.EnableBuf;
+  ArchiveFile.CentralDir.WriteToFile(TempFile);
+
+  EndTempProcessing(TempFile);
+  CentralDirChange;
+end;
+
+{-------------------------------------------------------------------------------
+  ExtractList
+
+  IN Assertion:
+  dest_dir, the destination directory is set.
+
+  Desc:
+  Extracts files in a list, which contains pointers to the central file
+  header of the files.
+
+  Algo:
+  Sorts the list of indexes according to their data offsets in the archive.
+  This is to optimize extraction.
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.ExtractList(List: TList;
+  var files_extracted, extracted_size: integer);
+
+  {-------------------------------------------------------------------------------
+    ExtractFile
+
+    IN Assertion:
+    dest_dir, the default destination directory is set.
+
+    Desc:
+    Extract the file referred by index in the CentralDir
+    Also imprint the file's attributes as stored in the CentralDir
+
+    Algo:
+    Get the CentralFileHeader for the file at index.
+    Create the file of filename
+    Seek to the data pos in ArchiveFile
+    BWTExpand the file
+
+    Extract directory:
+    If full path (drive+dir) specified, it is used.
+    If relative path (dir only), then add dest_dir to it.
+    If empty path, use dest_dir.
+
+    If UseFolderNames then
+      dir := CentralFileHeader.Folder
+    else
+      dir := '';
+
+    if (dir < 2) and (2nd char not a ':') then
+      dir := dest_dir + dir;
+
+
+    Notes:
+    Will check if destination file exist. EnsureDestFileClear will strip any
+    readonly or system bit from the file to overwrite. The Create para will then
+    rewrite the file.
+  -------------------------------------------------------------------------------}
+
+  procedure ExtractFile(CFH: TCentralFileHeader);
+  var
+    //CentralFileHeader: TCentralFileHeader;
+    OutFile: TFileStream;
+    i: integer;                     // counter
+    extract_folder: string;
+    out_file_path: string;
+
+    procedure EnsureDestFileClear;
+    begin
+      if FileExists(out_file_path) then
+        case Application.MessageBox(PChar('The file ' + out_file_path + ' exists. Do you want to overwrite the file?'), 'Warning', MB_YESNOCANCEL) of
+          IDYES:
+          begin
+            if (FileSetAttr(out_file_path, faArchive) <> 0) then
+              raise EInOutError.Create('Cannot clear dest file attributes');
+          end;
+          IDNO: raise EFileNotExtracted.Create('Destination file exists. File not extracted.');
+          IDCANCEL: raise EUserCancel.Create('Extract operation cancelled');
+        end;
+    end;
+
+
+  begin
+    // reset progress bar
+    ShowProgress(0);
+    ShowStatusMsg('');
+
+    //CentralFileHeader := TCentralFileHeader(ArchiveFile.CentralDir[index]);
+
+    // determine the directory to extract to
+    If use_folder_names then
+    begin
+      extract_folder := CFH.Folder;
+      // if it is relative, then must add dest_dir
+      if (length(extract_folder) < 2) or
+         ((length(extract_folder) > 2) and (extract_folder[2] <> ':')) then
+        extract_folder := dest_dir + extract_folder;
+    end
+    else
+      extract_folder := dest_dir;
+
+    // out_file_path is the final full path to the file
+    out_file_path := extract_folder + CFH.filename;
+    EnsureDestFileClear;
+
+    // status bar notice
+    ShowStatusMsg('Extracting ' + out_file_path);
+    AddLog('Total number of blocks - '+IntToStr(CFH.num_blocks));
+
+    OutFile := TFileStream.Create(out_file_path, fmCreate);
+    try
+      ArchiveFile.SmartSeek(CFH.data_offset, soFromBeginning);
+      for i := 1 to CFH.num_blocks do
+      begin
+        Expander.ExpandBlock(ArchiveFile, OutFile);
+        // update file progress bar and process paint messages
+        if Expander.GetLastCRC32Result = true then
+          AddLog('Block '+IntToStr(i-1)+' Expand and CRC32 Check OK.')
+        else
+          AddLog('Block '+IntToStr(i-1)+' Expand Error.');
+          
+        ShowProgress(i * 100 div CFH.num_blocks);
+        Application.ProcessMessages;
+      end;
+    finally
+      // set attributes that require the file handle
+      FileSetDate(OutFile.Handle, CFH.time);
+      OutFile.free;
+      // set attributes that require the file path
+      FileSetAttr(out_file_path, CFH.attr);
+    end;
+  end;
+
+var
+  i: integer;
+  CFH: TCentralFileHeader;
+begin
+  {Implement sort}
+
+  files_extracted := 0;
+  extracted_size := 0;
+  for i := 0 to List.Count-1 do
+  begin
+    try
+      CFH := TCentralFileHeader(List[i]);
+      ExtractFile(CFH);
+      inc(files_extracted);
+      inc(extracted_size, CFH.uncompressed_size);
+    except
+      on EFileNotExtracted do begin {nothing} end;
+    end;
+
+  end;
+end;
+
+
+procedure TArchiveManager.ExtractListToTemp(List: TList;
+  var files_extracted, extracted_size: integer; var temp_dir: string);
+begin
+  {Create the temporary directory.
+  Set dest_dir to the temp dir.
+  Call ExtractIndexes to do the extraction}
+
+  dest_dir := GetTempDir;  // set the dest dir
+  EDos.AddSlash(dest_dir);
+  temp_dir := dest_dir;    // return the dest dir
+
+  ExtractList(List, files_extracted, extracted_size);
+end;
+
+(*
+{-------------------------------------------------------------------------------
+  ExtractSelIdx
+
+  IN Assertion:
+  dest_dir, the default destination directory is set.
+
+  Desc:
+  Extracts files with their indexes in the index list.
+  The index must be the same as the file's index in the central directory.
+
+  Algo:
+  Sorts the list of indexes according to their data offsets in the archive.
+  This is to optimize extraction.
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.ExtractIndexes(indexlist: TIndexList;
+            var files_extracted, extracted_size: integer);
+
+  {-------------------------------------------------------------------------------
+    ExtractFile
+
+    IN Assertion:
+    dest_dir, the default destination directory is set.
+
+    Desc:
+    Extract the file referred by index in the CentralDir
+    Also imprint the file's attributes as stored in the CentralDir
+
+    Algo:
+    Get the CentralFileHeader for the file at index.
+    Create the file of filename
+    Seek to the data pos in ArchiveFile
+    BWTExpand the file
+
+    Extract directory:
+    If full path (drive+dir) specified, it is used.
+    If relative path (dir only), then add dest_dir to it.
+    If empty path, use dest_dir.
+
+    If UseFolderNames then
+      dir := CentralFileHeader.Folder
+    else
+      dir := '';
+
+    if (dir < 2) and (2nd char not a ':') then
+      dir := dest_dir + dir;
+
+
+    Notes:
+    Will check if destination file exist. EnsureDestFileClear will strip any
+    readonly or system bit from the file to overwrite. The Create para will then
+    rewrite the file.
+  -------------------------------------------------------------------------------}
+
+  procedure ExtractFile(index: integer);
+  var
+    CentralFileHeader: TCentralFileHeader;
+    OutFile: TFileStream;
+    i: integer;                     // counter
+    extract_folder: string;
+    out_file_path: string;
+
+    procedure EnsureDestFileClear;
+    begin
+      if FileExists(out_file_path) then
+        case Application.MessageBox(PChar('The file ' + out_file_path + ' exists. Do you want to overwrite the file?'), 'Warning', MB_YESNOCANCEL) of
+          IDYES:
+          begin
+            if (FileSetAttr(out_file_path, faArchive) <> 0) then
+              raise EInOutError.Create('Cannot clear dest file attributes');
+          end;
+          IDNO: raise EFileNotExtracted.Create('Destination file exists. File not extracted.');
+          IDCANCEL: raise EUserCancel.Create('Extract operation cancelled');
+        end;
+    end;
+
+
+  begin
+    // reset progress bar
+    MainForm.ShowProgress(0);
+    MainForm.ShowStatusMessage('');
+
+    CentralFileHeader := TCentralFileHeader(ArchiveFile.CentralDir[index]);
+
+    // determine the directory to extract to
+    If use_folder_names then
+    begin
+      extract_folder := CentralFileHeader.Folder;
+      // if it is relative, then must add dest_dir
+      if (length(extract_folder) < 2) or
+         ((length(extract_folder) > 2) and (extract_folder[2] <> ':')) then
+        extract_folder := dest_dir + extract_folder;
+    end
+    else
+      extract_folder := dest_dir;
+
+    // out_file_path is the final full path to the file
+    out_file_path := extract_folder + CentralFileHeader.filename;
+    EnsureDestFileClear;
+
+    // status bar notice
+    MainForm.ShowStatusMessage('Extracting ' + out_file_path);
+
+    OutFile := TFileStream.Create(out_file_path, fmCreate);
+    try
+      ArchiveFile.SmartSeek(CentralFileHeader.data_offset, soFromBeginning);
+      for i := 1 to CentralFileHeader.num_blocks do
+      begin
+        Expander.ExpandBlock(ArchiveFile, OutFile);
+        // update file progress bar and process paint messages
+        MainForm.ShowProgress(i * 100 div CentralFileHeader.num_blocks);
+        Application.ProcessMessages;
+      end;
+    finally
+      // set attributes that require the file handle
+      FileSetDate(OutFile.Handle, CentralFileHeader.time);
+      OutFile.free;
+      // set attributes that require the file path
+      FileSetAttr(out_file_path, CentralFileHeader.attr);
+    end;
+
+  end;
+
+
+
+
+var
+  i: integer;
+begin
+  {Implement sort}
+
+  files_extracted := 0;
+  extracted_size := 0;
+  for i := 0 to length(indexlist)-1 do
+  begin
+    try
+      ExtractFile(indexlist[i]);
+      inc(files_extracted);
+      //inc(extracted_size, CentralFileHeader.uncompressed_size);
+    except
+      on EFileNotExtracted do begin {nothing} end;
+    end;
+
+  end;
+end;
+
+
+{-------------------------------------------------------------------------------
+  ExtractIndexesToTemp
+
+  Creates the temp dir and extracts to the temp dir
+-------------------------------------------------------------------------------}
+procedure TArchiveManager.ExtractIndexesToTemp(indexlist: TIndexList;
+  var files_extracted, extracted_size: integer; var temp_dir: string);
+begin
+  {Create the temporary directory.
+  Set dest_dir to the temp dir.
+  Call ExtractIndexes to do the extraction}
+
+  dest_dir := GetTempDir;  // set the dest dir
+  EDos.AddSlash(dest_dir);
+  temp_dir := dest_dir;    // return the dest dir
+
+  ExtractIndexes(indexlist, files_extracted, extracted_size);
+end;
+*)
+
+{-------------------------------------------------------------------------------
+  AddFiles
+
+  Desc:
+  Add multiple files to the archive
+  the files are in the directory infile_dir
+
+  Notes:
+  The files to add are in a TStrings
+  if full paths are transferred in FileList, then infile_dir must be null.
+  if FileList count is 0 it will exit.
+  Will check if files added is a directory.
+
+  Algo:
+  Open Temp File
+  Do the following for all files in FileList
+    1) Check if it is a folder. Folders cannot be added.
+    2) Check if there is a file of a duplicate name. Warn the user if so.
+    3) Compress the block and append the block (new data).
+    4) Add the file info to the central directory.
+  Write the central directory.
+  Close Temp File
+-------------------------------------------------------------------------------}
+function TArchiveManager.AddFiles(FileList: TStrings; const infile_dir: string): integer;
+var
+  TempFile: TArchiveFile;       // temp archive
+  CentralFileHeader: TCentralFileHeader;
+  infile_name: string;
+
+  {-----------------------------------------------------------------------------
+    AppendNewData
+
+    Compresses the new file and appends the new data to the file.
+    IN Assertion: TempFile has been seeked to the correct position to add the
+                   new data
+  -----------------------------------------------------------------------------}
+  procedure AppendNewData;
+  var
+    InFile: TFileStream;          // file to add
+    block: PBlock;
+    bytes_read, block_compressed_size: integer;
+    EstimatedNumBlocks: integer;
+    //infile_size: integer;
+  begin
+    InFile := TFileStream.create(infile_name, fmOpenRead or fmShareDenyWrite);
+
+    infile_size := InFile.Size;
+
+    {Msg}
+    if infile_size > 0 then
+    begin
+      EstimatedNumBlocks := infile_size div BlockSize;
+      if (EstimatedNumBlocks = 0) or ((infile_size mod BlockSize) > 0) then
+        inc(EstimatedNumBlocks);
+    end
+    else
+      EstimatedNumBlocks := 0;
+
+    AddLog('File size = ' + IntToStr(infile_size)
+      +' bytes  (Num blocks='+IntToStr(EstimatedNumBlocks)+')');
+    // ShowProgress(0); {Progress bar does not work}
+    bytes_processed := 0; // reset counter
+
+    // Compress the infile block by block to tempfile
+    block := Compressor.GetInBlock;
+    CentralFileHeader.data_offset := TempFile.Position;
+    bytes_read := infile.Read(block^[0], BlockSize);
+    while (bytes_read > 0) do
+    begin
+      //TempFile.SmartSeek(TempFile.Position, soFromBeginning);
+
+      Compressor.CompressInBlockToFile(bytes_read, TempFile, block_compressed_size);
+      with CentralFileHeader do
+      begin
+        inc(num_blocks);
+        inc(compressed_size, block_compressed_size);
+        inc(uncompressed_size, bytes_read);
+      end;
+      with CentralFileHeader do
+        AddLog('Block ' + IntToStr(num_blocks-1)+' OK, (Raw size='+
+          IntToStr(bytes_read)+' Compressed= ' + IntToStr(block_compressed_size) + ')');
+
+      block := Compressor.GetInBlock; // in_block may have been swapped again.
+      bytes_read := infile.Read(block^[0], BlockSize);
+      //MainForm.ShowProgress(CentralFileHeader.uncompressed_size * 100 div infile_size);
+      //Application.ProcessMessages;
+
+      //TempFile.ResetBuffer;
+
+    end;
+
+    InFile.Free;
+  end;
+
+var
+  i: integer;
+  SearchRec: TSearchRec;
+  files_added: integer;
+begin
+  if (FileList.Count = 0) then
+  begin
+    result := 0;   // nothing to do if no files
+    Exit;
+  end;
+  
+  StartTempProcessing(TempFile);
+  // copy existing data to tempfile
+  CopyData(ArchiveFile, TempFile, ArchiveFile.CentralDir);
+  files_added := 0;
+
+  // change to the directory to add the file from
+  if (infile_dir <> '') then
+    CHDir(infile_dir);
+
+  // append new data to tempfile
+  for i := 0 to FileList.Count-1 do
+  begin
+    infile_name := FileList[i];
+    ShowStatusMsg('Adding file - ' + infile_name);
+    FindFirst(infile_name, faAnyFile, SearchRec);               // get file stats
+
+    // Check if it is a folders. Adding folders is not supported.
+    if (SearchRec.Attr and faDirectory <> 0) then
+    begin
+      Application.MessageBox(PChar('Could not add: ''' + infile_name + '''. Adding of folders is not supported.'),
+                             'Error', MB_OK);
+      // move on to next file
+      Continue;
+    end;
+
+    // Check if another file with a duplicate name exists
+    if (ArchiveFile.CentralDir.FileNameExists(ExtractFileName(infile_name))) then
+    begin
+      if (Application.MessageBox(PChar('A file of name ''' + ExtractFileName(infile_name) + ''' already exists in the archive. Do you still want to add the file?'),
+                                 'Confirmation', MB_YESNO) = IDNo) then Continue;
+    end;
+
+    CentralFileHeader := TCentralFileHeader.Create;
+    with CentralFileHeader do
+    begin
+      // these values filled in later
+      compressed_size := 0;
+      uncompressed_size := 0;
+      num_blocks := 0;
+
+      // init file attr
+      filename := infile_name;
+      time := SearchRec.Time;
+      attr := SearchRec.Attr;
+    end;
+
+    try
+      AppendNewData;             // this may raise EFOpenError for input file
+      ArchiveFile.CentralDir.Add(CentralFileHeader);
+      inc(files_added);
+    except
+      on EFOpenError do
+      begin
+        // file cannot be opened. may have to skip it.
+        Application.Messagebox(PChar('Cannot open file: ''' + infile_name + '''.' + #13 + 'It will not be added.'), ' Error', 0);
+      end;
+    end; {except}
+  end;
+
+  // write out the CentralDir
+  ArchiveFile.CentralDir.WriteToFile(TempFile);
+  EndTempProcessing(TempFile);
+  CentralDirChange;
+
+  // return the number of files added
+  result := files_added;
+end;
+
+
+
+
+procedure TArchiveManager.ShowProgress(a: integer);
+begin
+  if Assigned(OnShowProgress) then OnShowProgress(Self, a);
+end;
+
+procedure TArchiveManager.ShowStatusMsg(s: string);
+begin
+  if s <> '' then
+    AddLog(s);
+  if Assigned(OnShowStatusMsg) then OnShowStatusMsg(Self, s);
+end;
+
+procedure TArchiveManager.AddLog(s: string);
+begin
+  if Assigned(OnAddLog) then OnAddLog(Self, 'ArchiveMan: ' + s);
+end;
+
+function TArchiveManager.IsArchiveOpen: boolean;
+begin
+  result := ArchiveFile <> nil;
+end;
+
+end.

Component/BWTBaseUnit.pas

@@ -0,0 +1,46 @@
+unit BWTBaseUnit;
+{-------------------------------------------------------------------------------
+Burrows Wheeler Transformation
+Base Unit
+------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+Desc:
+  The base unit for TBWTCompress and TBWTExpand
+  contains common procedures used by both of them.
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses StructsUnit;
+
+type
+  TBWTBase = class
+  protected
+    in_block ,out_block: PBlock;
+
+    procedure SwapBlocks;
+  public
+  end;
+
+
+(**) implementation (**)
+
+{-------------------------------------------------------------------------------
+  Swap Blocks
+  in_block and out_block exchange pointer values
+-------------------------------------------------------------------------------}
+procedure TBWTBase.SwapBlocks;
+var
+  temp_block: PBlock;
+begin
+  temp_block := in_block;
+  in_block := out_block;
+  out_block := temp_block;
+end;
+
+
+end.

Component/BWTCompressUnit.pas

@@ -0,0 +1,691 @@
+unit BWTCompressUnit;
+{-------------------------------------------------------------------------------
+Burrows Wheeler Transformation
+Block Compression Unit
+------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+
+
+  Desc:
+    This is the class that brings all the engines together.
+    It uses the FSortUnit, MTFEncoder, StrucAriEncoder.
+    The whole compression for a block consists of:
+      1) Burrows Wheeler Transformation (Sort + Retrieve last column)
+      2) Move To Front encoding
+      3) Structured Arithmetic encoding
+
+    Brief Explanation:
+      1) BWT is the trick to the high performance compression
+      2) Move to Front coding is done to transform the block into a series
+         of numbers. The more frequantly appearing characters will thus be
+         transformed to lower numbers, resulting a low numbers dominating the
+         block (0 and 1s especially). This aids Arithmetic coding.
+      3) Arithmetic coding is performed with a structured or hierarchical model.
+         Read the system doc for more information about the structured
+         arithmetic model.
+      For a more in depth discussion of the compression process, refer
+      to the system doc.
+
+  Usage:
+    - just create the object and call CompressBlockToFile
+      CompressBlockToFile writes out the data header and the data
+    - to not use the structured arithmetic encoder, undefine USE_STRUC_ARI
+
+  Notes:
+    - read notes.txt for information about the block swapping technique used
+    - certain debug procedures have been commented out to prevent hints
+    - the general rule is pass only what is needed for the engine wrappers
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses // delphi
+     Classes, Forms, SysUtils, Dialogs,
+     // general
+     OFile, StructsUnit, ArchiveFileUnit, ArchiveHeadersUnit, CRC32Unit, 
+     // engine
+     RLEUnit, FSortUnit, MTFEncoderUnit, MTFDecoderUnit, BWTExpandUnit,
+     FileStrucAriEncoderUnit, StreamStrucAriEncoderUnit,
+     // base
+     BWTBaseUnit;
+
+type
+  TCompressor = class(TBWTBase)
+  private
+    //block1, block2: PBlock;
+    index: PLongintBlock;
+
+    // Debug
+    {original_block: PBlock;
+    recovered_block: PBlock;}
+    {Expander: TExpander;}
+
+    // Classes
+    FastSorter: TFastSorter;
+    MTFEncoder: TMTFEncoder;
+    FileStrucAriEncoder: TFileStrucAriEncoder;
+    StreamAriEncoder: TStreamAriEncoder;
+    {RunLengthEncoder: TRunLengthEncoder;}
+
+    // Main compression routines
+    {procedure AllocateStructs;
+    procedure FreeStructs;}
+
+    procedure InitStructs;
+    procedure SortBlock(var block_length: longint);
+    procedure MTFGetTransformedBlock(var block_length, first_sym_index, virtual_char_index: longint);
+    procedure AriEncodeBlock(ArchiveFile: TArchiveFile; block_length: longint);
+    procedure AriEncodeBlockToStream(OutStream: TStream; block_length: longint; var OutSize: integer);
+
+    procedure FillInBlockFromStream(Stream: TStream; var BlockLength: integer);
+    {procedure GetTransformedBlock(var first_sym_index, virtual_char_index: longint);
+    procedure MTFEncodeBlock;}
+    {procedure RLEEncode;}
+
+
+
+    // Debug
+    {procedure DoBlockRecover;
+    procedure DumpBlock(var b; bsize: longint; FileName: string);
+    procedure DumpSortedBlock;
+    procedure DumpTransformedBlock;
+    procedure DumpRecoveredBlock;
+    procedure CheckSortedBlock;
+    {procedure CheckRecoveredBlock;}
+
+    // Debug output
+    {procedure DebugShowDoingSorting;
+    procedure DebugShowDoingTransform;}
+    {procedure DebugShowDoingMTF;}
+    {procedure DebugShowDoingAriCompress;}
+
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    function GetInBlock: PBlock;  // fill the inblock then compress it
+    procedure CompressInBlockToFile(block_length: longint; ArchiveFile: TArchiveFile;
+                                    var packed_size: integer);
+
+    procedure CompressStream(InStream, OutStream: TStream);
+  end;
+
+
+(**) implementation (**)
+uses ErrorUnit;
+
+
+constructor TCompressor.Create;
+begin
+  inherited Create;
+  //AllocateStructs;
+  FastSorter := TFastSorter.Create;
+  MTFEncoder := TMTFEncoder.create;
+  FileStrucAriEncoder := TFileStrucAriEncoder.Create;
+  StreamAriEncoder := TStreamAriEncoder.Create;
+
+  {Debug}
+  {Expander := TExpander.Create;}
+end;
+
+destructor TCompressor.Destroy;
+begin
+  {Debug}
+  {Expander.Free;}
+
+  FileStrucAriEncoder.Free;
+  MTFEncoder.Free;
+  FastSorter.Free;
+  //FreeStructs;
+  inherited Destroy;
+end;
+
+(*
+{-------------------------------------------------------------------------------
+  AllocateStructs
+  ---------------
+
+  Allocate memory for the block transformation and assign in_block and out_block
+-------------------------------------------------------------------------------}
+procedure TCompressor.AllocateStructs;
+begin
+  New(block1);
+  New(block2);
+  New(index);
+
+  // Debug
+  {New(recovered_block);
+  New(original_block);}
+end;
+
+{-------------------------------------------------------------------------------
+  FreeStructs
+
+  Free whatever memory that was allocated by AllocateStructs
+-------------------------------------------------------------------------------}
+procedure TCompressor.FreeStructs;
+begin
+  // Debug
+  {Dispose(original_block);
+  Dispose(recovered_block);}
+
+  Dispose(index);
+  Dispose(block2);
+  Dispose(block1);
+end;
+*)
+
+{-------------------------------------------------------------------------------
+  InitStructs
+
+  inits swap block structures.
+  pass the block1 to be assigned
+  inits the index.
+  Assigns an index to every position in block. Each entry in index indicates the
+  start of a string.
+-------------------------------------------------------------------------------}
+procedure TCompressor.InitStructs;
+begin
+  // Assign block pointers for the swapblocks system
+  // in_block was assigned when GetInBlock was called. it took block1
+  out_block := BlockMan.block2;
+  index := BlockMan.longintblock1;
+end;
+
+function TCompressor.GetInBlock: PBlock;  // fill the inblock then compress it
+begin
+  in_block := BlockMan.block1;
+  result := BlockMan.block1;
+end;
+
+{-------------------------------------------------------------------------------
+  CompressBlockToFile
+  -------------------
+  Writes out the data header + data
+
+  IN Assertion: ArchiveFile has been seeked to the next write position
+  OUT Assertion: ArchiveFile is seeked to the next output position
+-------------------------------------------------------------------------------}
+procedure TCompressor.CompressInBlockToFile;
+var
+  data_header_offset,             // offset of the data header
+  next_free_pos: integer;         // the next output position when ArchiveFile is returned
+  ari_data_size: longword;        // size of the arithmetic data
+  crc: longword;                  // crc calculated for this block
+  first_sym_index, virtual_char_index: longint;
+  DataBlockHeader: TDataBlockHeader;             // the data header
+begin
+  {Compression process:
+  Sort
+  Transform
+  Move To Front
+  Ari Code}
+
+  // reserve space for the block size first
+  data_header_offset := ArchiveFile.Position;
+  ArchiveFile.ReserveSpace(DATA_HEADER_SIZE);
+
+  ArchiveFile.ResetBuffer;
+
+  InitStructs;
+  CalculateCRC32(in_block, block_length, crc);
+  SortBlock(block_length);
+  MTFGetTransformedBlock(block_length, first_sym_index, virtual_char_index);
+  AriEncodeBlock(ArchiveFile, block_length);
+
+  // save the current position
+  next_free_pos := ArchiveFile.Position;
+
+  // some calculations
+  ari_data_size := next_free_pos - data_header_offset -DATA_HEADER_SIZE;
+
+  // seek back to start of data block to write the data header of this block
+  ArchiveFile.SmartSeek(data_header_offset, soFromBeginning);
+
+  DataBlockHeader := TDataBlockHeader.Create;
+  DataBlockHeader.crc32 := crc;
+  DataBlockHeader.compressed_size := ari_data_size;
+  DataBlockHeader.first_sym_index := first_sym_index;
+  DataBlockHeader.virtual_char_index := virtual_char_index;
+  DataBlockHeader.WriteToFile(ArchiveFile);
+  DataBlockHeader.Free;
+
+  // seek back to where we left off
+  ArchiveFile.SmartSeek(next_free_pos, soFromBeginning);
+
+  // allow screen update
+  Application.ProcessMessages;
+
+  // return values
+  packed_size := ari_data_size;
+end;
+
+{-------------------------------------------------------------------------------
+  CompressStream
+  -------------------
+  Writes Compressed Data Only to OutStream.
+  No block information is stored.
+
+  IN Assertion: ArchiveFile has been seeked to the next write position
+  OUT Assertion: ArchiveFile is seeked to the next output position
+-------------------------------------------------------------------------------}
+procedure TCompressor.CompressStream(InStream, OutStream: TStream);
+var
+  BlockLength: integer;        // actual size of data in block
+  crc: longword;               // crc calculated for this block
+  AriDataSize: longint;        // size of the arithmetic data
+  first_sym_index, virtual_char_index: longint;
+  DataBlockHeader: TDataBlockHeader;             // the data header
+begin
+  {Compression process:
+  Sort
+  Transform
+  Move To Front
+  Ari Code}
+
+  GetInBlock; // init in_block.
+  InitStructs;
+
+  While (InStream.Position < InStream.Size) do
+  begin
+    FillInBlockFromStream(InStream, BlockLength);
+    CalculateCRC32(in_block, BlockLength, crc);
+    SortBlock(BlockLength);
+    MTFGetTransformedBlock(BlockLength, first_sym_index, virtual_char_index);
+    AriEncodeBlockToStream(OutStream, BlockLength, AriDataSize);
+  end;
+
+  (*
+  InitStructs;
+  CalculateCRC32(in_block, block_length, crc);
+  SortBlock(block_length);
+  MTFGetTransformedBlock(block_length, first_sym_index, virtual_char_index);
+  AriEncodeBlock(ArchiveFile, block_length);
+
+  // save the current position
+  next_free_pos := ArchiveFile.Position;
+
+  // some calculations
+  ari_data_size := next_free_pos - data_header_offset -DATA_HEADER_SIZE;
+
+  // seek back to start of data block to write the data header of this block
+  ArchiveFile.SmartSeek(data_header_offset, soFromBeginning);
+
+  DataBlockHeader := TDataBlockHeader.Create;
+  with DataBlockHeader do
+  begin
+    crc32 := crc;
+    compressed_size := ari_data_size;
+  end;
+  DataBlockHeader.first_sym_index := first_sym_index;
+  DataBlockHeader.virtual_char_index := virtual_char_index;
+  DataBlockHeader.WriteToFile(ArchiveFile);
+  DataBlockHeader.Free;
+
+  // seek back to where we left off
+  ArchiveFile.SmartSeek(next_free_pos, soFromBeginning);
+
+  // allow screen update
+  Application.ProcessMessages;
+
+  // return values
+  packed_size := ari_data_size;
+  *)
+end;
+
+procedure TCompressor.FillInBlockFromStream(Stream: TStream; var BlockLength: integer);
+begin
+  BlockLength := Stream.Read(in_block^[0], BlockSize);
+end;
+
+{-------------------------------------------------------------------------------
+  RLEEncode
+
+  Run Length Encode the block for faster sorting.
+  OUT Assertion: block_length is set to the new length
+-------------------------------------------------------------------------------}
+
+{procedure TCompressor.RLEEncode;
+var
+  RLEEncoder: TRunLengthEncoder;
+begin
+  RLEEncoder := TRunLengthEncoder.Create;
+  RLEEncoder.EncodeBlock(in_block, out_block, block_length, block_length);
+  RLEEncoder.Free;
+  SwapBlocks;
+end;}
+
+
+{-------------------------------------------------------------------------------
+  SortBlock
+-------------------------------------------------------------------------------}
+procedure TCompressor.SortBlock(var block_length: longint);
+var
+  i: longint;
+begin
+  for i := 0 to block_length-1 do
+    index[i] := i;
+
+  //DebugShowDoingSorting;
+  FastSorter.SortBlock(in_block, index, block_length);
+
+  // SadaSort adds a virtual char
+  inc(block_length);
+
+  // debug check
+  {DumpSortedBlock;}
+  {CheckSortedBlock;}
+  // in_block is not changed, only Index is created.
+  // swapblocks need not be called
+end;
+
+{-------------------------------------------------------------------------------
+  GetTransformedBlock and MTF encode
+
+  Get the last column l
+-------------------------------------------------------------------------------}
+procedure TCompressor.MTFGetTransformedBlock(var block_length, first_sym_index, virtual_char_index: longint);
+var
+  i, j: longint;
+begin
+  //DebugShowDoingTransform;
+  MTFEncoder.Init;
+
+  // mirror the last byte in block to block[-1], so when i = 0, block^[i-1] works
+  in_block^[-1] := in_block^[block_length-1];
+
+  // sada sort account for vitual. don't pass it to the mtf.
+  // we remove it from out_block and store its index.
+  i := 0;  // in_block index
+  j := 0;  // out_block index
+  virtual_char_index := -2;
+
+  while (i < block_length) do
+  begin
+    if (index[i] = 1) then
+      first_sym_index := i;
+
+    // the virtual char is accessed when in_block[-1] is accessed
+    if ((index[i]-1) = -1) then
+      virtual_char_index := j // we skip the virtual char
+    else
+    begin
+      out_block[j] := MTFEncoder.Encode(in_block[index[i]-1]);
+      inc(j);
+    end;
+
+    inc(i);
+  end;
+
+  if (virtual_char_index = -2) then
+  begin
+    // fatal error: virtual_char_index may not have been initialized at all
+    ShowError('virtual_char_index not initialized.');
+  end;
+
+  // we have taken out the virtual char, so we dec block_length
+  dec(block_length);
+
+  SwapBlocks;
+end;
+
+{-------------------------------------------------------------------------------
+  AriEncodeBlock
+
+  Notes:
+  Arithmetic compress block and output block
+-------------------------------------------------------------------------------}
+procedure TCompressor.AriEncodeBlock(ArchiveFile: TArchiveFile; block_length: longint);
+begin
+  //DebugShowDoingAriCompress;
+ // FileStrucAriEncoder := TFileStrucAriEncoder.Create;
+  FileStrucAriEncoder.EncodeBlock(ArchiveFile, in_block, block_length);
+
+  // debug check
+  {DecodeBlock(recovered_block, rsize);
+  CompareBlocks(mtf_block, recovered_block, block_length, 'Decompression error.');}
+end;
+
+procedure TCompressor.AriEncodeBlockToStream(OutStream: TStream; block_length: longint; var OutSize: integer);
+begin
+  StreamAriEncoder.EncodeBlock(OutStream, in_block, block_length, OutSize);
+end;
+
+
+(*
+procedure TCompressor.GetTransformedBlock(var first_sym_index, virtual_char_index: longint);
+var
+  i, j: longint;
+begin
+  DebugShowDoingTransform;
+
+  // mirror the last byte in block to block[-1], so when i = 0, block^[i-1] works
+  in_block^[-1] := in_block^[block_length-1];
+
+  // sada sort account for vitual. don't pass it to the mtf.
+  // we remove it from out_block and store its index.
+  i := 0;  // in_block index
+  j := 0;  // out_block index
+  virtual_char_index := -2;
+
+  while (i < block_length) do
+  begin
+    if (index^[i] = 1) then
+      first_sym_index := i;
+
+    // the virtual char is accessed when in_block[-1] is accessed
+    if ((index^[i]-1) = -1) then
+      virtual_char_index := j // we skip the virtual char
+    else
+    begin
+      out_block^[j] := in_block^[longint(index[i])-1];
+      inc(j);
+    end;
+
+    inc(i);
+  end;
+
+  //ShowMessage('Virtual char index: ' + IntToStr(virtual_char_index));
+
+  if (virtual_char_index = -2) then
+  begin
+    // fatal error: virtual_char_index may not have been initialized at all
+    ShowError('virtual_char_index not initialized.');
+  end;
+
+  // we have taken out the virtual char, so we dec block_length
+  dec(block_length);
+
+  // debug check
+  {DumpTransformedBlock;}
+  {DoBlockRecover;
+  CheckRecoveredBlock;}
+  SwapBlocks;
+end;
+
+{-------------------------------------------------------------------------------
+  MTFEncodeBlock
+-------------------------------------------------------------------------------}
+procedure TCompressor.MTFEncodeBlock;
+var
+  MTFEncoder: TMTFEncoder;
+  {MTFDecoder: TMTFDecoder;}
+begin
+  DebugShowDoingMTF;
+
+  MTFEncoder := TMTFEncoder.create;
+  MTFEncoder.EncodeBlock(in_block, out_block, block_length);
+  MTFEncoder.free;
+
+  SwapBlocks;
+
+  // debug check
+  {MTFDecoder := TMTFDecoder.create;
+  MTFDecoder.DecodeBlock(mtf_block, recovered_block, block_length);
+  MTFDecoder.free;}
+end;
+*)
+
+
+(*******************************************************************************
+  Debuging routines
+*******************************************************************************)
+
+(*
+procedure TCompressor.DoBlockRecover;
+{var
+  RecoveredBlockLength: Longint;}
+begin
+  //Expander.ExpandBlock(block, recovered_block, first_sym_index, block_length, RecoveredBlockLength);
+  //Expander.ExpandBlock(transformed_block, recovered_block, first_sym_index, block_length, RecoveredBlockLength);
+end;
+
+
+{-------------------------------------------------------------------------------
+  DumpSortedBlock
+  ---------------
+  Dumps the data in block sorted in alphabetical order.
+  Used to visually confirm the reliability of the sorting algorithm.
+-------------------------------------------------------------------------------}
+procedure TCompressor.DumpSortedBlock;
+var
+  f: text;
+  i: integer;
+begin
+  AssignFile(f, 'c:\ctest\SortedBlockDump.txt');
+  Rewrite(f);
+  writeln(f, 'Sorted Block Dump file');
+  writeln(f, 'reSource eXperimental (C) 1997 F-inc');
+  writeln(f, '=======================================');
+  writeln(f, 'block_length: ', block_length);
+  writeln(f, '=======================================');
+  for i := 0 to block_length-1 do
+    {if (index^[i] = block_length) then
+      write(f, '?')
+    else}
+      //write(f, char(block^[index^[i]]));
+  Close(f);
+end;
+
+{-------------------------------------------------------------------------------
+  DumpBlock
+  ---------
+  Dumps the block, b to a file.
+  Used by DumpTransformedBlock
+-------------------------------------------------------------------------------}
+procedure TCompressor.DumpBlock(var b; bsize: longint; FileName: string);
+var
+  f: TOFile;
+begin
+  f := TOFile.create(FileName);
+  f.Rewrite(1);
+  f.BlockWrite(b, block_length);
+  f.free;
+end;
+
+procedure TCompressor.DumpRecoveredBlock;
+begin
+  DumpBlock(recovered_block^, block_length, 'c:\ctest\out Recovered Block.txt');
+end;
+
+{-------------------------------------------------------------------------------
+  DumpTransformedBlock
+  --------------------
+  Dumps the transformed block to file.
+  This is actually L, or the last column in the transformation matrix.
+
+  IN Assertion: DoBlockTransform was called.
+-------------------------------------------------------------------------------}
+procedure TCompressor.DumpTransformedBlock;
+begin
+//  DumpBlock(block^, block_length, 'c:\ctest\out Transformed Block.txt');
+end;
+
+*)
+
+{-------------------------------------------------------------------------------
+  CheckSortedBlock
+  ----------------
+  Checks the sorted block for ascending order.
+  Only displays an error when one has occured.
+-------------------------------------------------------------------------------}
+(*
+procedure TCompressor.CheckSortedBlock;
+var
+  i: integer;
+begin
+  {Checks: INBLOCK
+  Assertion: Index has been created}
+  
+  i := 1;
+  while (i < block_length-1) and (in_block^[Index^[i]] >= in_block^[Index^[i-1]]) do
+    inc(i);
+
+  {An error has occured if i did not reach the end of block}
+  if (i < block_length-1) then
+    ShowError('Block not sorted correctly');
+end;
+
+
+{-------------------------------------------------------------------------------
+  CheckRecoveredBlock
+  -------------------
+  Does a byte to byte comparison of the recovered block and the original block.
+  Shows an error and the position where the first different byte was found.
+-------------------------------------------------------------------------------}
+procedure TCompressor.CheckRecoveredBlock;
+var
+  i: longint;
+begin
+  //DumpRecoveredBlock;
+
+   {recovered_block must be the same as original block}
+   for i := 0 to block_length-1 do
+     if recovered_block^[i] <> original_block^[i] then
+     begin
+       ShowError('Recovered block differs from original block at ' + IntToStr(i));
+       break;
+     end;
+
+
+   {Alternate way of comparing using CompareMem.
+   Position of difference start will not be shown.
+
+   if not CompareMem(recovered_block, block, block_length-1) then
+   ShowError('Recovered block differs from original block');}
+end;
+*)
+
+(*******************************************************************************
+  Debug Output routines
+*******************************************************************************)
+{procedure TCompressor.DebugShowDoingSorting;
+begin
+  if ConfigMan.ShowDebugForm then DebugForm.DoingSorting;
+end;
+
+procedure TCompressor.DebugShowDoingTransform;
+begin
+  if ConfigMan.ShowDebugForm then DebugForm.DoingTransform;
+end;}
+
+{procedure TCompressor.DebugShowDoingMTF;
+begin
+  if ConfigMan.ShowDebugForm then DebugForm.DoingMTF;
+end;}
+
+{procedure TCompressor.DebugShowDoingAriCompress;
+begin
+  if ConfigMan.ShowDebugForm then DebugForm.DoingAriCompress;
+end;}
+
+
+
+end.
+
+

Component/BWTExpandUnit.pas

@@ -0,0 +1,376 @@
+unit BWTExpandUnit;
+{-------------------------------------------------------------------------------
+Burrows Wheeler Transformation
+Block Expansion Unit
+------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+  Notes:
+  SwapBlock
+  After every decoding procedure is called, SwapBlocks is called.
+  in_block will always contain the latest block and out_block the block
+  to be used for further decoding.
+  block_length will always contain the length of in_block.
+
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses // delphi
+     SysUtils, Classes, Dialogs,
+     // general
+     StructsUnit, ArchiveFileUnit, ArchiveHeadersUnit, CRC32Unit,
+     // engine
+     RLEUnit, MTFDecoderUnit, GroupAriModelUnit,
+     // arithmetic engine
+     FileStrucAriDecoderUnit,
+     // base class
+     BWTBaseUnit;
+
+type
+  T256longintarray = array[-1..255] of longint;
+  P256longintarray = ^T256longintarray;
+
+  TExpander = class(TBWTBase)
+  private
+    FLastCRC32Result: boolean;
+    //block1, block2: PBlock;
+    block_length: integer; // length of out_block
+
+    transformation_block: PLongintBlock;
+    count, running_total: P256longintarray;
+    //count, running_total: array[-1..255] of longint;
+
+    // classes
+    FileStrucAriDecoder: TFileStrucAriDecoder;
+    MTFDecoder: TMTFDecoder;
+
+    {procedure AllocateStructs;
+    procedure FreeStructs;}
+    procedure InitStructs;
+
+    // Decoding routines
+    procedure AriDecode(InFile: TArchiveFile);
+    procedure MTFDecode(const virtual_char_index: longint);
+    procedure RecoverSortedBlock(const first_sym_index, virtual_char_index: longint);
+    //procedure RLEDecode;
+
+  public
+    //property OnProgressChange
+
+    //procedure ExpandStream(InStream, OutStream: TStream);
+    procedure ExpandBlock(InFile: TArchiveFile; OutFile: TFileStream);
+    
+    {Can call these after ExpandBlock to get error results}
+    function GetLastCRC32Result: boolean;
+
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+(**) implementation (**)
+uses ErrorUnit;
+
+{-------------------------------------------------------------------------------
+  Create
+  Destroy
+
+-------------------------------------------------------------------------------}
+
+constructor TExpander.Create;
+begin
+  inherited Create;
+  MTFDecoder := TMTFDecoder.create;
+  FileStrucAriDecoder := TFileStrucAriDecoder.Create;
+end;
+
+
+destructor TExpander.Destroy;
+begin
+  FileStrucAriDecoder.Free;
+  MTFDecoder.free;
+  inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------
+  Allocate Structs
+  Free Structs
+
+  Swap Blocks
+  in_block and out_block exchange pointer values
+-------------------------------------------------------------------------------}
+
+{procedure TExpander.AllocateStructs;
+begin
+  New(transformation_block);
+  New(block1);
+  New(block2);
+
+  in_block := block1;
+  out_block := block2;
+end;
+
+procedure TExpander.FreeStructs;
+begin
+  Dispose(block2);
+  Dispose(block1);
+  Dispose(transformation_block);
+end;}
+
+procedure TExpander.InitStructs;
+begin
+  in_block := BlockMan.block1;
+  out_block := BlockMan.block2;
+  transformation_block := BlockMan.longintblock1;
+  // blocksize is definitely greater than 256, so count and running_total
+  // can use longintblock
+  count := P256longintarray(BlockMan.longintblock2);
+  running_total := P256longintarray(BlockMan.longintblock3);
+end;
+
+{-------------------------------------------------------------------------------
+  ExpandBlock
+
+  IN Assertion:
+    InFile has been seeed to the pos to retrieve the block
+    OutFile has been seeked to the pos to add data
+-------------------------------------------------------------------------------}
+procedure TExpander.ExpandBlock(InFile: TArchiveFile; OutFile: TFileStream);
+var
+  DataBlockHeader: TDataBlockHeader;
+  crc: longword;
+begin
+  //AllocateStructs;
+
+  {InFile := _InFile;
+  OutFile := _OutFile;}
+  //InFile.ResetBuffer;
+
+  InitStructs;
+  DataBlockHeader := TDataBlockHeader.Create;
+  DataBlockHeader.ReadFromFile(InFile);
+
+  InFile.SetReadByteLimit(DataBlockHeader.compressed_size);
+
+  AriDecode(Infile);
+  MTFDecode(DataBlockHeader.virtual_char_index);
+  RecoverSortedBlock(DataBlockHeader.first_sym_index, DataBlockHeader.virtual_char_index);
+  {RLEDecode;}
+
+  // check crc
+  CalculateCRC32(in_block, block_length, crc);
+  if (DataBlockHeader.crc32 <> crc) then
+  begin
+    ShowMessage('CRC does not match!');
+    FLastCRC32Result := false;
+  end
+  else
+  begin
+    FLastCRC32Result := true;
+  end;
+
+  // Write to OutFile
+  OutFile.Write(in_block[0], block_length);
+
+  //FreeStructs;
+end;
+
+{-------------------------------------------------------------------------------
+  24/04/2001. IN DEVELOPMENT. DO NOT USE.
+  
+  ExpandStream
+
+
+  Notes:
+    Stream compression/decompression does not maintain any data header.
+    You must specify the block size yourself.
+
+  IN Assertion:
+    InStream has been seeed to the pos to retrieve the block
+    OutStream has been seeked to the pos to add data
+-------------------------------------------------------------------------------}
+(*
+procedure TExpander.ExpandStream(InStream, OutStream: TStream);
+var
+  DataBlockHeader: TDataBlockHeader;
+  crc: longword;
+begin
+
+  InitStructs;
+  //DataBlockHeader := TDataBlockHeader.Create;
+  //DataBlockHeader.ReadFromFile(InFile);
+
+  InFile.SetReadByteLimit(DataBlockHeader.compressed_size);
+
+  AriDecode(Infile);
+  MTFDecode(DataBlockHeader.virtual_char_index);
+  RecoverSortedBlock(DataBlockHeader.first_sym_index, DataBlockHeader.virtual_char_index);
+  {RLEDecode;}
+
+  // check crc
+  CalculateCRC32(in_block, block_length, crc);
+  if (DataBlockHeader.crc32 <> crc) then
+  begin
+    ShowMessage('CRC does not match!');
+    FLastCRC32Result := false;
+  end
+  else
+  begin
+    FLastCRC32Result := true;
+  end;
+
+  // Write to OutFile
+  OutFile.Write(in_block[0], block_length);
+
+  //FreeStructs;
+end;
+*)
+
+{-------------------------------------------------------------------------------
+  AriDecode
+
+  OUT Assertion:
+  Sets block_length
+-------------------------------------------------------------------------------}
+procedure TExpander.AriDecode(InFile: TArchiveFile);
+begin
+//  FileStrucAriDecoder := TFileStrucAriDecoder.Create;
+  FileStrucAriDecoder.DecodeBlock(InFile, out_block, block_length);
+  SwapBlocks;
+end;
+
+{-------------------------------------------------------------------------------
+  Move To Front Decode and count
+-------------------------------------------------------------------------------}
+procedure TExpander.MTFDecode(const virtual_char_index: longint);
+var
+  i, j: integer;
+  b: byte;
+begin
+  MTFDecoder.Init;
+
+  // Reset counts to 0
+  for i := 0 to 255 do
+    count[i] := 0;
+
+  // Count[-1] = 1 since it is the virtual smallest char
+  // -1 is the virtual character
+  count[-1] := 1;
+
+  // i: outblock index
+  // j: inblock index
+  i := 0;
+  j := 0;
+
+  // the decode/count loop is unrolled to 2 parts to ignore the virtual char
+  while (i < virtual_char_index) do
+  begin
+    b := MTFDecoder.Decode(in_block[j]);
+    out_block[i] := b;
+    inc(count[b]);
+    inc(i);
+    inc(j);
+  end;
+
+  inc(i);  // leave one char in outblock for virtual char
+
+  while (j < block_length) do  // 2nd time
+  begin
+    b := MTFDecoder.Decode(in_block[j]);
+    out_block[i] := b;
+    inc(count[b]);
+    inc(i);
+    inc(j);
+  end;
+
+
+  // add one to the block length because the virtual char was added
+  // outblock is now 1 char greater
+  inc(block_length);
+
+  SwapBlocks;
+end;
+
+
+{-------------------------------------------------------------------------------
+  RecoverSortedBlock
+
+  Processes in_block to produce out_block.
+  Reverses the process of Sort + Transform
+  IN Assertion: Memory has been allocated for out_block and transformation_block
+                first_sym_index has been set
+-------------------------------------------------------------------------------}
+procedure TExpander.RecoverSortedBlock(const first_sym_index, virtual_char_index: longint);
+var
+  i, j, sum, idx: longint;
+begin
+  {Map the symbols from the last column to the first column}
+  sum := 0;
+  for i := -1 to 255 do
+  begin
+    running_total[i] := sum;
+    sum := sum + count[i];
+    count[i] := 0;
+  end;
+
+  // the loop is unrolled to 2 parts to account for the virtual char
+  for i := 0 to virtual_char_index-1 do
+  begin
+    idx := in_block[i];
+
+    transformation_block[count[idx] + running_total[idx]] := i;
+    inc(count[idx]);
+  end;
+
+  // i = virtual_char_index
+  // we assign manually since -1 cannot be represented in a byte}
+  transformation_block[count[-1] + running_total[-1]] := virtual_char_index;
+
+  for i := virtual_char_index+1 to block_length-1 do
+  begin
+    idx := in_block[i];
+
+    transformation_block[count[idx] + running_total[idx]] := i;
+    inc(count[idx]);
+  end;
+
+  // Recover
+  i := first_sym_index;
+  for j := 0 to block_length-1 do
+  begin
+    out_block[j] := in_block[i];
+    i := transformation_block[i];
+  end;
+
+  // cut the virtual char. outblock less one char.
+  dec(block_length);
+
+  SwapBlocks;
+end;
+
+{-------------------------------------------------------------------------------
+  Run Length Decode
+-------------------------------------------------------------------------------}
+{procedure TExpander.RLEDecode;
+var
+  RunLengthDecoder: TRunLengthDecoder;
+begin
+  RunLengthDecoder := TRunLengthDecoder.Create;
+  RunLengthDecoder.DecodeBlock(in_block, out_block, block_length, block_length);
+  RunLengthDecoder.Free;
+  SwapBlocks;
+end;}
+
+
+function TExpander.GetLastCRC32Result: boolean;
+begin
+  result := FLastCRC32Result;
+end;
+
+
+end.

Component/BitStreamUnit.pas

@@ -0,0 +1,249 @@
+unit BitStreamUnit;
+{-------------------------------------------------------------------------------
+Bit Access for Streams
+----------------------
+revision 1.0
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+Desc:
+  Acts as a Bit access interface and buffer for a TStream.
+  Any Stream (TMemoryStream, TFileStream) can be assigned.
+  
+
+Usage Note:
+  Call BeginBitAccess and EndBitAccess to start and end bit access.
+  Failure to call any of which may lead to data corruption.
+
+Specially tailored procedures:
+
+  SetReadByteLimit
+  This checks that the bits read fall within the limit. It allows a maximum
+  of NUM_FAKED_BYTES bytes more read (which the decoder uses) after which data corruption
+  has most likely occured.
+  Set to MaxLongInt if the limit is not to be used (default).
+
+
+
+version
+  1.0: First release
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses Classes, SysUtils;
+
+const
+  NUM_FAKED_BYTES = 20;
+
+type
+
+  TBitStream = class
+  private
+    Stream: TStream;
+
+    mask: byte;
+    rack: byte;
+
+    IsOpenInput: boolean;
+
+    read_byte_limit: integer;
+    bytes_read: integer;
+    //extra_bytes_read: integer;    // bytes read past the limit
+
+    procedure BitGetNextByte(var b: byte);
+    procedure GetNextByte(var b: byte);
+    procedure WriteByte(b: byte);
+
+  public
+    constructor Create(_Stream: TStream; IsRead: boolean);
+    destructor Destroy; override;
+
+    procedure SetReadByteLimit(const limit: integer);
+
+    procedure BeginBitReadAccess;
+    procedure EndBitReadAccess;
+    procedure BeginBitWriteAccess;
+    procedure EndBitWriteAccess;
+
+    procedure OutputBit(bit: byte);
+    procedure OutputBits(code: longint; count: byte);
+    function  InputBit: byte;
+    function  InputBits( count: byte ): longint;
+  end;
+
+(**) implementation (**)
+uses ErrorUnit;
+
+constructor TBitStream.Create(_Stream: TStream; IsRead: boolean);
+begin
+  inherited Create;
+  IsOpenInput := IsRead;
+
+  rack := 0;
+  mask := $80;
+  SetReadByteLimit(MaxLongInt);
+  Stream := _Stream;
+end;
+
+destructor TBitStream.Destroy;
+begin
+  if (not IsOpenInput) and (Mask <> $80) then WriteByte(rack);
+  inherited Destroy;
+end;
+
+procedure TBitStream.SetReadByteLimit(const limit: integer);
+begin
+  bytes_read := 0;
+  read_byte_limit := limit;
+  //extra_bytes_read := 0;
+end;
+
+procedure TBitStream.BitGetNextByte(var b: byte);
+begin
+  if (bytes_read >= read_byte_limit) then    {If limit number of bytes already read}
+  begin
+
+    if (bytes_read - read_byte_limit >= NUM_FAKED_BYTES) then
+    begin
+      ShowError('Too many bytes read in bit mode.');
+      halt(1);
+    end
+    else
+    begin
+      b := 0;
+      inc(bytes_read);
+    end;
+
+  end
+  else
+  begin
+    GetNextByte(b);
+    inc(bytes_read);
+  end;
+end;
+
+procedure TBitStream.BeginBitReadAccess;
+begin
+  mask := $80;
+  rack := 0;
+end;
+
+procedure TBitStream.EndBitReadAccess;
+begin
+  mask := $80;
+  rack := 0;
+end;
+
+procedure TBitStream.BeginBitWriteAccess;
+begin
+  mask := $80;
+  rack := 0;
+end;
+
+procedure TBitStream.EndBitWriteAccess;
+begin
+  if (not IsOpenInput) and (Mask <> $80) then
+  begin
+    WriteByte(rack);
+  end;
+  Mask := $80;
+  rack := 0;
+end;
+
+
+
+procedure TBitStream.OutputBit(bit: byte);
+begin
+  if (bit <> 0) then
+    rack := rack or mask;
+
+  mask := mask shr 1;
+  if mask = 0 then
+  begin
+    WriteByte(rack);
+    rack := 0;
+    mask := $80;
+  end;
+end;
+
+procedure TBitStream.OutputBits(code: longint; count: byte);
+var
+  TempMask: longint;
+begin
+  TempMask := 1 Shl (Count-1);
+  while TempMask <> 0 do
+  begin
+    if (TempMask and Code <> 0) then
+      Rack := Rack or Mask;
+
+    Mask := Mask shr 1;
+    if Mask = 0 then
+    begin
+      WriteByte(Rack);
+      Rack := 0;
+      Mask := $80;
+    end;
+
+    TempMask := TempMask shr 1;
+  end;
+end;
+
+function TBitStream.InputBit: byte;
+var
+  value: byte;
+begin
+  if (mask = $80) then
+    BitGetNextByte(rack);
+
+  value := Rack and Mask;
+  Mask := Mask shr 1;
+  if Mask = 0 then Mask := $80;
+
+  if value = 0 then
+    result := 0
+  else
+    result := 1;
+end;
+
+function TBitStream.InputBits( count: byte ): longint;
+var
+  TempMask: longint;
+  value: longint;
+begin
+  TempMask := 1 shl (count-1);
+  value := 0;
+
+  while TempMask <> 0 do
+  begin
+    if (Mask = $80) then
+      BitGetNextByte(Rack);
+
+    if (Rack and Mask <> 0) then
+      value := (value or TempMask);
+
+    TempMask := TempMask shr 1;
+
+    Mask := Mask shr 1;
+    if Mask = 0 then Mask := $80;
+  end;
+
+  result := value;
+end;
+
+
+
+procedure TBitStream.GetNextByte(var b: byte);
+begin
+  {Interface to Stream}
+  Stream.ReadBuffer(b, 1);
+end;
+
+procedure TBitStream.WriteByte(b: byte);
+begin
+  Stream.WriteBuffer(b, 1);
+end;
+
+end.

Component/CRC32Unit.pas

@@ -0,0 +1,152 @@
+unit CRC32Unit;
+{-------------------------------------------------------------------------------
+CRC32 Unit
+----------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  Taken from Swag:
+  "Copyright (C) 1986 Gary S. Brown"
+  "File verification using CRC" by Mark R. Nelson in Dr. Dobbs' Journal, May 1992.
+  Delphi/Class conversion by Victor K / 1998
+
+
+  Desc:
+  Fast CRC-32 implementation using a table lookup.
+  The table is generated by another program.
+  Should be compatible or similar to the PKZip version.
+
+  To use:
+  1) Create the class
+  2) Run through the buffer passing each byte to Update
+  3) Get the crc-32
+
+    Algo:
+    crc_val: CRC value
+    1) Seeds crc_val
+    2) Uses a formula to update the crc_val
+    3) Returns the current value of crc_val
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses Classes, StructsUnit;
+
+type
+  TCRC32 = class
+  private
+    crc_val: Longword;
+  public
+    constructor Create;
+    procedure Update(b: byte);
+    function Get: Longword;
+  end;
+
+
+procedure CalculateCRC32(block: PBlock; block_length: integer; var crc: longword);
+procedure CalculateCRC32Stream(Stream: TStream; len: integer; var crc: longword);
+
+(**) implementation (**)
+
+
+procedure CalculateCRC32(block: PBlock; block_length: integer; var crc: longword);
+var
+  i: integer;
+  CRC32: TCRC32;
+begin
+  CRC32 := TCRC32.Create;
+  for i := 0 to block_length-1 do
+    CRC32.Update(block^[i]);
+  crc := CRC32.Get;
+  CRC32.Free;
+end;
+
+procedure CalculateCRC32Stream(Stream: TStream; len: integer; var crc: longword);
+var
+  i: integer;
+  CRC32: TCRC32;
+  b: byte;
+begin
+  CRC32 := TCRC32.Create;
+  for i := 0 to len-1 do
+  begin
+    Stream.ReadBuffer(b, 1);
+    CRC32.Update(b);
+  end;
+  crc := CRC32.Get;
+  CRC32.Free;
+end;
+
+{-------------------------------------------------------------------------------
+  CRC32 Class
+-------------------------------------------------------------------------------}
+
+
+Const
+  CRCSeed = $ffffffff;
+  CRC32tab : Array[0..255] of Longword = (
+    $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f,
+    $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,
+    $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064, $6ab020f2,
+    $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
+    $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
+    $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, $a2677172,
+    $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,
+    $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
+    $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423,
+    $cfba9599, $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
+    $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, $01db7106,
+    $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
+    $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d,
+    $91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,
+    $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
+    $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
+    $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7,
+    $a4d1c46d, $d3d6f4fb, $4369e96a, $346ed9fc, $ad678846, $da60b8d0,
+    $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa,
+    $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
+    $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,
+    $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,
+    $ead54739, $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84,
+    $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
+    $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
+    $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, $67dd4acc,
+    $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8, $a1d1937e,
+    $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
+    $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55,
+    $316e8eef, $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
+    $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28,
+    $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
+    $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f,
+    $72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,
+    $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
+    $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
+    $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69,
+    $616bffd3, $166ccf45, $a00ae278, $d70dd2ee, $4e048354, $3903b3c2,
+    $a7672661, $d06016f7, $4969474d, $3e6e77db, $aed16a4a, $d9d65adc,
+    $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
+    $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693,
+    $54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,
+    $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d  );
+
+
+constructor TCRC32.Create;
+begin
+  inherited Create;
+  crc_val := CRCSeed;
+end;
+
+procedure TCRC32.Update(b: byte);
+begin
+  crc_val := CRC32tab[Byte(crc_val xor Longword(b))] xor ((crc_val shr 8) and $00ffffff);
+end;
+
+function TCRC32.Get: Longword;
+begin
+  result := (crc_val xor CRCSeed)
+end;
+
+
+
+end.

Component/EDosUnit.pas

@@ -0,0 +1,665 @@
+unit EDosUnit;
+{-------------------------------------------------------------------------------
+Supporting Dos Unit.
+-------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  revision 2.1
+
+ Delphi version: 4.0
+
+ Purpose: Provide encapsulation and better error handling for delphi's
+          file/system functions.
+
+ Notes: This unit started out a long time ago to add to the Dos unit.
+        Delphi adds alot of system functionality that makes many of these procedures
+        redundant. Using this or Delphi's one should be similar.
+        Many procedures have been commented out, deleted or lost because they
+        were either too old or were lost in one of those h/d crash.
+
+ Conventions :
+   - S is used to represent "DirectoryString" or generally, string.
+
+
+ Rules to follow :
+   Directory paths:
+   - All directories end with a '\'
+     AddSlash appends the '\' if necessary.
+     DelSlash removes the '\' if there is one
+
+   File names/paths:
+   - file names may contain no extension.
+
+
+   - File seperators are '\'
+   - All file names are in 'string' type.
+
+
+   TDriveList
+   ----------
+   Used for enumerating drives
+
+
+   DEFUNCT: TEnSearchRec
+   ---------------------
+   The TEnhSearchRec (Enhanced Search Record) is a customized search
+   record object.
+   notes:
+   The fileTime used here is an integer. See FileDateToDateTime.
+
+   methods :
+   - constructor CreateFrom(const f: TSearchRec);
+     Creates a new object from f
+
+   - procedure CopySearchRec(const f: TSearchRec);
+     Copies data from f
+
+
+
+   EDosType
+   --------
+   Extra Dos functions type.
+   This object provides additional dos functions.
+
+   - GetWindowsDirectory: string;
+     Wrapper for the win32 API function, GetWindowsDirectory.
+     returns the string.
+
+   - function GetPathFromTree(const TreeView : TTreeView; const TreeNode : TTreeNode) : string;
+     Constructs a directory path to Tree Node, seperated by '\'
+     Note: If there  is a customised one, (eg. DirTreeForm) don't use this.
+
+   - function HasSubDir(var S : string) : boolean;
+     True if the directory, S, has a sub directory.
+
+   - FileExists (Under SysUtils)
+
+   - Path exists (Use DirectoryExists Delphi 4)
+     true if a file/drive/directry exists.
+     To check for a drive, use 'c:'. Do not append a slash.
+
+   - ForceDirectories
+     ripped from FileCtrl
+     will raise EInOutError if dir cannot be created e.g. drive not ready
+
+
+   - function ShowErrorMessageBox(const ErrorCode: integer): integer;
+     Shows a meaningful message (if available) for the ErrorCode.
+     Check help for "Error Codes". Returns the user's reponse from the
+     message box eg. IDRETRY, IDCANCEL.
+     Note: The message will not be shown if there is no error ie. ErrorCode = 0.
+-------------------------------------------------------------------------------}
+
+
+
+
+(**) interface (**)
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ExtCtrls, ComCtrls, ShellAPI,
+  FileCtrl,
+  // for SCannotCreateDir
+  Consts;
+
+
+type
+  TFilePos = Longint;
+
+  TDriveList = class
+  private
+    CurrPos: integer;          // current position in DriveStr
+    EndOfList: boolean;        // true when end of list is reached.
+  public
+    DriveStr: PChar;           // string of drive letters gotten from GetLogicalDrivesString
+    constructor Create;
+    destructor destroy; override;
+
+    function Next: string;
+    {Returns the next drive string, returns a null string when the
+     end of the list is reached}
+    procedure Reset;
+    {restart}
+  end;
+
+
+  (* TEnhSearchRec = class
+  public
+    constructor CreateFrom(const f: TSearchRec);
+    procedure CopySearchRec(const f: TSearchRec);
+
+    function IsArchive: boolean;
+    function IsReadOnly: boolean;
+    function IsSysFile: boolean;
+    function IsHidden: boolean;
+    function IsFolder: boolean;
+  private
+    FCreationTime,
+    FLastAccessTime,
+    FLastWriteTime: TDateTime;
+    FSize: Integer;
+    FAttr: Integer;
+    FName: TFileName;
+
+    {Time functions}
+    function Win32FileTimeToDosDateTime(const ftime: TFileTime): integer;
+
+  published
+    property Size: Integer read FSize;
+    property Attr: Integer read FAttr;
+    property Name: TFileName read FName;
+    property CreationTime: TDateTime read FCreationTime;
+    property LastAccessTime: TDateTime read FLastAccessTime;
+    property LastWriteTime: TDateTime read FLastWriteTime;
+  end; *)
+
+
+  EDosType = class
+  public
+    {defunct}
+    {function GetPathFromTree(const TreeNode: TTreeNode) : string;}
+
+    {Directory related functions}
+    function GetWindowsDirectory: string;
+    function HasSubDir(const S: string): boolean;
+    procedure AddSlash(var s: string);
+    procedure DelSlash(var s: string);
+
+    procedure DelTree(dir: string);
+    procedure ForceDirectories(Dir: string);
+    function PathExists(const s: string): boolean;
+    function ExtractFolders(s: string): string;
+    {function FileExists(const S: string): boolean;
+    procedure CreatePath(const s: string);}
+
+    {FindFirst/FindNext}
+    function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;
+    function FindNext(var F: TSearchRec): Integer;
+    procedure FindClose(var F: TSearchRec);
+
+    function GetSysImageList: TImageList;
+
+    {Error support}
+    function TestIO(const val: integer): boolean;
+  end;
+
+var
+  EDos : EDosType;
+
+(**) implementation (**)
+
+////////////////////////////////////////////////////////////////////////////////
+// TDriveList
+////////////////////////////////////////////////////////////////////////////////
+
+const
+  DriveStrSize = 1000;            // size of the DriveStr variable
+
+constructor TDriveList.create;
+begin
+  GetMem(DriveStr, DriveStrSize);
+  GetLogicalDriveStrings(DriveStrSize, DriveStr);
+  CurrPos := 0;
+  EndOfList := false;
+end;
+
+destructor TDriveList.destroy;
+begin
+  FreeMem(DriveStr);
+end;
+
+function TDriveList.Next: string;
+begin
+  result := '';
+  if (ord(DriveStr[CurrPos]) = 0) or EndOfList then
+  begin
+    EndOfList := true;
+    exit;
+  end;
+
+  while (ord(DriveStr[CurrPos]) <> 0) do
+  begin
+    result := result + DriveStr[CurrPos];
+    inc(CurrPos);
+  end;
+  inc(CurrPos); {Next position to start reading from}
+end;
+
+procedure TDriveList.Reset;
+begin
+  CurrPos := 0;
+  EndOfList := false;
+end;
+
+
+////////////////////////////////////////////////////////////////////////////////
+// TEnhSearchRec
+////////////////////////////////////////////////////////////////////////////////
+(* constructor TEnhSearchRec.CreateFrom(const f: TSearchRec);
+begin
+  inherited create;
+  CopySearchRec(f);
+end;
+
+procedure TEnhSearchRec.CopySearchRec(const f: TSearchRec);
+begin
+  FSize := f.Size;
+  FAttr := f.Attr;
+  FName := f.Name;
+  FLastWriteTime := FileDateToDateTime(f.Time);
+//  FCreationTime := FileDateToDateTime(Win32FileTimeToDosDateTime(f.FindData.ftCreationTime));
+//  FLastAccessTime := FileDateToDateTime(Win32FileTimeToDosDateTime(f.FindData.ftLastAccessTime));
+end;
+
+function TEnhSearchRec.IsFolder: boolean;
+begin
+  result := (Attr and faDirectory <> 0);
+end;
+
+function TEnhSearchRec.IsArchive: boolean;
+begin
+  result := (Attr and faArchive <> 0);
+end;
+
+function TEnhSearchRec.IsReadOnly: boolean;
+begin
+  result := (Attr and faReadOnly <> 0);
+end;
+
+function TEnhSearchRec.IsSysFile: boolean;
+begin
+  result := (Attr and faSysFile <> 0);
+end;
+
+function TEnhSearchRec.IsHidden: boolean;
+begin
+  result := (Attr and faHidden <> 0);
+end;
+
+function TEnhSearchRec.Win32FileTimeToDosDateTime(const ftime: TFileTime): integer;
+var
+  LocalFileTime: TFileTime;
+  Time: integer;
+begin
+  FileTimeToLocalFileTime(ftime, LocalFileTime);
+  FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi,
+    LongRec(Time).Lo);
+  result := Time;
+end;
+*)
+
+
+////////////////////////////////////////////////////////////////////////////////
+// EDosType
+////////////////////////////////////////////////////////////////////////////////
+
+
+
+
+function EDosType.GetWindowsDirectory: string;
+var
+  c: PChar;    {PChar to get the directory}
+const
+  cLength = MAX_PATH;     {Length of c}
+begin
+  c := StrAlloc(cLength + 1);
+  windows.GetWindowsDirectory(c, cLength);
+  result := c;
+  StrDispose(c);
+end;
+
+procedure EDosType.AddSlash(var s: string);
+var
+  len: integer;
+begin
+  len := length(s);
+  if (len > 0) and (s[len] <> '\') then
+    s := s + '\';
+end;
+
+procedure EDosType.DelSlash(var s: string);
+var
+  len: integer;
+begin
+  len := Length(s);
+  if (len > 0) and (s[len] = '\') then
+    delete(S, len, 1);
+end;
+
+
+function EDosType.HasSubDir(const S : string) : boolean;
+var
+  F : TSearchRec;
+  rc : integer;
+  found : boolean;
+begin
+  found := false;
+  rc := FindFirst(S + '*.*', faDirectory, F);
+  while (rc = 0) do begin
+    if (F.Attr and faDirectory <> 0) and (F.Name[1] <> '.') then begin
+      found := True;
+      break;
+    end;
+    rc := FindNext(F);
+  end;
+  FindClose(F);
+  result := found;
+end;
+
+(*
+function EDosType.GetPathFromTree(const TreeNode : TTreeNode) : string;
+var
+  rs : string;
+  WorkNode : TTreeNode;
+begin
+  rs := '';
+  WorkNode := TreeNode;
+  while (WorkNode <> nil) do begin
+    rs := rCheckDirStr(WorkNode.Text) {+ '\'} + rs;
+    WorkNode := WorkNode.Parent;
+  end;
+  result := rs;
+end;
+*)
+
+{$I-}
+{Path exists checks for drive, file or directory}
+function EDosType.PathExists(const s: string): boolean;
+var
+  F: TSearchRec;
+  ws: string;
+  curDir: string;
+begin
+  // create a working copy
+  ws := s;
+  DelSlash(ws);
+
+  // test for eg 'c:', 'z:', 'x:'
+  if (ws[2] = ':') and (length(ws) <= 2) then
+  begin
+    //drive
+    GetDir(0, curDir);
+    CHDir(ws);
+    result := (ioResult = 0);
+    CHDir(curDir);
+  end
+  else
+  begin
+    // File or dir
+    result := (FindFirst(ws, faAnyFile, F) = 0);
+    FindClose(F);
+  end;
+end;
+
+procedure EDosType.DelTree(dir: string);
+var
+  F: TSearchRec;
+  r: integer;
+  CurFileStr: string;
+begin
+  r := FindFirst(dir + '\*.*', faAnyFile - faVolumeID, F);
+  while (r = 0) do
+  begin
+    with F do
+    begin
+      CurFileStr := dir + '\' + Name;
+      // test if it is a directory
+      if (Attr and faDirectory <> 0) then
+      begin
+        // if it is a directory we rescurse into it
+        if (Name[1] <> '.') then
+          DelTree(CurFileStr);
+      end
+      else
+      begin
+        // test if it has a read only or system attribute which
+        // may hinder deletion. clear it.
+        // DO: IMPLEMENT EXCEPTION CHECKING FILESETATTR and DELETEFILE
+        if (Attr and faReadOnly <> 0) or
+           (Attr and faHidden <> 0) or
+           (Attr and faSysFile <> 0) then
+           FileSetAttr(CurFileStr, 0);
+        DeleteFile(CurFileStr);
+      end;
+    end;
+
+    r := FindNext(F); 
+  end;
+
+  // remove the empty dir
+  RmDir(dir);
+  FindClose(F);
+end;
+
+
+procedure EDosType.ForceDirectories(Dir: string);
+begin
+  FileCtrl.ForceDirectories(Dir);
+  if not DirectoryExists(Dir) then
+    raise EInOutError.Create('Cannot force directory');
+    
+  {if Length(Dir) = 0 then
+    raise Exception.Create(SCannotCreateDir);
+  if (AnsiLastChar(Dir) <> nil) and (AnsiLastChar(Dir)^ = '\') then
+    Delete(Dir, Length(Dir), 1);
+  if (Length(Dir) < 3) or DirectoryExists(Dir)
+    or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
+  ForceDirectories(ExtractFilePath(Dir));
+  if not CreateDir(Dir) then
+    raise EInOutError.Create('Cannot force directory');}
+end;
+
+
+function EDosType.GetSysImageList: TImageList;
+var
+  SysImageList: TImageList;
+  FileInfo: TSHFileInfo;
+begin
+  SysImageList := TImageList.create(Application);
+  with SysImageList do
+  begin
+    handle := SHGetFileInfo(PChar(EDos.GetWindowsDirectory), 0, FileInfo, sizeof(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
+    ShareImages := true;
+  end;
+  result := SysImageList;
+end;
+
+function EDosType.FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;
+begin
+  repeat
+    result := SysUtils.FindFirst(Path, Attr, F);
+  until TestIO(result);
+end;
+
+function EDosType.FindNext(var F: TSearchRec): Integer;
+begin
+  repeat
+    result := SysUtils.FindNext(F);
+  until TestIO(result);
+end;
+
+procedure FileSetAttr(const FileName: string; Attr: Integer);
+var
+  retval: integer;
+begin
+  retval := SysUtils.FileSetAttr(FileName, Attr);
+  if (retval <> 0) then
+    raise EInOutError.Create('FileSetAttr error');
+end;
+
+procedure DeleteFile(const FileName: string);
+begin
+  if (SysUtils.DeleteFile(FileName) = false) then
+    raise EInOutError.Create('DeleteFile error');
+end;
+
+
+
+procedure EDosType.FindClose(var F: TSearchRec);
+begin
+  SysUtils.FindClose(F);
+end;
+
+{-------------------------------------------------------------------------------
+  TestIO
+
+  Desc: Will test the IO return value val for error.
+  Returns True if IO is OK.
+          False means the operation should retry
+  If the user cancelled, then EInOutError will be raised with the error description
+-------------------------------------------------------------------------------}
+function EDosType.TestIO(const val: integer): boolean;
+var
+  Caption: string;
+  ErrorDesc: string;
+  HelpStr: string;
+  flags : integer;
+begin
+  if (val  = 0) OR
+    (val = ERROR_NO_MORE_FILES) then
+    result := true
+  else
+  begin
+    // give user choice of retrying
+    // the function will return a false indicating a retry
+    // otherwise if the user cancelled, then an EInOutError will be returned
+
+    Caption := 'Error';
+    ErrorDesc := '';
+    HelpStr := '';
+
+    case val of
+      // the error consts are taken from the Windows unit
+      
+      ERROR_PATH_NOT_FOUND:
+      begin
+        ErrorDesc := 'Path not found.';
+        //HelpStr := 'Try re-reading the directory.';
+      end;
+      ERROR_NOT_READY: {21: drive not ready}
+      begin
+        ErrorDesc := 'Drive not ready.';
+        HelpStr := 'Make sure the disk is properly inserted.';
+      end;
+
+      else
+      begin
+        ErrorDesc := 'No error description available.';
+        HelpStr := 'Choose ''Retry'' to retry the last operation.';
+      end;
+    end;
+
+    {Display the error code also}
+    flags := MB_ICONERROR or MB_RETRYCANCEL;
+
+    if (Application.MessageBox(PChar(ErrorDesc + #13 + HelpStr + ' (Error code: ' + IntToStr(val) + ')'),
+      PChar(Caption), flags) = IDRetry) then
+      result := false
+    else
+      raise EInOutError.Create(Caption);
+  end;
+end;
+
+
+{File exists checks if a file exists. Dirs and drives are not counted.
+Now defunct. exists in SysUtils.}
+{function EDosType.FileExists(const s: string): boolean;
+var
+  F: TSearchRec;
+  ws: string;
+  r: integer;
+begin
+  // create a working copy
+  ws := s;
+  DelSlash(ws);
+
+  r := FindFirst(ws, faAnyFile, F);
+  while (r = 0) do
+  begin
+    if (F.Attr and faDirectory = 0) then
+    begin
+      result := true;
+      FindClose(F);
+      exit;
+    end;
+    r := FindNext(F);
+  end;
+
+  result := false;
+  FindClose(F);
+end;}
+
+(* CreatePath
+Don't think this works. Use ForceDirectories
+{$I+}
+
+procedure EDosType.CreatePath(const s: string);
+var
+  i, path_length: integer;
+  next_dir: string;
+
+  function GetNextDir: string;
+  begin
+    next_dir := '';
+    while (i < path_length) and  (s[i] <> '\') do
+    begin
+      next_dir := next_dir + s[i];
+      inc(i);
+    end;
+
+    // skip the '\'
+    inc(i);
+  end;
+
+begin
+  i := 1;
+  path_length := length(s);
+
+  {$I-}
+  GetNextDir;
+
+  // make sure the drive is passed
+  Assert(next_dir[2] = ':', 'CreatePath: Drive not passed.');
+
+  // change to drive first. '\' added to change to root.
+  CHDir(next_dir + '\');
+  if (IOResult <> 0) then raise EInOutError.Create('CreatePath: Cannot change to drive');
+
+  GetNextDir;
+  while (next_dir <> '') do
+  begin
+    CHDir(next_dir);
+    if (IOResult <> 0) then
+    begin
+      // directory does not exist.
+      // try to create it.
+      MKDir(next_dir);
+      if (IOResult <> 0) then raise EInOutError.Create('CreatePath: Cannot create directory');
+    end
+    else
+      GetNextDir;
+
+  end;
+
+  {$I+}
+end; *)
+
+
+
+function EDosType.ExtractFolders(s: string): string;
+begin
+  // returns the folders only
+  // same as ExtractPath but without the drive
+  s := ExtractFilePath(s);
+  if (s[2] = ':') then delete(s, 1, 2);
+  if s[1] = '\' then delete(s, 1, 1);
+  result := s;
+end;
+
+initialization
+  EDos := EDosType.Create;
+finalization
+  EDos.free;
+end.

Component/ErrorUnit.pas

@@ -0,0 +1,38 @@
+unit ErrorUnit;
+{-------------------------------------------------------------------------------
+Error management unit
+---------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+Desc:
+Used for debugging and showing of error messages quickly.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls;
+
+{Displays a messagebox with the error description s}
+procedure ShowError(const s: string);
+procedure ShowFatal(const s: string);
+
+(**) implementation (**)
+
+procedure ShowError(const s: string);
+begin
+  Application.MessageBox(PChar(s), 'Error', 0);
+end;
+
+procedure ShowFatal(const s: string);
+begin
+  Application.MessageBox(PChar(s), 'Fatal', 0);
+  halt(1);
+end;
+
+end.

Component/FSortUnit.pas

@@ -0,0 +1,653 @@
+unit FSortUnit;
+{-------------------------------------------------------------------------------
+Fast sorter unit
+----------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  Fast sort unit.
+  Algos:
+    DJ Wheeler from his June 1989 report and
+    Kunihiko Sadakane's Suffix sort.
+
+  coded by gruv
+
+  Notes:
+  Sort the index, not the block.
+  SadaSort compares group indexes not block.
+
+  Sort rev 4:
+  Radix on symbol pairs.
+  Sadakane's Suffix sort.
+
+------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses SysUtils, Forms, dialogs, StructsUnit;
+
+const
+  STRIDE = 4;
+  MAXDEPTH = 20;
+  NUMOVERSHOOT = MAXDEPTH + 100;
+
+
+type
+  {THead = array[0..65535] of Longint;
+  PHead = ^THead;}
+
+
+  TFastSorter = class
+  private
+    block: PBlock;                // block to sort
+
+    index: PLongintBlock;         // index to the block to sort. each index pos is a string
+    block_length: longint;        // length of the block
+
+    last_index: integer;
+
+    head: P64kBlock;              // head of the linked list
+    link: PLongintBlock;         // links in the linked list
+    //link_count: PHead;            // Number of links in each head
+    //index_head: PHead;            // start of each group in index
+
+    group: PLongintBlock;         // group of suffix s
+    size: PLongintBlock;
+    {For SadaSort: from the paper
+    I -> index
+    V -> group
+    S -> size}
+
+    procedure RadixSortOnSymbolPairs;
+    procedure InitIndexFromLink;
+
+    procedure SadaSort;
+    procedure SortGroup(const stlo, sthi, depth: integer);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure SortBlock(const _block: PBlock; const _index: PLongintBlock; const _block_length: longint);
+  end;
+
+
+(**) implementation (**)
+uses ErrorUnit;
+
+{-------------------------------------------------------------------------------
+  Create/Destroy
+  --------------
+
+  Allocates and frees the memory structures used for sorting.
+-------------------------------------------------------------------------------}
+constructor TFastSorter.Create;
+begin
+  inherited Create;
+  {New(head);
+  New(link);
+  //New(link_count);
+  //New(index_head);
+
+  New(group);
+  New(size);}
+end;
+
+destructor TFastSorter.Destroy;
+begin
+  {Dispose(size);
+  Dispose(group);
+
+  //Dispose(index_head);
+  //Dispose(link_count);
+  Dispose(link);
+  Dispose(head);}
+  inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------
+  SortBlock
+  ---------
+
+  Main procedure to call.
+  Initializes the block then calls the respective procedures to sort the block.
+-------------------------------------------------------------------------------}
+procedure TFastSorter.SortBlock(const _block: PBlock; const _index: PLongintBlock; const _block_length: longint);
+
+  procedure Initialize;
+  var
+    i: integer;
+  begin
+    {Initialize}
+    block := _block;
+    index := _index;
+    block_length := _block_length;
+    last_index := block_length-1;
+
+    // sizes array need not be cleared. it will be init.
+
+    // assign block memory
+    // index -> longintblock1
+    head := BlockMan.k64Block;
+    link := BlockMan.longintblock2;
+    group := BlockMan.longintblock2;
+    size := BlockMan.longintblock3;
+
+    {Clear Arrays}
+    for i := 0 to 65535 do
+      head[i] := -1;
+
+
+  end;
+
+
+
+
+//var
+  //head_idx, cur_head: longword;
+  //first_char: byte;
+  //i, numkeys, first_head: integer; // numkeys: total number of keys with first_char
+  //t: longword;
+  //totalbytes: integer; // for progress bar
+
+begin
+  //totalbytes := 0;
+
+  Initialize;
+  RadixSortOnSymbolPairs;   // fill up head and link
+  InitIndexFromLink;        // get index in semi sorted order and index_head
+  SadaSort;
+end;
+
+{-------------------------------------------------------------------------------
+  RadixSortOnSymbolPairs
+  ----------------------
+
+  Radix sort: Run through the block array in words to get the buckets and dump
+  the indexes into their respective bucket.
+
+  Initializes long_block with each long integer straddling 4 bytes.
+
+  OUT Assertion:
+  head/link are linked lists to the sort.
+  long_block is initialized
+-------------------------------------------------------------------------------}
+procedure TFastSorter.RadixSortOnSymbolPairs;
+var
+  i: integer;
+  w: word;
+begin
+  {Init w with the first character}
+  w := block^[0];
+
+  for i := 0 to last_index-1 do
+  begin
+    w := word(w shl 8) or block^[i+1];
+
+    {if there is no entry in head then set the pos as the head.
+    Otherwise link the pos in by making it the head and setting its link}
+    if (head^[w] = -1) then
+    begin
+      head^[w] := i;
+      link^[i] := -1;
+      {Set link^[i] to -1 as the terminator}
+    end
+    else
+    begin
+      link^[i] := head^[w];
+      head^[w] := i;
+    end;
+  end; {for}
+
+
+end;
+
+
+
+{-------------------------------------------------------------------------------
+  InitIndexFromLink
+  -----------------
+
+  Out Assertion:
+  Inits index, index_head and link_count.
+  index_head will point to the head of each symbol pair in index.
+  link_count is the count for each symbol pair corresponding in head.
+  index will contain a continuous list of indexes. These indexes are in groups
+  with their head pointed to by index_head and counts in link_count.
+  Quicksort will sort the index.
+  head no more used.
+
+  Desc:
+  This will run through the head array.
+  It will fill in the index_head with all valid entries from head.
+  It is therefore possible that index_head be smaller than head, because all
+  -1 entries are removed.
+
+  The current index position is then filled with the head value.
+  If there is a head, there may be links. So the links are filled in trailing
+  after the head value until a -1 terminator is reached.
+
+  Note:
+  link_count includes the head node and all other link nodes.
+  link_count corresponds to the new def. of head, NOT the old one.
+  link_count[i] is the count for index_head[i].
+
+  All -1 or 'no entries' in index_head have been removed. index_head is a continuous list
+  of heads in index.
+  The end of index_head is marked by a -1.
+
+  New:
+  use link and head to init index, index_head, link_count, size
+  index_pos walks through to fill in index with the semi sorted indexes.
+  after this, link and head are no more used.
+  link and group share the same memory location
+-------------------------------------------------------------------------------}
+
+procedure TFastSorter.InitIndexFromLink;
+var
+  i, index_pos, {head_pos,} cur_node, t: longint;
+
+  group_num: integer;
+  //group_first_index: integer;
+  group_size: integer;
+
+  w: word;
+begin
+  index_pos := 1;  // start from 1 for virtual smallest character. for circular start from 0
+  //head_pos := 0;
+
+  // due to the last char being the smallest char, we must fill in manually
+  // link for that one.
+  // if actual last is 'e', then we get 'e$00' and we add to the head.
+  w := word(block[last_index] shl 8);
+  {if there is no entry in head then set the pos as the head.
+  Otherwise link the pos in by making it the head and setting its link}
+  if (head^[w] = -1) then
+  begin
+    head^[w] := last_index;
+    link^[last_index] := -1;
+    // Set link[i] to -1 as the terminator
+  end
+  else
+  begin
+    link^[last_index] := head^[w];
+    head^[w] := last_index;
+  end;
+
+
+
+  {go through each radix bucket}
+  for i := 0 to 65535 do
+  begin
+    cur_node := head^[i];
+
+    if (i = w) then
+    begin
+      // the link with the virtual smallest char is the first one
+      // we give it it's own group number, remove it from the linked list
+      // and continue as if this never happened
+      // cur_node is the index
+      // index_pos is the group number
+      Assert(cur_node = last_index);
+      index[index_pos] := cur_node;
+      size[index_pos] := 1;
+      // link and group share the same memory location. update cur_node then
+      // assign the group number because we'll never access that link again.
+      cur_node := link[cur_node];     // take out the memory contents
+      group[last_index] := index_pos; // override it
+      inc(index_pos);
+    end;
+
+
+    if (cur_node <> -1) then
+    begin
+      {Head now points to the head of a symbol pair linked list in index}
+      //index_head^[head_pos] := index_pos;
+      //link_count^[head_pos] := 0;
+
+      // walk the linked list
+      group_num := index_pos;  // group_num is i
+      //group_first_index := cur_node;
+      group_size := 0;
+
+      repeat
+        // collate the nodes in index
+        index[index_pos] := cur_node;
+        t := cur_node;   // save the cur_node
+        cur_node := link[cur_node];
+        // fill in the group number for index_pos
+        // override previous memory location in link with the group_num
+        group[t] := group_num;  // group[index[index[pos]] or V[I[i]]
+
+        inc(index_pos);
+        inc(group_size); // inc(link_count[head_pos]);
+      until (cur_node = -1);
+
+      // fill in the group size in size[group_num]
+      size[group_num] := group_size;
+      //size[group_num] := link_count[head_pos];
+
+      //inc(head_pos);
+    end;
+  end;
+
+  //index_head^[head_pos] := -1;
+
+
+  // init the virtual smallest character
+  block[block_length] := 0;
+  index[0] := block_length;
+  size[0] := -1;          // sorted, 1 char only
+  group[index[0]] := 0;   // first group}
+end;
+
+{Notes:
+group and index init from 1 to block_size
+0 is the virtual smallest char. compare with index[0]=block_size should
+be greater. note that index[0] may not contain block_size}
+procedure TFastSorter.SortGroup(const stlo, sthi, depth: integer);
+
+  {Swap - swaps 2 values v1 and v2 }
+  procedure Swap(var v1, v2: longword); overload;
+  var
+    t: longword;
+  begin
+    t := v1;
+    v1 := v2;
+    v2 := t;
+  end;
+
+  {Swap - swaps 2 values v1 and v2 }
+  procedure Swap(var v1, v2: longint); overload;
+  var
+    t: longword;
+  begin
+    t := v1;
+    v1 := v2;
+    v2 := t;
+  end;
+
+  {Vector swap}
+  procedure VecSwap(p1, p2, n: longword);
+  {var
+    t: longword;}
+  begin
+    while (n > 0) do
+    begin
+      {Swap p1, p2}
+      {t := p1;
+      p1 := p2;
+      p2 := t;}
+      Swap(index[p1], index[p2]);
+
+      inc(p1); inc(p2); dec(n);
+    end;
+  end;
+
+  {Median of 3}
+  function Med3(a, b, c: byte): byte; overload;
+  var
+    t: byte;
+  begin
+    if (a > b) then
+    begin
+      {Swap a, b}
+      t := a; a := b; b := t;
+    end;
+    if (b > c) then
+    begin
+      {Swap b, c}
+      t := b;
+      b := c;
+      c := t;
+    end;
+    if (a > b) then b := a;
+    result := b;
+  end;
+
+  function Min(a, b: integer): integer;
+  begin
+    if (a < b) then
+      result := a
+    else
+      result := b;
+  end;
+
+  function Med3(a, b, c: longword): longword; overload;
+  var
+    t: longword;
+  begin
+    if (a > b) then
+    begin
+      {Swap a, b}
+      t := a; a := b; b := t;
+    end;
+    if (b > c) then
+    begin
+      {Swap b, c}
+      t := b;
+      b := c;
+      c := t;
+    end;
+    if (a > b) then b := a;
+    result := b;
+  end;
+
+  function Med3(a, b, c: integer): integer; overload;
+  var
+    t: integer;
+  begin
+    if (a > b) then
+    begin
+      {Swap a, b}
+      t := a; a := b; b := t;
+    end;
+    if (b > c) then
+    begin
+      {Swap b, c}
+      t := b;
+      b := c;
+      c := t;
+    end;
+    if (a > b) then b := a;
+    result := b;
+  end;
+
+  {function NormIdx(idx: integer): integer;
+  begin
+    repeat
+      if (idx > last_index) then
+        dec(idx, last_index)
+      else
+      begin
+        result := idx;
+        exit;
+      end;
+    until false;
+  end;}
+
+  procedure QSort3(lo, hi: integer);
+  {lo, hi: first and last element
+  Note: we will compare group numbers
+  the depth of comparison is constant througout the recursion}
+  var
+    a, b, c, d: integer; // may become negative?
+    r: integer;
+    med: integer; // byte
+    i, group_num: integer;
+  begin
+    if (hi-lo < 1) then
+    begin
+      // 1 item only. assign it a group
+      if (hi = lo) then
+      begin
+        group[index[hi]] := hi;
+        size[hi] := 1;
+      end;
+      exit;
+    end;
+
+    med := Med3(group[index[lo] + depth],
+                group[index[hi] + depth],
+                group[index[(lo + hi) shr 1] + depth]);
+
+
+    a := lo;
+    b := lo;
+    c := hi;
+    d := hi;
+
+    while true do
+    begin
+
+      { = < }
+      { find item greater than med, while swapping equal items to the left }
+      while (b <= c) and (group[index[b] + depth] <= med) do
+      begin
+        if (group[index[b] + depth] = med) then
+        begin
+          Swap(index[a], index[b]);
+          inc(a);
+        end;
+        inc(b);
+      end;
+
+      { > = }
+      { find item smaller than med, while swapping equal items to the right }
+      while (b <= c) and (group[index[c] + depth] >= med) do
+      begin
+        if (group[index[c] + depth] = med) then
+        begin
+          Swap(index[c], index[d]);
+          dec(d);
+        end;
+        dec(c);
+      end;
+
+      if (b > c) then break;
+
+      // swap b and c
+      Swap(index[b], index[c]);
+      inc(b);
+      dec(c);
+    end;
+
+    {b = c+1 once we are out}
+    Assert(b = c+1);
+    //if b <> (c+1) then ShowMessage('bc');
+
+    {final arrangment:
+    lo  a  c  b  d  hi
+    d is next avail pos. d+1 to hi: = items
+    a is next avail pos. lo to a-1: = items}
+
+    {left centre right}
+
+    {swap enough to get left from '= <' to '< ='
+    a-lo: num of = items
+    b-a: num of < items
+    r gives the min items to swap}
+    r := min(a-lo, b-a);
+    VecSwap(lo, b-r, r);
+
+    {swap enough to get right from '> =' to '= >'
+    d-c: num of > items
+    hi-d: num of = items}
+    r := min(d-c, hi-d);
+    VecSwap(b, hi-r+1, r);
+
+    // sort from higher to lower
+    // for equal items update their group numbers to the same group
+
+    r := d-c;                          // num of '>' items
+    QSort3(hi-r+1, hi);  // sort right
+
+    r := (a-lo) + (hi-d);
+    {QSort3(lo+b-a, lo+b-a+r-1);      // sort middle}
+    group_num := lo+b-a;
+    for i := lo+b-a to lo+b-a+r-1 do   // give the '=' items the same group number
+      group[index[i]] := group_num;
+    size[group_num] := r;
+
+    r := b-a;                          // size of '<' items
+    QSort3(lo, lo + r - 1);     // sort left
+
+  end; {QSort3}
+
+begin
+  QSort3(stlo, sthi);
+end;
+
+procedure TFastSorter.SadaSort;
+var
+  i, k: integer;
+  first_i: integer;
+  group_size: integer;
+
+begin
+  // sort unsorted groups
+  // go through the size array. anything with size 1 we ignore and add to the
+  // previous group size
+  // if first_i = -1 that means first_i not avail and next sorted group can
+  // be first_i
+
+  // blocksize has increased by 1 because of the vitual char
+  inc(block_length);
+
+  // keep sorting until all has been sorted
+  k := 2;
+  while (abs(size[0]) < (block_length-1)) do
+  begin
+    i := 0;//i := abs(size[0]);
+    first_i := -1;
+
+    repeat
+
+      if (size[i] < 0) then
+      begin
+        if (first_i = -1) then
+        begin
+          first_i := i; // we can add further sorted groups to this group
+          inc(i, abs(size[i])); // skip this group
+        end
+        else
+        begin
+          Assert(size[first_i] < 0);
+          inc(size[first_i], size[i]); // add to the first_i
+          inc(i, abs(size[i]));        // skip, because it is sorted and group has been combined
+        end;
+      end
+      else if (size[i] = 1) then
+      begin
+        if (first_i = -1) then
+        begin
+          first_i := i; // we can add further sorted groups to this group
+          size[first_i] := -1;  // make this the head sorted group
+        end
+        else
+        begin
+          Assert(size[first_i] < 0);
+          dec(size[first_i]);   // add this group to the first_i
+        end;
+        inc(i);
+      end
+      else
+      begin
+        // group size > 1 sort it
+        group_size := size[i];
+        SortGroup(i, i + size[i]-1, k);
+
+        inc(i, group_size); // size[i] may change after sort group
+        first_i := -1;
+      end;
+    until (i >= block_length);  // while (i < block_length-1)
+
+    k := k * 2;
+  end;
+
+end;
+
+
+end.
+

Component/FileStrucAriDecoderUnit.pas

@@ -0,0 +1,149 @@
+unit FileStrucAriDecoderUnit;
+{-------------------------------------------------------------------------------
+File Structured Arithmetic Decoder Unit
+---------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  Desc:
+  Derives from Structured arithmetic decoder to allow it to write to files.
+  Handles the input from the archive file by implementing InputBit/InputBits.
+
+  To use:
+  Create the class.
+  Call DecodeBlock.
+  Free.
+
+
+  DecodeBlock
+  Wrapper proc.
+  Decode from file to block. returns the block length in block_length.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses Classes,
+     StructsUnit,
+     StrucAriDecoderUnit, GroupAriModelUnit, ArchiveFileUnit;
+
+type
+  TFileStrucAriDecoder = class(TStrucAriDecoder)
+  protected
+    ArchiveFile: TArchiveFile;
+    function  InputBit: byte; override;
+    function  InputBits( count: byte ): longint; override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure DecodeBlock(_ArchiveFile: TArchiveFile; block: PBlock; var block_length: integer);
+  end;
+
+(**) implementation (**)
+
+constructor TFileStrucAriDecoder.Create;
+begin
+  inherited Create;
+end;
+
+destructor TFileStrucAriDecoder.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function  TFileStrucAriDecoder.InputBit: byte;
+begin
+  result := ArchiveFile.InputBit;
+end;
+
+function  TFileStrucAriDecoder.InputBits( count: byte ): longint;
+begin
+  result := ArchiveFile.InputBits(count);
+end;
+
+procedure TFileStrucAriDecoder.DecodeBlock(_ArchiveFile: TArchiveFile; block: PBlock; var block_length: integer);
+var
+  i, j: longint;
+  symbol: integer;
+  mask: integer;
+  run_length: integer;
+
+begin
+  ArchiveFile := _ArchiveFile;
+  ArchiveFile.BeginBitReadAccess;
+  StartDecoding;
+
+  i := 0;
+  DecodeSymbol(symbol);
+  while (symbol <> EOF_SYMBOL) do
+  begin
+    {Convert the symbols to ascii
+     symbols 0 and 1 represent runs of 0s.
+     symbols 2 - 256 represent ascii 1-255 repectively.
+     symbol 257 is the EOB}
+
+
+    if (symbol <= 1) then
+    begin
+
+      {expand runs}
+      {successive 0s have weights 1, 2, 4,  8, 16, ..., while
+       successive 1s have weights 2, 4, 8, 16, 32, ... .}
+
+      {read in symbols and get run length.
+      start off with the currently read symbol}
+      run_length := 0;
+      mask := 1;
+      repeat
+        if (symbol = 0) then
+          inc(run_length, mask)
+        else
+          inc(run_length, (mask shl 1));
+
+        mask := mask shl 1;
+
+        DecodeSymbol(symbol);
+      until (symbol > 1) or (symbol = EOF_SYMBOL);
+
+      {expand run and update i}
+      for j := 1 to run_length do
+      begin
+        block^[i] := 0;
+        inc(i);
+      end;
+
+
+      {DEBUG: Test no run expansion.
+       1 should not appear because MTF_1 is symbol_2}
+      {Assert(symbol <> 1, 'No run expansion but symbol_1 appeared.');
+      block^[i] := 0;
+      DecodeSymbol(symbol);
+      inc(i);}
+
+      {symbol has been filled with a value greater than 1 or it is EOF_SYMBOL
+       i is positioned to the next pos to fill}
+    end
+    else
+    begin
+      {decrement symbol value by 1 to get the ascii}
+      block^[i] := byte(symbol-1);
+      inc(i);
+      DecodeSymbol(symbol);
+    end;
+
+  end;
+
+
+  block_length := i;
+
+  {DEBUG: If there is no run_length compression, then the block_length should be
+  blocksize for all except the last block.}
+  //Assert(block_length = BLOCKSIZE, 'block_length <> BlockSize');
+
+  DoneDecoding;
+  ArchiveFile.EndBitReadAccess;  
+end;
+
+
+end.

Component/FileStrucAriEncoderUnit.pas

@@ -0,0 +1,165 @@
+unit FileStrucAriEncoderUnit;
+{-------------------------------------------------------------------------------
+File Structured Arithmetic Encoder Unit
+---------------------------------------
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+  Desc:
+  Derives from Structured arithmetic encoder to allow it to write to files.
+  Handles the output to the archive file by implementing OutputBit/OutputBits.
+
+  procedure EncodeBlock(block: PBlock; block_length: integer);
+  Encodes the block with block length block_length.
+  Will encode the block with an EOF symbol trailing.
+
+
+  To Use:
+  Create it.
+  Call EncodeBlock
+  Free.
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses Classes, dialogs,
+     // general
+     StructsUnit,
+     // base class
+     StrucAriEncoderUnit, GroupAriModelUnit, ArchiveFileUnit, BitStreamUnit;
+
+
+type
+  TFileStrucAriEncoder = class(TStrucAriEncoder)
+  protected
+    ArchiveFile: TArchiveFile;  // required by OutputBit
+    procedure OutputBit(bit: byte); override;
+    procedure OutputBits(code: longint; count: byte); override;
+
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure EncodeBlock(_ArchiveFile: TArchiveFile; block: PBlock; block_length: integer);
+  end;
+
+
+(**) implementation (**)
+
+constructor TFileStrucAriEncoder.Create;
+begin
+  inherited Create;
+  //ArchiveFile := _ArchiveFile;
+end;
+
+destructor TFileStrucAriEncoder.Destroy;
+begin
+  //ArchiveFile.ResetBuffer;
+  inherited Destroy;
+end;
+
+procedure TFileStrucAriEncoder.OutputBit(bit: byte);
+begin
+  ArchiveFile.OutputBit(bit);
+end;
+
+procedure TFileStrucAriEncoder.OutputBits(code: longint; count: byte);
+begin
+  ArchiveFile.OutputBits(code, count);
+end;
+
+procedure TFileStrucAriEncoder.EncodeBlock(_ArchiveFile: TArchiveFile; block: PBlock; block_length: integer);
+var
+  i, j: longint;
+  run_length: integer;
+  mask, num_bits: integer;
+begin
+  ArchiveFile := _ArchiveFile;
+  ArchiveFile.BeginBitWriteAccess;
+  StartEncoding;
+  i := 0;
+  while (i < block_length) do
+  begin
+    {DEBUG panick case: plain encode}
+    //EncodeSymbol(block^[i]);
+
+    {Convert the ascii to symbols.
+     symbols 0 and 1 represent runs of 0s.
+     symbols 2 - 256 represent ascii 1-255 repectively.
+     symbol 257 is the EOB}
+
+
+    if (block^[i] = 0) then
+    begin
+      {Wheeler's run length coding.
+       convert to runs of 0s
+       Algo: Count run_length, or number of 0s (run length includes init byte
+             Increment run_length by one
+             Ignore most significant one bit and encode run_length
+             as ordinary binary number}
+
+
+      {count run length and inc i. min run_length will be 1}
+      run_length := 0;
+      repeat
+        inc(i);
+        inc(run_length);
+      until (i >= block_length) or (block^[i] <> 0);
+      //if (i > block_length) then ShowMessage('Hello');
+
+      {increment by 1}
+      inc(run_length);
+
+      {find the most significant 1 bit and count the number of bits
+      to output in num_bits}
+      num_bits := 32;
+      mask := 1 shl 31;
+      while (run_length and mask = 0) do
+      begin
+        mask := mask shr 1;
+        dec(num_bits);
+      end;
+
+      {ignore most significant 1 bit}
+      dec(num_bits);
+
+      {output the number as an ordinary binary number from the lsb}
+      mask := 1;
+      for j := 1 to num_bits do
+      begin
+        if (run_length and mask <> 0) then
+          EncodeSymbol(1)
+        else
+          EncodeSymbol(0);
+
+        mask := mask shl 1;
+      end;
+
+
+      {DEBUG: Test no run length coding. code 0s directly.
+              The value 1 should not appear at all}
+      {EncodeSymbol(0);
+      inc(i);}
+
+      {i will have been set to the next character during the run_length count}
+    end
+    else
+    begin
+      {increment the ascii by 1 to get the symbol}
+      EncodeSymbol(block^[i]+1);
+      inc(i);
+    end;
+
+  end; {While}
+
+  EncodeSymbol(EOF_SYMBOL);
+  DoneEncoding;
+  ArchiveFile.EndBitWriteAccess;
+end;
+
+
+
+end.

Component/GroupAriModelUnit.pas

@@ -0,0 +1,352 @@
+unit GroupAriModelUnit;
+{-------------------------------------------------------------------------------
+Group Arithmetic Model Unit
+---------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  The Arithmetic model for the structured arithmetic encoder and decoder.
+
+  Desc:
+  There are 9 groups.
+  Each group handles a group of characters. Each group size is different.
+  The EOF symbol is in the last group.
+
+  Each group is a TGroupAriModel and handles a range of characters.
+  The range is between ch_lo and ch_hi inclusive.
+  Within each group the symbol may be mapped to another value. This value
+  is called the group symbol.
+
+  The main group handles the probability that each group would appear. It is
+  also a TGroupAriModel class.
+
+  There are therefore 3 levels of symbols:
+  symbol, group number, group symbol
+
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+const
+  NUM_GROUPS = 9;
+type
+  TGroupIntArray = array[0..NUM_GROUPS-1] of integer;
+const
+  ROOT_LIMIT = 4096;
+  ROOT_INCREMENT = 32;
+  GROUP_INCREMENT = 1;
+
+  // leaf group info
+                             {0  1  2-3 4-7 8-15 16-31 32-63 64-127 128-256}
+  grpStart: TGroupIntArray = (0, 1,   2,  4,   8,   16,   32,    64,    128);
+  grpLast : TGroupIntArray = (0, 1,   3,  7,  15,   31,   63,   127,    257);
+  grpLimit: TGroupIntArray = (0, 0, 256,256, 128, 1024, 2048,  4096,   8192);
+
+  {0: Run MTF_0
+   1: Run MTF_0
+   2: MTF_1
+   3: MTF_2
+   ...
+   256: MTF_255
+   257: EOF
+  }
+
+  {grpStart: TGroupIntArray = (0, 1,   2,  4,   6,   8,   76,    136,    196);
+  grpLast : TGroupIntArray = (0, 1,   3,  5,  7,   75,   135,   195,    257);
+  grpLimit: TGroupIntArray = (0, 0, 256,256, 256, 1024, 1024,  1024,   1024);}
+
+
+const
+  EOF_SYMBOL = 257;
+  MAX_SYMBOL_COUNT = 300;
+
+  // constants used for encoding/decoding
+  CODE_VALUE_BITS = 16;
+  TOP_VALUE = (1 SHL CODE_VALUE_BITS) -1;
+
+  FIRST_QTR = (TOP_VALUE DIV 4) + 1;
+  HALF = 2 * FIRST_QTR;
+  THIRD_QTR = 3 * FIRST_QTR;
+
+
+type
+  TCumFreq = array[0..MAX_SYMBOL_COUNT] of integer;
+
+  TGroupAriModel = class
+  private
+  protected
+    num_chars, num_symbols: integer;    // number of members and symbols in the group
+    max_freq: integer;                  // max count before scaling
+    increment: integer;                 // increment the frequancy for each occurence
+    char_to_index: array[0..MAX_SYMBOL_COUNT] of integer;
+    index_to_char: array[0..MAX_SYMBOL_COUNT] of integer;
+
+    procedure StartModel;
+  public
+    ch_lo, ch_hi: integer;              // range of chars the group handles
+    freq: array[0..MAX_SYMBOL_COUNT] of integer;
+    cum_freq: TCumFreq;
+
+    constructor Create(new_ch_lo, new_ch_hi, new_max_freq, new_increment: integer);
+    procedure UpdateModel(Symbol: integer);
+
+    function SymbolToIndex(const symbol: integer): integer;
+    function IndexToSymbol(const index: integer): integer;
+    function IndexToChar(const index: integer): byte;
+  end;
+
+
+  THeadAriModel = class
+  private
+    symbol_to_group_num: array[0..MAX_SYMBOL_COUNT] of integer;
+
+  public
+    MainAriModel: TGroupAriModel;                            // main AriModel
+    AriModelList: array[0..NUM_GROUPS-1] of TGroupAriModel;  // AriModel for each group
+
+    constructor Create;
+    destructor Destroy; override;
+
+    function GetGroupNum(const symbol: integer): integer;
+    procedure GetSymbolInfo(const symbol: integer;
+                            var AriModel: TGroupAriModel;
+                            var symbol_index: integer);
+
+    procedure GetGroupSymbolInfo(const group_symbol, group_num: integer;
+                                 var AriModel: TGroupAriModel;
+                                 var symbol_index: integer);
+
+    function HasResidue(group_num: integer): boolean;
+    function SymbolToGroupSymbol(symbol: integer; group_num: integer): integer;
+    function GroupSymbolToSymbol(group_symbol: integer; group_num: integer): integer;
+  end;
+
+(**) implementation (**)
+
+(*******************************************************************************
+  THeadAriModel
+*******************************************************************************)
+
+constructor THeadAriModel.Create;
+var
+  i, j: integer;
+begin
+  inherited Create;
+
+  // create the main group that handles the frequancies of the groups appearing
+  MainAriModel := TGroupAriModel.Create(0, NUM_GROUPS-1, ROOT_LIMIT, ROOT_INCREMENT);
+
+  // create the arithmetic model for the various groups
+  AriModelList[0] := nil;
+  AriModelList[1] := nil;
+  for i := 2 to 8 do
+    AriModelList[i] := TGroupAriModel.Create(grpStart[i], grpLast[i], grpLimit[i], GROUP_INCREMENT);
+
+  // init the symbol_to_group_num mapping array
+  for i := 0 to 8 do
+    for j := grpStart[i] to grpLast[i] do
+      symbol_to_group_num[j] := i;
+end;
+
+destructor THeadAriModel.Destroy;
+var
+  i: integer;
+begin
+  for i := 2 to 8 do
+    AriModelList[i].Free;
+  inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------
+  GetGroupNum
+  -----------
+  returns a group number/root symbol
+  Get the root symbol's info using GetRootSymbolInfo
+-------------------------------------------------------------------------------}
+function THeadAriModel.GetGroupNum(const symbol: integer): integer;
+begin
+  result := symbol_to_group_num[symbol];
+end;
+
+{-------------------------------------------------------------------------------
+  GetRootSymbolInfo
+  -----------------
+  returns the root symbol information
+-------------------------------------------------------------------------------}
+procedure THeadAriModel.GetSymbolInfo(const symbol: integer;
+                                      var AriModel: TGroupAriModel;
+                                      var symbol_index: integer);
+begin
+  AriModel := MainAriModel;
+  symbol_index := AriModel.SymbolToIndex(symbol);
+end;
+
+{-------------------------------------------------------------------------------
+  GetGroupSymbolInfo
+  -----------------
+  returns the leaf symbol info from a leaf symbol
+  Obtain leaf_symbol using SymbolToGroupSymbol
+-------------------------------------------------------------------------------}
+procedure THeadAriModel.GetGroupSymbolInfo(const group_symbol, group_num: integer;
+                                           var AriModel: TGroupAriModel;
+                                           var symbol_index: integer);
+begin
+  AriModel := AriModelList[group_num];
+  symbol_index := AriModel.SymbolToIndex(group_symbol);
+end;
+
+
+{-------------------------------------------------------------------------------
+  HasResidue
+  ----------
+  returns true if the group has members.
+-------------------------------------------------------------------------------}
+function THeadAriModel.HasResidue(group_num: integer): boolean;
+begin
+  HasResidue := (group_num > 1);
+end;
+
+function THeadAriModel.SymbolToGroupSymbol(symbol: integer; group_num: integer): integer;
+begin
+  result := symbol - AriModelList[group_num].ch_lo;
+end;
+
+function THeadAriModel.GroupSymbolToSymbol(group_symbol: integer; group_num: integer): integer;
+begin
+  result := AriModelList[group_num].ch_lo + group_symbol;
+end;
+
+
+(*******************************************************************************
+  TGroupAriModel
+*******************************************************************************)
+
+Constructor TGroupAriModel.Create;
+begin
+  inherited Create;
+
+  ch_lo := new_ch_lo;
+  ch_hi := new_ch_hi;
+  num_chars := ch_hi - ch_lo + 1;
+  num_symbols := num_chars + 1;
+  max_freq := new_max_freq;
+  increment := new_increment;
+
+  StartModel;
+end;
+
+function TGroupAriModel.SymbolToIndex(const symbol: integer): integer;
+begin
+  result := char_to_index[symbol];
+end;
+
+function TGroupAriModel.IndexToSymbol(const index: integer): integer;
+begin
+  result := index_to_char[index];
+end;
+
+function TGroupAriModel.IndexToChar(const index: integer): byte;
+var
+  r: integer;
+begin
+  r := IndexToSymbol(index);
+  if (r <= 255) then
+    result := r
+  else
+    result := 0;
+end;
+
+{-------------------------------------------------------------------------------
+  StartModel
+  ----------
+  initialises variables
+
+  Notes:
+  The index corresponds to the frequancy. They start from 1.
+  freq[0] is just a dummy value.
+-------------------------------------------------------------------------------}
+procedure TGroupAriModel.StartModel;
+var
+  i: integer;
+begin
+  for i := 0 to num_chars-1 do
+  begin
+    char_to_index[i] := i + 1;
+    index_to_char[i+1] := i;
+  end;
+
+  // initialise frequancies and the cum_freq
+  for i := 0 to num_symbols do
+  begin
+    freq[i] := 1;
+    cum_freq[i] := num_symbols-i;
+  end;
+
+  // the frequancy for 0 and 1 cannot be equal (see UpdateModel)
+  freq[0] := 0;
+end;
+
+{-------------------------------------------------------------------------------
+  UpdateModel
+  -----------
+  updates the model for the Symbol
+
+  Desc:
+  Keeps the symbols in sorted order according to frequancy. This allows
+  the more frequantly appearing symbols to be found and encoded faster.
+
+  Notes:
+  The cumulative frequancy is stored upside down. The total is in cum_freq[0].
+  The moost frequantly upated symbols are stored to the front.
+-------------------------------------------------------------------------------}
+procedure TGroupAriModel.UpdateModel(Symbol: integer);
+var
+  i, cum: integer;
+  ch_i, ch_symbol: integer;
+begin
+
+  // scale down if over the max_freq count
+  if (cum_freq[0] >= max_freq) then
+  begin
+    cum := 0;
+    for i := num_symbols downto 0 do
+    begin
+      freq[i] := (freq[i] + 1) div 2;
+      cum_freq[i] := cum;
+      inc(cum, freq[i]);
+    end;
+  end;
+
+  // search for the next position to place the symbol
+  // the next position is the position where freq[i-1] > freq[i] 
+  i := symbol;
+  while (freq[i] = freq[i-1]) do dec(i);
+
+  // update the translation tables if the symbol has moved
+  if (i < symbol) then
+  begin
+    ch_i := index_to_char[i];
+    ch_symbol := index_to_char[symbol];
+    index_to_char[i] := ch_symbol;
+
+    index_to_char[symbol] := ch_i;
+    char_to_index[ch_i] := symbol;
+    char_to_index[ch_symbol] := i;
+  end;
+
+  // increment the frequancy count for the symbol
+  // update the cumulative frequancy for the other symbols in front of it
+  inc(freq[i], increment);
+  while (i > 0) do
+  begin
+    dec(i);
+    inc(cum_freq[i], increment);
+  end;
+
+end;
+
+
+end.

Component/MTFBaseUnit.pas

@@ -0,0 +1,94 @@
+unit MTFBaseUnit;
+{-------------------------------------------------------------------------------
+Move To Front Base Class
+------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  The MTF is derived from Peter Fenwick's implementation.
+
+  Desc:
+  We work with two arrays --
+    image contains an image of the MTF list, most recent in posn 0
+    map contains the position of the chars in image.
+
+    MTFDest has been removed.
+
+    This is done so that searching for the character is faster.
+    e.g. search for 'c', look up index 2 in map to get its position.
+    Then move it to the front by shifting all chars before it in the image
+    one step up. Update the map accordingly.
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses StructsUnit;
+
+const
+  NumSym = 256;
+
+type
+  TMTFBase = class
+  protected
+    map: array[0..NumSym-1] of byte;     // index of a character
+    image: array[0..NumSym-1] of byte;   // chars in MTF order
+    procedure MoveToFront(const s:byte);
+
+  public
+    constructor Create;
+    procedure Init;
+  end;
+
+(**) implementation (**)
+
+(*******************************************************************************
+  TMTFBase
+*******************************************************************************)
+
+constructor TMTFBase.Create;
+begin
+  inherited Create;
+end;
+
+procedure TMTFBase.Init;
+var
+  i: byte;
+begin
+  for i := 0 to NumSym-1 do
+  begin
+    image[i] := i;
+    map[i] := i;
+  end;
+end;
+
+{-------------------------------------------------------------------------------
+  MoveToFront
+  -----------
+  Move symbol s to the front
+-------------------------------------------------------------------------------}
+
+procedure TMTFBase.MoveToFront(const s:byte);
+var
+  i: byte;
+begin
+  if (map[s] <> 0) then
+  begin
+
+    {Move everything before s in image up one step.
+    update the maps accordingly}
+    for i := map[s] downto 1 do
+    begin
+      image[i] := image[i-1];
+      map[image[i]] := i;
+    end;
+
+    {s is moved to the front}
+    image[0] := s;
+    map[s] := 0;
+  end;
+end;
+
+
+
+end.

Component/MTFDecoderUnit.pas

@@ -0,0 +1,93 @@
+unit MTFDecoderUnit;
+{-------------------------------------------------------------------------------
+Move To Front Decoder
+---------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+  
+  Notes: For manual decoding, call init then decode.
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses StructsUnit, MTFBaseUnit;
+
+type
+  TMTFDecoder = class(TMTFBase)
+  public
+    function Decode(const posn: byte): byte;
+    {procedure DecodeBlock(const inblock, outblock: PBlock; const block_length: longint);
+    procedure DecodeBlockWithVirtualChar(const inblock, outblock: PBlock; var block_length: longint; const virtual_char_index: longint);}
+  private
+  end;
+
+
+(**) implementation (**)
+uses ErrorUnit;
+
+////////////////////////////////////////////////////////////////////////////////
+// TMTFDecoder
+////////////////////////////////////////////////////////////////////////////////
+
+{-------------------------------------------------------------------------------
+  Decode
+  ------
+  given its position posn, return a symbol and update the decoder
+-------------------------------------------------------------------------------}
+
+function TMTFDecoder.Decode(const posn: byte): byte;
+begin
+  result := image[posn];
+  MoveToFront(result);
+end;
+
+(*
+procedure TMTFDecoder.DecodeBlock;
+var
+  i: longint;
+begin
+  for i := 0 to block_length-1 do
+    outblock^[i] := Decode(inblock^[i]);
+end;
+
+procedure TMTFDecoder.DecodeBlockWithVirtualChar(const inblock, outblock: PBlock; var block_length: longint; const virtual_char_index: longint);
+var
+  i, j: longint;
+begin
+  // Error Check. virtual_char_index < block_length
+  if (virtual_char_index > block_length) then
+  begin
+    ShowError('Warning: Virtual char index wrong.');
+    exit;
+  end;
+
+  // i: outblock index
+  // j: inblock index
+  i := 0;
+  j := 0;
+
+  while (i < virtual_char_index) do
+  begin
+    outblock[i] := Decode(inblock[j]);
+    inc(i);
+    inc(j);
+  end;
+
+  inc(i);  // leave one char in outblock for virtual char
+
+  while (j < block_length) do
+  begin
+    outblock[i] := Decode(inblock[j]);
+    inc(i);
+    inc(j);
+  end;
+
+
+  // add one to the block length because the virtual char was added
+  // outblock is now 1 char greater
+  inc(block_length);
+end;
+*)
+
+end.

Component/MTFEncoderUnit.pas

@@ -0,0 +1,50 @@
+unit MTFEncoderUnit;
+{-------------------------------------------------------------------------------
+Move To Front Encoder
+---------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses StructsUnit, MTFBaseUnit;
+
+type
+  TMTFEncoder = class(TMTFBase)
+  public
+    procedure EncodeBlock(const inblock, outblock: PBlock; const block_length: longint);
+    function Encode(const s: byte): byte;
+  private
+  end;
+
+
+(**) implementation (**)
+
+////////////////////////////////////////////////////////////////////////////////
+// TMTFEncoder
+////////////////////////////////////////////////////////////////////////////////
+
+{-------------------------------------------------------------------------------
+  Encode
+  ------
+  Return symbol's current position then move it to the front
+-------------------------------------------------------------------------------}
+
+function TMTFEncoder.Encode(const s: byte): byte;
+begin
+  result := map[s];
+  MoveToFront(s);
+end;
+
+procedure TMTFEncoder.EncodeBlock;
+var
+  i: longint;
+begin
+  for i := 0 to block_length-1 do
+    outblock^[i] := Encode(inblock^[i]);
+end;
+
+
+end.

Component/RLEUnit.pas

@@ -0,0 +1,325 @@
+unit RLEUnit;
+{-------------------------------------------------------------------------------
+Run Length Encoder Unit
+-----------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  Desc:
+  This is the run length encoder for preprocessing the file before the sorting
+  phase.
+
+  Naming convention notes:
+  ix: input index
+  oix: output index
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses StructsUnit;
+
+const
+  {RunThreshold number of bytes signifies the start of a run.
+  4 = 4 + 0
+  5 = 4 + 1
+  6 = 4 + 1 bytes
+  4 will expand to 5 bytes, 5 will retain, 6 will compress to 5 bytes}
+  RUN_THRESHOLD = 100;
+
+type
+  TRunLengthEncoder = class
+  private
+    in_block, out_block: PBlock;
+    block_length: longint;               // in_block length
+    oix: longint;                        // index into out_block
+    run_length: longint;                 // current run count
+    last_symbol: byte;                   // the symbol that has a run
+
+    procedure PutByte(const b: byte);
+    procedure PutRunCount;
+  public
+    procedure EncodeBlock(_in_block, _out_block: PBlock; _block_length: longint;
+                          var out_block_length: longint);
+
+  end;
+
+
+
+  TRunLengthDecoder = class
+    in_block, out_block: PBlock;
+    block_length: longint;                 // length of in_block
+    ix, oix: longint;                      // index into input and output block
+
+    function GetRunCount: longint;
+    procedure ExpandRun;
+  public
+    procedure DecodeBlock(_in_block, _out_block: PBlock; _block_length: longint;
+                          var out_block_length: longint);
+  end;
+
+
+(**) implementation (**)
+
+
+
+////////////////////////////////////////////////////////////////////////////////
+// Run Length Encoder
+////////////////////////////////////////////////////////////////////////////////
+
+{-------------------------------------------------------------------------------
+  PutByte
+  -------
+  output a byte to out_block and increment the output index (oix)
+-------------------------------------------------------------------------------}
+procedure TRunLengthEncoder.PutByte(const b: byte);
+begin
+  out_block^[oix] := b;
+  inc(oix);
+end;
+
+{-------------------------------------------------------------------------------
+  PutRunCount
+  -----------
+
+  Desc:
+  The count is encoded in as many 6 bit codes as needed, up to a max of 30 bits.
+  The 7th bit is set if more codes follow.
+  The most significant 6 bits are transmitted first.
+-------------------------------------------------------------------------------}
+procedure TRunLengthEncoder.PutRunCount;
+var
+  d: byte;
+  bits_shift: shortint;
+  must_put: boolean;
+begin
+  // Start by getting bits 25-30, then 19-24, 13-19 etc.
+  // if a bigger value was set eg. 25-30, then the rest of the values must be
+  // put although they may be 0
+  dec(run_length, RUN_THRESHOLD);
+  bits_shift := 24;
+  must_put := false;
+  repeat
+    d := ((run_length shr bits_shift) and $3F);
+
+    if (d > 0) or must_put then
+    begin
+      d := d or $40;
+      PutByte(d);
+      must_put := true;
+    end;
+    dec(bits_shift, 6);
+  until (bits_shift = 0);
+
+  // Put last byte (terminator) without the 7th bit set
+  d := (run_length and $3F);
+  PutByte(d);
+end;
+
+{-------------------------------------------------------------------------------
+  EncodeBlock
+  -----------
+
+  Algo:
+  Maintain 2 index, ix and oix into the input and output block respectively.
+  curr_symbol: current symbol
+  1) Read curr_symbol from the block
+  2) If curr_symbol equals the previous symbol then
+     a) increase run count
+     ELSE
+     a) If it is the end of a run (run count > run threshold) then
+       i) output the run length
+       ii) reset run length
+  3) Only output the curr_symbol if the run length is below run threshold
+  4) Repeat (1)
+
+  Notes:
+  If the run goes all the way to the end of the block, we must output the
+  run length in the end.
+-------------------------------------------------------------------------------}
+procedure TRunLengthEncoder.EncodeBlock(_in_block, _out_block: PBlock; _block_length: longint;
+                                        var out_block_length: longint);
+
+
+  {
+    Initialize resets the variables to process a new block
+  }
+  procedure Initialize;
+  begin
+    out_block := _out_block;
+    in_block := _in_block;
+    block_length := _block_length;
+    oix := 0;
+  end;
+
+
+var
+  curr_symbol: byte;
+  ix: longint;
+begin
+  Initialize;
+
+  {Init out_block with the first byte in in_block}
+  run_length := 1;
+  last_symbol := in_block^[0];
+  PutByte(last_symbol);
+
+  for ix := 1 to block_length-1 do
+  begin
+    curr_symbol := in_block^[ix];
+
+    if (curr_symbol = last_symbol) then
+      inc(run_length)
+    else
+    begin
+      {A different symbol indicates an end of run}
+      if (run_length >= RUN_THRESHOLD) then
+        PutRunCount;
+      run_length := 1;
+    end;
+
+    if (run_length <= RUN_THRESHOLD) then
+      PutByte(curr_symbol);
+
+    last_symbol := curr_symbol;
+  end;
+
+  {If there were more than RunThreshold bytes at the end of the block,
+  then we must terminate the run at the end}
+  if (run_length >= RUN_THRESHOLD) then PutRunCount;
+
+
+  out_block_length := oix;
+end;
+
+
+
+
+////////////////////////////////////////////////////////////////////////////////
+// Run Length Decoder
+////////////////////////////////////////////////////////////////////////////////
+
+{-------------------------------------------------------------------------------
+  DecodeBlock
+  -----------
+  Decode a block.
+
+  Algo:
+  Maintain 2 indexes, ix and oix into the input and output block.
+  1) Read in a character
+  2) If the character is repeated, then increase run length
+  3) If run length hits run threshold, (a run length follows)
+     a) decode the run length
+     b) expand the run (fill output block with run length number of thbe char curr_symbol)
+     b) reset run length to zero
+  4) Repeat (1)
+
+  Notes:
+  We start counting from index 1 so that previous char is init to the char at
+  index 0.
+-------------------------------------------------------------------------------}
+procedure TRunLengthDecoder.DecodeBlock(_in_block, _out_block: PBlock; _block_length: longint;
+                                        var out_block_length: longint);
+
+
+  procedure Initialize;
+  begin
+    out_block := _out_block;
+    in_block := _in_block;
+    block_length := _block_length;
+  end;
+
+
+var
+  run_length: byte;
+  curr_symbol, last_symbol: byte;
+begin
+  Initialize;
+  run_length := 1;
+  last_symbol := in_block^[0];
+  out_block^[0] := last_symbol;
+
+  oix := 1;
+  ix := 1;
+  while (ix < block_length) do
+  begin
+    curr_symbol := in_block^[ix];
+    out_block^[oix] := curr_symbol;
+
+    inc(ix);        {The next index could point to a run length or another char}
+    inc(oix);
+
+    if (curr_symbol = last_symbol) then
+    begin
+      inc(run_length);
+      if (run_length = RUN_THRESHOLD) then
+      begin
+        ExpandRun;
+        run_length := 1;
+      end;
+    end
+    else
+      run_length := 1;
+
+    last_symbol := curr_symbol;
+  end; {while}
+
+  out_block_length := oix;
+end;
+
+{-------------------------------------------------------------------------------
+  GetRunCount
+  -----------
+  gets the run count by reading as many bits as necessary that represent the
+  run length. The run length is represented in 7 bits per byte.
+-------------------------------------------------------------------------------}
+function TRunLengthDecoder.GetRunCount: longint;
+var
+  count: longint;
+  b: byte;
+begin
+  count := 0;
+
+  repeat
+    b := in_block^[ix];
+    count := (count shl 6) or (b and $3F);  // extract last 6 bits from b
+    inc(ix);
+  until ((b and $40) = 0);                  // continue if 7th bit set
+
+  result := count;
+end;
+
+
+{-------------------------------------------------------------------------------
+  ExpandRun
+  ---------
+  Expand the run with length pointed to by ix.
+  ix-1 is the symbol used to expand.
+
+  GetRunCount will inc ix to get the run count.
+  ExpandRun itself will inc oix accordingly.
+
+  IN and OUT assertion:
+  ix and oix point to the next pos to input and output respectively.
+-------------------------------------------------------------------------------}
+procedure TRunLengthDecoder.ExpandRun;
+var
+  run_symbol: byte;
+  expand_count: longint;
+  expand_limit: longint;
+begin
+  run_symbol := in_block^[ix-1];
+  expand_count := GetRunCount;
+  expand_limit := oix + expand_count;
+
+  while (oix < expand_limit) do
+  begin
+    out_block^[oix] := run_symbol;
+    inc(oix);
+  end;
+
+end;
+
+
+end.

Component/ResourceCompUnit.pas

@@ -0,0 +1,317 @@
+unit ResourceCompUnit;
+{reSource Component Unit
+Component Front End for reSource Compression Engine
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+  USAGE:
+  Drop the component onto the form to use it.
+  Default name will be Resource1.
+  To perform any action on the archive, use Resource1.ArchiveMan (Archive Manager)
+
+  There are 2 ways to perform actions on archives:
+    Type 1: To deal directly with ArchiveMan.
+            This is the most efficient type and allows the fastest way to add/extract
+            multiple files from archive.
+    Type 2: Call CompressToFile, DecompressFromFile.
+            This wraps ArchiveMan and is simple to use if only dealing with one file.
+
+  ACTIONS: (Type 1)
+  Before doing any action, set the parameters for ArchiveMan
+    Resource1.ArchiveMan.TempDir := 'c:\temp';  // Set the Temporary Directory
+
+  To Open an Archive:
+    Resource1.ArchiveMan.OpenArchive(<ArchiveName>);
+
+  To Close the Archive:
+    Resource1.ArchiveMan.CloseArchive;
+
+  To Add files:
+    Resource1.ArchiveMan.AddFiles(FileList: TStrings; const infile_dir: string)
+    There are 2 ways to send the FileList
+      - If each entry in FileList has the full Path+Name, then infile_dir can be ''.
+      - If each entry in FileList is only the name, then infile_dir must contain
+        the path the files are in.
+
+  To Extract the file:
+    Before calling ExtractList, set the parameters for file extract:
+      Resource1.ArchiveMan.dest_dir := 'c:\mydir'; // destination dir for extract
+
+    Resource1.ArchiveMan.ExtractList(List: TList; var files_extracted, extracted_size: integer);
+
+    List is a TList of TCentralFileHeader.
+    The CentralFileHeader is gotten from Resource1.ArchiveMan.ArchiveFile.CentralDir[i],
+    where i is the index of the file.
+    So to add file index 2 to the extract list, call
+    List.Add(Resource1.ArchiveMan.ArchiveFile.CentralDir[2]);
+    Then call ExtractList(List, a, b)
+    The files_extracted and extracted_size are returned values.
+
+  To Delete files:
+    Resource1.ArchiveMan.DeleteFiles
+    All files that are flagged for deletion are removed.
+    To flag a file for delete, set the Delete property in its CentralFileHeader entry.
+    e.g. to delete file of index 2 and 5,
+      Resource1.ArchiveMan.ArchiveFile.CentralDir[2].Deleted := true; // flag
+      Resource1.ArchiveMan.ArchiveFile.CentralDir[5].Deleted := true; // flag
+      Resource1.ArchiveMan.DeleteFiles;                               // actual process
+
+
+      
+  EVENTS:
+  OnCentralDirChange
+    - called when Resource1.ArchiveMan.ArchiveFile.CentralDir changes.
+      use it to update the list of files in the archive.
+  OnAddLog (for debugging)
+    - called when ArchiveMan outputs verbose information on what it is doing.
+      mainly used for debugging.
+}
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  {CG}
+  ArchiveManagerUnit, ArchiveHeadersUnit, StructsUnit;
+
+type
+  TResource = class(TComponent)
+  private
+    {function GetOnShowStatusMsg: TStrEvent;
+    procedure SetOnShowStatusMsg(const Value: TStrEvent);}
+    function GetOnCentralDirChange: TNotifyEvent;
+    procedure SetOnCentralDirChange(const Value: TNotifyEvent);
+    function GetOnAddLog: TStrEvent;
+    procedure SetOnAddLog(const Value: TStrEvent);
+  protected
+    FArchiveMan: TArchiveManager;
+  public
+    property ArchiveMan: TArchiveManager read FArchiveMan;
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    {Wrapper for ArchiveMan.
+    To work on one file in one archive
+    NOTE:
+    - These do not require an archive to be opened. They can be called
+    'immediately'.
+    - Do not call ArchiveMan.OpenArchive when you use these procedures.
+    
+    See Help above for description.
+
+    CompressToArchive:
+    SourceFileNamePath - File to compress
+    ArchiveNamePath - Archive to add to.
+                      If it exists, the file will be Added to the existing archive.
+
+    DecompressFromArchive:
+    ArchiveNamePath - Full path to archive file
+    DestPath - Destination dir to extract files to
+    FileName - the name of the file to extract. Leave blank to extract all files (Default)
+    }
+    procedure CompressToArchive(SourceFileNamePath, ArchiveNamePath: string);
+    procedure DecompressFromArchive(ArchiveNamePath, DestPath: string; ExtractFileName: string = '');
+
+  published
+    property OnCentralDirChange: TNotifyEvent read GetOnCentralDirChange write SetOnCentralDirChange;
+    //property OnShowStatusMsg: TStrEvent read GetOnShowStatusMsg write SetOnShowStatusMsg;
+    property OnAddLog: TStrEvent read GetOnAddLog write SetOnAddLog;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('Compression', [TResource]);
+end;
+
+
+{ TResource }
+
+
+constructor TResource.Create(AOwner: TComponent);
+begin
+  inherited;
+  {if not (csDesigning in ComponentState) then
+  begin}
+    FArchiveMan := TArchiveManager.Create;
+  {end;}
+end;
+
+
+
+destructor TResource.Destroy;
+begin
+  if Assigned(FArchiveMan) then FArchiveMan.Free;
+  inherited;
+end;
+
+function TResource.GetOnAddLog: TStrEvent;
+begin
+  result := FArchiveMan.OnAddLog;
+end;
+
+function TResource.GetOnCentralDirChange: TNotifyEvent;
+begin
+  result := FArchiveMan.OnCentralDirChange;
+end;
+
+{function TResource.GetOnShowStatusMsg: TStrEvent;
+begin
+  result := FArchiveMan.OnShowStatusMsg;
+end;}
+
+procedure TResource.SetOnAddLog(const Value: TStrEvent);
+begin
+  FArchiveMan.OnAddLog := Value;
+end;
+
+procedure TResource.SetOnCentralDirChange(const Value: TNotifyEvent);
+begin
+  FArchiveMan.OnCentralDirChange := Value;
+end;
+
+{procedure TResource.SetOnShowStatusMsg(const Value: TStrEvent);
+begin
+  FArchiveMan.OnShowStatusMsg := Value;
+end;}
+
+{-------------------------------------------------------------------------------
+  CompressToArchive
+-------------------------------------------------------------------------------}
+procedure TResource.CompressToArchive(SourceFileNamePath,
+  ArchiveNamePath: string);
+var
+  FilesAdded: integer;
+  list: TStringList;
+begin
+  {Algorithm:
+   Open Archive
+   Add the file
+   Close Archive}
+  if ArchiveMan.IsArchiveOpen then
+  begin
+    {Error Check: Cannot use when Archive is opened.
+    We will open and close the Archive ourselves}
+    Application.MessageBox('reSource: ArchiveMan cannot be opened to use CompressToArchive',
+      'Error', MB_OK);
+    exit;
+  end;
+
+  { Step 1: Open Archive }
+  ArchiveMan.OpenArchive(ArchiveNamePath, false);
+
+  Screen.Cursor := crHourGlass;
+  try
+    { Step 2: Add the file }
+    // Construct a TStringList of files to add
+    // We pass a nil in the folder because the full path is in list
+    list := TStringList.Create;
+    list.Add(SourceFileNamePath);
+    FilesAdded := ArchiveMan.AddFiles(list, '');
+    if (FilesAdded = 0) then
+    begin
+      Application.MessageBox('reSource.CompressToArchive: Error No Files Added',
+        'Error', MB_OK);
+      exit;
+    end
+    else
+    begin
+      Application.MessageBox('reSource.CompressToArchive: One file added to archive.',
+        'Error', MB_OK);
+      exit;
+    end;
+
+  finally
+    { Step 3: Close the archive }
+    if ArchiveMan.IsArchiveOpen then
+      ArchiveMan.CloseArchive;
+    Screen.Cursor := crDefault;      
+  end;
+end;
+
+{-------------------------------------------------------------------------------
+  DecompressFromArchive
+-------------------------------------------------------------------------------}
+procedure TResource.DecompressFromArchive(ArchiveNamePath, DestPath: string;
+  ExtractFileName: string='');
+var
+  CFH: TCentralFileHeader;
+  i, FilesExtracted, ExtractedSize: integer;
+  CFHList: TList;
+begin
+  {Algorithm
+  Check that the Archive exists before calling this.
+  Open Archive
+  if FileName <> '' then
+    search for FileName and extract one file
+  else
+    extract all files in archive
+  Close Archive
+  }
+
+  FilesExtracted := 0;
+  ExtractedSize := 0;
+  
+  if not FileExists(ArchiveNamePath) then
+  begin
+    Application.MessageBox('reSource.DecompressFromArchive: Archive file does not exist.',
+      'Error', MB_OK);
+    exit;
+  end;
+
+  ArchiveMan.OpenArchive(ArchiveNamePath, true);
+  Screen.Cursor := crHourGlass;
+  try
+    with ArchiveMan.ArchiveFile do
+    begin
+      ArchiveMan.dest_dir := IncludeTrailingBackslash(DestPath);
+      {Search for file name in CentralFileHeader}
+      if ExtractFileName <> '' then
+      begin
+        for i := 0 to CentralDir.Count-1 do
+        begin
+          CFH := TCentralFileHeader(CentralDir[i]);
+          if CompareText(CFH.filename, ExtractFileName) = 0 then
+          begin
+            {Construct a CFHList with one CentralFileHeader (CFH) }
+            CFHList := TList.Create;
+            CFHList.Add(CFH);
+            ArchiveMan.ExtractList(CFHList, FilesExtracted, ExtractedSize);
+            CFHList.Free;
+            break;
+          end;
+        end;
+      end
+      else
+      begin
+        {extract all files in archive.
+        Add all the CentralDir CFH into CFHList}
+        CFHList := TList.Create;
+        for i := 0 to CentralDir.Count-1 do
+          CFHList.Add(TCentralFileHeader(CentralDir[i]));
+        ArchiveMan.ExtractList(CFHList, FilesExtracted, ExtractedSize);
+        CFHList.Free;
+      end;
+    end;
+
+    if FilesExtracted = 0 then
+      ShowMessage('Error: No files extracted')
+    else
+      ShowMessage(IntToStr(FilesExtracted)+' file(s) extracted');
+
+  finally
+    if ArchiveMan.IsArchiveOpen then
+      ArchiveMan.CloseArchive;
+    Screen.Cursor := crDefault;      
+  end;
+end;
+
+
+end.

Component/ResourcePack.cfg

@@ -0,0 +1,37 @@
+-$A+
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J+
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q+
+-$R+
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-E"c:\temp\cg"
+-LE"c:\borland\delphi5\Projects\Bpl"
+-LN"c:\borland\delphi5\Projects\Bpl"
+-Z

Component/ResourcePack.dof

@@ -0,0 +1,109 @@
+[Compiler]
+A=1
+B=0
+C=1
+D=1
+E=0
+F=0
+G=1
+H=1
+I=1
+J=1
+K=0
+L=1
+M=0
+N=1
+O=1
+P=1
+Q=1
+R=1
+S=0
+T=0
+U=0
+V=1
+W=0
+X=1
+Y=1
+Z=1
+ShowHints=1
+ShowWarnings=1
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+[Linker]
+MapFile=0
+OutputObjs=0
+ConsoleApp=1
+DebugInfo=0
+RemoteSymbols=0
+MinStackSize=16384
+MaxStackSize=1048576
+ImageBase=4194304
+ExeDescription=reSource Compression Component
+
+[Directories]
+OutputDir=c:\temp\cg
+UnitOutputDir=
+PackageDLLOutputDir=
+PackageDCPOutputDir=
+SearchPath=
+Packages=VCL50;VCLX50;VCLSMP50;VCLDB50;VCLADO50;ibevnt50;VCLBDE50;VCLDBX50;QRPT50;TEEUI50;TEEDB50;TEE50;DSS50;TEEQR50;VCLIB50;VCLMID50;VCLIE50;INETDB50;INET50;NMFAST50;WEBMID50;dclocx50;dclaxserver50;DragDropD5;ColorPicker;preview;Icsdel50;galoled
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+
+[Parameters]
+RunParams=
+HostApplication=
+
+[Language]
+ActiveLang=
+ProjectLang=$00000409
+RootDir=
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1033
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlUnitAliases]
+Count=1
+Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+
+[HistoryLists\hlSearchPath]
+Count=1
+Item0=C:\Save\Delphi\resource\Component
+
+[HistoryLists\hlUnitOutputDirectory]
+Count=1
+Item0=C:\temp\rs
+
+[HistoryLists\hlOutputDirectorry]
+Count=2
+Item0=c:\temp\cg
+Item1=C:\temp\rs
+
+[HistoryLists\hlBPLOutput]
+Count=1
+Item0=c:\temp\rs

Component/ResourcePack.dpk

@@ -0,0 +1,62 @@
+package ResourcePack;
+
+{$R *.RES}
+{$R 'ResourceCompUnit.dcr'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS ON}
+{$RANGECHECKS ON}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'reSource Compression Component'}
+{$IMPLICITBUILD OFF}
+
+requires
+  vcl50,
+  VCLX50,
+  VCLSMP50;
+
+contains
+  ArchiveManagerUnit in 'ArchiveManagerUnit.pas',
+  EDosUnit in 'EDosUnit.pas',
+  ArchiveHeadersUnit in 'ArchiveHeadersUnit.pas',
+  ArchiveFileUnit in 'ArchiveFileUnit.pas',
+  bit_file_unit in 'bit_file_unit.pas',
+  BWTBaseUnit in 'BWTBaseUnit.pas',
+  BWTCompressUnit in 'BWTCompressUnit.pas',
+  BWTExpandUnit in 'BWTExpandUnit.pas',
+  CRC32Unit in 'CRC32Unit.pas',
+  ErrorUnit in 'ErrorUnit.pas',
+  FileStrucAriDecoderUnit in 'FileStrucAriDecoderUnit.pas',
+  FileStrucAriEncoderUnit in 'FileStrucAriEncoderUnit.pas',
+  FSortUnit in 'FSortUnit.pas',
+  GroupAriModelUnit in 'GroupAriModelUnit.pas',
+  MTFBaseUnit in 'MTFBaseUnit.pas',
+  MTFDecoderUnit in 'MTFDecoderUnit.pas',
+  MTFEncoderUnit in 'MTFEncoderUnit.pas',
+  Ofile in 'ofile.pas',
+  RLEUnit in 'RLEUnit.pas',
+  smart_buf_filestream_unit in 'smart_buf_filestream_unit.pas',
+  StrucAriDecoderUnit in 'StrucAriDecoderUnit.pas',
+  StrucAriEncoderUnit in 'StrucAriEncoderUnit.pas',
+  StructsUnit in 'StructsUnit.pas',
+  ResourceCompUnit in 'ResourceCompUnit.pas',
+  BitStreamUnit in 'BitStreamUnit.pas',
+  StreamStrucAriEncoderUnit in 'StreamStrucAriEncoderUnit.pas';
+
+end.

Component/ResourcePack.dsk

@@ -0,0 +1,304 @@
+[Closed Files]
+File_0=SourceModule,'C:\Save\Delphi\resource\Component\StructsUnit.pas',0,1,1,1,9,0,0
+File_1=SourceModule,'C:\Save\Delphi\resource\Component\StrucAriEncoderUnit.pas',0,1,1,1,9,0,0
+File_2=SourceModule,'C:\Save\Delphi\resource\Component\StrucAriDecoderUnit.pas',0,1,1,1,9,0,0
+File_3=SourceModule,'C:\Save\Delphi\resource\Component\StreamStrucAriEncoderUnit.pas',0,1,1,1,11,0,0
+File_4=SourceModule,'C:\Save\Delphi\resource\Component\smart_buf_filestream_unit.pas',0,1,1,1,10,0,0
+File_5=SourceModule,'C:\Save\Delphi\resource\Component\RLEUnit.pas',0,1,1,1,9,0,0
+File_6=SourceModule,'C:\Save\Delphi\resource\Component\ResourceCompUnit.pas',0,1,1,1,9,0,0
+File_7=SourceModule,'C:\Save\Delphi\resource\Component\ofile.pas',0,1,1,1,1,0,0
+File_8=SourceModule,'C:\Save\Delphi\resource\Component\MTFEncoderUnit.pas',0,1,1,1,9,0,0
+File_9=SourceModule,'C:\Save\Delphi\resource\Component\MTFDecoderUnit.pas',0,1,1,1,9,0,0
+
+[Modules]
+Module0=C:\Save\Delphi\resource\Component\ResourcePack.dpk
+Count=1
+EditWindowCount=1
+PackageWindowCount=1
+
+[C:\Save\Delphi\resource\Component\ResourcePack.dpk]
+ModuleType=PackageEditModule
+FormState=0
+FormOnTop=0
+
+[C:\Save\Delphi\resource\Component\ProjectGroup1.bpg]
+FormState=0
+FormOnTop=0
+
+[EditWindow0]
+ViewCount=1
+CurrentView=0
+View0=0
+CodeExplorer=CodeExplorer@EditWindow0
+MessageView=MessageView@EditWindow0
+Create=1
+Visible=1
+State=2
+Left=229
+Top=232
+Width=564
+Height=334
+MaxLeft=-4
+MaxTop=97
+MaxWidth=808
+MaxHeight=479
+ClientWidth=800
+ClientHeight=452
+LeftPanelSize=0
+LeftPanelClients=CodeExplorer@EditWindow0
+LeftPanelData=00000400010000000C000000436F64654578706C6F7265720000000000000000000000000000000000FFFFFFFF
+RightPanelSize=0
+BottomPanelSize=0
+BottomPanelClients=CallStackWindow,WatchWindow,MessageView@EditWindow0
+BottomPanelData=00000400030000000F00000043616C6C537461636B57696E646F770B000000576174636857696E646F770B0000004D657373616765566965772003000000000000004D00000000000000FFFFFFFF
+
+[View0]
+Module=C:\Save\Delphi\resource\Component\ResourcePack.dpk
+CursorX=1
+CursorY=1
+TopLine=1
+LeftCol=1
+
+[PackageWindow0]
+Create=1
+Visible=0
+State=0
+Left=202
+Top=147
+Width=422
+Height=398
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=414
+ClientHeight=376
+TBDockHeight=284
+LRDockWidth=421
+Dockable=1
+StatusBar=0
+TextLabels=1
+Toolbar=1
+SectionWidth0=186
+SectionWidth1=228
+Module=C:\Save\Delphi\resource\Component\ResourcePack.dpk
+
+[Watches]
+Count=0
+
+[Breakpoints]
+Count=0
+
+[AddressBreakpoints]
+Count=0
+
+[Main Window]
+Create=1
+Visible=1
+State=2
+Left=0
+Top=28
+Width=777
+Height=105
+MaxLeft=-1
+MaxTop=-1
+MaxWidth=808
+MaxHeight=105
+ClientWidth=800
+ClientHeight=78
+
+[ProjectManager]
+Create=1
+Visible=0
+State=0
+Left=155
+Top=124
+Width=448
+Height=413
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=440
+ClientHeight=391
+TBDockHeight=303
+LRDockWidth=510
+Dockable=1
+
+[CPUWindow]
+Create=1
+Visible=0
+State=0
+Left=10
+Top=108
+Width=732
+Height=433
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=724
+ClientHeight=406
+DumpPane=79
+DisassemblyPane=349
+RegisterPane=231
+FlagPane=64
+
+[AlignmentPalette]
+Create=1
+Visible=0
+State=0
+Left=50
+Top=119
+Width=156
+Height=80
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=150
+ClientHeight=60
+
+[PropertyInspector]
+Create=1
+Visible=1
+State=0
+Left=304
+Top=200
+Width=236
+Height=303
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=226
+ClientHeight=279
+TBDockHeight=494
+LRDockWidth=164
+Dockable=0
+SplitPos=108
+ArrangeBy=Name
+SelectedItem=
+ExpandedItems=BorderIcons,Brush,Dragtypes,Font.Style,Options,Pen
+HiddenCategories=Legacy
+ShowStatusBar=1
+
+[WatchWindow]
+Create=1
+Visible=0
+State=0
+Left=12
+Top=0
+Width=788
+Height=77
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=788
+ClientHeight=77
+TBDockHeight=77
+LRDockWidth=421
+Dockable=1
+
+[BreakpointWindow]
+Create=1
+Visible=0
+State=0
+Left=181
+Top=255
+Width=453
+Height=197
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=445
+ClientHeight=175
+TBDockHeight=197
+LRDockWidth=453
+Dockable=1
+Column0Width=100
+Column1Width=75
+Column2Width=225
+Column3Width=40
+Column4Width=75
+Column5Width=75
+
+[CallStackWindow]
+Create=1
+Visible=0
+State=0
+Left=412
+Top=0
+Width=388
+Height=77
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=388
+ClientHeight=77
+TBDockHeight=77
+LRDockWidth=379
+Dockable=1
+
+[LocalVarsWindow]
+Create=1
+Visible=0
+State=0
+Left=273
+Top=197
+Width=421
+Height=192
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=413
+ClientHeight=170
+TBDockHeight=192
+LRDockWidth=421
+Dockable=1
+
+[ToDo List]
+Create=1
+Visible=0
+State=0
+Left=154
+Top=175
+Width=470
+Height=250
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=462
+ClientHeight=228
+TBDockHeight=250
+LRDockWidth=470
+Dockable=1
+Column0Width=260
+Column1Width=30
+Column2Width=100
+Column3Width=70
+Column4Width=70
+SortOrder=4
+ShowHints=1
+ShowChecked=1
+
+[CodeExplorer@EditWindow0]
+Create=1
+Visible=0
+State=0
+Left=0
+Top=12
+Width=200
+Height=348
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=200
+ClientHeight=348
+TBDockHeight=305
+LRDockWidth=200
+Dockable=1
+
+[MessageView@EditWindow0]
+Create=1
+Visible=0
+State=0
+Left=12
+Top=0
+Width=788
+Height=77
+MaxLeft=-1
+MaxTop=-1
+ClientWidth=788
+ClientHeight=77
+TBDockHeight=77
+LRDockWidth=443
+Dockable=1
+
+[DockHosts]
+DockHostCount=0
+

Component/StreamStrucAriEncoderUnit.pas

@@ -0,0 +1,169 @@
+unit StreamStrucAriEncoderUnit;
+{-------------------------------------------------------------------------------
+Stream Structured Arithmetic Encoder Unit
+---------------------------------------
+
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+  Desc:
+  Derives from Structured arithmetic encoder to allow it to write to Stream.
+  Handles the output to the Stream by implementing OutputBit/OutputBits.
+  Very similar to FileStrucAriEncoder because it's ported from there.
+
+  procedure EncodeBlock(_Stream: TStream; block: PBlock; block_length: integer);
+  Encodes the block with block length block_length.
+  Will encode the block with an EOF symbol trailing.
+
+
+  To Use:
+  Create it.
+  Call EncodeBlock
+  Free.
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses Classes, dialogs,
+     // general
+     StructsUnit,
+     // base class
+     StrucAriEncoderUnit, GroupAriModelUnit, BitStreamUnit;
+
+
+type
+  {For Stream out, must implement Bit Buffer }
+  TStreamAriEncoder = class(TStrucAriEncoder)
+  protected
+    BitStream: TBitStream;
+    procedure OutputBit(bit: byte); override;
+    procedure OutputBits(code: longint; count: byte); override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure EncodeBlock(_Stream: TStream; block: PBlock; block_length: integer;
+      var OutSize: integer);
+  end;
+
+
+(**) implementation (**)
+
+{ TStreamAriEncoder }
+
+constructor TStreamAriEncoder.Create;
+begin
+  inherited Create;
+end;
+
+destructor TStreamAriEncoder.Destroy;
+begin
+  inherited;
+end;
+
+procedure TStreamAriEncoder.EncodeBlock(_Stream: TStream; block: PBlock;
+  block_length: integer; var OutSize: integer);
+var
+  i, j: longint;
+  run_length: integer;
+  mask, num_bits: integer;
+  StartPos: integer;
+begin
+  StartPos := _Stream.Position;
+  BitStream := TBitStream.Create(_Stream, false);
+  BitStream.BeginBitWriteAccess;
+  StartEncoding;
+
+  i := 0;
+  while (i < block_length) do
+  begin
+
+    {Convert the ascii to symbols.
+     symbols 0 and 1 represent runs of 0s.
+     symbols 2 - 256 represent ascii 1-255 repectively.
+     symbol 257 is the EOB}
+
+    if (block^[i] = 0) then
+    begin
+      {Wheeler's run length coding.
+       convert to runs of 0s
+       Algo: Count run_length, or number of 0s (run length includes init byte
+             Increment run_length by one
+             Ignore most significant one bit and encode run_length
+             as ordinary binary number}
+
+
+      {count run length and inc i. min run_length will be 1}
+      run_length := 0;
+      repeat
+        inc(i);
+        inc(run_length);
+      until (i >= block_length) or (block^[i] <> 0);
+      //if (i > block_length) then ShowMessage('Hello');
+
+      {increment by 1}
+      inc(run_length);
+
+      {find the most significant 1 bit and count the number of bits
+      to output in num_bits}
+      num_bits := 32;
+      mask := 1 shl 31;
+      while (run_length and mask = 0) do
+      begin
+        mask := mask shr 1;
+        dec(num_bits);
+      end;
+
+      {ignore most significant 1 bit}
+      dec(num_bits);
+
+      {output the number as an ordinary binary number from the lsb}
+      mask := 1;
+      for j := 1 to num_bits do
+      begin
+        if (run_length and mask <> 0) then
+          EncodeSymbol(1)
+        else
+          EncodeSymbol(0);
+
+        mask := mask shl 1;
+      end;
+
+
+      {DEBUG: Test no run length coding. code 0s directly.
+              The value 1 should not appear at all}
+      {EncodeSymbol(0);
+      inc(i);}
+
+      {i will have been set to the next character during the run_length count}
+    end
+    else
+    begin
+      {increment the ascii by 1 to get the symbol}
+      EncodeSymbol(block^[i]+1);
+      inc(i);
+    end;
+
+  end; {While}
+
+  EncodeSymbol(EOF_SYMBOL);
+  DoneEncoding;
+  BitStream.EndBitWriteAccess;
+  OutSize := _Stream.Position - StartPos;
+end;
+
+procedure TStreamAriEncoder.OutputBit(bit: byte);
+begin
+  BitStream.OutputBit(bit);
+  //ShowMessage('asdf');
+end;
+
+procedure TStreamAriEncoder.OutputBits(code: Integer; count: byte);
+begin
+  { Not Implemented }
+end;
+
+end.

Component/StrucAriDecoderUnit.pas

@@ -0,0 +1,165 @@
+unit StrucAriDecoderUnit;
+{-------------------------------------------------------------------------------
+Structured Arithmetic Decoder Unit
+----------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  uses the Group Arithmetic Model to decode the symbols
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses
+  GroupAriModelUnit;
+
+
+type
+  TStrucAriDecoder = class
+  private
+    low, high, value: longint;
+    HeadAriModel: THeadAriModel;
+  protected
+    function  InputBit: byte; virtual; abstract;
+    function  InputBits( count: byte ): longint; virtual; abstract;
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    // for decoding
+    procedure DecodeSymbol(var symbol: integer);
+    procedure StartDecoding;
+    procedure DoneDecoding;
+  end;
+
+
+(**) implementation (**)
+
+constructor TStrucAriDecoder.Create;
+begin
+  inherited Create;
+end;
+
+destructor TStrucAriDecoder.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TStrucAriDecoder.StartDecoding;
+var
+  i: longint;
+begin
+  HeadAriModel := THeadAriModel.Create;
+  
+  value := 0;                            // input bits to fill the
+  for i := 1 to CODE_VALUE_BITS do       // code value
+    value := 2 * value + InputBit;
+
+  low := 0;                              // full code range
+  high := TOP_VALUE;
+end;
+
+procedure TStrucAriDecoder.DoneDecoding;
+begin
+  HeadAriModel.Free;
+end;
+
+{-------------------------------------------------------------------------------
+  DecodeSymbol
+  ------------
+  decodes the next symbol in the stream and returns the symbol in symbol.
+
+  Algo:
+  The decoding process is either 1 or 2 steps, depending on whether the group
+  has one or more members.
+  The design of the algo is such that the unique groups are zero and one.
+  The symbols correspond to the unique group values.
+
+  1) Decode the group number  (step 1)
+  2) If the group has several members, then
+     a) decode the residue to obtain the member symbol (step 2)
+     b) convert the member symbol to the corresponding symbol and return this.
+     ELSE
+     Otherwise, the symbol is unique in the group and the group_num is the symbol.
+     return this.
+-------------------------------------------------------------------------------}
+procedure TStrucAriDecoder.DecodeSymbol(var symbol: integer);
+
+  procedure DoDecodeSymbol(var symbol: integer; AriModel: TGroupAriModel);
+  var
+    range: longint;   // size of current code region
+    cum: integer;     // cumulative frequancy calculated
+    index: integer;   // index of the symbol
+  begin
+     range := high - low + 1;
+
+     // find cum freq for value
+     cum := ((value-low+1) * AriModel.cum_freq[0] -1) div range;
+
+     // find the symbol that straddles the range
+     index := 1;
+     while (AriModel.cum_freq[index] > cum) do inc(index);
+
+     // return the symbol
+     symbol := AriModel.IndexToSymbol(index);
+
+     // narrow the code region to that allooted to this symbol
+     high := low + (range * AriModel.cum_freq[index-1]) div AriModel.cum_freq[0] -1;
+     low := low + (range * AriModel.cum_freq[index]) div AriModel.cum_freq[0];
+
+     // remove the bits that represent the current symbol to get the next symbol's
+     // range
+     repeat
+       if (high < HALF) then
+       begin
+         {nothing}                             // expand low half
+       end
+       else if (low >= HALF) then              // expand high half
+       begin
+         dec(value, HALF);
+         dec(low, HALF);                       // substract offset to top
+         dec(high, HALF);
+       end else if ((low >= FIRST_QTR) and     // expand middle half
+                    (high < THIRD_QTR)) then
+       begin
+         dec(value, FIRST_QTR);
+         dec(low, FIRST_QTR);
+         dec(high, FIRST_QTR);                 // substract offset to middle
+       end else break;                         // otherwise exit loop
+
+       low := 2 * low;
+       high := 2 * high + 1;                   // scale up code range
+       value := 2 * value + InputBit;          // move in next input bit
+     until false;
+
+    // update the model with the new symbol found
+    AriModel.UpdateModel(index);
+  end;
+
+var
+  group_num: integer;     // group number for the symbol
+  group_symbol: integer;  // the group symbol in the respective group (group_num)
+begin
+  DoDecodeSymbol(group_num, HeadAriModel.MainAriModel);
+
+  if HeadAriModel.HasResidue(group_num) then
+  begin
+    // decode the group_symbol using the respetive AriModel
+    DoDecodeSymbol(group_symbol, HeadAriModel.AriModelList[group_num]);
+    // convert the group_symbol to its corresponding symbol using the group_num
+    symbol := HeadAriModel.GroupSymbolToSymbol(group_symbol, group_num);
+  end
+  else
+  begin
+    // the group has only one character
+    // therefore the symbol is the group_num
+    symbol := group_num;
+  end;
+
+end;
+
+
+
+end.

Component/StrucAriEncoderUnit.pas

@@ -0,0 +1,187 @@
+unit StrucAriEncoderUnit;
+{-------------------------------------------------------------------------------
+Structured Arithmetic Encoder Unit
+----------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+  uses the Group Arithmetic Model to encode the symbols
+
+  first_level_symbol: 0-9
+  second_level_symbol: 0 - (NumberOfEntries-1)
+
+  Each entry in the AriModelList corresponds to the AriModel for the first_level_symbol.
+
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses GroupAriModelUnit;
+
+
+type
+  TStrucAriEncoder = class
+  private
+    high, low: integer;     // ends of current code region
+    bits_to_follow: integer;
+    procedure BitPlusFollow(bit: byte);
+  protected
+    HeadAriModel: THeadAriModel;
+
+    procedure OutputBit(bit: byte); virtual; abstract;
+    procedure OutputBits(code: longint; count: byte); virtual; abstract;
+
+    procedure StartEncoding;
+    procedure DoneEncoding;
+
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    {procedure EncodeByte(a: byte);}
+    procedure EncodeSymbol(symbol: integer);
+  end;
+
+
+(**) implementation (**)
+
+
+
+constructor TStrucAriEncoder.Create;
+begin
+  inherited Create;
+end;
+
+destructor TStrucAriEncoder.Destroy;
+begin
+  inherited Destroy;
+end;
+
+{ At the end of the encoding process, there are still significant bits left
+in the high and low registers. We output two bits, plus as many underflow
+bits as are necessary }
+
+procedure TStrucAriEncoder.BitPlusFollow(bit: byte);
+begin
+  OutputBit(bit);
+  // output bits_to_follow opposite bits. Set bits_to_follow to zero.
+  while (bits_to_follow > 0) do
+  begin
+    if bit = 0 then
+      OutputBit(1)
+    else
+      OutputBit(0);
+
+    dec(bits_to_follow);
+  end;
+end;
+
+procedure TStrucAriEncoder.StartEncoding;
+begin
+  low := 0;               // full code region
+  high := TOP_VALUE;
+  bits_to_follow := 0;    // no bits to follow next
+  HeadAriModel := THeadAriModel.Create;
+end;
+
+procedure TStrucAriEncoder.DoneEncoding;
+begin
+  // output two bits that select the quarter that the
+  // current code range contains
+  inc(bits_to_follow);
+  if (low < FIRST_QTR) then
+    BitPlusFollow(0)
+  else
+    BitPlusFollow(1);
+
+  //OutputBits(0, 15);    //16 or 15 or none?
+  HeadAriModel.Free;
+end;
+
+{-------------------------------------------------------------------------------
+  EncodeSymbol
+  ------------
+  encodes the symbol 'symbol'.
+
+  Algo:
+  The encoding process is either 1 or 2 steps, depending on whether the group
+  has several members.
+  The design of the algo is such that the unique groups are zero and one.
+  The symbols correspond to the unique group values.
+
+  1) Get the group number for the symbol
+  2) Encode the group number                 (step 1)
+  3) If the group has residue, then
+     a) Get the group symbol for the corresponding symbol in its group
+     b) Encode the group symbol              (step 2)
+-------------------------------------------------------------------------------}
+
+procedure TStrucAriEncoder.EncodeSymbol(symbol: integer);
+
+  procedure DoEncodeSymbol(symbol_index: integer; AriModel: TGroupAriModel);
+  var
+    range: integer;
+  begin
+    // narrow the code region to that alloted to this symbol
+    range := high-low + 1;
+    high := low + (((range * AriModel.cum_freq[symbol_index-1]) div AriModel.cum_freq[0]) -1);
+    low := low + ((range * AriModel.cum_freq[symbol_index]) div AriModel.cum_freq[0]);
+
+    // loop to output bits
+    repeat
+      if (high < HALF) then
+        BitPlusFollow(0)                 // output 0 if in low half  (MSB=0)
+      else if (low >= HALF) then
+      begin
+        BitPlusFollow(1);                // output 1 if in high half (MSB=1)
+        dec(low, HALF);                  // set MSB to 0 for both low and high
+        dec(high, HALF);
+      end
+      else if ((low >= FIRST_QTR) and (high < THIRD_QTR)) then
+      begin
+        inc(bits_to_follow);             // output an opposite bit later if in middle half
+        dec(low, FIRST_QTR);             // substract offset to middle
+        dec(high, FIRST_QTR);
+      end
+      else break;
+
+      low := 2 * low;                    // scale up code region
+      high := 2 * high + 1;
+    until false;
+
+    AriModel.UpdateModel(symbol_index);  // update the model with the symbol
+  end;
+
+var
+  AriModel: TGroupAriModel;          // AriModel. reused through the levels
+  symbol_index: integer;             // index for symbols. reused through the levels
+  group_num, group_symbol: integer;  // 2nd and 3rd level symbols
+begin
+  // get the group number from the HeadAriModel
+  group_num := HeadAriModel.GetGroupNum(symbol);
+  // retrieve the AriModel and symbol_index for group_num
+  HeadAriModel.GetSymbolInfo(group_num, AriModel, symbol_index);
+  // encode the group number
+  DoEncodeSymbol(symbol_index, AriModel);
+
+  // encode any residue
+  if HeadAriModel.HasResidue(group_num) then
+  begin
+    // convert the symbol to a group symbol in its respective group (group_num)
+    group_symbol := HeadAriModel.SymbolToGroupSymbol(symbol, group_num);
+    // get the AriModel and symbol_index for the group_symbol
+    HeadAriModel.GetGroupSymbolInfo(group_symbol, group_num, AriModel, symbol_index);
+    Assert(AriModel <> nil);
+    // encode the group_symbol or residue
+    DoEncodeSymbol(symbol_index, AriModel);
+  end;
+end;
+
+
+
+end.
+
+
+

Component/StructsUnit.pas

@@ -0,0 +1,120 @@
+unit StructsUnit;
+{-------------------------------------------------------------------------------
+Structures Unit
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+Contains:
+  Common data structures used across the compressor and related test files.
+
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+
+var
+  reSourceIDStr: string = 'reSource - BWT Compressor';
+  reSourceVerStr: string = 'reSource v2.6';
+  reSourceCopyrightStr: string = 'Copyright (C) 1998-2000 Victor Kasenda / gruv';
+
+type
+  {Event types for ArchiveManager}
+  TIntEvent = procedure(Sender: TObject; a: integer) of object;
+  TStrEvent = procedure(Sender: TObject; s: string) of object;
+
+const
+  //BlockSize = 500; {bytes}
+  BlockSize = 400 * 1024; {kilobytes}
+  //BlockSize = 2 * 1024 * 1000;  {megabytes}
+
+  GHOST_BUFFER = 2000; // for overshoot, only for block (see FSortUnit)
+
+  {Run Length encoding may expand the block by a few bytes.
+  If run length encoding before sorting is not performed, this can be set to 0}
+  RLE_EXPAND_EXTRA_BYTES = 0; {BLOCKSIZE * 20 DIV 100;  {20% of BlockSize}
+  //RLE_EXPAND_EXTRA_BYTES = 10000;  {20% of BlockSize}
+
+  MaxLongword = high(Longword);
+
+  {String constants}
+  SRESOURCE_EXT = 'rs';
+
+type
+
+  {Block with ghost buffers at the front (1 byte) and back (5 bytes)
+  Extra 1000 bytes in case RLEncoder expands the block}
+  TBlock = array[-1..BlockSize*2 + GHOST_BUFFER + RLE_EXPAND_EXTRA_BYTES] of byte;
+  PBlock = ^TBlock;
+
+  TLongintBlock = array[0..BlockSize-1 + 1000 + RLE_EXPAND_EXTRA_BYTES] of longint;
+  PLongintBlock = ^TLongintBlock;
+
+  TLongWordBlock = array[0..BlockSize * 2 + GHOST_BUFFER + RLE_EXPAND_EXTRA_BYTES] of Longword;
+  PLongWordBlock = ^TLongwordBlock;
+
+  PWord = ^Word;
+
+  T64kBlock = array[0..65535] of longint;
+  P64kBlock = ^T64kBlock;
+
+
+  TBlockMan = class
+  public
+    // common blocks. shared memory blocks between compressor and expander
+    // call InitBlocks, FreeBlocks to use
+    longintblock1, longintblock2, longintblock3: PLongintblock;
+    block1, block2: PBlock;
+    k64Block: P64kBlock;
+
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  procedure CompareBlocks(const block1, block2: PBlock; const block_length: longint;
+                              error_msg: string);
+
+var
+  BlockMan: TBlockMan;
+  
+
+(**) implementation (**)
+uses ErrorUnit, SysUtils;
+
+constructor TBlockMan.Create;
+begin
+  inherited Create;
+  New(longintblock1);
+  New(longintblock2);
+  New(longintblock3);
+  New(block1);
+  New(block2);
+  New(k64Block);
+end;
+
+destructor TBlockMan.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure CompareBlocks(const block1, block2: PBlock; const block_length: longint;
+                              error_msg: string);
+var
+  i: longint;
+begin
+  for i := 0 to block_length-1 do
+     if block1^[i] <> block2^[i] then
+     begin
+       if error_msg = '' then error_msg := 'block1 differs from block2 at ';
+       ShowError(error_msg + ' position: ' + IntToStr(i));
+       break;
+     end;
+end;
+
+initialization
+  BlockMan := TBlockMan.Create;
+finalization
+  BlockMan.Free;
+end.

Component/bit_file_unit.pas

@@ -0,0 +1,237 @@
+unit bit_file_unit;
+{-------------------------------------------------------------------------------
+Bit Access for Files
+--------------------
+revision 1.3
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+
+
+Usage Note:
+  Call BeginBitAccess and EndBitAccess to start and end bit access.
+  Failure to call any of which may lead to data corruption.
+
+Specially tailored procedures:
+
+  SetReadByteLimit
+  This checks that the bits read fall within the limit. It allows a maximum
+  of NUM_FAKED_BYTES bytes more read (which the decoder uses) afther which data corruption
+  has most likely occured.
+  Set to MaxLongInt if the limit is not to be used (default).
+
+
+
+version
+       1.1: Added SetReadByteLimit
+       1.2: Added BeginBitAccess and EndBitAccess
+       1.3: Fixed read_byte_limit. off by one.
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses smart_buf_filestream_unit, SysUtils;
+
+const
+  NUM_FAKED_BYTES = 20;
+
+type
+
+  TBitFile = class(TBufferedFileStream)
+  private
+
+    mask: byte;
+    rack: byte;
+
+    IsOpenInput: boolean;
+
+    read_byte_limit: integer;
+    bytes_read: integer;
+    //extra_bytes_read: integer;    // bytes read past the limit
+
+    procedure BitGetNextByte(var b: byte);
+
+  public
+    constructor Create(const FileName: string; Mode: Word);
+    destructor Destroy; override;
+
+    procedure SetReadByteLimit(const limit: integer);
+
+    procedure BeginBitReadAccess;
+    procedure EndBitReadAccess;
+    procedure BeginBitWriteAccess;
+    procedure EndBitWriteAccess;
+
+    procedure OutputBit(bit: byte);
+    procedure OutputBits(code: longint; count: byte);
+    function  InputBit: byte;
+    function  InputBits( count: byte ): longint;
+
+  end;
+
+(**) implementation (**)
+uses ErrorUnit;
+
+constructor TBitFile.Create(const FileName: string; Mode: Word);
+begin
+  inherited Create(FileName, Mode, 64*1024);
+
+  IsOpenInput := (Mode = fmOpenRead);
+  rack := 0;
+  mask := $80;
+  SetReadByteLimit(MaxLongInt);
+end;
+
+destructor TBitFile.Destroy;
+begin
+  if (not IsOpenInput) and (Mask <> $80) then WriteByte(rack);
+  inherited Destroy;
+end;
+
+procedure TBitFile.SetReadByteLimit(const limit: integer);
+begin
+  bytes_read := 0;
+  read_byte_limit := limit;
+  //extra_bytes_read := 0;
+end;
+
+procedure TBitFile.BitGetNextByte(var b: byte);
+begin
+  if (bytes_read >= read_byte_limit) then    {If limit number of bytes already read}
+  begin
+
+    if (bytes_read - read_byte_limit >= NUM_FAKED_BYTES) then
+    begin
+      ShowError('Too many bytes read in bit mode.');
+      halt(1);
+    end
+    else
+    begin
+      b := 0;
+      inc(bytes_read);
+    end;
+
+  end
+  else
+  begin
+    inherited GetNextByte(b);
+    inc(bytes_read);
+  end;
+end;
+
+procedure TBitFile.BeginBitReadAccess;
+begin
+  mask := $80;
+  rack := 0;
+end;
+
+procedure TBitFile.EndBitReadAccess;
+begin
+  mask := $80;
+  rack := 0;
+end;
+
+procedure TBitFile.BeginBitWriteAccess;
+begin
+  mask := $80;
+  rack := 0;
+end;
+
+procedure TBitFile.EndBitWriteAccess;
+begin
+  if (not IsOpenInput) and (Mask <> $80) then
+  begin
+    WriteByte(rack);
+  end;
+  Mask := $80;
+  rack := 0;
+end;
+
+
+
+procedure TBitFile.OutputBit(bit: byte);
+begin
+  if (bit <> 0) then
+    rack := rack or mask;
+  {if bit = 1 then
+    rack := rack or mask;}
+
+  mask := mask shr 1;
+  if mask = 0 then
+  begin
+    WriteByte(rack);
+    rack := 0;
+    mask := $80;
+  end;
+end;
+
+procedure TBitFile.OutputBits(code: longint; count: byte);
+var
+  TempMask: longint;
+begin
+  TempMask := 1 Shl (Count-1);
+  while TempMask <> 0 do
+  begin
+    if (TempMask and Code <> 0) then
+      Rack := Rack or Mask;
+
+    Mask := Mask shr 1;
+    if Mask = 0 then
+    begin
+      WriteByte(Rack);
+      Rack := 0;
+      Mask := $80;
+    end;
+
+    TempMask := TempMask shr 1;
+  end;
+end;
+
+function TBitFile.InputBit: byte;
+var
+  value: byte;
+begin
+  if (mask = $80) then
+    BitGetNextByte(rack);
+
+  value := Rack and Mask;
+  Mask := Mask shr 1;
+  if Mask = 0 then Mask := $80;
+
+  if value = 0 then
+    result := 0
+  else
+    result := 1;
+end;
+
+function TBitFile.InputBits( count: byte ): longint;
+var
+  TempMask: longint;
+  value: longint;
+begin
+  TempMask := 1 shl (count-1);
+  value := 0;
+
+  while TempMask <> 0 do
+  begin
+    if (Mask = $80) then
+      BitGetNextByte(Rack);
+
+    if (Rack and Mask <> 0) then
+      value := (value or TempMask);
+
+    TempMask := TempMask shr 1;
+
+    Mask := Mask shr 1;
+    if Mask = 0 then Mask := $80;
+  end;
+
+  result := value;
+end;
+
+
+
+end.

Component/ofile.pas

@@ -0,0 +1,351 @@
+unit Ofile;
+{$I-}
+{Object file unit.
+ Copyright (C) 1995 F-inc.
+ rev 2.1 5/July/1996
+
+ Borland Delphi Object Pascal compatible.
+ Do not use with BP7.
+}
+
+(**) interface (**)
+uses
+  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
+  Forms, Dialogs, StdCtrls, Buttons;
+
+    (***************************************************************************
+
+    General Notes:
+    If you want to override any of the functions, only do so
+    for those that are virtual.
+    Do not override non virtual methods!
+
+    Notes v2.0:
+    - Many virtual methods have been taken out for faster execution.
+      For faster, buffered saving of delphi data types, use TWriter or TBufferedFileStream.
+      See unit buffered_file_stream_unit (F-inc).
+    - To check for errors, use the Error function (this calls IOResult) or IOResult method.
+
+    v2.1:
+    - Took out AssignFile. Directly pass the file name in create. This is more inline
+      with Borland's own TStreamFile creation procedure and is less confusing.
+
+    ***************************************************************************)
+
+
+
+Type
+  PFile = ^File;
+  TErrorFlag = Integer;
+
+  TOFile = Class
+  private
+    procedure AssignFile(const AFilePath : string);   {Accepts : A file path. The path to the file}
+
+  public
+    Constructor Create(const file_path: string);
+    Destructor  Destroy; Override;
+
+    function  Error: Boolean;           {Returns true if there is an error}
+    function IOResult: integer;         {wraps the system's IOResult}
+
+    {Wrapper methods}
+    procedure Reset(Const aSize : Word);
+    procedure ResetReadOnly(Const aSize : Word);
+    procedure Rewrite(Const aSize : Word); //virtual;
+    procedure Close; //virtual;
+
+    function  FilePos : LongInt; //virtual;
+    procedure Seek(Const aPos : LongInt); //virtual;
+    procedure SeekEOF;                  {Seeks to the end of file}
+
+    {Block read/write support
+     Returns number of bytes read/written}
+    function BlockRead(Var Buf; Const Count : longint): longint; {virtual;}
+    function BlockWrite(Var Buf; Const Count : longint): longint; {virtual;}
+
+    {Writes/reads a string
+     String is stored in the format [StringLength][...String...]}
+    procedure ReadString(Var rString : String);
+    procedure WriteString(aString : String);
+    function  GetString : string;
+
+    {Writes/reads a byte}
+    procedure ReadByte(Var rByte : Byte);
+    procedure WriteByte(aByte : Byte);
+    function  GetByte : byte;
+
+    {Writes/reads a integer}
+    procedure ReadInteger(Var rInteger : Integer);
+    procedure WriteInteger(aInteger : Integer);
+    function  GetInteger : Integer;
+
+    {Writes/reads a integer}
+    procedure ReadLongint(Var rLongint : Longint);
+    procedure WriteLongint(aLongint : Longint);
+    function  GetLongint : Longint;
+
+    function  EOF : Boolean;             {True if end of file reached}
+    function  Exists : Boolean;          {True if file exists}
+
+    function  FileSize : LongInt;
+
+  protected
+
+    F : File;                           {The actual file variable}
+    FName : String;                      {The actual file name}
+    FPath : String;                      {The actual file path}
+    FOpen : Boolean;                     {True if file is open}
+
+    //BlockResult : longint;              {BlockRead/Write result stored here}
+    //ErrorFlag   : TErrorFlag;           {The error flag. 0 - no error.}
+
+    //procedure UpdateErrorFlag;          {Assigns IOError to ErrorFlag}
+    //function  GetErrorFlag : TErrorFlag; {Returns the value of the error flag}
+
+    procedure _Reset(Const aSize : Word); virtual;       {Real reset}
+    //procedure _BlockRead(Var Buf; Const Count : word);   {Default BlockRead procedure}
+    //procedure _BlockWrite(Var Buf; Const Count : word);  {Default BlockWrite prrocedure}
+
+  published
+    property Handle: File read F;        {Returns a pointer to the file handle}
+    property IsOpen: boolean read FOpen;   {True if file is open}
+    property FileName: string read FName;
+    property FilePath: string read FPath;
+  end;
+
+
+(**) implementation (**)
+//Uses EDosu;
+
+{/////////////////////////////////////////////////////////////}
+{Constructor/Destructor}
+{/////////////////////////////////////////////////////////////}
+Constructor TOFile.Create(const file_path: string);
+//Constructor TOFile.Create;
+begin
+  Inherited Create;
+
+  FOpen := False;
+  AssignFile(file_path);
+end;
+
+Destructor TOFile.Destroy;
+begin
+  Close;
+  Inherited  Destroy;
+end;
+
+{/////////////////////////////////////////////////////////////}
+{Misc functions}
+{/////////////////////////////////////////////////////////////}
+{function TOFile.GetHandle: PFile;
+begin
+  result := @F;
+end;}
+
+{/////////////////////////////////////////////////////////////}
+{Wrapper functions}
+{/////////////////////////////////////////////////////////////}
+procedure TOFile.AssignFile(const AFilePath : String);
+begin
+  Close;
+
+  {Init fields}
+  FName := ExtractFileName(AFilePath);
+  FPath := ExtractFilePath(AFilePath);
+  Assign(f, AFilePath);
+end;
+
+procedure TOFile.Reset;
+begin
+  FileMode := 2;
+  _Reset(aSize);
+end;
+
+procedure TOFile.ResetReadOnly;
+begin
+  FileMode := 0;
+  _Reset(aSize);
+end;
+
+procedure TOFile._Reset;
+begin
+  Close;
+  System.Reset(f, aSize);
+  FOpen := True;
+end;
+
+procedure TOFile.Rewrite;
+begin
+  Close;
+  System.Rewrite(f, aSize);
+  FOpen := True;
+end;
+
+procedure TOFile.Close;
+begin
+  If IsOpen then
+  begin
+    System.Close(f);
+    FOpen := False;
+  end;
+end;
+
+function  TOFile.FilePos : LongInt;
+begin
+  FilePos := System.FilePos(f);
+end;
+
+procedure TOFile.Seek;
+begin
+  System.Seek(f, aPos);
+end;
+
+procedure TOFile.SeekEOF;
+begin
+  Seek(FileSize);
+end;
+
+function  TOFile.EOF;
+begin
+  Result := System.EOF(f);
+end;
+
+function TOFile.Exists;
+begin
+  Result := FileExists(FPath + FName);
+end;
+
+Function TOFile.FileSize;
+begin
+  Result := System.FileSize(f);
+end;
+
+{/////////////////////////////////////////////////////////////}
+{BlockRead / BlockWrite wrappers}
+{/////////////////////////////////////////////////////////////}
+{The procedurers call the virtual BlockRead and BlockWrite.
+ These can be overriden. _BlockRead and _BlockWrite cannot.}
+
+function TOFile.BlockRead(Var Buf; Const Count: longint): longint;
+begin
+  System.BlockRead(f, Buf, Count, result);
+end;
+
+function TOFile.BlockWrite(Var Buf; Const Count: longint): longint;
+begin
+  System.BlockWrite(f, Buf, Count, result);
+end;
+
+
+{/////////////////////////////////////////////////////////////}
+{Write data types support}
+{/////////////////////////////////////////////////////////////}
+
+{/////////////////////////////////////////////////////////////}
+{String support}
+{/////////////////////////////////////////////////////////////}
+procedure TOFile.WriteString(aString : String);
+begin
+  {Write Length + 1 bytes because the length byte is also written}
+  BlockWrite(aString, Length(aString));
+end;
+
+procedure TOFile.ReadString(Var rString : String);
+begin
+  {Read length,
+   Read string data if length is  > 0}
+
+  If length(rString) > 0 then
+    BlockRead(rString, length(rString));
+end;
+
+function TOFile.GetString : string;
+var
+  s : string;
+begin
+  ReadString(s);
+  GetString := s;
+end;
+
+{/////////////////////////////////////////////////////////////}
+{Byte support}
+{/////////////////////////////////////////////////////////////}
+procedure TOFile.WriteByte(aByte : Byte);
+begin
+  BlockWrite(aByte, SizeOf(Byte));
+end;
+
+procedure TOFile.ReadByte(Var rByte : Byte);
+begin
+  BlockRead(rByte, SizeOf(Byte));
+end;
+
+function TOFile.GetByte : byte;
+var
+  b : byte;
+begin
+  ReadByte(b);
+  GetByte := b;
+end;
+
+{/////////////////////////////////////////////////////////////}
+{Integer support}
+{/////////////////////////////////////////////////////////////}
+procedure TOFile.WriteInteger(aInteger : Integer);
+begin
+  BlockWrite(aInteger, SizeOf(Integer));
+end;
+
+procedure TOFile.ReadInteger(Var rInteger : Integer);
+begin
+  BlockRead(rInteger, SizeOf(Integer));
+end;
+
+function TOFile.GetInteger : Integer;
+var
+  i : Integer;
+begin
+  ReadInteger(i);
+  GetInteger := i;
+end;
+
+{/////////////////////////////////////////////////////////////}
+{Long Integer support}
+{/////////////////////////////////////////////////////////////}
+procedure TOFile.WriteLongInt(aLongint : Longint);
+begin
+  BlockWrite(aLongint, SizeOf(Longint));
+end;
+
+procedure TOFile.ReadLongint(Var rLongint : Longint);
+begin
+  BlockRead(rLongint, SizeOf(Longint));
+end;
+
+function TOFile.GetLongint : Longint;
+var
+  i : Longint;
+begin
+  ReadLongint(i);
+  GetLongint := i;
+end;
+
+{/////////////////////////////////////////////////////////////}
+{Error support}
+{/////////////////////////////////////////////////////////////}
+function TOFile.Error;
+begin
+  Result := (IOResult = 0);
+end;
+
+function TOFile.IOResult: integer;
+begin
+  result := system.IOResult;
+end;
+
+
+
+
+end.

Component/smart_buf_filestream_unit.pas

@@ -0,0 +1,352 @@
+unit smart_buf_filestream_unit;
+{-------------------------------------------------------------------------------
+Smart Buffered file stream input/output
+rev 2.1
+
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+
+
+  Features:
+  Enable/Disable buffering.
+  efficient in-buffer seeks.
+
+  Notes:
+  Buffering is enabled by default.
+  To enable/disable buffering, call EnableBuf/DisableBuf.
+
+  Procedures allowed when buffering is on or off.
+
+  When Buffering is on:
+  GetNextByte
+  WriteByte
+  ReadBuf
+  WriteBuf
+
+  When buffering is off:
+  Read
+  Write
+  Seek
+
+  Buffering on/off:
+  SmartSeek
+
+
+  Assertions are used to check if they are used correctly.
+  Be warned that not all procedures are protected.
+
+  Warning:
+  Do not call seek when buffering is used. Try not to use it at all.
+  Call SmartSeek all the time.
+
+  Notes:
+  For GetNextByte
+  EOF is assumed when bytes_read is smaller than bufsize. Therefore to force
+  a buffer reread set bytes_read to bufsize. (ResetBuffer)
+
+Version
+  2.1: Fixed buffer reread and rewrite on GetByte and WriteByte
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses Classes, Sysutils;
+
+
+  type
+    ESeekError = class(Exception);
+    {public
+      constructor Create;
+    end;}
+
+
+    TBuf = array[0..MaxLongInt-1] of byte;
+    PBuf = ^TBuf;
+
+    TBufferedFileStream = class( TFileStream )
+    private
+        buf: PBuf;
+        bufsize: integer;         // actual size of the buffer
+        bytes_read: integer;      // number of bytes read into the buffer
+        bufpos: integer;
+        bufoffset: integer;       // actual buffer offset in file
+        dirty: Boolean;
+        buf_enabled: boolean;
+        FFileName: string;
+        write_mode: boolean;
+        reread_buffer: boolean;
+
+
+        function GetBufFilePos: integer;
+
+    public
+        property Position: integer read GetBufFilePos;
+        property FileName: string read FFileName;
+
+        constructor Create(const FileName: string; Mode: Word; _bufsize: Cardinal);
+        destructor Destroy; override;
+
+        function SmartSeek(offset: Longint; origin: Word): Longint;
+
+        procedure ResetBuffer;
+        function GetNextByte(var c: byte): Boolean; virtual;
+        procedure WriteByte(b: byte); virtual;
+        function ReadBuf(var Buffer; Count: Longint): Longint;
+        function WriteBuf(const Buffer; Count: Longint): Longint;
+
+        procedure EnableBuf;
+        procedure DisableBuf;
+    end;
+
+
+
+(**) implementation (**)
+uses ErrorUnit;
+
+{constructor ESeekError.Create;
+begin
+  inherited Create('Gruv: Fatal Seek Error');
+end;}
+
+////////////////////////////////////////////////////////////////////////////////
+//   Create
+//   ------
+//   Only resets the buffer after object is constructed.
+////////////////////////////////////////////////////////////////////////////////
+
+constructor TBufferedFileStream.Create( const FileName : string; Mode : Word; _bufsize: Cardinal);
+begin
+  inherited Create(FileName, Mode);
+
+  bufsize := _bufsize;
+  bytes_read := 0;
+  bufoffset := 0;
+  dirty := False;
+  buf_enabled := true;
+  FFileName := FileName;
+  write_mode := (Mode and fmOpenWrite <> 0) or (Mode and fmOpenReadWrite <> 0);
+
+  GetMem(buf, bufsize);
+  ResetBuffer;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+//  Destroy
+//  -------
+//  Commits any data and destroys object.
+////////////////////////////////////////////////////////////////////////////////
+
+destructor TBufferedFileStream.Destroy;
+begin
+  ResetBuffer;
+  Freemem(buf);
+  inherited Destroy;
+end;
+
+function TBufferedFileStream.GetBufFilePos: integer;
+begin
+  if (bufpos = 0) and (bytes_read = 0) then
+  begin
+    // buffer could be just reset. get the actual physical position
+    result := inherited Position;
+  end
+  else
+    result := bufoffset + bufpos;
+end;
+
+
+(*------------------------------------------------------------------------------
+  ResetBuffer
+  -----------
+  Writes any information that has not  been committed.
+
+  Will set BufferPos and BytesRead to values that will force a file read the
+  next time GetNextChar is called *)
+
+procedure TBufferedFileStream.ResetBuffer;
+begin
+  if dirty then
+  begin
+    Write(buf^, bufpos);  {bufpos already incremented by 1}
+    dirty := False;
+    bufoffset := inherited Position;
+  end;
+
+  bufpos := 0;
+  bytes_read := 0;
+  reread_buffer := true;
+end;
+
+
+////////////////////////////////////////////////////////////////////////////////
+//  SmartSeek
+//
+//  Will attempt to do an in buffer seek.
+////////////////////////////////////////////////////////////////////////////////
+
+function TBufferedFileStream.SmartSeek(offset: Longint; origin: Word) : Longint;
+var
+  abs_offset: integer;           // absolute offset
+  new_relative_offset: integer;  // new pos in buffer if seek in buffer possible
+
+begin
+
+  if write_mode then
+  begin
+    // write out data if buffer is dirty then do the seek
+    ResetBuffer;
+    Result := Seek(Offset, Origin);
+    bufoffset := inherited Position;
+  end
+  else
+  begin
+    // Attempt to do a seek in buffer if buf_enabled
+    if buf_enabled then
+    begin
+      // Convert offset to absolute offset
+      case origin of
+        soFromBeginning: abs_offset := offset;
+        soFromCurrent: abs_offset := GetBufFilePos + offset;
+        soFromEnd: abs_offset := Size - 1 + offset;    { - 1 to convert to zero base }
+        else
+        begin
+          ShowError('abs_offset not initialized');
+          abs_offset := offset;                        {this line to remove the warning}
+        end;
+      end; {Case Origin}
+
+      // Test if seek in buffer is possible
+      new_relative_offset := abs_offset - bufoffset;
+      if (new_relative_offset > 0) and (new_relative_offset < bytes_read-1) then
+      begin
+        bufpos := new_relative_offset;
+        Result := GetBufFilePos;
+      end
+      else
+      begin
+        Result := Seek(Offset, Origin);
+        ResetBuffer;
+      end;
+    end
+    else
+      Result := Seek(Offset, Origin);
+  end; // write_mode
+
+  if (Result < 0) then raise ESeekError.Create('SmartSeek General error');
+end;
+
+(*------------------------------------------------------------------------------
+  GetNextByte
+  -----------
+  Reads the next byte in the stream.
+
+  bufsize characters are read from disk at a time, and when the buffer
+  runs out, a new buffer is automatically read.
+
+  Making BufferSize larger will reduce the number of reads and thus
+  increase speed, but will ( of course ) consume more memory. *)
+
+function TBufferedFileStream.GetNextByte(var c: byte): Boolean;
+begin
+  Assert(buf_enabled = true);
+
+  // If the bufpos is over the bytes_read, then must fill buffer with new characters
+  if (bufpos >= bytes_read) or reread_buffer then
+  begin
+    // bytes_read = bufsize implies the file has not reached eof yet
+    // the file is read in bufsize chunks. smaller than that implies no more data.
+    if (bytes_read = bufsize) or reread_buffer then
+    begin
+      reread_buffer := false;
+      bufoffset := inherited Position;
+      bytes_read := Read(buf^, bufsize);
+      bufpos := 0;
+      result := GetNextByte(c)
+    end
+    else
+    begin
+        c := 0;
+        // return EOF reached
+        result := false;
+    end;
+   end
+  else
+  begin
+    c := buf^[bufpos];
+    inc(bufpos);
+    result := True;
+  end;
+end;
+
+
+(*-----------------------------------------------------------------------------
+  PutChar
+  -------
+  If the buffer is full and dirty, it will be written to disk and restarted.  *)
+
+procedure TBufferedFileStream.WriteByte(b: byte);
+begin
+  Assert(buf_enabled = true);
+
+  if (bufpos >= bufsize) then
+  begin
+    ResetBuffer;
+  end;
+  buf^[bufpos] := b;
+  inc(bufpos);
+  dirty := True;
+end;
+
+
+procedure TBufferedFileStream.EnableBuf;
+begin
+  buf_enabled := true;
+  ResetBuffer;
+
+  {All changes were made directly to the file. No buffer flushing needed.
+  Resume normal buffer operation as usual.}
+end;
+
+procedure TBufferedFileStream.DisableBuf;
+begin
+  buf_enabled := false;
+  ResetBuffer;
+end;
+
+function TBufferedFileStream.ReadBuf(var Buffer; Count: Longint): Longint;
+var
+  b: PBuf;
+  c: byte;
+  i: integer;
+begin
+  Assert(buf_enabled = true);
+
+  b := PBuf(@Buffer);
+
+  for i := 0 to Count-1 do
+  begin
+    GetNextByte(c);
+    b^[i] := c;
+  end;
+
+  result := Count;                                             // return number of bytes read
+end;
+
+function TBufferedFileStream.WriteBuf(const Buffer; Count: Longint): Longint;
+var
+  b: PBuf;
+  i: integer;
+begin
+  Assert(buf_enabled = true);
+
+  b := PBuf(@Buffer);
+  for i := 0 to Count-1 do
+    WriteByte(b^[i]);
+  result := Count;
+end;
+
+
+
+end.