Files Joiner/Unjoiner //Pascal Class

This is just a snippet since I didn't added some units that can be replaced without major efforts:
- PathParser.pas: parses paths shortcuts (it's on my bigbold snippets, search on my tags)
- Stack.pas: implements a simple stack (it's on my bigbold snippets, search on my tags)
- ZlibEx.pas: used to compress/decompress the file contents (My ZlibEx is a modified version of this file: http://www.dellapasqua.com/delphizlib)
- MD5.pas: used to calculate the file hash and check consistency when unjoining files
- SysUtils2: Some idiot functions =b

I used this in a personalized installer that I've made in my first job =b


unit FileJoiner;

interface

uses
  SysUtils, SysUtils2, Classes, MD5, ZlibEx, PathParser, Stack;

type
  TOverwriteMode = ( omNo, omAskUser, omIfNewer, omIfOlder, omIfDiff );
  TOverwriteAction = ( oaOverwriteAll, oaNoOverwriteAll, oaYes, oaNo );

  TFileHeader = record
    MD5Hash: TDigestStr;
    ModificationDate: TDateTime;
    Attributes: LongWord;
    Overwrite: TOverwriteMode;
    Size: Int64;
    MustKeep: Boolean;
  end;

  TFileJoinerItem = class
  public
    Source, Destiny: string;
    MustKeep, Recurse: Boolean;
    Overwrite: TOverwriteMode;

    constructor Create( const FromPath, ToPath: string; const OverwriteMode: TOverwriteMode = omIfNewer; const Recursive: Boolean = True; const MustKeepFile: Boolean = False ); overload;
    function Assign( Item: TFileJoinerItem ): TFileJoinerItem;

    procedure Save( const Stream: TStream );
    procedure Load( const Stream: TStream );
  end;

  TCustomFileJoiner = class;

  TFileJoinerFilesCallback = procedure( Sender: TCustomFileJoiner; Item: TFileJoinerItem ) of object;
  TFileJoinerNotifyEvent = procedure( Sender: TCustomFileJoiner ) of object;
  TFileJoinerFileExists = procedure( Sender: TCustomFileJoiner; var CanOverwrite: TOverwriteAction ) of object;

  TJoinerStatus = ( jsIdle, jsJoining, jsUnjoining );

  TCustomFileJoiner = class
  private
    FStream: TStream;
    FCurFile, FTotalFiles: LongWord;
    FCurSize, FTotalSize, FCurPosition, FCurWrittenBytes: Int64;
    FCurFilename: string;
    FCurFileInfo: TFileHeader;
    FOnFileExists: TFileJoinerFileExists;
    FOnWorkEnd, FOnWorkBegin, FOnWork, FOnProcessFile: TFileJoinerNotifyEvent;

    procedure ProgressNotifier( Sender: TObject );

  public
    //properties
    property CurFilename: string read FCurFilename;
    property CurFileInfo: TFileHeader read FCurFileInfo;
    property CurFilePosition: Int64 read FCurPosition;
    property CurWrittenBytes: Int64 read FCurWrittenBytes;
    property CurSize: Int64 read FCurSize;
    property CurFile: LongWord read FCurFile;

    property TotalSize: Int64 read FTotalSize;
    property TotalFiles: LongWord read FTotalFiles;

    //events
    property OnWorkBegin: TFileJoinerNotifyEvent read FOnWorkBegin write FOnWorkBegin;
    property OnWork: TFileJoinerNotifyEvent read FOnWork write FOnWork;
    property OnWorkEnd: TFileJoinerNotifyEvent read FOnWorkEnd write FOnWorkEnd;
    property OnProcessFile: TFileJoinerNotifyEvent read FOnProcessFile write FOnProcessFile;
    property OnFileExists: TFileJoinerFileExists read FOnFileExists write FOnFileExists;
  end;

  TFileJoiner = class( TCustomFileJoiner )
  private
    FPaths: TList;

    function GetItem(const Index: Integer): TFileJoinerItem;
    function GetCount: Integer;
    procedure StreamFile( Sender: TCustomFileJoiner; Item: TFileJoinerItem );
    procedure Compress( Input: TStream );

  public
    constructor Create;
    destructor Destroy; override;

    procedure Join( const Filename: string ); overload;
    procedure Join( const Stream: TStream ); overload;

    procedure SaveList( const Filename: string ); overload;
    procedure SaveList( Stream: TStream ); overload;
    procedure LoadList( const Filename: string ); overload;
    procedure LoadList( Stream: TStream ); overload;

    procedure CountFiles;

    function Add( const FromPath, ToPath: string; const OverwriteMode: TOverwriteMode = omIfNewer; const Recursive: Boolean = False; const MustKeep: Boolean = False ): Integer;
    procedure Clear;
    procedure Remove( const Index: Integer );
    procedure ListFiles( const Callback: TFileJoinerFilesCallback );

    property Count: Integer read GetCount;
    property Items[ const Index: Integer ]: TFileJoinerItem read GetItem; default;
  end;

  TFileUnjoiner = class( TCustomFileJoiner )
  private
    FDataBegin: Int64;
    procedure Decompress( Output: TStream );

  public
    procedure Assign( const Filename: string ); overload;
    procedure Assign( Stream: TStream ); overload;
    procedure UnJoin;
  end;

implementation

{ TCustomFileJoiner }

procedure TCustomFileJoiner.ProgressNotifier(Sender: TObject);
begin
  if Assigned( FOnWork ) then
    with TStream( Sender ) do
    begin
      FCurWrittenBytes := Position - FCurPosition;
      FCurPosition := Position;
      FOnWork( Self );
    end;
end;

{ TFileJoiner }

procedure TFileJoiner.Join( const Filename: string );
begin
  FStream := TFileStream.Create( Filename, fmCreate );
  try
    Join( FStream );
  finally
    FStream.Free;
  end;
end;

procedure TFileJoiner.Join( const Stream: TStream );
var
  Pos: array[0..1] of Int64;
begin
  FStream := Stream;
  if Assigned( FOnWorkBegin ) then
    FOnWorkBegin( Self );

  FCurFile := 0;
  FCurSize := 0;

  //record position to get back later and reserve space on the file to record the "totals"
  Pos[0] := FStream.Position;
  FStream.Seek( SizeOf( FCurFile ) + SizeOf( FCurSize ), soCurrent );

  //write files
  ListFiles( StreamFile );

  //write the totals and get back
  Pos[1] := Stream.Position;
  FStream.Position := Pos[0];
  FStream.Write( FCurFile, SizeOf( FCurFile ) );
  FStream.Write( FCurSize, SizeOf( FCurSize ) );
  FStream.Position := Pos[1];

  //job done
  if Assigned( FOnWorkEnd ) then
    FOnWorkEnd( Self );
end;

procedure TFileJoiner.StreamFile( Sender: TCustomFileJoiner; Item: TFileJoinerItem );
var
  InputFile: TFileStream;
  Pos: array[0..1] of Int64;
begin
  try
    Inc( FCurFile );
    FCurPosition := 0;
    FCurFilename := Item.Source;

    FCurFileInfo.MD5Hash := FileMD5Digest( Item.Source );
    FCurFileInfo.ModificationDate := FileDateToDateTime( FileAge( Item.Source ) );
    FCurFileInfo.Attributes := FileGetAttr( Item.Source );
    FCurFileInfo.Overwrite := Item.Overwrite;

    InputFile := TFileStream.Create( Item.Source, fmOpenRead or fmShareDenyWrite );
    try
      FCurFileInfo.Size := InputFile.Size;
      if Assigned( FOnProcessFile ) then
        FOnProcessFile( Self );

      Pos[0] := FStream.Position;
      //reserve space for the file header and EOF position
      FStream.Seek( SizeOf( FCurFileInfo ) + SizeOf( Pos[0] ), soCurrent );
      StringWrite( FStream, Item.Destiny );

      Compress( InputFile );

      //update the header and get back
      Pos[1] := FStream.Position;
      FStream.Position := Pos[0];
      FStream.Write( FCurFileInfo, SizeOf( FCurFileInfo ) );
      FStream.Write( Pos[1], SizeOf( Pos[1] ) );
      FStream.Position := Pos[1];

      //update summary
      Inc( FCurSize, FCurFileInfo.Size );
    finally
      InputFile.Free;
    end;
  except
    on E: Exception do
      raise EWriteError.CreateFmt( '%s.StreamFile: Error on joining: "%s" - %s',  [ ClassName, FCurFilename, E.Message ] );
  end;
end;

function TFileJoiner.Add(const FromPath, ToPath: string;
  const OverwriteMode: TOverwriteMode; const Recursive: Boolean; const MustKeep: Boolean ): Integer;
begin
  Result := FPaths.Add( TFileJoinerItem.Create( FromPath, ToPath, OverwriteMode, Recursive, MustKeep ) );
end;

procedure TFileJoiner.Clear;
var
  I: Integer;
begin
  for I := FPaths.Count - 1 downto 0 do
  begin
    TFileJoinerItem( FPaths[I] ).Free;
    FPaths.Delete( I );
  end;
end;

constructor TFileJoiner.Create;
begin
  FPaths := TList.Create;
end;

destructor TFileJoiner.Destroy;
begin
  Clear;
  FPaths.Free;
  inherited;
end;

procedure TFileJoiner.CountFiles;
type
  PStackItem = ^TStackItem;
  TStackItem = record
    Data: PChar;
    Searcher: TSearchRec;
  end;

var
  I: Integer;
  Path, Filter: string;
  Stack: TStack;
  CurStack, X: PStackItem;
begin
  FTotalFiles := 0;
  FTotalSize := 0;

  Stack := TStack.Create;
  try
    for I := 0 to FPaths.Count - 1 do
    begin
      Path := Self[I].Source;
      if LastDelimiter( '*?', ExtractFileName( Path ) ) <> 0 then
      begin
        Filter := ExtractFileName( Path );
        Path := ExtractFilePath( Path );
      end
      else if FileExists( Path ) then
      else if DirectoryExists( Path ) then
      begin
        Filter := '*';
        Path := AddSlash( Path );
      end
      else
        raise Exception.CreateFmt( '%s.GetFilesSumary: "%s" não encontrado', [ ClassName, Path ] );

      New( CurStack );
      CurStack^.Data := CopyString( Path );
      repeat
        with CurStack^ do
        begin
          if FindFirst( Data + Filter, faDirectory, Searcher ) = 0 then
          begin
            repeat
              Inc( FTotalFiles );
              Inc( FTotalSize, Searcher.Size );
            until FindNext( Searcher ) <> 0;
            FindClose( Searcher );
          end;

          if Self[I].Recurse and ( FindFirst( Data + Filter, faArchive, Searcher ) = 0 ) then
          begin
            repeat
              if Searcher.Name[1] <> '.' then
              begin
                New( X );
                X^.Data := CopyString( AddSlash( Data + Searcher.Name ) );
                Stack.Push( X );
              end;
            until FindNext( Searcher ) <> 0;
            FindClose( Searcher );
          end;
          FreeMem( Data );
          Dispose( CurStack );
          CurStack := Stack.Pop;
        end;
      until CurStack = nil;
    end;
  finally
    Stack.Free;
  end;
end;

function TFileJoiner.GetItem(const Index: Integer): TFileJoinerItem;
begin
  Result := FPaths.Items[ Index ];
end;

function TFileJoiner.GetCount: Integer;
begin
  Result := FPaths.Count;
end;

procedure TFileJoiner.ListFiles( const Callback: TFileJoinerFilesCallback);
type
  PStackItem = ^TStackItem;
  TStackItem = record
    Source, Destiny: PChar;
    Searcher: TSearchRec;
  end;

var
  Stack: TStack;
  Filter: string;
  Current, X: PStackItem;
  Data: TFileJoinerItem;
  I: Integer;
begin
  Stack := TStack.Create;
  try
    Data := TFileJoinerItem.Create;
    try
      for I := 0 to FPaths.Count - 1 do
      begin
        Data.Assign( Self[I] );
        with Data do
        begin
          Destiny := AddSlash( Destiny );
          if LastDelimiter( '*?', ExtractFileName( Source ) ) <> 0 then
          begin
            Filter := ExtractFileName( Source );
            Source := ExtractFilePath( Source );
          end
          else if FileExists( Source ) then
          begin
            Destiny := Destiny + ExtractFileName( Data.Source );
            Callback( Self, Data );
            Continue;
          end
          else if DirectoryExists( Source ) then
          begin
            Filter := '*';
            Destiny := AddSlash( Destiny + ExtractFileName( RemoveSlash( Source ) ) );
            Source := AddSlash( Source );
          end
          else
            raise Exception.CreateFmt( '%s.ListFiles: "%s" não encontrado', [ ClassName, Source ] );
        end;

        New( Current );
        with Current^ do
        begin
          Source := CopyString( Data.Source );
          Destiny := CopyString( Data.Destiny );
        end;

        repeat
          with Current^ do
          begin
            if FindFirst( Source + Filter, faDirectory, Searcher ) = 0 then
            begin
              repeat
                Data.Source := Source + Searcher.Name;
                Data.Destiny := Destiny + Searcher.Name;
                Callback( Self, Data )
              until FindNext( Searcher ) <> 0;
              FindClose( Searcher );
            end;

            if Data.Recurse and ( FindFirst( Source + '*', faArchive, Searcher ) = 0 ) then
            begin
              repeat
                if Searcher.Name[1] <> '.' then
                begin
                  New( X );
                  X^.Source := CopyString( AddSlash( Source + Searcher.Name ) );
                  X^.Destiny := CopyString( AddSlash( Destiny + Searcher.Name ) );
                  Stack.Push( X );
                end;
              un