Files Joiner/Unjoiner //Pascal Class
DZone's Guide to
Files Joiner/Unjoiner //Pascal Class
Join the DZone community and get the full member experience.
Join For FreeThis 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
Topics:
Opinions expressed by DZone contributors are their own.
{{ parent.title || parent.header.title}}
{{ parent.tldr }}
{{ parent.linkDescription }}
{{ parent.urlSource.name }}