Groesz.org
/
rsvk
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
rsvk/Component/ArchiveManagerUnit.pas

948 lines
30 KiB
Plaintext
Raw Permalink Blame History

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.
Reference in New Issue View Git Blame Copy Permalink