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);
+  e