mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

UPD: Some operations with archives

Browse source
This commit is contained in:
Alexander Koblov 2007-11-28 22:14:36 +00:00
commit 94fc197300
7 changed files with 362 additions and 283 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/fmain.txt
View file

@ -13,4 +13,5 @@
UPD: При создания ссылки/символьной ссылки в качестве имени ссылки
подставляется имя исходного файла/каталога
24.11.2007 ADD: Возможность использовать на панели инструментов значки из *.exe и *.dll
файлов под Windows
файлов под Windows
28.11.2007 Добавил блокировку, если выполняется операция c архивом

3
doc/uwcxmodule.txt
View file

@ -11,4 +11,5 @@
больше код
30.07.2007 Добавил ProgressBar для операции удаления
04.08.2007 Добавил упаковку в подкаталоги, распаковку по маске
16.08.2007 Сделал более корректной распаковку по маске
16.08.2007 Сделал более корректной распаковку по маске
28.11.2007 Добавил блокировку, если выполняется операция

3
fextractdlg.pas
View file

@ -52,9 +52,6 @@ TfrmExtractDlg = class(TForm)
{ public declarations }
end;
var
frmExtractDlg: TfrmExtractDlg;
procedure ShowExtractDlg(ActiveFrame:TFrameFilePanel; var fl : TFileList; sDestPath:String);
implementation

15
fmain.lfm
View file

@ -4,11 +4,11 @@ object frmMain: TfrmMain
Top = 278
Width = 540
HorzScrollBar.Page = 539
VertScrollBar.Page = 315
VertScrollBar.Page = 316
VertScrollBar.Range = 79
ActiveControl = pnlNotebooks
Caption = 'Double Commander'
ClientHeight = 316
ClientHeight = 317
ClientWidth = 540
Font.Color = clBlack
Font.Height = 13
@ -29,7 +29,7 @@ object frmMain: TfrmMain
ShowHint = True
object pnlSyncSize: TPanel
Height = 26
Top = 23
Top = 24
Width = 540
Align = alTop
BevelOuter = bvNone
@ -60,6 +60,7 @@ object frmMain: TfrmMain
CheckToolButton = True
FlatButtons = True
IsDiskPanel = True
ButtonGlyphSize = 16
end
object dskRight: TKAStoolBar
Left = 143
@ -75,12 +76,13 @@ object frmMain: TfrmMain
CheckToolButton = True
FlatButtons = True
IsDiskPanel = True
ButtonGlyphSize = 16
end
end
end
object pnlNotebooks: TPanel
Height = 240
Top = 49
Top = 50
Width = 540
Align = alClient
ClientHeight = 240
@ -291,7 +293,7 @@ object frmMain: TfrmMain
end
end
object MainToolBar: TKAStoolBar
Height = 23
Height = 24
Width = 540
Align = alTop
TabOrder = 2
@ -299,11 +301,12 @@ object frmMain: TfrmMain
OnToolButtonClick = MainToolBarToolButtonClick
OnLoadButtonGlyph = MainToolBarLoadButtonGlyph
FlatButtons = True
ButtonGlyphSize = 16
EnvVar = '%commander_path%'
end
object pnlKeys: TPanel
Height = 27
Top = 289
Top = 290
Width = 540
Align = alBottom
Anchors = [akLeft, akRight]

153
fmain.pas
View file

@ -343,7 +343,7 @@ implementation
uses
uTypes, fAbout, uGlobs, uLng, fOptions,{ fViewer,}fconfigtoolbar,
uCopyThread, uFileList, uDeleteThread, uVFSUtil,
uCopyThread, uFileList, uDeleteThread, uVFSUtil, uWCXModule,
fMkDir, fCopyDlg, fCompareFiles,{ fEditor,} fMoveDlg, uMoveThread, uShowMsg,
fFindDlg, uSpaceThread, fHotDir, fSymLink, fHardLink,
fMultiRename, uShowForm, uGlobsPaths, fFileOpDlg, fMsg, fPackDlg, fExtractDlg,
@ -369,21 +369,23 @@ procedure TfrmMain.actPackFilesExecute(Sender: TObject);
var
fl : TFileList;
begin
fl:=TFileList.Create;
with ActiveFrame do
if not IsBlocked then
begin
SelectFileIfNoSelected(GetActiveItem);
CopyListSelectedExpandNames(pnlFile.FileList,fl,ActiveDir);
fl.CurrentDirectory := ActiveDir;
end;
try
ShowPackFilesForm(NotActiveFrame.pnlFile.VFS, fl, NotActiveFrame.ActiveDir);
finally
frameLeft.RefreshPanel;
frameRight.RefreshPanel;
end;
fl:=TFileList.Create;
with ActiveFrame do
begin
SelectFileIfNoSelected(GetActiveItem);
CopyListSelectedExpandNames(pnlFile.FileList,fl,ActiveDir);
fl.CurrentDirectory := ActiveDir;
end;
try
ShowPackDlg(NotActiveFrame.pnlFile.VFS, fl, NotActiveFrame.ActiveDir);
finally
frameLeft.RefreshPanel;
frameRight.RefreshPanel;
end;
end; // IsBlocked
end;
procedure TfrmMain.actRightOpenDrivesExecute(Sender: TObject);
@ -445,21 +447,23 @@ procedure TfrmMain.actExtractFilesExecute(Sender: TObject);
var
fl : TFileList;
begin
fl:=TFileList.Create;
with ActiveFrame do
if not IsBlocked then
begin
SelectFileIfNoSelected(GetActiveItem);
CopyListSelectedExpandNames(pnlFile.FileList,fl,ActiveDir);
fl.CurrentDirectory := ActiveDir;
end;
try
ShowExtractDlg(ActiveFrame, fl, NotActiveFrame.ActiveDir);
finally
frameLeft.RefreshPanel;
frameRight.RefreshPanel;
end;
fl:=TFileList.Create;
with ActiveFrame do
begin
SelectFileIfNoSelected(GetActiveItem);
CopyListSelectedExpandNames(pnlFile.FileList,fl,ActiveDir);
fl.CurrentDirectory := ActiveDir;
end;
try
ShowExtractDlg(ActiveFrame, fl, NotActiveFrame.ActiveDir);
finally
frameLeft.RefreshPanel;
frameRight.RefreshPanel;
end;
end; // IsBlocked
end;
procedure TfrmMain.actFocusCmdLineExecute(Sender: TObject);
@ -1796,6 +1800,14 @@ var
CT : TCopyThread;
blDropReadOnlyFlag : Boolean;
begin
if (ActiveFrame.pnlFile.PanelMode in [pmVFS, pmArchive]) and
(NotActiveFrame.pnlFile.PanelMode in [pmVFS, pmArchive]) then
begin
ShowMessage('Function not supported!');
Exit;
end;
fl:=TFileList.Create; // free at Thread end by thread
sCopyQuest:=GetFileDlgStr(rsMsgCpSel, rsMsgCpFlDr);
@ -1808,17 +1820,34 @@ begin
else
sDestPath:=sDestPath+'*.*';
(* Extract files from archive *)
(* Copy files between archive and real file system *)
(* Check active panel *)
if ActiveFrame.pnlFile.PanelMode = pmArchive then
begin
DebugLN('+++ Extract files from archive +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ShowExtractDlg(ActiveFrame, fl, ExtractFilePath(sDestPath));
NotActiveFrame.RefreshPanel;
if not IsBlocked then
begin
DebugLN('+++ Extract files from archive +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ShowExtractDlg(ActiveFrame, fl, ExtractFilePath(sDestPath));
NotActiveFrame.RefreshPanel;
end;
Exit;
end;
(* Check not active panel *)
if NotActiveFrame.pnlFile.PanelMode = pmArchive then
begin
if not IsBlocked then
begin
DebugLN('+++ Pack files to archive +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
sDestPath:=ExtractFilePath(sDestPath);
ShowPackDlg(NotActiveFrame.pnlFile.VFS, fl, sDestPath, False);
end;
Exit;
end;
with TfrmCopyDlg.Create(Application) do
begin
try
@ -1837,8 +1866,10 @@ begin
end;
end; //with
(* Copy files between VFS and real file system *)
(* Check not active panel *)
if NotActiveFrame.pnlFile.PanelMode in [pmArchive, pmVFS] then
if NotActiveFrame.pnlFile.PanelMode = pmVFS then
begin
DebugLN('+++ Copy files to VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
@ -1847,39 +1878,31 @@ begin
end;
(* Check active panel *)
try
(*Copy files from VFS*)
if ActiveFrame.pnlFile.PanelMode = pmVFS then
begin
DebugLN('+++ Copy files from VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyOutEx(fl, sDestPath, 0);
NotActiveFrame.RefreshPanel;
end
else
(*Copy files*)
begin
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
CT := TCopyThread.Create(fl);
CT.FFileOpDlg := frmFileOp;
CT.sDstPath:=sDestPath;
CT.sDstMask:=sDstMaskTemp;
CT.bDropReadOnlyFlag := blDropReadOnlyFlag;
if ActiveFrame.pnlFile.PanelMode = pmVFS then
begin
DebugLN('+++ Copy files from VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyOutEx(fl, sDestPath, 0);
Exit;
end;
frmFileOp.Thread := TThread(CT);
frmFileOp.Show;
CT.Resume;
except
CT.Free;
end;
end;
(* Copy files between real file system *)
except
//frmFileOp.Free;
end;
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
CT := TCopyThread.Create(fl);
CT.FFileOpDlg := frmFileOp;
CT.sDstPath:=sDestPath;
CT.sDstMask:=sDstMaskTemp;
CT.bDropReadOnlyFlag := blDropReadOnlyFlag;
frmFileOp.Thread := TThread(CT);
frmFileOp.Show;
CT.Resume;
except
CT.Free;
end;
end;
procedure TfrmMain.actCopySamePanelExecute(Sender: TObject);

416
fpackdlg.pas
View file

@ -1,195 +1,221 @@
{
Double Commander
-------------------------------------------------------------------------
File packing window
Copyright (C) 2007 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit fPackDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, uFileList, uVFS, EditBtn, ExtCtrls;
type
{ TfrmPackDlg }
TfrmPackDlg = class(TForm)
btnConfig: TButton;
btnHelp: TButton;
btnCancel: TButton;
cbCreateSeparateArchives: TCheckBox;
cbCreateSFX: TCheckBox;
cbEncrypt: TCheckBox;
cbMoveToArchive: TCheckBox;
cbMultivolume: TCheckBox;
btnOk: TButton;
cbPackerList: TComboBox;
cbOtherPlugins: TCheckBox;
edtPackCmd: TDirectoryEdit;
lblPrompt: TLabel;
cbRecurse: TCheckBox;
cbStoredir: TCheckBox;
rgPacker: TRadioGroup;
procedure btnConfigClick(Sender: TObject);
procedure cbOtherPluginsChange(Sender: TObject);
procedure edtPackCmdAcceptDirectory(Sender: TObject; var Value: String);
procedure FormShow(Sender: TObject);
procedure arbChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure ShowPackFilesForm(VFS : TVFS; var fl : TFileList; sDestPath:String);
implementation
uses
uWCXhead;
var
CurrentVFS : TVFS;
procedure ShowPackFilesForm(VFS : TVFS; var fl: TFileList; sDestPath:String);
var
Flags : LongInt;
begin
with TfrmPackDlg.Create(nil) do
begin
(* if one file selected *)
if fl.Count = 1 then
begin
edtPackCmd.Text := sDestPath + ExtractFileName(fl.GetFileName(0));
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.none');
end
else
(* if some files selected *)
begin
edtPackCmd.Text := sDestPath + ExtractFileName(ExcludeTrailingPathDelimiter(fl.CurrentDirectory)) + '.none';
end;
CurrentVFS := VFS;
if (ShowModal = mrOK) then
if VFS.FindModule(edtPackCmd.Text) then
begin
Flags := 0;
if cbMoveToArchive.Checked then Flags := Flags or PK_PACK_MOVE_FILES;
if cbStoredir.Checked then Flags := Flags or PK_PACK_SAVE_PATHS;
if cbEncrypt.Checked then Flags := Flags or PK_PACK_ENCRYPT;
VFS.VFSmodule.VFSCopyIn(fl, '', Flags);
end;
Free;
end;
end;
{ TfrmPackDlg }
procedure TfrmPackDlg.FormShow(Sender: TObject);
var
I, J : Integer;
sCurrentPlugin : String;
iCurPlugCaps : Integer;
Count : Integer;
begin
J := 0;
Count := 0;
with CurrentVFS do
begin
for I:=0 to WCXPlugins.Count - 1 do
begin
if Pos('#', WCXPlugins.Names[I]) <> 0 then Continue;
sCurrentPlugin := WCXPlugins.ValueFromIndex[i];
iCurPlugCaps := StrToInt(Copy(sCurrentPlugin, 1, Pos(',',sCurrentPlugin) - 1));
if (iCurPlugCaps and PK_CAPS_NEW) = PK_CAPS_NEW then
begin
(* First 9 plugins we display as RadioButtons *)
if J < 9 then
begin
rgPacker.Items.Add(WCXPlugins.Names[I]);
J := J + 1;
end
else
(* Other plugins we add in ComboBox *)
begin
cbPackerList.Items.Add(WCXPlugins.Names[I]);
end;
end;
end; //for
if rgPacker.Items.Count > 0 then
rgPacker.ItemIndex := 0;
if cbPackerList.Items.Count > 0 then
begin
cbOtherPlugins.Visible := True;
cbPackerList.Visible := True;
cbOtherPlugins.Enabled := True;
cbOtherPlugins.Enabled := True;
cbPackerList.ItemIndex := 0;
end
else
btnConfig.AnchorToCompanion(akTop, 6, rgPacker);
end;
end;
procedure TfrmPackDlg.btnConfigClick(Sender: TObject);
begin
if CurrentVFS.FindModule(edtPackCmd.Text) then
CurrentVFS.VFSmodule.VFSConfigure(Handle);
end;
procedure TfrmPackDlg.cbOtherPluginsChange(Sender: TObject);
begin
if cbOtherPlugins.Checked then
begin
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + cbPackerList.Text);
rgPacker.ItemIndex := -1;
end
else
begin
if rgPacker.ItemIndex = -1 then
rgPacker.ItemIndex := 0;
end;
cbPackerList.Enabled := cbOtherPlugins.Checked;
end;
procedure TfrmPackDlg.edtPackCmdAcceptDirectory(Sender: TObject; var Value: String
);
begin
Value := IncludeTrailingPathDelimiter(Value) + ExtractFileName(edtPackCmd.Text);
end;
procedure TfrmPackDlg.arbChange(Sender: TObject);
begin
if rgPacker.ItemIndex >= 0 then
begin
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + rgPacker.Items[rgPacker.ItemIndex]);
cbOtherPlugins.Checked := False;
end;
end;
initialization
{$I fpackdlg.lrs}
end.
{
Double Commander
-------------------------------------------------------------------------
File packing window
Copyright (C) 2007 Koblov Alexander (Alexx2000@mail.ru)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit fPackDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, uFileList, uVFS, EditBtn, ExtCtrls;
type
{ TfrmPackDlg }
TfrmPackDlg = class(TForm)
btnConfig: TButton;
btnHelp: TButton;
btnCancel: TButton;
cbCreateSeparateArchives: TCheckBox;
cbCreateSFX: TCheckBox;
cbEncrypt: TCheckBox;
cbMoveToArchive: TCheckBox;
cbMultivolume: TCheckBox;
btnOk: TButton;
cbPackerList: TComboBox;
cbOtherPlugins: TCheckBox;
edtPackCmd: TDirectoryEdit;
lblPrompt: TLabel;
cbRecurse: TCheckBox;
cbStoredir: TCheckBox;
rgPacker: TRadioGroup;
procedure btnConfigClick(Sender: TObject);
procedure cbOtherPluginsChange(Sender: TObject);
procedure edtPackCmdAcceptDirectory(Sender: TObject; var Value: String);
procedure FormShow(Sender: TObject);
procedure arbChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure ShowPackDlg(VFS : TVFS; var fl : TFileList; sDestPath:String; bNewArchive : Boolean = True);
implementation
uses
uWCXhead;
var
CurrentVFS : TVFS;
procedure ShowPackDlg(VFS : TVFS; var fl: TFileList; sDestPath:String; bNewArchive : Boolean = True);
var
Flags : LongInt;
begin
with TfrmPackDlg.Create(nil) do
begin
if bNewArchive then // create new archive
(* if one file selected *)
if fl.Count = 1 then
begin
edtPackCmd.Text := sDestPath + ExtractFileName(fl.GetFileName(0));
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.none');
end
else
(* if some files selected *)
begin
edtPackCmd.Text := sDestPath + ExtractFileName(ExcludeTrailingPathDelimiter(fl.CurrentDirectory)) + '.none';
end
else // pack in exsists archive
edtPackCmd.Text := VFS.ArcFullName;
CurrentVFS := VFS;
if (ShowModal = mrOK) then
if VFS.FindModule(edtPackCmd.Text) then
begin
Flags := 0;
if cbMoveToArchive.Checked then Flags := Flags or PK_PACK_MOVE_FILES;
if cbStoredir.Checked then Flags := Flags or PK_PACK_SAVE_PATHS;
if cbEncrypt.Checked then Flags := Flags or PK_PACK_ENCRYPT;
if bNewArchive then
VFS.VFSmodule.VFSCopyIn(fl, '', Flags)
else
VFS.VFSmodule.VFSCopyIn(fl, sDestPath, Flags)
end;
Free;
end;
end;
{ TfrmPackDlg }
procedure TfrmPackDlg.FormShow(Sender: TObject);
var
iIndex,
I, J : Integer;
bExsistArchive : Boolean;
sExt,
sCurrentPlugin : String;
iCurPlugCaps : Integer;
Count : Integer;
begin
J := 0;
Count := 0;
sExt := ExtractFileExt(edtPackCmd.Text);
Delete(sExt, 1, 1); // delete a dot
bExsistArchive := (sExt <> 'none');
with CurrentVFS do
begin
for I:=0 to WCXPlugins.Count - 1 do
begin
if Pos('#', WCXPlugins.Names[I]) <> 0 then Continue;
sCurrentPlugin := WCXPlugins.ValueFromIndex[i];
iCurPlugCaps := StrToInt(Copy(sCurrentPlugin, 1, Pos(',',sCurrentPlugin) - 1));
if (iCurPlugCaps and PK_CAPS_NEW) = PK_CAPS_NEW then
begin
(* First 9 plugins we display as RadioButtons *)
if J < 9 then
begin
iIndex := rgPacker.Items.Add(WCXPlugins.Names[I]);
if bExsistArchive then
if (sExt = WCXPlugins.Names[I]) then
rgPacker.ItemIndex := iIndex
else
rgPacker.Controls[iIndex + 1].Enabled := False;
J := J + 1;
end
else
(* Other plugins we add in ComboBox *)
begin
iIndex := cbPackerList.Items.Add(WCXPlugins.Names[I]);
if bExsistArchive and (sExt = WCXPlugins.Names[I]) then
cbPackerList.ItemIndex := iIndex;
end;
end;
end; //for
if (rgPacker.Items.Count > 0) and (rgPacker.ItemIndex < 0) then
rgPacker.ItemIndex := 0;
if cbPackerList.Items.Count > 0 then
begin
cbOtherPlugins.Visible := True;
cbPackerList.Visible := True;
if bExsistArchive then
cbPackerList.Enabled:= False
else
cbOtherPlugins.Enabled := True;
if cbPackerList.ItemIndex < 0 then
cbPackerList.ItemIndex := 0;
end
else
btnConfig.AnchorToCompanion(akTop, 6, rgPacker);
end;
end;
procedure TfrmPackDlg.btnConfigClick(Sender: TObject);
begin
if CurrentVFS.FindModule(edtPackCmd.Text) then
CurrentVFS.VFSmodule.VFSConfigure(Handle);
end;
procedure TfrmPackDlg.cbOtherPluginsChange(Sender: TObject);
begin
if cbOtherPlugins.Checked then
begin
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + cbPackerList.Text);
rgPacker.ItemIndex := -1;
end
else
begin
if rgPacker.ItemIndex = -1 then
rgPacker.ItemIndex := 0;
end;
cbPackerList.Enabled := cbOtherPlugins.Checked;
end;
procedure TfrmPackDlg.edtPackCmdAcceptDirectory(Sender: TObject; var Value: String
);
begin
Value := IncludeTrailingPathDelimiter(Value) + ExtractFileName(edtPackCmd.Text);
end;
procedure TfrmPackDlg.arbChange(Sender: TObject);
begin
if rgPacker.ItemIndex >= 0 then
begin
edtPackCmd.Text := ChangeFileExt(edtPackCmd.Text, '.' + rgPacker.Items[rgPacker.ItemIndex]);
cbOtherPlugins.Checked := False;
end;
end;
initialization
{$I fpackdlg.lrs}
end.

50
uwcxmodule.pas
View file

@ -119,18 +119,19 @@ Type
function VFSList(const sDir:String; var fl:TFileList ):Boolean;override;{Return the filelist of archive}
end;
function IsBlocked : Boolean;
implementation
uses Forms, SysUtils, uFileOp, uOSUtils, LCLProc, uFileProcs, uDCUtils, uLng, Controls;
var
WCXModule : TWCXModule;
WCXModule : TWCXModule; // used in ProcessDataProc
iResult : Integer;
constructor TWCXModule.Create;
begin
FFilesSize:= 0;
FPercent := 0;
WCXModule := Self;
end;
destructor TWCXModule.Destroy;
@ -359,11 +360,11 @@ begin
Result := False;
Exit;
end;
{
WCXModule := Self; // set WCXModule variable to current module
SetChangeVolProc(ArcHandle, ChangeVolProc);
SetProcessDataProc(ArcHandle, ProcessDataProc);
}
DebugLN('Get File List');
(*Get File List*)
@ -496,6 +497,7 @@ begin
Exit;
end;
WCXModule := Self; // set WCXModule variable to current module
SetChangeVolProc(ArcHandle, ChangeVolProc);
SetProcessDataProc(ArcHandle, ProcessDataProc);
@ -567,6 +569,7 @@ begin
(* Convert TFileList into PChar *)
FileList := PChar(GetFileList(FFileList));
WCXModule := Self; // set WCXModule variable to current module
SetChangeVolProc(0, ChangeVolProc);
SetProcessDataProc(0, ProcessDataProc);
@ -696,8 +699,9 @@ begin
WCXCopyOut;
FFileOpDlg.Close;
FFileOpDlg.Free;
FFileOpDlg := nil;
except
FFileOpDlg := nil;
Result := False;
end;
end;
@ -723,9 +727,10 @@ begin
WCXCopyIn;
FFileOpDlg.Close;
FFileOpDlg.Free;
FFileOpDlg := nil;
except
Result := False
FFileOpDlg := nil;
Result := False;
end;
end;
@ -752,6 +757,7 @@ begin
FFileOpDlg.Thread := TThread(CT);
CT.Resume;
except
FFileOpDlg := nil;
Result := False;
end;
end;
@ -780,7 +786,8 @@ begin
FFileOpDlg.Thread := TThread(CT);
CT.Resume;
except
Result := False
FFileOpDlg := nil;
Result := False;
end;
end;
@ -808,6 +815,7 @@ begin
CT := nil;
WCXModule := Self; // set WCXModule variable to current module
SetChangeVolProc(0, ChangeVolProc);
SetProcessDataProc(0, ProcessDataProc);
@ -817,8 +825,10 @@ begin
FFileOpDlg.Close;
FFileOpDlg.Free;
FFileOpDlg := nil;
except
Result := False
FFileOpDlg := nil;
Result := False;
end;
end;
@ -887,9 +897,27 @@ begin
end;
end; //case
Synchronize(FFileOpDlg.Close);
Synchronize(FFileOpDlg.Free);
FFileOpDlg := nil;
end; //with
except
DebugLN('Error in "WCXCopyThread.Execute"');
end;
end;
end;
function IsBlocked : Boolean;
begin
Result := Assigned(WCXModule);
if Result then
with WCXModule do
begin
Result := Assigned(FFileOpDlg);
if Result then
if Assigned(CT) then
CT.Synchronize(FFileOpDlg.ShowOnTop)
else
FFileOpDlg.ShowOnTop;
end; // with
end;
end.