mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-28 10:02:14 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: Enable option "Create separate archives, one per selected file/dir"

Browse source
This commit is contained in:
Alexander Koblov 2011-06-25 16:08:33 +00:00
commit 0d956cf22c
3 changed files with 153 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/fpackdlg.lfm
View file

@ -17,7 +17,7 @@ object frmPackDlg: TfrmPackDlg
Constraints.MinWidth = 482
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '0.9.31'
LCLVersion = '0.9.29'
object lblPrompt: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
@ -211,7 +211,9 @@ object frmPackDlg: TfrmPackDlg
Top = 17
Width = 260
Caption = 'Recursively pack &subdirectories'
Checked = True
Enabled = False
State = cbChecked
TabOrder = 1
end
object cbMultivolume: TCheckBox
@ -253,7 +255,7 @@ object frmPackDlg: TfrmPackDlg
Top = 102
Width = 260
Caption = 'Create separate archives, o&ne per selected file/dir'
Enabled = False
OnChange = cbCreateSeparateArchivesChange
TabOrder = 6
end
end

2
src/fpackdlg.lrt
View file

@ -1,4 +1,4 @@
TFRMPACKDLG.CAPTION=Pack files
TFRMPACKDLG.FRMPACKDLG.CAPTION=Pack files
TFRMPACKDLG.LBLPROMPT.CAPTION=Pack file(s) to the file:
TFRMPACKDLG.BTNOK.CAPTION=OK
TFRMPACKDLG.BTNCANCEL.CAPTION=Cancel

229
src/fpackdlg.pas
View file

@ -29,7 +29,7 @@ interface
uses
SysUtils, Forms, Controls, Dialogs, StdCtrls, EditBtn, ExtCtrls, uWcxArchiveFileSource,
uArchiveFileSource, uFile, uFileSource;
uArchiveFileSource, uFile, uFileSource, Classes;
type
@ -54,6 +54,7 @@ type
rgPacker: TRadioGroup;
pnlOptions: TPanel;
procedure btnConfigClick(Sender: TObject);
procedure cbCreateSeparateArchivesChange(Sender: TObject);
procedure cbCreateSFXChange(Sender: TObject);
procedure cbOtherPluginsChange(Sender: TObject);
procedure edtPackCmdAcceptDirectory(Sender: TObject; var Value: String);
@ -61,7 +62,8 @@ type
procedure arbChange(Sender: TObject);
private
FArchiveType: String;
FArchiveName,
FArchiveType: UTF8String;
FArchiveTypeCount: Integer;
FExistsArchive : Boolean;
FSourceFileSource: IFileSource;
@ -96,6 +98,7 @@ function ShowPackDlg(const SourceFileSource: IFileSource;
TargetPathInArchive: String;
bNewArchive : Boolean = True): Boolean;
var
I: Integer;
NewTargetFileSource: IArchiveFileSource = nil;
aFlags : PtrInt;
Operation: TFileSourceOperation;
@ -103,6 +106,59 @@ var
ProgressDialog: TfrmFileOp;
PackDialog: TfrmPackDlg;
aFile: TFile = nil;
aFiles: TFiles = nil;
procedure Pack(var FilesToPack: TFiles);
begin
with PackDialog do
begin
if Assigned(NewTargetFileSource) then
begin
// Set flags according to user selection in the pack dialog.
aFlags := 0;
if cbMoveToArchive.Checked then aFlags := aFlags or PK_PACK_MOVE_FILES;
if cbStoredir.Checked then aFlags := aFlags or PK_PACK_SAVE_PATHS;
if cbEncrypt.Checked then aFlags := aFlags or PK_PACK_ENCRYPT;
Operation := NewTargetFileSource.CreateCopyInOperation(
SourceFileSource,
FilesToPack,
TargetPathInArchive);
if Assigned(Operation) then
begin
// TODO: Check if another operation is not running first (for WCX).
if NewTargetFileSource.IsInterface(IWcxArchiveFileSource) then
begin
with Operation as TWcxArchiveCopyInOperation do
begin
PackingFlags := aFlags;
end;
end
else if NewTargetFileSource.IsInterface(IMultiArchiveFileSource) then
begin
with Operation as TMultiArchiveCopyInOperation do
begin
if cbEncrypt.Checked then
Password:= InputBox(Caption, rsMsgPasswordEnter, EmptyStr);
if cbMultivolume.Checked then
VolumeSize:= InputBox(Caption, rsMsgVolumeSizeEnter, EmptyStr);
PackingFlags := aFlags;
CustomParams:= FCustomParams;
end;
end;
// Start operation.
OperationHandle := OperationsManager.AddOperation(Operation, ossQueueLast);
ProgressDialog := TfrmFileOp.Create(OperationHandle);
ProgressDialog.Show;
end;
end;
end;
end;
begin
PackDialog := TfrmPackDlg.Create(nil);
try
@ -111,25 +167,23 @@ begin
FArchiveType:= 'none';
FSourceFileSource:= SourceFileSource;
if bNewArchive then // create new archive
(* if one file selected *)
if Files.Count = 1 then
begin
edtPackCmd.Text := TargetArchivePath + Files[0].Name;
if Files[0].IsDirectory then
edtPackCmd.Text := edtPackCmd.Text + ExtensionSeparator + FArchiveType
else
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, ExtensionSeparator + FArchiveType);
end
else
(* if some files selected *)
begin
edtPackCmd.Text := TargetArchivePath + MakeFileName(Files.Path, 'archive') + ExtensionSeparator + FArchiveType;
end
begin
if Files.Count = 1 then // if one file selected
begin
FArchiveName:= Files[0].NameNoExt;
edtPackCmd.Text := TargetArchivePath + FArchiveName + ExtensionSeparator + FArchiveType;
end
else // if some files selected
begin
FArchiveName:= MakeFileName(Files.Path, 'archive');
edtPackCmd.Text := TargetArchivePath + FArchiveName + ExtensionSeparator + FArchiveType;
end
end
else // pack in exsists archive
begin
if Assigned(TargetFileSource) then
edtPackCmd.Text := TargetFileSource.ArchiveFileName;
end;
begin
if Assigned(TargetFileSource) then
edtPackCmd.Text := TargetFileSource.ArchiveFileName;
end;
Result:= (ShowModal = mrOK);
@ -144,68 +198,61 @@ begin
NewTargetFileSource := TargetFileSource;
end
else
else // Create a new target file source.
begin
// Create a new target file source.
try
// Check if there is an ArchiveFileSource for possible archive.
aFile := SourceFileSource.CreateFileObject(ExtractFilePath(edtPackCmd.Text));
aFile.Name := ExtractFileName(edtPackCmd.Text);
NewTargetFileSource := GetArchiveFileSource(SourceFileSource, aFile, FArchiveType);
except
on e: EFileSourceException do
// If create separate archives, one per selected file/dir
if cbCreateSeparateArchives.Checked then
try
for I:= 0 to Files.Count - 1 do
begin
MessageDlg(e.Message, mtError, [mbOK], 0);
Exit;
// Fill files to pack
aFiles:= TFiles.Create(Files.Path);
aFiles.Add(Files[I].Clone);
try
try
// Check if there is an ArchiveFileSource for possible archive.
aFile := SourceFileSource.CreateFileObject(ExtractFilePath(edtPackCmd.Text));
aFile.Name := Files[I].Name + ExtensionSeparator + FArchiveType;
NewTargetFileSource := GetArchiveFileSource(SourceFileSource, aFile, FArchiveType);
except
on e: EFileSourceException do
begin
MessageDlg(e.Message, mtError, [mbOK], 0);
Exit;
end;
end;
// Pack current item
Pack(aFiles);
finally
FreeAndNil(aFile);
end;
end;
end;
finally
FreeAndNil(aFiles);
end
else
begin
try
// Check if there is an ArchiveFileSource for possible archive.
aFile := SourceFileSource.CreateFileObject(ExtractFilePath(edtPackCmd.Text));
aFile.Name := ExtractFileName(edtPackCmd.Text);
NewTargetFileSource := GetArchiveFileSource(SourceFileSource, aFile, FArchiveType);
except
on e: EFileSourceException do
begin
MessageDlg(e.Message, mtError, [mbOK], 0);
Exit;
end;
end;
// Pack files
Pack(Files);
end;
end;
if Assigned(NewTargetFileSource) then
begin
// Set flags according to user selection in the pack dialog.
aFlags := 0;
if cbMoveToArchive.Checked then aFlags := aFlags or PK_PACK_MOVE_FILES;
if cbStoredir.Checked then aFlags := aFlags or PK_PACK_SAVE_PATHS;
if cbEncrypt.Checked then aFlags := aFlags or PK_PACK_ENCRYPT;
Operation := NewTargetFileSource.CreateCopyInOperation(
SourceFileSource,
Files,
TargetPathInArchive);
if Assigned(Operation) then
begin
// TODO: Check if another operation is not running first (for WCX).
if NewTargetFileSource.IsInterface(IWcxArchiveFileSource) then
begin
with Operation as TWcxArchiveCopyInOperation do
begin
PackingFlags := aFlags;
end;
end
else if NewTargetFileSource.IsInterface(IMultiArchiveFileSource) then
begin
with Operation as TMultiArchiveCopyInOperation do
begin
if cbEncrypt.Checked then
Password:= InputBox(Caption, rsMsgPasswordEnter, EmptyStr);
if cbMultivolume.Checked then
VolumeSize:= InputBox(Caption, rsMsgVolumeSizeEnter, EmptyStr);
PackingFlags := aFlags;
CustomParams:= FCustomParams;
end;
end;
// Start operation.
OperationHandle := OperationsManager.AddOperation(Operation, ossAutoStart);
ProgressDialog := TfrmFileOp.Create(OperationHandle);
ProgressDialog.Show;
end;
end;
// Save last used packer
gLastUsedPacker:= FArchiveType;
end;
@ -288,6 +335,14 @@ begin
end;
end;
procedure TfrmPackDlg.cbCreateSeparateArchivesChange(Sender: TObject);
begin
if cbCreateSeparateArchives.Checked then
edtPackCmd.Text:= ExtractFilePath(edtPackCmd.Text) + '*.*' + ExtensionSeparator + FArchiveType
else
edtPackCmd.Text:= ExtractFilePath(edtPackCmd.Text) + FArchiveName + ExtensionSeparator + FArchiveType;
end;
procedure TfrmPackDlg.cbCreateSFXChange(Sender: TObject);
begin
if cbCreateSFX.Checked then
@ -343,6 +398,17 @@ begin
begin
// If plugin supports packing with password
EnableControl(cbEncrypt, ((gWCXPlugins.Flags[I] and PK_CAPS_ENCRYPT) <> 0));
// If archive can contain multiple files
if ((gWCXPlugins.Flags[I] and PK_CAPS_MULTIPLE) <> 0) then
cbCreateSeparateArchives.Enabled:= True
else
begin
cbCreateSeparateArchives.Checked:= True;
cbCreateSeparateArchives.Enabled:= False;
end;
// Options that supported by plugins
EnableControl(cbStoredir, True);
// Options that don't supported by plugins
EnableControl(cbMultivolume, False);
Exit;
@ -354,6 +420,8 @@ begin
begin
if FEnabled and MatchesMaskList(FArchiveType, FExtension, ',') then
begin
// Archive can contain multiple files
cbCreateSeparateArchives.Enabled:= True;
// If addon supports create self extracting archive
EnableControl(cbCreateSFX, (Length(FAddSelfExtract) <> 0));
@ -366,6 +434,13 @@ begin
EnableControl(cbMultivolume, (Pos('%V', sCmd) <> 0));
// If addon supports packing with password
EnableControl(cbEncrypt, (Pos('%W', sCmd) <> 0));
// Options that don't supported by addons
cbStoredir.Checked:= True;
cbRecurse.Checked:= True;
EnableControl(cbStoredir, False);
EnableControl(cbRecurse, False);
Exit;
end;
end;