Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 1-1 of 1 total  RSS 

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
« Newer Snippets
Older Snippets »
Showing 1-1 of 1 total  RSS