rs26src.zip from torry.net

Archiver Demo/AboutDlgUnit.pas

@@ -0,0 +1,66 @@
+unit AboutDlgUnit;
+{-------------------------------------------------------------------------------
+  About Dialog Unit
+  -----------------
+  The about dialog shows copyright and other information about Resource.
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, Buttons, ComCtrls, ExtCtrls, ShellAPI;
+
+type
+  TAboutDlg = class(TForm)
+    Label1: TLabel;
+    CopyrightLabel: TLabel;
+    VersionLabel: TLabel;
+    Label4: TLabel;
+    Label5: TLabel;
+    Label2: TLabel;
+    Button1: TButton;
+    Button2: TButton;
+    procedure FormShow(Sender: TObject);
+    procedure Label2Click(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  AboutDlg: TAboutDlg;
+
+(**) implementation (**)
+uses CreditFormUnit, StructsUnit;
+
+{$R *.DFM}
+
+procedure TAboutDlg.FormShow(Sender: TObject);
+begin
+  VersionLabel.Caption := reSourceVerStr;
+  CopyrightLabel.Caption := reSourceCopyrightStr;
+end;
+
+procedure TAboutDlg.Label2Click(Sender: TObject);
+begin
+  ShellExecute(0, Nil, 'http://gruv.tripod.com/resource/', Nil, Nil, SW_NORMAL);
+end;
+
+procedure TAboutDlg.Button1Click(Sender: TObject);
+begin
+  CreditsForm.ShowModal;
+end;
+
+end.

Archiver Demo/AddOptionsDlgUnit.pas

@@ -0,0 +1,101 @@
+unit AddOptionsDlgUnit;
+{-------------------------------------------------------------------------------
+  Add Options Dialog Unit
+  -----------------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+
+  Desc:
+  Shown when the user wants to add files to the archive.
+  Allows user to select files to add to the archive through the use of
+  a FileList. A directory tree allows the uses to change directory easily.
+  User can also change drive through a combo box.
+  No typing in of files to add is required. User need only select the files
+  to add.
+
+  Notes:
+  The dialog will check if the user selected the archive file itself to
+  be added. It is impossible to add the archive file to itself so an error
+  will be reported. The archive file will be deselected from the FileList and
+  the user can confirm again the files he selected.
+  This check is only done when the OK button is pressed because it is the most
+  efficient implementation for the set of controls. There are no support events
+  for "OnSelectChange" or similar events.
+
+  Not supported:
+  Directories cannot be added to the archive. To add all files in a directory,
+  select all of them in the FileList.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, Buttons, ComCtrls, FileCtrl;
+
+type
+  TAddOptionsDlg = class(TForm)
+    OKBtn: TBitBtn;
+    CancelBtn: TBitBtn;
+    DirectoryListBox: TDirectoryListBox;
+    FileListBox: TFileListBox;
+    DriveComboBox: TDriveComboBox;
+    procedure FormCreate(Sender: TObject);
+    procedure OKBtnClick(Sender: TObject);
+  private
+  public
+    {set parameters before calling for error check}
+    archive_file_folder, archive_file_name: string;
+  end;
+
+var
+  AddOptionsDlg: TAddOptionsDlg;
+
+(**) implementation (**)
+
+{$R *.DFM}
+
+procedure TAddOptionsDlg.FormCreate(Sender: TObject);
+begin
+  {$IFDEF DEBUG}
+  //DirectoryListBox.Directory := 'c:\ctest\corpus';
+  {$ENDIF}
+end;
+
+procedure TAddOptionsDlg.OKBtnClick(Sender: TObject);
+var
+  i: integer;
+begin
+  // Check that the archive file is not added in
+
+  // The directory format stored in FileListBox.Directory does not include
+  // the back slash, so it must be added
+  if (CompareText(FileListBox.Directory + '\', archive_file_folder) = 0) then
+  begin
+    for i := 0 to FileListBox.Items.Count-1 do
+    begin
+      if FileListBox.Selected[i] then
+        if (CompareText(FileListBox.Items[i], archive_file_name) = 0) then
+        begin
+          // found the archive file that was selected
+          // show message box to deselect it
+          Application.MessageBox('You have selected the archive file. It will be deselected.',
+                                 'Select Error', 0);
+          // deselect the file
+          FileListBox.Selected[i] := false;
+          // prevent the form from closing for the user to confirm selection again
+          ModalResult := 0;
+          break;
+        end;
+    end;
+  end;
+end;
+
+end.

Archiver Demo/BrowseForDirUnit.pas

@@ -0,0 +1,72 @@
+unit BrowseForDirUnit;
+{-------------------------------------------------------------------------------
+  Browse for Dir Unit
+  -------------------
+  Contains a form which allows the user to select a directory by means of
+  a directory tree.
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+
+Used in:
+  ConigDialog, where the user selects the custom temp directory.
+
+Usage:
+  retrieve the directory from the directory property.
+  The dialog box will open in the current directory.
+-------------------------------------------------------------------------------}
+
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, Buttons, FileCtrl;
+
+type
+  TBrowseForDirForm = class(TForm)
+    DirectoryListBox: TDirectoryListBox;
+    OKBtn: TBitBtn;
+    CancelBtn: TBitBtn;
+    Label1: TLabel;
+    Label2: TLabel;
+    procedure OKBtnClick(Sender: TObject);
+    procedure CancelBtnClick(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+    fdirectory: string;
+  public
+    property directory: string read fdirectory;
+
+  end;
+
+var
+  BrowseForDirForm: TBrowseForDirForm;
+
+(**) implementation (**)
+Uses Main;
+
+{$R *.DFM}
+
+procedure TBrowseForDirForm.OKBtnClick(Sender: TObject);
+begin
+  fdirectory := DirectoryListBox.Directory;
+end;
+
+procedure TBrowseForDirForm.CancelBtnClick(Sender: TObject);
+begin
+  fdirectory := '';
+end;
+
+procedure TBrowseForDirForm.FormShow(Sender: TObject);
+begin
+  CentreFormToMain(Self);
+end;
+
+end.

Archiver Demo/CompressionStatsDlgUnit.pas

@@ -0,0 +1,204 @@
+unit CompressionStatsDlgUnit;
+{-------------------------------------------------------------------------------
+  Compression Statistics Dialog Unit
+  ----------------------------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+  Desc:
+  The compression stats dialog shows compression stats and averages for the
+  files in the archive.
+  Useful for comparing against other archivers.
+
+  Features:
+  Able to print out the compression stats.
+  Font can be changed.
+
+  Workings:
+  The stats are calculated just before the form is shown. (OnShow)
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  Menus, StdCtrls, Buttons, ComCtrls;
+
+type
+  TCompressionStatsDlg = class(TForm)
+    RichEdit: TRichEdit;
+    PrintDialog: TPrintDialog;
+    MainMenu: TMainMenu;
+    File1: TMenuItem;
+    MIPrint: TMenuItem;
+    MIExit: TMenuItem;
+    FontDialog: TFontDialog;
+    RichEditPopup: TPopupMenu;
+    MIFont: TMenuItem;
+    N1: TMenuItem;
+    MICopytoClipboard: TMenuItem;
+    procedure MIPrintClick(Sender: TObject);
+    procedure MIExitClick(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure FontDialogApply(Sender: TObject; Wnd: Integer);
+    procedure MIFontClick(Sender: TObject);
+    procedure MICopytoClipboardClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  CompressionStatsDlg: TCompressionStatsDlg;
+
+(**) implementation (**)
+uses Main, ArchiveHeadersUnit, StructsUnit;
+
+{$R *.DFM}
+
+procedure TCompressionStatsDlg.MIPrintClick(Sender: TObject);
+begin
+  if PrintDialog.Execute then
+  begin
+    // print the statistics
+    RichEdit.Print('Caption');
+  end;
+end;
+
+procedure TCompressionStatsDlg.MIExitClick(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TCompressionStatsDlg.FormShow(Sender: TObject);
+
+  procedure AddColLine(const s: string);
+  begin
+    // The tabs have to be set for every paragraph in Rich Edit.
+    // Each line is a paragraph, so the tabs have to be set for every line.
+    with RichEdit do
+    begin
+      SelStart := length(Text);
+      With Paragraph do
+      begin
+        Tab[0] := 100;            // filename
+        Tab[1] := Tab[0] + 80;    // uncompressed
+        Tab[2] := Tab[1] + 80;    // compressed
+        Tab[3] := Tab[2] + 80;    // ratio
+        Tab[4] := Tab[3] + 80;    // bits per byte
+      end;
+      Lines.Add(s);
+    end;
+  end;
+
+
+var
+  i: integer;
+  CentralFileHeader: TCentralFileHeader;
+  s, ws: string;
+  total_bits_per_byte: extended;
+  bits_per_byte: extended;
+  compression_ratio, total_ratio: integer;     // ratios
+  total_raw_size, total_compressed_size: integer;
+  num_files: integer;
+begin
+  CentreFormToMain(Self);
+  
+  with RichEdit.Lines, MainForm do
+  begin
+    num_files := Resource1.ArchiveMan.ArchiveFile.CentralDir.Count;
+    total_bits_per_byte := 0;
+    total_ratio := 0;
+    total_raw_size := 0;
+    total_compressed_size := 0;
+
+    Clear;
+    Add('reSource Engine ' + reSourceVerStr);
+    Add('Burrows Wheeler Transformation (BWT) Compression');
+    Add('');
+    Add('Compression statistics for file: ' + Resource1.ArchiveMan.archive_file_full_path);
+    Add('');
+    if (num_files > 0) then
+    begin
+      AddColLine('File name' + #9 + 'Raw size' + #9 + 'Compressed' + #9 + 'Ratio' + #9  + 'Bits per byte');
+      AddColLine('---------' + #9 + '--------' + #9 + '----------' + #9 + '-----' + #9  + '-------------');
+
+      for i := 0 to num_files-1 do
+      begin
+        CentralFileHeader := Resource1.ArchiveMan.ArchiveFile.CentralDir[i] as TCentralFileHeader;
+        with CentralFileHeader do
+        begin
+          // update bits per byte
+          bits_per_byte := GetBitsPerByte(compressed_size, uncompressed_size);
+          total_bits_per_byte := total_bits_per_byte + bits_per_byte;
+          // update compression ratio
+          compression_ratio := GetCompressionRatio(compressed_size, uncompressed_size);
+          inc(total_ratio, compression_ratio);
+          // update totals
+          inc(total_raw_size, uncompressed_size);
+          inc(total_compressed_size, compressed_size);
+
+          s := '';
+          s := filename + #9 +
+               IntToStr(uncompressed_size) + #9 +
+               IntToStr(compressed_size) + #9 +
+               IntToStr(compression_ratio) + '%' + #9 +
+               GetBitsPerByteStr(compressed_size, uncompressed_size);
+
+          AddColLine(s);
+        end;
+      end;
+
+      Str((total_bits_per_byte / num_files):5:3 {(total_compressed_size * 8 / total_raw_size):5:3}, ws);
+      s := 'Average' + #9 +
+           IntToStr(total_raw_size) + #9 +
+           IntToStr(total_compressed_size) + #9 +
+           IntToStr(total_ratio div num_files) + '%' + #9 +    // add average ratio
+           ws;                                                     // add average bits per byte
+
+      AddColLine('---------' + #9 + '------------' + #9 + '----------' + #9 + '-----' + #9  + '-------------');
+      AddColLine(s);
+      Add('');
+      Add('Number of files: ' + IntToStr(num_files));
+    end
+    else
+    begin
+      Add('There are no files in this archive.');
+    end;
+  end; {with}
+
+end;
+
+procedure TCompressionStatsDlg.FontDialogApply(Sender: TObject;
+  Wnd: Integer);
+begin
+  RichEdit.Font := FontDialog.Font;
+end;
+
+procedure TCompressionStatsDlg.MIFontClick(Sender: TObject);
+begin
+  FontDialog.Font := RichEdit.Font;
+  if FontDialog.Execute then
+    RichEdit.Font := FontDialog.Font;
+end;
+
+procedure TCompressionStatsDlg.MICopytoClipboardClick(Sender: TObject);
+begin
+  MainForm.ShowBusy;
+  with RichEdit do
+  begin
+    SelectAll;         // select everything then copy to clipboard
+    CopyToClipBoard;
+    SelLength := 0;    // deselect everything
+  end;
+  MainForm.ShowReady;
+end;
+
+end.

Archiver Demo/ConfigDlgUnit.pas

@@ -0,0 +1,144 @@
+unit ConfigDlgUnit;
+{-------------------------------------------------------------------------------
+  Configuration Dialog Unit
+  -------------------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+
+  Desc:
+  The interface for ConfigMan.
+  Anything that is configurable by the user is exposed through ConfigDlg
+  It will also check if the input is valid.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, Buttons, ComCtrls;
+
+type
+  TConfigDlg = class(TForm)
+    PageControl: TPageControl;
+    OKBtn: TBitBtn;
+    CancelBtn: TBitBtn;
+    TabSheet1: TTabSheet;
+    GroupBox1: TGroupBox;
+    RBUseWindowsDefaultTempDir: TRadioButton;
+    RBUseCustomTempDir: TRadioButton;
+    WinDefTempDirLabel: TLabel;
+    TabSheet2: TTabSheet;
+    GroupBox2: TGroupBox;
+    XBConfirmOnDelete: TCheckBox;
+    CustomTempDirBtn: TBitBtn;
+    CustomTempDirLabel: TLabel;
+    procedure FormActivate(Sender: TObject);
+    procedure CustomTempDirBtnClick(Sender: TObject);
+    procedure OKBtnClick(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+  public
+
+  end;
+
+var
+  ConfigDlg: TConfigDlg;
+
+(**) implementation (**)
+uses ConfigUnit, BrowseForDirUnit, EDosUnit, Main;
+
+{$R *.DFM}
+
+
+{-------------------------------------------------------------------------------
+FormActivate
+------------
+Init all the fields with their respective data from ConfigMan.
+-------------------------------------------------------------------------------}
+procedure TConfigDlg.FormActivate(Sender: TObject);
+begin
+  // read in the config from ConfigMan
+  with ConfigMan do
+  begin
+    // temporary directory
+    WinDefTempDirLabel.Caption := ConfigMan.default_temp_dir;
+    if (temp_dir = default_temp_dir) then
+      RBUseWindowsDefaultTempDir.Checked := true
+    else
+    begin
+      RBUseCustomTempDir.Checked := true;
+      CustomTempDirLabel.Caption := temp_dir;
+    end;
+
+    // confirmation
+    XBConfirmOnDelete.Checked := confirm_on_delete;
+  end;
+end;
+
+{-------------------------------------------------------------------------------
+CustomTempDirBtnClick
+---------------------
+Let the user choose their own cutom directory using BrowseForDirForm.
+Will auto select the radio button for custom temp dir if user has not done so
+-------------------------------------------------------------------------------}
+procedure TConfigDlg.CustomTempDirBtnClick(Sender: TObject);
+var
+  dir: string;
+begin
+  if (BrowseForDirForm.ShowModal = mrOK) then
+  begin
+    dir := BrowseForDirForm.Directory;
+    EDos.AddSlash(dir);
+    CustomTempDirLabel.Caption := dir;
+    RBUseCustomTempDir.Checked := true;
+  end
+  else
+    RBUseWindowsDefaultTempDir.Checked := true;
+
+end;
+
+{-------------------------------------------------------------------------------
+OKBtnClick
+----------
+Save the config to ConfigMan
+-------------------------------------------------------------------------------}
+procedure TConfigDlg.OKBtnClick(Sender: TObject);
+begin
+  // save the config to ConfigMan
+
+  // confirm on delete
+  ConfigMan.confirm_on_delete := XBConfirmOnDelete.Checked;
+
+  // temporary directory
+  if (RBUseWindowsDefaultTempDir.Checked) then
+    ConfigMan.temp_dir := ConfigMan.default_temp_dir
+  else
+  begin
+    // check the temp_dir is not empty
+    if (CustomTempDirLabel.Caption = '') then
+    begin
+      Application.MessageBox('The custom temporary directory is invalid. Please correct it.', 'Error', 0);
+      PageControl.ActivePage := TabSheet1;
+      ModalResult := 0;
+    end
+    else
+      ConfigMan.temp_dir := CustomTempDirLabel.Caption;
+  end;
+end;
+
+
+
+
+procedure TConfigDlg.FormShow(Sender: TObject);
+begin
+  CentreFormToMain(Self);
+end;
+
+end.

Archiver Demo/ConfigUnit.pas

@@ -0,0 +1,97 @@
+unit ConfigUnit;
+{-------------------------------------------------------------------------------
+  Configuration Unit
+  ------------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+
+  Desc:
+  All configurable variables are stored in the ConfigMan class.
+  The user uses the interface, ConfigDlg to change these values.
+
+-------------------------------------------------------------------------------}
+
+(**) interface (**)
+uses SysUtils, Windows;
+
+
+type
+  TConfigMan = class
+  private
+    FShowDebugForm: boolean;
+    procedure EnableDebugForm(enable: boolean);
+    
+  public
+    ClipDebugFormToMainForm: boolean;
+
+    temp_dir: string;
+    default_temp_dir: string;
+
+    confirm_on_delete: boolean;
+    property ShowDebugForm: boolean read FShowDebugForm write EnableDebugForm;
+
+    constructor Create;
+    procedure ResetDefaults;
+  end;
+
+var
+  ConfigMan: TConfigMan;
+
+
+(**) implementation (**)
+uses DebugFormUnit, EDosUnit;
+
+constructor TConfigMan.Create;
+begin
+  inherited Create;
+  ResetDefaults;
+end;
+
+
+procedure TConfigMan.ResetDefaults;
+var
+  dir: PChar;
+begin
+  ShowDebugForm := false;
+  ClipDebugFormToMainForm := true;
+
+  // get the windows default temp dir
+  dir := StrAlloc(MAX_PATH + 1);
+  GetTempPath(MAX_PATH, dir);
+  default_temp_dir := dir;
+  StrDispose(dir);
+  EDos.AddSlash(default_temp_dir);
+  temp_dir := default_temp_dir;
+
+  confirm_on_delete := false;
+end;
+
+procedure TConfigMan.EnableDebugForm(enable: boolean);
+begin
+  FShowDebugForm := enable;
+  if (enable = false) then
+  begin
+    if Assigned(DebugForm) then
+    begin
+      DebugForm.Free;
+      DebugForm := nil;
+    end;
+  end
+  else
+  begin
+    DebugForm := TDebugForm.Create(nil);
+    DebugForm.Show;
+  end;
+end;
+
+initialization
+  ConfigMan := TConfigMan.Create;
+finalization
+  ConfigMan.Free;
+end.

Archiver Demo/CreditFormUnit.dfm

@@ -0,0 +1,99 @@
+object CreditsForm: TCreditsForm
+  Left = 250
+  Top = 171
+  BorderStyle = bsDialog
+  Caption = 'Credits'
+  ClientHeight = 276
+  ClientWidth = 369
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Memo1: TMemo
+    Left = 9
+    Top = 14
+    Width = 352
+    Height = 211
+    Lines.Strings = (
+      'read readme.txt for more info'
+      
+        'read resource.txt for description of files and more information ' +
+        'about'
+      'understanding this whole program.'
+      ''
+      ''
+      'credits:'
+      'i would like to thank:'
+      ''
+      '    Mark Nelson, who with his wonderful book,'
+      ''
+      '    Michael Burrows  and  David J. Wheeler for the block sorting'
+      'algorithm.'
+      ''
+      '    Peter  Fenwick'#39's for his tuned structured arithmetic encoder'
+      ''
+      
+        '    Kunihiko Sadakane'#39's Suffix sort, which rocks, and imho is th' +
+        'e'
+      'best'
+      '    general purpose sorter for the block sorting algorithm.'
+      ''
+      '    Angus Johnson, Anders Melander & Graham Wideman for their'
+      'wonderful, totally incredible drag and drop package. I had'
+      'managed to incorporate the older version of their package into'
+      
+        'resource and it turned instantly totally drag and drop to and fr' +
+        'om'
+      'explorer.. simply amazing.'
+      ''
+      
+        '   Julian Seward, author of BZip. BZip really inspired me to wri' +
+        'te on,'
+      
+        'although i didn'#39't really understand much of the '#39'c'#39' implementati' +
+        'on of'
+      'the BWT algorithm... ;-)'
+      ''
+      ''
+      
+        '   the author(s) of the delphi superpage and delphi deli, withou' +
+        't'
+      'which i may not even have been able to have finished.'
+      ''
+      ''
+      
+        '   and of course Inprise for creating Delphi, which is totally r' +
+        'adical!'
+      
+        '   (and Inprise: when are we gonna have inline functions? it wil' +
+        'l'
+      'surely'
+      'speed up delphi apps alot!)'
+      ''
+      
+        '   loop guru for excellent groove and inspirational music. if yo' +
+        'u'
+      
+        'haven'#39't listened to them, you don'#39't know what real cross cultura' +
+        'l,'
+      #39'no'
+      'barriers'#39' is...')
+    ScrollBars = ssVertical
+    TabOrder = 0
+  end
+  object Button1: TButton
+    Left = 288
+    Top = 240
+    Width = 75
+    Height = 25
+    Cancel = True
+    Caption = 'Close'
+    ModalResult = 1
+    TabOrder = 1
+  end
+end

Archiver Demo/CreditFormUnit.pas

@@ -0,0 +1,39 @@
+unit CreditFormUnit;
+{-------------------------------------------------------------------------------
+ Credits Form
+ Shows credits.
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+-------------------------------------------------------------------------------}
+ 
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls;
+
+type
+  TCreditsForm = class(TForm)
+    Memo1: TMemo;
+    Button1: TButton;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  CreditsForm: TCreditsForm;
+
+implementation
+
+{$R *.DFM}
+
+end.

Archiver Demo/DebugFormUnit.pas

@@ -0,0 +1,92 @@
+unit DebugFormUnit;
+{-------------------------------------------------------------------------------
+  DebugFormUnit
+  -------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+  Desc:
+  Currently defunct.
+  Used for showing the status or stage of the compression. Useful to detect
+  for stalls or 'hangs' that may occur (and many did).
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  ExtCtrls, StdCtrls;
+
+type
+  TDebugForm = class(TForm)
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    Label4: TLabel;
+    ArrowImage: TImage;
+    procedure FormClose(Sender: TObject; var Action: TCloseAction);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+
+    procedure DoingSorting;
+    procedure DoingMTF;
+    procedure DoingTransform;
+    procedure DoingAriCompress;
+  end;
+
+var
+  DebugForm: TDebugForm;
+
+(**) implementation (**)
+uses ConfigUnit;
+
+{$R *.DFM}
+
+
+const
+  ArrowInitialTop = 15;
+  ArrowMoveHeight = 25;
+
+
+procedure TDebugForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+  Action := caFree;
+  DebugForm := nil;
+  ConfigMan.ShowDebugForm := false;
+end;
+
+procedure TDebugForm.DoingSorting;
+begin
+  ArrowImage.Top := ArrowInitialTop;
+  Application.ProcessMessages;
+end;
+
+procedure TDebugForm.DoingTransform;
+begin
+  ArrowImage.Top := ArrowInitialTop + ArrowMoveHeight;
+  Application.ProcessMessages;
+end;
+
+procedure TDebugForm.DoingMTF;
+begin
+  ArrowImage.Top := ArrowInitialTop + ArrowMoveHeight*2;
+  Application.ProcessMessages;
+end;
+
+procedure TDebugForm.DoingAriCompress;
+begin
+  ArrowImage.Top := ArrowInitialTop + ArrowMoveHeight*3;
+  Application.ProcessMessages;
+end;
+
+
+
+end.

Archiver Demo/ExtractOptionsDlgUnit.pas

@@ -0,0 +1,92 @@
+unit ExtractOptionsDlgUnit;
+{-------------------------------------------------------------------------------
+  ExtractOptionsDlgUnit
+  ---------------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+  
+
+  Desc:
+  Shows a directory list that allows the user to select the directory
+  to extract to.
+
+-------------------------------------------------------------------------------}
+
+{  if not EDos.FileExists(DriveComboBox.drive + ':') then
+  begin
+    Application.MessageBox(PChar('The drive ' + DriveComboBox.drive + ' is not available. Please select another drive.'),
+                           'IO Error', 0);
+
+  end;}
+
+
+(**) interface (**)
+
+uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
+  Buttons, ExtCtrls, FileCtrl, ComCtrls, Dialogs;
+
+type
+  TExtractOptionsDlg = class(TForm)
+    GroupBox1: TGroupBox;
+    RBExtractAllFiles: TRadioButton;
+    RBExtractSelectedFiles: TRadioButton;
+    Label1: TLabel;
+    OKBtn: TBitBtn;
+    CancelBtn: TBitBtn;
+    DirTree: TDirectoryListBox;
+    DriveComboBox: TDriveComboBox;
+    procedure DirectoryListBoxChange(Sender: TObject);
+    procedure FormActivate(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+  private
+
+  public
+    function ExtractDir: string;
+  end;
+
+var
+  ExtractOptionsDlg: TExtractOptionsDlg;
+
+(**) implementation (**)
+uses EDosUnit, Main;
+
+{$R *.DFM}
+
+
+function TExtractOptionsDlg.ExtractDir: string;
+begin
+  result := DirTree.Directory;
+  EDos.AddSlash(result);
+end;
+
+procedure TExtractOptionsDlg.DirectoryListBoxChange(Sender: TObject);
+begin
+  //ExtractDirEdit.Text := DirectoryListBox.Directory;
+end;
+
+procedure TExtractOptionsDlg.FormActivate(Sender: TObject);
+begin
+  //ExtractDirEdit.Text := DirectoryListBox.Directory;
+end;
+
+procedure TExtractOptionsDlg.FormCreate(Sender: TObject);
+begin
+  {$IFDEF DEBUG}
+  //DirTree.Directory := 'c:\ctestout';
+  {$ENDIF}
+end;
+
+procedure TExtractOptionsDlg.FormShow(Sender: TObject);
+begin
+  CentreFormToMain(Self);
+end;
+
+end.
+

Archiver Demo/FileAttrDlgUnit.pas

@@ -0,0 +1,110 @@
+unit FileAttrDlgUnit;
+{-------------------------------------------------------------------------------
+  File Attribute Dialog Unit
+  --------------------------
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+  Interface for the user to change the file attributes in the archive.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, Buttons,
+  ArchiveHeadersUnit;
+
+type
+  TFileAttrDlg = class(TForm)
+    NameEdit: TEdit;
+    Label1: TLabel;
+    Label2: TLabel;
+    GroupBox1: TGroupBox;
+    XBReadOnly: TCheckBox;
+    XBHidden: TCheckBox;
+    XBArchive: TCheckBox;
+    XBSystem: TCheckBox;
+    OKBtn: TBitBtn;
+    CancelBtn: TBitBtn;
+    LastModifiedDateLabel: TLabel;
+    Label3: TLabel;
+    SizeLabel: TLabel;
+    procedure FormShow(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+    function Execute(CentralFileHeader: TCentralFileHeader): integer;
+    procedure GetCentralFileHeader(CentralFileHeader: TCentralFileHeader);
+  end;
+
+var
+  FileAttrDlg: TFileAttrDlg;
+
+(**) implementation (**)
+uses Main;
+
+{$R *.DFM}
+
+
+function TFileAttrDlg.Execute(CentralFileHeader: TCentralFileHeader): integer;
+var
+  s: string;
+begin
+  // initialize fields with info from CentralFileHeader
+  with CentralFileHeader do
+  begin
+    // name
+    NameEdit.Text := FileName;
+    // size
+    SizeLabel.Caption := Format('%d', [uncompressed_size]) + ' bytes';
+    // date
+    DateTimeToString(s, 'dddd, mmmm d, yyyy hh:nn:ss AM/PM', FileDateToDateTime(time));
+    LastModifiedDateLabel.Caption := s;
+    // attributes
+    XBReadOnly.Checked := (attr and faReadOnly <> 0);
+    XBArchive.Checked := (attr and faArchive <> 0);
+    XBHidden.Checked := (attr and faHidden <> 0);
+    XBSystem.Checked := (attr and faSysFile <> 0);
+  end;
+  result := ShowModal;
+end;
+
+{-------------------------------------------------------------------------------
+  GetCentralFileHeader
+  --------------------
+
+  Updates CentralFileHeader with the data in the dialog
+-------------------------------------------------------------------------------}
+procedure TFileAttrDlg.GetCentralFileHeader(CentralFileHeader: TCentralFileHeader);
+var
+  nattr: integer;
+begin
+  // store new attribute in nattr
+  nattr := 0;
+  if (XBReadOnly.Checked) then nattr := nattr or faReadOnly;
+  if (XBArchive.Checked) then nattr := nattr or faArchive;
+  if (XBHidden.Checked) then nattr := nattr or faHidden;
+  if (XBSystem.Checked) then nattr := nattr or faSysFile;
+
+  with CentralFileHeader do
+  begin
+    FileName := NameEdit.Text;
+    attr := nattr;
+  end;
+end;
+
+
+procedure TFileAttrDlg.FormShow(Sender: TObject);
+begin
+  CentreFormToMain(Self);
+end;
+
+end.

Archiver Demo/ProgStatsDlgUnit.pas

@@ -0,0 +1,76 @@
+unit ProgStatsDlgUnit;
+{-------------------------------------------------------------------------------
+  Program Statistics Dialog
+  -------------------------
+  show program statistics
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+  Use:
+  To check if memory is enough, or if we are out of memory.
+  To help in debugging if the user reports a bug to the developer.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls, ComCtrls;
+
+type
+  TProgStatsDlg = class(TForm)
+    RichEdit: TRichEdit;
+    procedure FormShow(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  ProgStatsDlg: TProgStatsDlg;
+
+(**) implementation (**)
+uses Main, StructsUnit;
+
+{$R *.DFM}
+
+procedure TProgStatsDlg.FormShow(Sender: TObject);
+var
+  HeapStatus: THeapStatus;
+begin
+  CentreFormToMain(Self);
+
+  // fill in the program stats richedit
+  HeapStatus := GetHeapStatus;
+  with RichEdit.Lines, RichEdit, HeapStatus do
+  begin
+    Clear;
+    Add('reSource ' + reSourceVerStr);
+    Add('Burrows Wheeler Transformation (BWT) Compressor');
+    Add(reSourceCopyrightStr);
+    Add('');
+    Add('Engine:');
+    Add('Block Size = ' + IntToStr(BlockSize));
+    Add('');
+    Add('Program:');
+    Add('rs Total Allocated = ' + IntToStr(TotalAllocated));
+    Add('Heap manager overhead = ' + IntToStr(Overhead));
+    Add('');
+    Add('System:');
+    Add('Win Total Address Space = ' + IntToStr(TotalAddrSpace));
+    Add('Win Total Uncommitted = ' + IntToStr(TotalUncommitted));
+    SelStart := 0;
+  end;
+end;
+
+
+
+
+end.

Archiver Demo/ReSource.SUP

@@ -0,0 +1,5 @@
+//SUPPRESSIONPROJ:ReSource
+//VERSION:5.00
+//ENABLE:Yes
+!include DELPHI.SUP
+

Archiver Demo/ReSource.cfg

@@ -0,0 +1,35 @@
+-$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
+-LE"c:\borland\delphi5\Projects\Bpl"
+-LN"c:\borland\delphi5\Projects\Bpl"

Archiver Demo/ReSource.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=
+
+[Directories]
+OutputDir=
+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=2
+MinorVer=6
+Release=0
+Build=0
+Debug=0
+PreRelease=1
+Special=0
+Private=0
+DLL=0
+Locale=1033
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=Resource
+FileVersion=2.6.0.0
+InternalName=Resource experimental
+LegalCopyright=Victor K
+LegalTrademarks=
+OriginalFilename=Resource
+ProductName=Resource
+ProductVersion=1.0.0.0
+Comments=The BWT Block compressor
+
+[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\rs
+Item1=c:\temp\cg
+
+[HistoryLists\hlBPLOutput]
+Count=1
+Item0=c:\temp\rs

Archiver Demo/ReSource.dpr

@@ -0,0 +1,34 @@
+program reSource;
+
+uses
+  Forms,
+  main in 'main.pas' {MainForm},
+  DebugFormUnit in 'DebugFormUnit.pas' {DebugForm},
+  ConfigUnit in 'ConfigUnit.pas',
+  ExtractOptionsDlgUnit in 'ExtractOptionsDlgUnit.pas' {ExtractOptionsDlg},
+  AddOptionsDlgUnit in 'AddOptionsDlgUnit.pas' {AddOptionsDlg},
+  AboutDlgUnit in 'AboutDlgUnit.pas' {AboutDlg},
+  ConfigDlgUnit in 'ConfigDlgUnit.pas' {ConfigDlg},
+  FileAttrDlgUnit in 'FileAttrDlgUnit.pas' {FileAttrDlg},
+  BrowseForDirUnit in 'BrowseForDirUnit.pas' {BrowseForDirForm},
+  CompressionStatsDlgUnit in 'CompressionStatsDlgUnit.pas' {CompressionStatsDlg},
+  ProgStatsDlgUnit in 'ProgStatsDlgUnit.pas' {ProgStatsDlg},
+  CreditFormUnit in 'CreditFormUnit.pas' {CreditsForm};
+
+{$R *.RES}
+
+begin
+  Application.Initialize;
+  Application.Title := 'reSource v2.6';
+  Application.CreateForm(TMainForm, MainForm);
+  Application.CreateForm(TExtractOptionsDlg, ExtractOptionsDlg);
+  Application.CreateForm(TAddOptionsDlg, AddOptionsDlg);
+  Application.CreateForm(TAboutDlg, AboutDlg);
+  Application.CreateForm(TConfigDlg, ConfigDlg);
+  Application.CreateForm(TFileAttrDlg, FileAttrDlg);
+  Application.CreateForm(TBrowseForDirForm, BrowseForDirForm);
+  Application.CreateForm(TCompressionStatsDlg, CompressionStatsDlg);
+  Application.CreateForm(TProgStatsDlg, ProgStatsDlg);
+  Application.CreateForm(TCreditsForm, CreditsForm);
+  Application.Run;
+end.

Archiver Demo/ReSource.dsk

@@ -0,0 +1,282 @@
+[Closed Files]
+File_0=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\ProgStatsDlgUnit.pas',0,1,1,1,13,1,0
+File_1=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\main.pas',0,1,1,1,13,1,0
+File_2=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\FileAttrDlgUnit.pas',0,1,1,1,12,1,0
+File_3=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\ExtractOptionsDlgUnit.pas',0,1,1,1,12,1,0
+File_4=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\DebugFormUnit.pas',0,1,1,1,12,1,0
+File_5=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\CreditFormUnit.pas',0,1,1,1,12,0,0
+File_6=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\ConfigUnit.pas',0,1,1,1,12,0,0
+File_7=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\ConfigDlgUnit.pas',0,1,1,1,12,0,0
+File_8=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\CompressionStatsDlgUnit.pas',0,1,1,1,12,0,0
+File_9=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\BrowseForDirUnit.pas',0,1,1,1,14,1,0
+
+[Modules]
+Module0=C:\Save\Delphi\resource\Archiver Demo\ReSource.dpr
+Count=1
+EditWindowCount=1
+
+[C:\Save\Delphi\resource\Archiver Demo\ReSource.dpr]
+ModuleType=SourceModule
+FormState=0
+FormOnTop=0
+
+[C:\Save\Delphi\resource\Archiver Demo\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=100
+MaxWidth=808
+MaxHeight=476
+ClientWidth=800
+ClientHeight=449
+LeftPanelSize=0
+LeftPanelClients=CodeExplorer@EditWindow0
+LeftPanelData=00000400010000000C000000436F64654578706C6F7265720000000000000000000000000000000000FFFFFFFF
+RightPanelSize=0
+BottomPanelSize=77
+BottomPanelClients=CallStackWindow,WatchWindow,MessageView@EditWindow0
+BottomPanelData=00000400020000000F00000043616C6C537461636B57696E646F770B000000576174636857696E646F772003000000000000004D000000000000000100000000200300000B0000004D65737361676556696577FFFFFFFF
+
+[View0]
+Module=C:\Save\Delphi\resource\Archiver Demo\ReSource.dpr
+CursorX=59
+CursorY=9
+TopLine=1
+LeftCol=1
+
+[Watches]
+Count=0
+
+[Breakpoints]
+Count=1
+Breakpoint0='C:\Save\Delphi\resource\Component\BWTCompressUnit.pas',299,'',0,1,'',1,0,0,'',1,'','',''
+
+[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=1
+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
+

Archiver Demo/ResourcePack.cfg

@@ -0,0 +1,42 @@
+-$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"
+-N"c:\temp\cg"
+-LE"c:\borland\delphi5\Projects\Bpl"
+-LN"c:\borland\delphi5\Projects\Bpl"
+-U"c:\save\delphi\flib"
+-O"c:\save\delphi\flib"
+-I"c:\save\delphi\flib"
+-R"c:\save\delphi\flib"
+-Z

Archiver Demo2/Main.dfm

@@ -0,0 +1,204 @@
+object MainForm: TMainForm
+  Left = 261
+  Top = 106
+  BorderStyle = bsDialog
+  Caption = 'reSource Demo 2'
+  ClientHeight = 394
+  ClientWidth = 443
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'MS Sans Serif'
+  Font.Style = []
+  OldCreateOrder = False
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Label1: TLabel
+    Left = 8
+    Top = 8
+    Width = 335
+    Height = 13
+    Caption = 
+      'This demo shows the use of CompressToFile and DecompressFromFile' +
+      '.'
+  end
+  object Label2: TLabel
+    Left = 8
+    Top = 24
+    Width = 312
+    Height = 13
+    Caption = 
+      'These procedures compress  one file to it'#39's corresponding archiv' +
+      'e.'
+  end
+  object Label3: TLabel
+    Left = 29
+    Top = 59
+    Width = 44
+    Height = 13
+    Caption = 'File Path:'
+    FocusControl = SourceFileEdit
+  end
+  object Label4: TLabel
+    Left = 8
+    Top = 81
+    Width = 64
+    Height = 13
+    Caption = 'Archive Path:'
+    FocusControl = ArchiveFileEdit
+  end
+  object Label5: TLabel
+    Left = 148
+    Top = 374
+    Width = 131
+    Height = 18
+    Caption = 'reSource Demo 2'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -16
+    Font.Name = 'Arial'
+    Font.Style = [fsBold, fsItalic]
+    ParentFont = False
+  end
+  object Bevel1: TBevel
+    Left = 0
+    Top = 155
+    Width = 441
+    Height = 9
+    Shape = bsBottomLine
+  end
+  object Label6: TLabel
+    Left = 8
+    Top = 218
+    Width = 64
+    Height = 13
+    Caption = 'Archive Path:'
+    FocusControl = DecompressArchiveEdit
+  end
+  object Label7: TLabel
+    Left = 8
+    Top = 179
+    Width = 106
+    Height = 13
+    Caption = 'Name of file to extract:'
+  end
+  object Label8: TLabel
+    Left = 264
+    Top = 172
+    Width = 157
+    Height = 13
+    Caption = '(The file must exist in the archive)'
+  end
+  object Label9: TLabel
+    Left = 8
+    Top = 245
+    Width = 72
+    Height = 13
+    Caption = 'Destination Dir:'
+  end
+  object Label10: TLabel
+    Left = 264
+    Top = 188
+    Width = 143
+    Height = 13
+    Caption = 'Leave blank to extract all files.'
+  end
+  object CompressBtn: TButton
+    Left = 56
+    Top = 120
+    Width = 345
+    Height = 33
+    Caption = 'Compress File to Archive'
+    TabOrder = 4
+    OnClick = CompressBtnClick
+  end
+  object DecompressBtn: TButton
+    Left = 56
+    Top = 337
+    Width = 345
+    Height = 33
+    Caption = 'Decompress File From Archive'
+    TabOrder = 9
+    OnClick = DecompressBtnClick
+  end
+  object SourceFileEdit: TEdit
+    Left = 80
+    Top = 54
+    Width = 321
+    Height = 21
+    TabOrder = 0
+  end
+  object ArchiveFileEdit: TEdit
+    Left = 80
+    Top = 78
+    Width = 321
+    Height = 21
+    TabOrder = 2
+  end
+  object BrowseSourceBtn: TButton
+    Left = 408
+    Top = 55
+    Width = 25
+    Height = 21
+    Caption = '...'
+    TabOrder = 1
+    OnClick = BrowseSourceBtnClick
+  end
+  object BrowseArchiveBtn: TButton
+    Left = 408
+    Top = 79
+    Width = 25
+    Height = 21
+    Caption = '...'
+    TabOrder = 3
+    OnClick = BrowseArchiveBtnClick
+  end
+  object DecompressArchiveEdit: TEdit
+    Left = 88
+    Top = 215
+    Width = 313
+    Height = 21
+    TabOrder = 6
+  end
+  object BrowseBtn2: TButton
+    Left = 408
+    Top = 216
+    Width = 25
+    Height = 21
+    Caption = '...'
+    TabOrder = 7
+    OnClick = BrowseBtn2Click
+  end
+  object ExtractFileNameEdit: TEdit
+    Left = 124
+    Top = 175
+    Width = 133
+    Height = 21
+    TabOrder = 5
+  end
+  object DirListBox: TDirectoryListBox
+    Left = 89
+    Top = 245
+    Width = 169
+    Height = 81
+    ItemHeight = 16
+    TabOrder = 8
+  end
+  object SaveDialog1: TSaveDialog
+    Filter = 'reSource Archive (*.rs)|*.rs'
+    Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
+    Title = 'The File To Compress'
+    Left = 408
+    Top = 104
+  end
+  object OpenDialog1: TOpenDialog
+    Title = 'Select Archive File. Type a new name to Create a new Archive.'
+    Left = 400
+    Top = 24
+  end
+  object Resource1: TResource
+    Left = 8
+    Top = 104
+  end
+end

Archiver Demo2/Main.pas

@@ -0,0 +1,113 @@
+unit Main;
+
+{ reSource Demo 2
+  Demonstrates the use of reSource to compress/decompress one file
+  at a time.
+  This behaviour is more similar to like what MS does in some of
+  their installation disks, where each individual file is compressed.
+
+  The main procedures are:
+  CompressToArchive
+  DecompressFromArchive
+  
+}
+
+
+(**) interface (**)
+
+uses
+  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+  StdCtrls,
+  // engine - include the following units in your app to access TCentralFileHeader etc.
+  // your search path must contain the dir the units are located in.
+  ResourceCompUnit,
+  ArchiveHeadersUnit, ErrorUnit, EDosUnit, ArchiveManagerUnit, StructsUnit,
+  ExtCtrls, FileCtrl;
+
+type
+  TMainForm = class(TForm)
+    Label1: TLabel;
+    Label2: TLabel;
+    CompressBtn: TButton;
+    DecompressBtn: TButton;
+    Label3: TLabel;
+    Label4: TLabel;
+    SourceFileEdit: TEdit;
+    ArchiveFileEdit: TEdit;
+    Label5: TLabel;
+    BrowseSourceBtn: TButton;
+    BrowseArchiveBtn: TButton;
+    SaveDialog1: TSaveDialog;
+    OpenDialog1: TOpenDialog;
+    Resource1: TResource;
+    Bevel1: TBevel;
+    DecompressArchiveEdit: TEdit;
+    Label6: TLabel;
+    BrowseBtn2: TButton;
+    ExtractFileNameEdit: TEdit;
+    Label7: TLabel;
+    Label8: TLabel;
+    DirListBox: TDirectoryListBox;
+    Label9: TLabel;
+    Label10: TLabel;
+    procedure BrowseSourceBtnClick(Sender: TObject);
+    procedure BrowseArchiveBtnClick(Sender: TObject);
+    procedure CompressBtnClick(Sender: TObject);
+    procedure DecompressBtnClick(Sender: TObject);
+    procedure BrowseBtn2Click(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  MainForm: TMainForm;
+
+(**) implementation (**)
+
+{$R *.DFM}
+
+procedure TMainForm.BrowseSourceBtnClick(Sender: TObject);
+var
+  s: string;
+begin
+  if OpenDialog1.Execute then
+  begin
+    s := OpenDialog1.FileName;
+    SourceFileEdit.Text := s;
+    // suggest a name for the archive file
+    if ArchiveFileEdit.Text = '' then
+      ArchiveFileEdit.Text := ChangeFileExt(s, '.rs');
+  end;
+end;
+
+procedure TMainForm.BrowseArchiveBtnClick(Sender: TObject);
+begin
+  if SaveDialog1.Execute then
+  begin
+    ArchiveFileEdit.Text := SaveDialog1.FileName;
+  end;
+end;
+
+procedure TMainForm.CompressBtnClick(Sender: TObject);
+begin
+  reSource1.CompressToArchive(SourceFileEdit.Text, ArchiveFileEdit.Text);
+end;
+
+procedure TMainForm.DecompressBtnClick(Sender: TObject);
+begin
+  reSource1.DecompressFromArchive(DecompressArchiveEdit.Text, DirListBox.Directory,
+    ExtractFileNameEdit.Text); 
+end;
+
+procedure TMainForm.BrowseBtn2Click(Sender: TObject);
+begin
+  {Archive for decompression}
+  if SaveDialog1.Execute then
+  begin
+    DecompressArchiveEdit.Text := SaveDialog1.FileName;
+  end;
+end;
+
+end.

Archiver Demo2/reSourceDemo2.cfg

@@ -0,0 +1,35 @@
+-$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
+-LE"c:\borland\delphi5\Projects\Bpl"
+-LN"c:\borland\delphi5\Projects\Bpl"

Archiver Demo2/reSourceDemo2.dof

@@ -0,0 +1,105 @@
+[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=0
+R=0
+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=
+
+[Directories]
+OutputDir=
+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;ColorPicker;preview;Icsdel50;galoled;NtfyIcon
+Conditionals=
+DebugSourceDirs=
+UsePackages=0
+
+[Parameters]
+RunParams=
+HostApplication=
+
+[Language]
+ActiveLang=
+ProjectLang=$00000409
+RootDir=
+
+[Version Info]
+IncludeVerInfo=0
+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=2
+Item0=c:\temp\rs
+Item1=C:\Save\Delphi\resource\Component
+
+[HistoryLists\hlUnitOutputDirectory]
+Count=1
+Item0=C:\temp\rs
+
+[HistoryLists\hlOutputDirectorry]
+Count=1
+Item0=C:\temp\rs

Archiver Demo2/reSourceDemo2.dpr

@@ -0,0 +1,14 @@
+program reSourceDemo2;
+
+uses
+  Forms,
+  Main in 'Main.pas' {MainForm};
+
+{$R *.RES}
+
+begin
+  Application.Initialize;
+  Application.Title := 'reSource Demo 2';
+  Application.CreateForm(TMainForm, MainForm);
+  Application.Run;
+end.

Archiver Demo2/reSourceDemo2.dsk

@@ -0,0 +1,283 @@
+[Closed Files]
+File_0=SourceModule,'C:\Save\Delphi\resource\Archiver Demo2\Main.pas',0,1,14,3,23,0,0
+File_1=SourceModule,'C:\Save\Delphi\resource\Component\BWTExpandUnit.pas',0,1,226,35,234,0,0
+File_2=SourceModule,'C:\Save\Delphi\resource\Component\ResourceCompUnit.pas',0,1,268,2,274,0,0
+File_3=SourceModule,'C:\Save\Delphi\resource\Component\ArchiveManagerUnit.pas',0,1,479,30,479,0,0
+File_4=SourceModule,'C:\Save\Delphi\resource\Component\BWTBaseUnit.pas',0,1,1,1,1,0,0
+File_5=SourceModule,'C:\Save\Delphi\resource\Component\BWTCompressUnit.pas',0,1,1,1,1,0,0
+File_6=SourceModule,'C:\Save\Delphi\resource\Archiver Demo\main.pas',0,1,1956,14,1959,1,0
+File_7=SourceModule,'C:\Save\Delphi\newr2\Component\StructsUnit.pas',0,1,1,1,7,0,0
+File_8=SourceModule,'C:\Save\Delphi\newr2\Component\StrucAriEncoderUnit.pas',0,1,1,1,9,0,0
+File_9=SourceModule,'C:\Save\Delphi\newr2\Component\StrucAriDecoderUnit.pas',0,1,1,1,9,0,0
+
+[Modules]
+Module0=C:\Save\Delphi\resource\Archiver Demo2\reSourceDemo2.dpr
+Count=1
+EditWindowCount=1
+
+[C:\Save\Delphi\resource\Archiver Demo2\reSourceDemo2.dpr]
+ModuleType=SourceModule
+FormState=0
+FormOnTop=0
+
+[C:\Save\Delphi\resource\Archiver Demo2\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=100
+MaxWidth=808
+MaxHeight=476
+ClientWidth=800
+ClientHeight=449
+LeftPanelSize=0
+LeftPanelClients=CodeExplorer@EditWindow0
+LeftPanelData=00000400010000000C000000436F64654578706C6F7265720000000000000000000000000000000000FFFFFFFF
+RightPanelSize=0
+BottomPanelSize=0
+BottomPanelClients=CallStackWindow,WatchWindow,MessageView@EditWindow0
+BottomPanelData=00000400030000000F00000043616C6C537461636B57696E646F770B000000576174636857696E646F770B0000004D657373616765566965772003000000000000004D00000000000000FFFFFFFF
+
+[View0]
+Module=C:\Save\Delphi\resource\Archiver Demo2\reSourceDemo2.dpr
+CursorX=52
+CursorY=10
+TopLine=1
+LeftCol=1
+
+[Watches]
+Count=2
+Watch0='CFH.FileName',256,0,18,1,0
+Watch1='FileName',256,0,18,1,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/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.

Xtra/QSortUnit.pas

@@ -0,0 +1,139 @@
+unit QSortUnit;
+{-------------------------------------------------------------------------------
+  Quick Sort unit
+  ---------------
+  reSource (C) 1998 Victor K /97S66
+
+  Desc:
+  Sorts the index of a block.
+  This is the classic quick sort. Idiot proof, gueranteed to sort everytime.
+  Used for debugging. To confirm that any corrupted data is not the fault of
+  the sort.
+
+
+  Notes:
+  Uses a custom CompareStr routine that wraps around the end of the block.
+-------------------------------------------------------------------------------}
+
+
+(**) interface (**)
+uses BWTCompressUnit, StructsUnit;
+
+
+type
+  TQSortBlock = class
+  private
+    block: PBlock;           // block that contains the data
+    index: PLongintBlock;    // index to sort
+    block_length: longint;   // data size in block
+    last_index: longint;     // the index to the last piece of data in the block
+  public
+    constructor Create(const _block: PBlock; const _index: PLongintBlock; const _block_length: longint);
+    procedure Run;
+  end;
+
+
+
+(**) implementation (**)
+
+
+constructor TQSortBlock.Create(const _block: PBlock; const _index: PLongintBlock; const _block_length: longint);
+begin
+  block := _block;
+  index := _index;
+  block_length := _block_length;
+  last_index := block_length-1;
+end;
+
+
+
+procedure TQSortBlock.Run;
+
+  function CompareStr(a, b: integer): integer;
+  var
+    times: byte;
+    first, index: longint;
+  begin
+    if (a <> b) then
+    begin
+      for times := 1 to 3 do
+      begin
+        {Take the later index to be the counter so that we know when we reach
+        the end}
+        if (a > b) then
+          first := a
+        else
+          first := b;
+
+        for index := first to last_index do
+        begin
+          if block^[a] < block^[b] then
+          begin
+            result := -1;
+            exit;
+          end
+          else
+          if block^[a] > block^[b] then
+          begin
+            result := 1;
+            exit;
+          end;
+
+          inc(a);
+          inc(b);
+        end;
+
+        {wrap indices around}
+        if (a = last_index+1) then
+          a := 0;
+        if (b = last_index+1) then
+          b := 0;
+      end;
+
+      {Equal comparison right to the end.
+      Shorter string, or the index closer to the end is greater}
+      if (a < b) then
+        result := -1
+      else
+        result := 1;
+    end
+    else
+      result := 0;
+  end;  {Compare Str}
+
+
+
+  procedure QuickSort(const iLo, iHi: Integer);
+  var
+    Lo, Hi, Mid, T: Integer;
+  begin
+    Lo := iLo;
+    Hi := iHi;
+    Mid := index[(Lo + Hi) div 2];
+    repeat
+      while (CompareStr(index^[Lo], Mid) < 0) do inc(Lo);
+      while (CompareStr(index^[Hi], Mid) > 0) do dec(Hi);
+      {Swap}
+      if (Lo <= Hi) then
+      begin
+        T := index^[Lo];
+        index^[Lo] := index^[Hi];
+        index^[Hi] := T;
+
+        Inc(Lo);
+        Dec(Hi);
+      end;
+    until Lo > Hi;
+
+    if Hi > iLo then QuickSort(iLo, Hi);
+    if Lo < iHi then QuickSort(Lo, iHi);
+  end;
+
+begin
+  QuickSort(0, last_index);
+end;
+
+
+
+
+end.

arcstruc.txt

@@ -0,0 +1,101 @@
+--------------------------------------------------------------------------------
+Archive Structure Text file.
+revision 1.0
+
+Applicable for reSource v2.1 and above.
+Last Modified: 11/December/2000
+
+reSource (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+
+revisions:
+1.0: Final revision. Added more comments.
+0.3: Added archive signature
+0.2: Cleaned up and added several data
+0.1: Initial version
+--------------------------------------------------------------------------------
+
+
+Data types and definition:
+--------------------------
+byte    - basic unit.
+longint - 4 bytes. (Long Integer. Can take a negative value.)
+string  - variable length + null termination
+...     - variable size. Also used to indicate the data can be repeated as
+many times as wanted.
+
+
+General Format of a reSource Archive
+------------------------------------
+The extension for a reSource archive is 'rS'. All archives have a signature to
+confirm that it is a reSource archive.
+An empty archive is one that has no files. It must have a valid signature and
+a central directory end header.
+A zero byte file is not a valid archive.
+Generally, the reSource archive will have an archive header, as many data
+blocks as needed, a central directory and a central directory end record.
+
+Signatures:
+-----------
+Long integers are stored in groups of 4 bytes. The byte with the lsb goes
+first. So the signatures values had to be reversed to allow them to be seen by
+a hex editor.
+The signatures are stored in ArchiveHeadersUnit.
+
+
+Headers
+-------
+Each header has a corresponding class.
+For some headers, the actual size in bytes is required so it is stored in
+a constant e.g. DATA_HEADER_SIZE is the size of a data header.
+
+  Data Header
+  -----------
+  Each data block has a data header.
+  first similarity index - first char to start with when restoring the block
+  virtual smallest char - it does not exist, so it is not output to the block.
+  when restoring, leave a space at this index to pretend it's there. used in
+  sada sort.
+  
+
+
+Overall reSource format:
+[archive header]
+[data header + data block] . . .
+[central directory] end of central directory record
+
+A.      Archive Header
+          reSource Archive signature    4 bytes   ('RSVK')
+
+B.      Data Header
+          Data header signature         4 bytes   ('DATA')
+          crc 32                        4 bytes
+          compressed size               4 bytes
+          first similarity index        4 bytes
+          virtual smallest char index   4 bytes
+
+
+C.      Central Director Structure:
+
+        [file header] . . . + end of central directory record
+
+        File Header:
+
+          Central file header signature          4 bytes  ('CFHS')
+          compressed size                        4 bytes
+          uncompressed size                      4 bytes
+          number of blocks                       4 bytes
+          offset of first local data header      4 bytes
+
+          (attributes)
+          time (dos date + time)                 4 bytes
+          attr                                   4 bytes
+          file name                              string
+
+        End Of Central Directory Record:
+
+          Signature                              4 bytes  ('ECDR') End of Central Directory Record
+          Block Size                             4 bytes
+          offset of first Central File Header    4 bytes
+
+

bugs.txt

@@ -0,0 +1,8 @@
+--------------------------------------------------------------------------------
+Known bugs
+reSource (C) 1998-2000 Victor Kasenda / gruv
+
+contains a list of bugs that are still around.
+--------------------------------------------------------------------------------
+
+(Please email all bugs or quirks to vickas@singnet.com.sg)

install.txt

@@ -0,0 +1,65 @@
+-------------------------------------------------------
+reSource 
+installation/getting to know/compiling and running
+
+---------------------------------------------
+reSource v2.6
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+reSource support site: http://go.to/gruv
+email: vickas@singnet.com.sg
+---------------------------------------------
+
+This file last updated on 08 May 2001
+reSource version 2.6
+-------------------------------------------------------
+
+
+
+INSTALLATION:
+unzip everything, including subdirectories into a directory.
+The following directories will be created:
+
+\Archiver Demo	 (Full featured Archiver demo that uses the TResource Component)
+\Archiver Demo2  (demo for compressing/decompressing one file at a time)
+\Component	 (The TResource component)
+\manuals	 (System Doc and other txt files)
+\Xtra		 (extra sources)
+
+
+
+
+INSTALLING TRESOURCE COMPONENT
+
+In Delphi, Open ResourcePack.dpk under \Components and press 'Install'.
+The Component Package will be installed.
+You should be able to see the TResource component under the 'Compression' tab in the component list.
+
+RUNNING THE DEMO APP
+make sure TResource component has been installed. Just Build and Run the Project.
+
+
+TXT FILES INCLUDED IN THE PROJECT
+---------------------------------
+readme.txt - first file you should have read. 
+arcstruc.txt - the archive structure
+install.txt - This file. Getting to know and using the component.
+notes.txt - some notes I wrote about the implementation.
+version.txt - The version of reSource and History.
+
+UNDERSTANDING RESOURCE
+----------------------
+On the top of every unit there is a small description of what the unit does, how it works and maybe a brief description of the algorithm.
+Also, before some procedures there is a detailed description of what the procedure does and how it does the work.
+
+The main unit for the component is Component\ResourceCompUnit.pas. At the top of the unit is a detailed explanation of how to use it in code.
+
+the following documents are in word 97 format, they are in the \manuals directory:
+
+system doc.doc - 
+system documentation. about the archiver, how it works and organisation of the classes. may be quite outdated. the major change in version 2.1 is the sadakane suffix sort, which is much more efficient than the one described in the doc. this doc was written for the project, and as such has a lot of credits, names and references which you may not understand. but for completeness and originality's sake, i left them all in.
+
+
+
+
+
+...carry on, compile/run/go/copy/paste/learn/code/delphirulez...

manuals/Readme.txt

@@ -0,0 +1,7 @@
+WARNING:
+
+SYSTEM DOC.DOC
+
+The System Doc is semi-outdated.
+It refers to Version 1.0 of reSource which did not have the more advanced sorting algorithm.
+But the design and structure still remains the same, so it should provide a reasonable explanation as to how reSource works. It also explains a little the concept behind block sorting.

notes.txt

@@ -0,0 +1,144 @@
+--------------------------------------------------------------------------------
+  Notes file
+  reSource (C) 1998-2001 Victor Kasenda / gruv
+--------------------------------------------------------------------------------
+  This file contains important information that should be reviewed before the
+  software, reSource, is released.
+
+Pre Release Check list
+----------------------
+
+
++ Check that all 'debug' statements are removed. All statements preceded by
+  a comment with the word 'debug' should be checked and removed if necessary.
+
++ remove debug columns from file list
+
+
+
+If there are errors:
+--------------------
+- SendMessage in MainForm, parameter typecasted to longint to prevent range
+check error.
+
+- Block has indexes -1 to over the block size. When doing memory compares or
+passing compares, make sure the same type is passed and memory is accessed
+correctly i.e. From 0.
+
+
+- if manually decoding then init may be necessary e.g. mtfEncode/Decode
+  if wrapper is called then may not need. ariEncodeBlock/DecodeBlock
+
+  
+Design Notes:
+
+
+Archive Manager -> Block compressor -> Output file.
+The archive manager chops the file into blocks.
+Each block is passed to the block compressor
+The block compressor compresses each block and writes it to the output file.
+
+reSource probably cannot be used on tape backup systems due to its file
+structure. Decompressing requires several random seeks to be done. If support
+was to be added, then local file headers at the start of each data block would
+have to be added which add to the archive size.
+
+
+Drag and drop Notes:
+  During drag and drop, the path of the file is ignored. All files are dumped
+  in the drop directory. Duplicate names are handled by decompressing everything
+  into a common temp directory. User will be asked whether he wants to overwrite
+  the file. This behaviour is similar to Winzip.
+
+
+Variable Type Selection:
+
+  Longint and Longword
+  --------------------
+  Longint should be enough for storing sizes, index etc. 2 gigs.
+  Only if unsigned or 4 gigs is necessary then longword should be used.
+  
+
+
+Buffer sizes
+------------
+It seems RLEncoder may expand the block (UC.EXE)
+Therefore 10% of BlockSize have been added as overflow areas.
+
+Deleting files
+--------------
+The interface will confirm the deletion of every file first before actually
+calling archive manager to delete the files.
+Therefore, cancel aborts the whole operation and nothing is changed in the
+archive.
+
+
+Adding files
+------------
+
+  Shared files
+  ------------
+  Adding of shared files is allowed. Files that are currently being added
+  are also allowed to be read. The file mode is fmShareDenyWrite, where
+  only writing is denied. An exe that is currently running can be added.
+  
+  Input file cannot be opened
+  ---------------------------
+  If the disk is not ready, or the input file cannot be opened, EFOpenError
+  is raised and captured in ArchiveManager.AddFiles. The file will not be
+  added. The user can add it himself later on when the problem is fixed.
+  
+  Adding the archive file itself
+  ------------------------------
+  This is checked for and the archive will be deselected upon pressing the
+  ok button in the add dialog.
+
+  File names
+  ----------
+  Duplicate file names can be added to the archive.
+  The files can be differentiated by their dates and times.
+  The user will be alerted if a file of duplicate name is added to the archive.
+  He will be given a choice whether he wants to add it or not.
+
+  Zero length files
+  -----------------
+  It is possible to add zero length files.
+
+  Drag and Drop
+  -------------
+  If only one file is dropped and this file is a reSource archive, then
+  it is opened instead of being added. To add reSource archives, use Add.
+
+
+Valid Archives
+--------------
+A valid archive contains at least a signature and an EndOfCentralDir header.
+A 0 byte file is not a valid archive.
+
+
+Opening Archives
+----------------
+EWrongSignature will be raised if the archive to be opened is corrupted.
+An extension is compulsary. Due to a bug in the TFileStream.Create routine,
+if a directory 'z' exists and you try to open a file called 'z', an EFCreateError
+will occur. reSource currently overcomes this by forcing an extension.
+e.g. 'z' --> 'z.rs'
+     'z.' -> 'z.rs'
+     'z.rs > 'z.rs'
+     The logic and algo can be found in ArchiveManager.OpenArchive. A dot is
+     first checed for then the extension is checked and added if needed.
+
+Interface
+---------
+The interface may be slow in updating, especially during adding and extraction
+of files. This is because the compressor and decompressor operates on blocks
+of data and should not be interrupted half way. Adding of
+Application.ProcessMessages throughout the operations may slow things down
+greatly.
+Therefore ProcessMessages is called after adding/extraction of every block.
+
+  Archive file name
+  -----------------
+  The archive file name will be displayed on the title bar.
+
+

readme.txt

@@ -0,0 +1,142 @@
+---------------------------------
+resource readme
+version 2.6 full source code
+08 May 2001
+---------------------------------
+
+Copyright (C) 1998-2001 Victor Kasenda / gruv
+http://go.to/gruv
+email: vickas@singnet.com.sg
+icq me at: 6505245
+
+...resource...
+  " compression ratios approaching that of PPM, speeds closer to LZ77 compressors"
+
+only for delphi 5.0
+later versions of delphi may work, earlier versions may need minor code modifications.
+
+reSource features
+- Burrows Wheeler Transformation (BWT) compression technology with efficient implementation
+- addition
+- extraction
+- deletion
+- modification of file attributes. The filename or attribute can be changed.
+- compression statistics viewer
+- compression ratios are close to PPM and speeds close to LZ77 (zip,arj) archivers.
+
+Implementation features
+- Kunihiko Sadakane's Suffix Sort
+- Peter Fenwick's Structured Arithmetic Encoder Model
+- Standard 1989 CACM Arithmetic Encoder (Patent Free)
+- CRC 32 file extraction integrity check
+- dual layer file read/write buffering - bit buffer (8 bits) and byte buffer (64kbytes)
+- efficient block memory manager that shares and reuses blocks between classes
+- full object oriented design
+- pure pascal/delphi 4.0      
+
+
+the ideas came from:
+- mark nelson: 1989 CACM arithmetic encoder 'c' source
+- dj wheeler : 1989 report on the block sorting algorithm for DES
+- peter fenwick: structured arithmetic encoder/model from his final report on the block sorting algorithm 
+- kunihiko sadakane: suffix sort algorithm
+- julian seward: bzip, BWT implementation
+
+this is my contribution to the delphi community.
+don't you just hate it when you see 'pay $10 for full source'?
+
+
+
+...copyright...
+
+the source code to the program is free for non-commercial and educational use. It can be incorporated
+freely into programs that are 'freeware' or public domain'.
+please do at least drop me a note at gruv@bigfoot.com, mention where you got the code from in the credits and acknowledge the people as listed at the end of the document.
+
+in no way is any of the code to be used in a shareware, commercial software, or commercial environments
+without the permission or consent from the author, and also the people where the ideas came from.
+Please note that this is not entirely my work, and is actually also based on the work, ideas of several people as mentioned at the end of this document.
+
+
+...disclaimer...
+
+regarding patents and licenses, i will not be held responsible if any of this code violates patent or legal legislations in your country.
+
+this code is provided as is. i will not be held responsible for any damage done to your computer, or your brain.
+
+to the best of my knowledge, resource does not violate any patent legislations. the arithmetic encoder is a standard CACM 1989 implementation and the rest of the algorithms are fairly new.
+
+
+...for the impatient...
+
+read install.txt to get familier with the files, how to install, compile and run resource.
+
+
+...background...
+this was intended to be an industrial strength archiver, comparable 
+to zip and other more established formats, but i got tired.... and there 
+are always buts...
+it was released in 1998 as a school project, complete with system docs and user manual.
+maybe if inspiration strikes again i'll dig everything out of the grave and rejuvenate the project.
+
+
+...differences between bzip and resource...
+
+                                      resource					bzip
+                                    
+Graphical interface			implemented    				-           
+encoder type                            1989 CACM arithmetic			huffman
+sort method				sadakane's suffix sort			
+
+speed differences in speed due to different encoding and sort methods. bzip may be faster because huffman encoding is much faster than  arithmetic encoding
+ 
+
+...hopes...
+so i hope all this code, which i have written for more than a year, will 
+come in handy to someone, be it the sorting routine, arithmetic coding
+routine, or even the file list that can display shell icons!
+
+
+...credits...
+everything here was coded entirely in pascal/delphi by me, and 
+ideas/references came from many people, all of them i have 
+referred to in the respective files and also at the end of this document.
+
+it was lotsa sweat and pain, and this is in the end released to the 
+public, free for non-commercial use.
+
+
+
+i would like to thank (and also shout out a big hello! to):
+
+    Mark Nelson, who with his wonderful book, 
+    
+    Michael Burrows  and  David J. Wheeler for the block sorting algorithm.
+    
+    Peter  Fenwick's for his tuned structured arithmetic encoder
+
+    Kunihiko Sadakane's Suffix sort, which rocks, and imho is the best 
+    general purpose sorter for the block sorting algorithm.
+    
+    Angus Johnson, Anders Melander & Graham Wideman for their wonderful, totally incredible drag and drop package. I had managed to incorporate the older version of their package into resource and it turned instantly totally drag and drop to and from explorer.. simply amazing.
+    
+   Julian Seward, author of BZip. BZip really inspired me to write on, although i didn't really understand much of the 'c' implementation of the BWT algorithm... ;-)
+   
+   
+   the author(s) of the delphi superpage and delphi deli, without which i may not even have been able to have finished.
+   
+   
+   and of course Inprise for creating Delphi, which is totally radical!
+   (and Inprise: when are we gonna have inline functions? it will surely speed up delphi apps alot!)
+   
+
+
+
+... a bit about the author ...
+
+the author, Victor Kasenda (born 1980), lives on a small island of Singapore (check your atlas). 
+He treks neighbouring mountains, and enjoys a mountain biking.
+programming is his life, his source of energy and motivation. he loves delphi, hates basic, and befriends java more than c, shys away from assembly because it's too much of a fuss. totally normal, partially insane, a little disturbed and totally lost his marbles when he released this source code.... hmmm....
+
+   
+...end of document, now go to sleep...

version.txt

@@ -0,0 +1,25 @@
+reSource version 2.6 public release full source
+copyright (C) 1998-2001 Victor Kasenda / gruv
+email: vickas@singnet.com.sg
+icq: 6505245
+
+
+HISTORY
+-------
+
+Version 2.6
+- Fixed ShellTypeName and ShellSmallImageIndex in TCentralFileHeader. Now implemented as properties and it will read itself when data is requested.
+- Added 2 new functions: TResource.CompressToArchive and TResource.DecompressFromArchive
+- Added Archiver Demo2 to demonstrate use of reSource to compress/decompress one file at a time.
+
+
+Version 2.5 BETA
+- Removed inter unit dependencies with the Component. TResource is now a stand alone component and you can integrate it easily with your application to provide Block Sorting compression.
+- Cleaned up source code, and reorganized units into seperate dirs.
+- The demo app now looks much better, and also has verbose output of what the engine is doing.
+
+
+Version 2.1
+First public release of source code. 
+Probably the only full Object Pascal/Delphi implementation of the Block Sorting Compression Algorithm + Arithmetic Encoding.
+The first full source code release for a full featured archiver that has add/extract/delete and CRC32 Error checks.