318 lines
9.7 KiB
ObjectPascal
318 lines
9.7 KiB
ObjectPascal
unit ResourceCompUnit;
|
|
{reSource Component Unit
|
|
Component Front End for reSource Compression Engine
|
|
|
|
reSource v2.6
|
|
Copyright (C) 1998-2001 Victor Kasenda / gruv
|
|
http://go.to/gruv
|
|
email: vickas@singnet.com.sg
|
|
|
|
|
|
USAGE:
|
|
Drop the component onto the form to use it.
|
|
Default name will be Resource1.
|
|
To perform any action on the archive, use Resource1.ArchiveMan (Archive Manager)
|
|
|
|
There are 2 ways to perform actions on archives:
|
|
Type 1: To deal directly with ArchiveMan.
|
|
This is the most efficient type and allows the fastest way to add/extract
|
|
multiple files from archive.
|
|
Type 2: Call CompressToFile, DecompressFromFile.
|
|
This wraps ArchiveMan and is simple to use if only dealing with one file.
|
|
|
|
ACTIONS: (Type 1)
|
|
Before doing any action, set the parameters for ArchiveMan
|
|
Resource1.ArchiveMan.TempDir := 'c:\temp'; // Set the Temporary Directory
|
|
|
|
To Open an Archive:
|
|
Resource1.ArchiveMan.OpenArchive(<ArchiveName>);
|
|
|
|
To Close the Archive:
|
|
Resource1.ArchiveMan.CloseArchive;
|
|
|
|
To Add files:
|
|
Resource1.ArchiveMan.AddFiles(FileList: TStrings; const infile_dir: string)
|
|
There are 2 ways to send the FileList
|
|
- If each entry in FileList has the full Path+Name, then infile_dir can be ''.
|
|
- If each entry in FileList is only the name, then infile_dir must contain
|
|
the path the files are in.
|
|
|
|
To Extract the file:
|
|
Before calling ExtractList, set the parameters for file extract:
|
|
Resource1.ArchiveMan.dest_dir := 'c:\mydir'; // destination dir for extract
|
|
|
|
Resource1.ArchiveMan.ExtractList(List: TList; var files_extracted, extracted_size: integer);
|
|
|
|
List is a TList of TCentralFileHeader.
|
|
The CentralFileHeader is gotten from Resource1.ArchiveMan.ArchiveFile.CentralDir[i],
|
|
where i is the index of the file.
|
|
So to add file index 2 to the extract list, call
|
|
List.Add(Resource1.ArchiveMan.ArchiveFile.CentralDir[2]);
|
|
Then call ExtractList(List, a, b)
|
|
The files_extracted and extracted_size are returned values.
|
|
|
|
To Delete files:
|
|
Resource1.ArchiveMan.DeleteFiles
|
|
All files that are flagged for deletion are removed.
|
|
To flag a file for delete, set the Delete property in its CentralFileHeader entry.
|
|
e.g. to delete file of index 2 and 5,
|
|
Resource1.ArchiveMan.ArchiveFile.CentralDir[2].Deleted := true; // flag
|
|
Resource1.ArchiveMan.ArchiveFile.CentralDir[5].Deleted := true; // flag
|
|
Resource1.ArchiveMan.DeleteFiles; // actual process
|
|
|
|
|
|
|
|
EVENTS:
|
|
OnCentralDirChange
|
|
- called when Resource1.ArchiveMan.ArchiveFile.CentralDir changes.
|
|
use it to update the list of files in the archive.
|
|
OnAddLog (for debugging)
|
|
- called when ArchiveMan outputs verbose information on what it is doing.
|
|
mainly used for debugging.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
{CG}
|
|
ArchiveManagerUnit, ArchiveHeadersUnit, StructsUnit;
|
|
|
|
type
|
|
TResource = class(TComponent)
|
|
private
|
|
{function GetOnShowStatusMsg: TStrEvent;
|
|
procedure SetOnShowStatusMsg(const Value: TStrEvent);}
|
|
function GetOnCentralDirChange: TNotifyEvent;
|
|
procedure SetOnCentralDirChange(const Value: TNotifyEvent);
|
|
function GetOnAddLog: TStrEvent;
|
|
procedure SetOnAddLog(const Value: TStrEvent);
|
|
protected
|
|
FArchiveMan: TArchiveManager;
|
|
public
|
|
property ArchiveMan: TArchiveManager read FArchiveMan;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
{Wrapper for ArchiveMan.
|
|
To work on one file in one archive
|
|
NOTE:
|
|
- These do not require an archive to be opened. They can be called
|
|
'immediately'.
|
|
- Do not call ArchiveMan.OpenArchive when you use these procedures.
|
|
|
|
See Help above for description.
|
|
|
|
CompressToArchive:
|
|
SourceFileNamePath - File to compress
|
|
ArchiveNamePath - Archive to add to.
|
|
If it exists, the file will be Added to the existing archive.
|
|
|
|
DecompressFromArchive:
|
|
ArchiveNamePath - Full path to archive file
|
|
DestPath - Destination dir to extract files to
|
|
FileName - the name of the file to extract. Leave blank to extract all files (Default)
|
|
}
|
|
procedure CompressToArchive(SourceFileNamePath, ArchiveNamePath: string);
|
|
procedure DecompressFromArchive(ArchiveNamePath, DestPath: string; ExtractFileName: string = '');
|
|
|
|
published
|
|
property OnCentralDirChange: TNotifyEvent read GetOnCentralDirChange write SetOnCentralDirChange;
|
|
//property OnShowStatusMsg: TStrEvent read GetOnShowStatusMsg write SetOnShowStatusMsg;
|
|
property OnAddLog: TStrEvent read GetOnAddLog write SetOnAddLog;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('Compression', [TResource]);
|
|
end;
|
|
|
|
|
|
{ TResource }
|
|
|
|
|
|
constructor TResource.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
{if not (csDesigning in ComponentState) then
|
|
begin}
|
|
FArchiveMan := TArchiveManager.Create;
|
|
{end;}
|
|
end;
|
|
|
|
|
|
|
|
destructor TResource.Destroy;
|
|
begin
|
|
if Assigned(FArchiveMan) then FArchiveMan.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TResource.GetOnAddLog: TStrEvent;
|
|
begin
|
|
result := FArchiveMan.OnAddLog;
|
|
end;
|
|
|
|
function TResource.GetOnCentralDirChange: TNotifyEvent;
|
|
begin
|
|
result := FArchiveMan.OnCentralDirChange;
|
|
end;
|
|
|
|
{function TResource.GetOnShowStatusMsg: TStrEvent;
|
|
begin
|
|
result := FArchiveMan.OnShowStatusMsg;
|
|
end;}
|
|
|
|
procedure TResource.SetOnAddLog(const Value: TStrEvent);
|
|
begin
|
|
FArchiveMan.OnAddLog := Value;
|
|
end;
|
|
|
|
procedure TResource.SetOnCentralDirChange(const Value: TNotifyEvent);
|
|
begin
|
|
FArchiveMan.OnCentralDirChange := Value;
|
|
end;
|
|
|
|
{procedure TResource.SetOnShowStatusMsg(const Value: TStrEvent);
|
|
begin
|
|
FArchiveMan.OnShowStatusMsg := Value;
|
|
end;}
|
|
|
|
{-------------------------------------------------------------------------------
|
|
CompressToArchive
|
|
-------------------------------------------------------------------------------}
|
|
procedure TResource.CompressToArchive(SourceFileNamePath,
|
|
ArchiveNamePath: string);
|
|
var
|
|
FilesAdded: integer;
|
|
list: TStringList;
|
|
begin
|
|
{Algorithm:
|
|
Open Archive
|
|
Add the file
|
|
Close Archive}
|
|
if ArchiveMan.IsArchiveOpen then
|
|
begin
|
|
{Error Check: Cannot use when Archive is opened.
|
|
We will open and close the Archive ourselves}
|
|
Application.MessageBox('reSource: ArchiveMan cannot be opened to use CompressToArchive',
|
|
'Error', MB_OK);
|
|
exit;
|
|
end;
|
|
|
|
{ Step 1: Open Archive }
|
|
ArchiveMan.OpenArchive(ArchiveNamePath, false);
|
|
|
|
Screen.Cursor := crHourGlass;
|
|
try
|
|
{ Step 2: Add the file }
|
|
// Construct a TStringList of files to add
|
|
// We pass a nil in the folder because the full path is in list
|
|
list := TStringList.Create;
|
|
list.Add(SourceFileNamePath);
|
|
FilesAdded := ArchiveMan.AddFiles(list, '');
|
|
if (FilesAdded = 0) then
|
|
begin
|
|
Application.MessageBox('reSource.CompressToArchive: Error No Files Added',
|
|
'Error', MB_OK);
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
Application.MessageBox('reSource.CompressToArchive: One file added to archive.',
|
|
'Error', MB_OK);
|
|
exit;
|
|
end;
|
|
|
|
finally
|
|
{ Step 3: Close the archive }
|
|
if ArchiveMan.IsArchiveOpen then
|
|
ArchiveMan.CloseArchive;
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
{-------------------------------------------------------------------------------
|
|
DecompressFromArchive
|
|
-------------------------------------------------------------------------------}
|
|
procedure TResource.DecompressFromArchive(ArchiveNamePath, DestPath: string;
|
|
ExtractFileName: string='');
|
|
var
|
|
CFH: TCentralFileHeader;
|
|
i, FilesExtracted, ExtractedSize: integer;
|
|
CFHList: TList;
|
|
begin
|
|
{Algorithm
|
|
Check that the Archive exists before calling this.
|
|
Open Archive
|
|
if FileName <> '' then
|
|
search for FileName and extract one file
|
|
else
|
|
extract all files in archive
|
|
Close Archive
|
|
}
|
|
|
|
FilesExtracted := 0;
|
|
ExtractedSize := 0;
|
|
|
|
if not FileExists(ArchiveNamePath) then
|
|
begin
|
|
Application.MessageBox('reSource.DecompressFromArchive: Archive file does not exist.',
|
|
'Error', MB_OK);
|
|
exit;
|
|
end;
|
|
|
|
ArchiveMan.OpenArchive(ArchiveNamePath, true);
|
|
Screen.Cursor := crHourGlass;
|
|
try
|
|
with ArchiveMan.ArchiveFile do
|
|
begin
|
|
ArchiveMan.dest_dir := IncludeTrailingBackslash(DestPath);
|
|
{Search for file name in CentralFileHeader}
|
|
if ExtractFileName <> '' then
|
|
begin
|
|
for i := 0 to CentralDir.Count-1 do
|
|
begin
|
|
CFH := TCentralFileHeader(CentralDir[i]);
|
|
if CompareText(CFH.filename, ExtractFileName) = 0 then
|
|
begin
|
|
{Construct a CFHList with one CentralFileHeader (CFH) }
|
|
CFHList := TList.Create;
|
|
CFHList.Add(CFH);
|
|
ArchiveMan.ExtractList(CFHList, FilesExtracted, ExtractedSize);
|
|
CFHList.Free;
|
|
break;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{extract all files in archive.
|
|
Add all the CentralDir CFH into CFHList}
|
|
CFHList := TList.Create;
|
|
for i := 0 to CentralDir.Count-1 do
|
|
CFHList.Add(TCentralFileHeader(CentralDir[i]));
|
|
ArchiveMan.ExtractList(CFHList, FilesExtracted, ExtractedSize);
|
|
CFHList.Free;
|
|
end;
|
|
end;
|
|
|
|
if FilesExtracted = 0 then
|
|
ShowMessage('Error: No files extracted')
|
|
else
|
|
ShowMessage(IntToStr(FilesExtracted)+' file(s) extracted');
|
|
|
|
finally
|
|
if ArchiveMan.IsArchiveOpen then
|
|
ArchiveMan.CloseArchive;
|
|
Screen.Cursor := crDefault;
|
|
end;
|
|
end;
|
|
|
|
|
|
end.
|