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 code optimizations

Browse source
This commit is contained in:
Alexander Koblov 2008-09-14 10:21:40 +00:00
commit 321ca9983e
5 changed files with 600 additions and 638 deletions
Download patch file Download diff file Expand all files Collapse all files

4
fFileOpDlg.pas
View file

@ -47,9 +47,6 @@ type
procedure UpdateDlg;
end;
var
frmFileOp : TfrmFileOp;
implementation
uses fMain;
//uses uFileOpThread;
@ -63,6 +60,7 @@ end;
procedure TfrmFileOp.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:= caFree;
frmMain.frameLeft.RefreshPanel;
frmMain.frameRight.RefreshPanel;
frmMain.ActiveFrame.SetFocus;

353
fmain.pas
View file

@ -1453,28 +1453,16 @@ begin
end;
end;
(* Move files *)
(* Move files *)
try
begin
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
MT:= TMoveThread.Create(srcFileList);
MT.FFileOpDlg:= frmFileOp;
MT.sDstPath:= sDestPath;
MT.sDstMask:= sDstMaskTemp;
frmFileOp.Thread:= TThread(MT);
frmFileOp.Show;
MT.Resume;
except
MT.Free;
end;
try
MT:= TMoveThread.Create(srcFileList);
MT.sDstPath:= sDestPath;
MT.sDstMask:= sDstMaskTemp;
MT.Resume;
except
MT.Free;
end;
except
//FreeAndNil(frmFileOp);
end;
end;
(* Used for drag&drop copy from external application *)
@ -1548,21 +1536,15 @@ begin
(* Copy files between real file system *)
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
CT := TCopyThread.Create(srcFileList);
CT.FFileOpDlg := frmFileOp;
CT.sDstPath:=sDestPath;
CT.sDstMask:=sDstMaskTemp;
CT.bDropReadOnlyFlag := blDropReadOnlyFlag;
frmFileOp.Thread := TThread(CT);
frmFileOp.Show;
CT.Resume;
except
CT.Free;
end;
try
CT:= TCopyThread.Create(srcFileList);
CT.sDstPath:= sDestPath;
CT.sDstMask:= sDstMaskTemp;
CT.bDropReadOnlyFlag:= blDropReadOnlyFlag;
CT.Resume;
except
CT.Free;
end;
end;
procedure TfrmMain.RenameFile(sDestPath:String);
@ -1572,68 +1554,60 @@ var
sCopyQuest:String;
MT : TMoveThread;
begin
fl:=TFileList.Create; // free at Thread end by thread
sCopyQuest:=GetFileDlgStr(rsMsgRenSel, rsMsgRenFlDr);
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
fl:= TFileList.Create; // free at Thread end by thread
try
sCopyQuest:=GetFileDlgStr(rsMsgRenSel, rsMsgRenFlDr);
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
if (ActiveFrame.pnlFile.GetSelectedCount=1) then
begin
if sDestPath='' then
if (ActiveFrame.pnlFile.GetSelectedCount=1) then
begin
ShowRenameFileEdit(ActiveFrame.pnlFile.GetActiveItem^.sName);
Exit;
if sDestPath='' then
begin
ShowRenameFileEdit(ActiveFrame.pnlFile.GetActiveItem^.sName);
Exit;
end
else
begin
if FPS_ISDIR(ActiveFrame.pnlFile.GetActiveItem^.iMode) then
sDestPath:=sDestPath + '*.*'
else
sDestPath:=sDestPath + ExtractFileName(ActiveFrame.pnlFile.GetActiveItem^.sName);
end;
end
else
begin
if FPS_ISDIR(ActiveFrame.pnlFile.GetActiveItem^.iMode) then
sDestPath:=sDestPath + '*.*'
else
sDestPath:=sDestPath + ExtractFileName(ActiveFrame.pnlFile.GetActiveItem^.sName);
end;
end
else
sDestPath:=sDestPath+'*.*';
sDestPath:=sDestPath+'*.*';
with TfrmMoveDlg.Create(Application) do
begin
try
edtDst.Text:=sDestPath;
lblMoveSrc.Caption:=sCopyQuest;
if ShowModal=mrCancel then Exit ; // throught finally
with TfrmMoveDlg.Create(Application) do
begin
try
edtDst.Text:=sDestPath;
lblMoveSrc.Caption:=sCopyQuest;
if ShowModal=mrCancel then Exit ; // throught finally
{ ActiveFrame.UnMarkAll;
Exit;}
sDestPath := ExtractFilePath(edtDst.Text);
sDstMaskTemp:=ExtractFileName(edtDst.Text);
finally
with ActiveFrame do
UnSelectFileIfSelected(GetActiveItem);
Free;
sDestPath := ExtractFilePath(edtDst.Text);
sDstMaskTemp:=ExtractFileName(edtDst.Text);
finally
with ActiveFrame do
UnSelectFileIfSelected(GetActiveItem);
Free;
end;
end;
end;
(* Move files *)
(* Move files *)
try
begin
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
MT := TMoveThread.Create(fl);
MT.FFileOpDlg := frmFileOp;
MT.sDstPath:=sDestPath;
MT.sDstMask:=sDstMaskTemp;
frmFileOp.Thread := TThread(MT);
frmFileOp.Show;
MT.Resume;
except
MT.Free;
end;
try
MT:= TMoveThread.Create(fl);
MT.sDstPath:=sDestPath;
MT.sDstMask:=sDstMaskTemp;
MT.Resume;
except
MT.Free;
end;
except
FreeAndNil(fl);
end;
except
//FreeAndNil(frmFileOp);
end;
end;
procedure TfrmMain.CopyFile(sDestPath:String);
@ -1653,117 +1627,116 @@ begin
end;
fl:=TFileList.Create; // free at Thread end by thread
sCopyQuest:=GetFileDlgStr(rsMsgCpSel, rsMsgCpFlDr);
try
sCopyQuest:=GetFileDlgStr(rsMsgCpSel, rsMsgCpFlDr);
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
if (ActiveFrame.pnlFile.GetSelectedCount=1) and not (FPS_ISDIR(ActiveFrame.pnlFile.GetActiveItem^.iMode) or ActiveFrame.pnlFile.GetActiveItem^.bLinkIsDir) then
sDestPath:=sDestPath + ExtractFileName(ActiveFrame.pnlFile.GetActiveItem^.sName)
else
sDestPath:=sDestPath + '*.*';
if (ActiveFrame.pnlFile.GetSelectedCount=1) and not (FPS_ISDIR(ActiveFrame.pnlFile.GetActiveItem^.iMode) or ActiveFrame.pnlFile.GetActiveItem^.bLinkIsDir) then
sDestPath:=sDestPath + ExtractFileName(ActiveFrame.pnlFile.GetActiveItem^.sName)
else
sDestPath:=sDestPath + '*.*';
(* Copy files between archive and real file system *)
(* Copy files between archive and real file system *)
(* Check active panel *)
if ActiveFrame.pnlFile.PanelMode = pmArchive then
begin
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 active panel *)
if ActiveFrame.pnlFile.PanelMode = pmArchive then
begin
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
if (VFS_CAPS_COPYIN in NotActiveFrame.pnlFile.VFS.VFSmodule.VFSCaps) then
begin
DebugLn('+++ Pack files to archive +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
sDestPath:=ExtractFilePath(sDestPath);
ShowPackDlg(NotActiveFrame.pnlFile.VFS, fl, sDestPath, False);
end
else
msgWarning(rsMsgErrNotSupported);
end;
Exit;
end;
(* Check not active panel *)
if NotActiveFrame.pnlFile.PanelMode = pmArchive then
begin
if not IsBlocked then
begin
if (VFS_CAPS_COPYIN in NotActiveFrame.pnlFile.VFS.VFSmodule.VFSCaps) then
begin
DebugLn('+++ Pack files to archive +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
sDestPath:=ExtractFilePath(sDestPath);
ShowPackDlg(NotActiveFrame.pnlFile.VFS, fl, sDestPath, False);
end
else
msgWarning(rsMsgErrNotSupported);
end;
Exit;
end;
with TfrmCopyDlg.Create(Application) do
begin
try
edtDst.Text:=sDestPath;
lblCopySrc.Caption := sCopyQuest;
cbDropReadOnlyFlag.Checked := gDropReadOnlyFlag;
cbDropReadOnlyFlag.Visible := (NotActiveFrame.pnlFile.PanelMode = pmDirectory);
if ShowModal=mrCancel then
Exit ; // throught finally
sDestPath:=ExtractFilePath(edtDst.Text);
sDstMaskTemp:=ExtractFileName(edtDst.Text);
blDropReadOnlyFlag := cbDropReadOnlyFlag.Checked;
with TfrmCopyDlg.Create(Application) do
begin
try
edtDst.Text:=sDestPath;
lblCopySrc.Caption := sCopyQuest;
cbDropReadOnlyFlag.Checked := gDropReadOnlyFlag;
cbDropReadOnlyFlag.Visible := (NotActiveFrame.pnlFile.PanelMode = pmDirectory);
if ShowModal=mrCancel then
Exit ; // throught finally
sDestPath:=ExtractFilePath(edtDst.Text);
sDstMaskTemp:=ExtractFileName(edtDst.Text);
blDropReadOnlyFlag := cbDropReadOnlyFlag.Checked;
finally
with ActiveFrame do
UnSelectFileIfSelected(GetActiveItem);
Free;
end;
end; //with
finally
with ActiveFrame do
UnSelectFileIfSelected(GetActiveItem);
Free;
end;
end; //with
(* Copy files between VFS and real file system *)
(* Copy files between VFS and real file system *)
(* Check not active panel *)
if NotActiveFrame.pnlFile.PanelMode = pmVFS then
begin
if (VFS_CAPS_COPYIN in NotActiveFrame.pnlFile.VFS.VFSmodule.VFSCaps) then
begin
DebugLn('+++ Copy files to VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
NotActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyInEx(fl, sDestPath, 0);
end
else
msgOK(rsMsgErrNotSupported);
Exit;
end;
(* Check not active panel *)
if NotActiveFrame.pnlFile.PanelMode = pmVFS then
begin
if (VFS_CAPS_COPYIN in NotActiveFrame.pnlFile.VFS.VFSmodule.VFSCaps) then
begin
DebugLn('+++ Copy files to VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
NotActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyInEx(fl, sDestPath, 0);
end
else
msgOK(rsMsgErrNotSupported);
Exit;
end;
(* Check active panel *)
if ActiveFrame.pnlFile.PanelMode = pmVFS then
begin
if (VFS_CAPS_COPYOUT in ActiveFrame.pnlFile.VFS.VFSmodule.VFSCaps) then
begin
DebugLn('+++ Copy files from VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyOutEx(fl, sDestPath, 0);
end
else
msgOK(rsMsgErrNotSupported);
Exit;
end;
(* Check active panel *)
if ActiveFrame.pnlFile.PanelMode = pmVFS then
begin
if (VFS_CAPS_COPYOUT in ActiveFrame.pnlFile.VFS.VFSmodule.VFSCaps) then
begin
DebugLn('+++ Copy files from VFS +++');
fl.CurrentDirectory := ActiveFrame.ActiveDir;
ActiveFrame.pnlFile.VFS.VFSmodule.VFSCopyOutEx(fl, sDestPath, 0);
end
else
msgOK(rsMsgErrNotSupported);
Exit;
end;
(* Copy files between real file system *)
(* Copy files between real file system *)
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:= TCopyThread.Create(fl);
CT.sDstPath:= sDestPath;
CT.sDstMask:= sDstMaskTemp;
CT.bDropReadOnlyFlag:= blDropReadOnlyFlag;
CT.Resume;
except
CT.Free;
end;
except
FreeAndNil(fl);
end;
end;
@ -2098,7 +2071,7 @@ begin
sDest:= (Parent as TFrameFilePanel).ActiveDir + fri^.sName + PathDelim
else
sDest:= (Parent as TFrameFilePanel).ActiveDir;
if (GetKeyState(VK_SHIFT) and $8000) <> 0 then // if Shift then move
begin
RenameFile(sDest);
@ -2108,16 +2081,16 @@ begin
CopyFile(sDest);
end;
end;
mbRight:
begin
// save in parent drop target
pmDropMenu.Parent:= (Sender as TDrawGridEx);
// save in tag Y coordinate
pmDropMenu.Tag:= Y;
MousePoint:= ClientToScreen(Classes.Point(X, Y));
pmDropMenu.PopUp(MousePoint.X, MousePoint.Y);
end;
end;
mbRight:
begin
// save in parent drop target
pmDropMenu.Parent:= (Sender as TDrawGridEx);
// save in tag Y coordinate
pmDropMenu.Tag:= Y;
MousePoint:= ClientToScreen(Classes.Point(X, Y));
pmDropMenu.PopUp(MousePoint.X, MousePoint.Y);
end;
end; // case
end;
procedure TfrmMain.seLogWindowSpecialLineColors(Sender: TObject; Line: integer;

50
uacts.pas
View file

@ -534,27 +534,22 @@ begin
end;
end;
fl:=TFileList.Create; // free at Thread end by thread
fl:= TFileList.Create; // free at Thread end by thread
try
CopyListSelectedExpandNames(FrmMain.ActiveFrame.pnlFile.FileList,fl,FrmMain.ActiveFrame.ActiveDir);
(* Wipe files *)
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
WT := TWipeThread.Create(fl);
WT.FFileOpDlg:= frmFileOp;
WT.sDstPath:= FrmMain.NotActiveFrame.ActiveDir;
//DT.sDstMask:=sDstMaskTemp;
frmFileOp.Thread:= TThread(WT);
frmFileOp.Show;
WT.Resume;
except
WT.Free;
end;
try
WT:= TWipeThread.Create(fl);
WT.sDstPath:= FrmMain.NotActiveFrame.ActiveDir;
//DT.sDstMask:=sDstMaskTemp;
WT.Resume;
except
WT.Free;
end;
except
FreeAndNil(frmFileOp);
FreeAndNil(fl);
end;
end;
@ -862,7 +857,7 @@ begin
end;
end;
fl:=TFileList.Create; // free at Thread end by thread
fl:= TFileList.Create; // free at Thread end by thread
try
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
@ -876,24 +871,17 @@ begin
end;
(* Delete files *)
begin
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
DT := TDeleteThread.Create(fl);
DT.FFileOpDlg := frmFileOp;
DT.sDstPath:=NotActiveFrame.ActiveDir;
//DT.sDstMask:=sDstMaskTemp;
frmFileOp.Thread := TThread(DT);
frmFileOp.Show;
DT.Resume;
except
DT.Free;
end;
try
DT := TDeleteThread.Create(fl);
DT.sDstPath:= NotActiveFrame.ActiveDir;
//DT.sDstMask:=sDstMaskTemp;
DT.Resume;
except
DT.Free;
end;
except
FreeAndNil(frmFileOp);
FreeAndNil(fl);
end;
end;
end;

18
ucopythread.pas
View file

@ -22,10 +22,10 @@ type
TCopyThread = class(TFileOpThread)
protected
Function CpFile (fr:PFileRecItem; const sDst:String; bShowDlg:Boolean):Boolean;
Function CopyFile(const sSrc, sDst:String; bAppend:Boolean):Boolean;
function CpFile (fr:PFileRecItem; const sDst:String; bShowDlg:Boolean):Boolean;
function CopyFile(const sSrc, sDst:String; bAppend:Boolean):Boolean;
procedure MainExecute; override;
Function GetCaptionLng:String; override;
function GetCaptionLng:String; override;
end;
implementation
@ -175,13 +175,13 @@ begin
src:=TFileStreamEx.Create(sSrc,fmOpenRead or fmShareDenyNone);
DebugLn(sDst);
if bAppend then
begin
dst:=TFileStreamEx.Create(sDst,fmOpenReadWrite);
dst.Seek(0,soFromEnd); // seek to end
end
begin
dst:=TFileStreamEx.Create(sDst,fmOpenReadWrite);
dst.Seek(0,soFromEnd); // seek to end
end
else
dst:=TFileStreamEx.Create(sDst,fmCreate);
iDstBeg:=dst.Size;
// we dont't use CopyFrom, because it's alocate and free buffer every time is called
FFileOpDlg.iProgress1Pos:=0;
@ -271,7 +271,7 @@ end;
Function TCopyThread.GetCaptionLng:String;
begin
Result:=rsDlgCp;
Result:= rsDlgCp;
end;
end.

811
ufileopthread.pas
View file

@ -1,404 +1,407 @@
{
Seksi Commander
----------------------------
Implementing of Generic File operation thread
(copying, moving ... is inherited from this)
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
contributors:
Copyright (C) 2006-2008 Koblov Alexander (Alexx2000@mail.ru)
}
unit uFileOpThread;
{$mode objfpc}{$H+}
{$DEFINE NOFAKETHREAD}
interface
uses
Classes, uFileList, fFileOpDlg, uTypes, uDescr, fMsg, uShowMsg {$IFNDEF NOFAKETHREAD}, uFakeThread{$ENDIF};
type
{ TFileOpThread }
{$IFDEF NOFAKETHREAD}
TFileOpThread = class(TThread)
{$ELSE}
TFileOpThread = class(TFakeThread)
{$ENDIF}
private
{ Private declarations }
protected
FFileList: TFileList; // input filelist (not rekursive walked)
NewFileList: TFileList; // fill it with complete list of all files
FFilesCount: Integer;
FFilesSize: Int64;
FDirCount :Integer;
FBeginTime: TDateTime;
FDownTo: Boolean; // browse list backward (for deleting)
FReplaceAll:Boolean;
FSkipAll:Boolean;
FDstNameMask:String;
FDstExtMask:String;
FAppend: Boolean; // used mainly for pass information between move and copy
FSymLinkAll, // process all symlinks
FNotSymLinkAll : Boolean; // process all real files/folders
FDescr: TDescription;
procedure Execute; override;
procedure MainExecute; virtual; abstract; // main loop for copy /delete ...
procedure FillAndCount;
procedure FillAndCountRec(const srcPath, dstPath:String); // rekursive called
procedure EstimateTime(iSizeCoped:Int64);
Function GetCaptionLng:String; virtual;
procedure CorrectMask;
Function CorrectDstName(const sName:String):String;
Function CorrectDstExt(const sExt:String):String;
public
FFileOpDlg: TfrmFileOp; // progress window
sDstPath: String;
sDstMask: String;
bDropReadOnlyFlag : Boolean; // for copy operation
constructor Create(aFileList:TFileList);virtual;
destructor Destroy; override;
function UseForm:Boolean; virtual;
function FreeAtEnd:Boolean; virtual;
function DlgFileExist(const sMsg:String):Boolean; // result=true > rewrite file
function DlgProcessSymLink(const sMsg:String):Boolean;
end;
const
FMyMsgButtons : array[0..5] of TMyMsgButton = (msmbRewrite, msmbNo, msmbSkip, msmbAppend, msmbRewriteAll, msmbSkipAll); //Alexx2000
FSymLinkBtns : array[0..3] of TMyMsgButton = (msmbYes, msmbNo, msmbRewriteAll, msmbSkipAll); //Alexx2000
implementation
uses
SysUtils, uLng, uFileProcs, uFileOp, Forms, uFindEx, uDCUtils, uOSUtils,
LCLProc, uGlobs;
{ TFileOpThread }
{if we use WaitFor, we don't use FreeOnTerminate
possible SIGSEV}
constructor TFileOpThread.Create(aFileList:TFileList);
begin
inherited Create(True); // create Suspended
FFileList := aFileList;
FreeOnTerminate:=FreeAtEnd;
sDstMask:='*.*';
FSymLinkAll := False;
FNotSymLinkAll := False;
end;
destructor TFileOpThread.Destroy;
begin
if assigned(FFileList) then
FreeAndNil(FFileList);
end;
procedure TFileOpThread.FillAndCountRec(const srcPath, dstPath:String);
var
sr:TSearchRec;
fr:TFileRecItem;
begin
if FindFirstEx(srcPath+'*',faAnyFile,sr)<>0 then
begin
FindClose(sr);
Exit;
end;
repeat
if (sr.Name='.') or (sr.Name='..') then Continue;
fr.sName:=srcPath+sr.Name;
// write(fr.sName,': ');
fr.sPath:=dstPath;
fr.sNameNoExt:=sr.Name; // we use to save dstname
// writeln(sr.Name);
fr.iSize:= sr.Size;
fr.iMode:= sr.Attr;
fr.fTimeI:= FileDateToDateTime(sr.Time);
fr.sTime:=''; // not interested
fr.bIsLink:=FPS_ISLNK(fr.iMode);
fr.sLinkTo:='';
fr.bSelected:=False;
fr.sModeStr:=''; // not interested
// fr.sPath:=srcPath;
NewFileList.AddItem(@fr);
if fr.bIsLink then
Continue;
if FPS_ISDIR(fr.iMode) then
begin
inc(FDirCount);
FillAndCountRec(srcPath+sr.Name+DirectorySeparator, dstPath+sr.Name+DirectorySeparator);
end
else
begin
inc(FFilesSize, fr.iSize);
inc(FFilesCount);
end;
until FindNextEx(sr)<>0;
FindClose(sr);
end;
procedure TFileOpThread.FillAndCount;
var
i:Integer;
ptr:PFileRecItem;
sRealName : String;
sr : TSearchRec;
begin
NewFileList.Clear;
FFilesCount:=0;
FFilesSize:=0;
FDirCount:=0;
for i:=0 to FFileList.Count-1 do
begin
ptr:=FFileList.GetItem(i);
//----------------------------------------
(* For process symlink or real file/folder *)
if FPS_ISLNK(ptr^.iMode) then
if (not FSymLinkAll) and (FNotSymLinkAll or not DlgProcessSymLink('Process SymLink "' + ptr^.sName +'"? Press "Yes" to copy or "No" for copy real file/folder')) then //TODO: Localize message
begin
sRealName:=ReadSymLink(ptr^.sName);
sRealName := GetAbsoluteFileName(ExtractFilePath(ptr^.sName), sRealName);
FindFirstEx(sRealName, faAnyFile, sr);
with ptr^ do
begin
iSize := sr.Size;
sTime := DateTimeToStr(Trunc(FileDateToDateTime(sr.Time)));
iMode := sr.Attr;
sModeStr := AttrToStr(sr.Attr);
bLinkIsDir:=False;
bSelected:=False;
end;
DivFileName(sRealName, ptr^.sNameNoExt, ptr^.sExt);
ptr^.sNameNoExt := sr.Name;
ptr^.sName := sRealName;
end;
DebugLn('sNameNoExt ==' + ptr^.sNameNoExt);
//----------------------------------------
if FPS_ISDIR(ptr^.iMode) and (not ptr^.bLinkIsDir) then
begin
inc(FDirCount);
NewFileList.AddItem(ptr); // add DIR to List
FillAndCountRec(ptr^.sName+DirectorySeparator,ptr^.sNameNoExt+DirectorySeparator); // rekursive browse child dir
end
else
begin
NewFileList.AddItem(ptr);
inc(FFilesCount);
inc(FFilesSize, ptr^.iSize); // in first level we know file size -> use it
end;
end;
end;
procedure TFileOpThread.Execute;
begin
// main thread code started here
try
FReplaceAll:=False;
FSkipAll:=False;
NewFileList:=TFileList.Create;
try
FillAndCount; // gets full list of files (rekursive)
if gProcessComments then
FDescr:= TDescription.Create(True);
if UseForm then
begin
//FFileOpDlg:=TfrmFileOp.Create(Application);
//FFileOpDlg.Thread := TThread(Self);
FFileOpDlg.Caption:=GetCaptionLng;
//FFileOpDlg.Show;
FFileOpDlg.Update;
end;
FBeginTime:=Now;
if UseForm then
begin
FFileOpDlg.iProgress2Pos:=0;
FFileOpDlg.iProgress2Max:=FFilesSize;
Synchronize(@FFileOpDlg.UpdateDlg);
end;
MainExecute; // main executive (virtual)
finally
if gProcessComments and Assigned(FDescr) then
begin
FDescr.SaveDescription;
FreeAndNil(FDescr);
end;
if UseForm then
begin
Synchronize(@FFileOpDlg.Close);
DebugLN('TFileOpThread finally');
end;
if Assigned(NewFileList) then
FreeAndNil(NewFileList);
end;
except
on E:Exception do
msgOK(Self, E.Message);
end;
end;
function TFileOpThread.UseForm:Boolean;
begin
Result:=True;
end;
function TFileOpThread.FreeAtEnd:Boolean;
begin
Result:=True;
{ if we use WaitFor, we don't use FreeOnTerminate
possible SIGSEV!!!!!!!!!!
}
// Result:=False;
end;
procedure TFileOpThread.EstimateTime(iSizeCoped:Int64);
begin
if not UseForm then Exit;
with FFileOpDlg do
begin
if iSizeCoped=0 then
sEstimated:='????'
else
sEstimated:=FormatDateTime('HH:MM:SS',(Now-FBeginTime)*FFilesSize/iSizeCoped);
// This is BAD ..., fixed in near future
// TimeToStr((Now-FBeginTime)*FFilesSize/iSizeCoped);
{ writeln(FloatToStr(Now));
writeln(sEstimated);}
Synchronize(@FFileOpDlg.UpdateDlg);
end;
end;
function TFileOpThread.DlgFileExist(const sMsg:String):Boolean; // result=true > rewrite file
begin
FAppend:=False;
Result:=False;
case MsgBox(Self,sMsg, FMyMsgButtons, msmbYes, msmbNo) of
mmrNo, mmrSkip:;
mmrRewrite:
begin
Result:=True;
end;
mmrRewriteAll:
begin
FReplaceAll:=True;
Result:=True;
end;
mmrAppend:
begin
FAppend:=True;
Result:=True;
end;
mmrSkipAll:
begin
FSkipAll:=True;
end;
else
Raise Exception.Create('bad handling msg result');
end; //case
end;
{Dialog for process symlink or real file/folder}
function TFileOpThread.DlgProcessSymLink(const sMsg:String):Boolean; // result=true > process symlink
begin
FAppend:=False;
Result:=False;
case MsgBox(Self, sMsg, FSymLinkBtns, msmbYes, msmbNo) of
mmrNo:;
mmrYes:
begin
Result:=True;
end;
mmrRewriteAll:
begin
FSymLinkAll:=True;
Result:=True;
end;
mmrSkipAll:
begin
FNotSymLinkAll:=True;
end;
else
Raise Exception.Create('bad handling msg result');
end; //case
end;
{/Dialog for process symlink or real file/folder}
Function TFileOpThread.GetCaptionLng:String;
begin
Result:='';
end;
procedure TFileOpThread.CorrectMask;
begin
DivFileName(sDstMask,FDstNameMask,FDstExtMask);
if FDstNameMask='' then
FDstNameMask:='*';
if FDstExtMask='' then
FDstExtMask:='.*';
end;
Function TFileOpThread.CorrectDstName(const sName:String):String;
var
i:Integer;
begin
Result:='';
for i:=1 to length(FDstNameMask) do
begin
if FDstNameMask[i]= '?' then
Result:=Result+sName[i]
else
if FDstNameMask[i]= '*' then
Result:=Result+Copy(sName,i,length(sName)-i+1)
else
Result:=Result+FDstNameMask[i];
end;
end;
Function TFileOpThread.CorrectDstExt(const sExt:String):String;
var
i:Integer;
begin
Result:='';
for i:=1 to length(FDstExtMask) do
begin
if FDstExtMask[i]= '?' then
Result:=Result+sExt[i]
else
if FDstExtMask[i]= '*' then
Result:=Result+Copy(sExt,i,length(sExt)-i+1)
else
Result:=Result+FDstExtMask[i];
end;
end;
end.
{
Seksi Commander
----------------------------
Implementing of Generic File operation thread
(copying, moving ... is inherited from this)
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
contributors:
Copyright (C) 2006-2008 Koblov Alexander (Alexx2000@mail.ru)
}
unit uFileOpThread;
{$mode objfpc}{$H+}
{$DEFINE NOFAKETHREAD}
interface
uses
Classes, uFileList, fFileOpDlg, uTypes, uDescr, fMsg, uShowMsg {$IFNDEF NOFAKETHREAD}, uFakeThread{$ENDIF};
type
{ TFileOpThread }
{$IFDEF NOFAKETHREAD}
TFileOpThread = class(TThread)
{$ELSE}
TFileOpThread = class(TFakeThread)
{$ENDIF}
private
{ Private declarations }
protected
FFileList: TFileList; // input filelist (not rekursive walked)
NewFileList: TFileList; // fill it with complete list of all files
FFilesCount: Integer;
FFilesSize: Int64;
FDirCount :Integer;
FBeginTime: TDateTime;
FDownTo: Boolean; // browse list backward (for deleting)
FReplaceAll:Boolean;
FSkipAll:Boolean;
FDstNameMask:String;
FDstExtMask:String;
FAppend: Boolean; // used mainly for pass information between move and copy
FSymLinkAll, // process all symlinks
FNotSymLinkAll : Boolean; // process all real files/folders
FDescr: TDescription;
procedure Execute; override;
procedure MainExecute; virtual; abstract; // main loop for copy /delete ...
procedure CreateForm;
procedure FillAndCount;
procedure FillAndCountRec(const srcPath, dstPath:String); // rekursive called
procedure EstimateTime(iSizeCoped:Int64);
Function GetCaptionLng:String; virtual;
procedure CorrectMask;
Function CorrectDstName(const sName:String):String;
Function CorrectDstExt(const sExt:String):String;
public
FFileOpDlg: TfrmFileOp; // progress window
sDstPath: String;
sDstMask: String;
bDropReadOnlyFlag : Boolean; // for copy operation
constructor Create(aFileList:TFileList);virtual;
destructor Destroy; override;
function UseForm:Boolean; virtual;
function FreeAtEnd:Boolean; virtual;
function DlgFileExist(const sMsg:String):Boolean; // result=true > rewrite file
function DlgProcessSymLink(const sMsg:String):Boolean;
end;
const
FMyMsgButtons : array[0..5] of TMyMsgButton = (msmbRewrite, msmbNo, msmbSkip, msmbAppend, msmbRewriteAll, msmbSkipAll); //Alexx2000
FSymLinkBtns : array[0..3] of TMyMsgButton = (msmbYes, msmbNo, msmbRewriteAll, msmbSkipAll); //Alexx2000
implementation
uses
SysUtils, uLng, uFileProcs, uFileOp, Forms, uFindEx, uDCUtils, uOSUtils,
LCLProc, uGlobs;
{ TFileOpThread }
{if we use WaitFor, we don't use FreeOnTerminate
possible SIGSEV}
constructor TFileOpThread.Create(aFileList:TFileList);
begin
inherited Create(True); // create Suspended
FFileList := aFileList;
FreeOnTerminate:=FreeAtEnd;
sDstMask:='*.*';
FSymLinkAll := False;
FNotSymLinkAll := False;
end;
destructor TFileOpThread.Destroy;
begin
if assigned(FFileList) then
FreeAndNil(FFileList);
end;
procedure TFileOpThread.FillAndCountRec(const srcPath, dstPath:String);
var
sr:TSearchRec;
fr:TFileRecItem;
begin
if FindFirstEx(srcPath+'*',faAnyFile,sr)<>0 then
begin
FindClose(sr);
Exit;
end;
repeat
if (sr.Name='.') or (sr.Name='..') then Continue;
fr.sName:=srcPath+sr.Name;
// write(fr.sName,': ');
fr.sPath:=dstPath;
fr.sNameNoExt:=sr.Name; // we use to save dstname
// writeln(sr.Name);
fr.iSize:= sr.Size;
fr.iMode:= sr.Attr;
fr.fTimeI:= FileDateToDateTime(sr.Time);
fr.sTime:=''; // not interested
fr.bIsLink:=FPS_ISLNK(fr.iMode);
fr.sLinkTo:='';
fr.bSelected:=False;
fr.sModeStr:=''; // not interested
// fr.sPath:=srcPath;
NewFileList.AddItem(@fr);
if fr.bIsLink then
Continue;
if FPS_ISDIR(fr.iMode) then
begin
inc(FDirCount);
FillAndCountRec(srcPath+sr.Name+DirectorySeparator, dstPath+sr.Name+DirectorySeparator);
end
else
begin
inc(FFilesSize, fr.iSize);
inc(FFilesCount);
end;
until FindNextEx(sr)<>0;
FindClose(sr);
end;
procedure TFileOpThread.FillAndCount;
var
i:Integer;
ptr:PFileRecItem;
sRealName : String;
sr : TSearchRec;
begin
NewFileList.Clear;
FFilesCount:=0;
FFilesSize:=0;
FDirCount:=0;
for i:=0 to FFileList.Count-1 do
begin
ptr:=FFileList.GetItem(i);
//----------------------------------------
(* For process symlink or real file/folder *)
if FPS_ISLNK(ptr^.iMode) then
if (not FSymLinkAll) and (FNotSymLinkAll or not DlgProcessSymLink('Process SymLink "' + ptr^.sName +'"? Press "Yes" to copy or "No" for copy real file/folder')) then //TODO: Localize message
begin
sRealName:=ReadSymLink(ptr^.sName);
sRealName := GetAbsoluteFileName(ExtractFilePath(ptr^.sName), sRealName);
FindFirstEx(sRealName, faAnyFile, sr);
with ptr^ do
begin
iSize := sr.Size;
sTime := DateTimeToStr(Trunc(FileDateToDateTime(sr.Time)));
iMode := sr.Attr;
sModeStr := AttrToStr(sr.Attr);
bLinkIsDir:=False;
bSelected:=False;
end;
DivFileName(sRealName, ptr^.sNameNoExt, ptr^.sExt);
ptr^.sNameNoExt := sr.Name;
ptr^.sName := sRealName;
end;
DebugLn('sNameNoExt ==' + ptr^.sNameNoExt);
//----------------------------------------
if FPS_ISDIR(ptr^.iMode) and (not ptr^.bLinkIsDir) then
begin
inc(FDirCount);
NewFileList.AddItem(ptr); // add DIR to List
FillAndCountRec(ptr^.sName+DirectorySeparator,ptr^.sNameNoExt+DirectorySeparator); // rekursive browse child dir
end
else
begin
NewFileList.AddItem(ptr);
inc(FFilesCount);
inc(FFilesSize, ptr^.iSize); // in first level we know file size -> use it
end;
end;
end;
procedure TFileOpThread.Execute;
begin
// main thread code started here
try
FReplaceAll:=False;
FSkipAll:=False;
NewFileList:=TFileList.Create;
try
FillAndCount; // gets full list of files (rekursive)
if gProcessComments then
FDescr:= TDescription.Create(True);
FBeginTime:=Now;
if UseForm then
begin
Synchronize(@CreateForm); // create progress form in main thread
FFileOpDlg.iProgress2Pos:=0;
FFileOpDlg.iProgress2Max:=FFilesSize;
Synchronize(@FFileOpDlg.UpdateDlg);
end;
MainExecute; // main executive (virtual)
finally
if gProcessComments and Assigned(FDescr) then
begin
FDescr.SaveDescription;
FreeAndNil(FDescr);
end;
if UseForm then
begin
Synchronize(@FFileOpDlg.Close);
DebugLN('TFileOpThread finally');
end;
if Assigned(NewFileList) then
FreeAndNil(NewFileList);
end;
except
on E:Exception do
msgOK(Self, E.Message);
end;
end;
procedure TFileOpThread.CreateForm;
begin
DebugLn('TFileOpThread.CreateForm');
FFileOpDlg:= TfrmFileOp.Create(Application);
FFileOpDlg.Thread:= TThread(Self);
FFileOpDlg.Caption:= GetCaptionLng;
FFileOpDlg.Show;
FFileOpDlg.Update;
end;
function TFileOpThread.UseForm:Boolean;
begin
Result:=True;
end;
function TFileOpThread.FreeAtEnd:Boolean;
begin
Result:=True;
{ if we use WaitFor, we don't use FreeOnTerminate
possible SIGSEV!!!!!!!!!!
}
// Result:=False;
end;
procedure TFileOpThread.EstimateTime(iSizeCoped:Int64);
begin
if not UseForm then Exit;
with FFileOpDlg do
begin
if iSizeCoped=0 then
sEstimated:='????'
else
sEstimated:=FormatDateTime('HH:MM:SS',(Now-FBeginTime)*FFilesSize/iSizeCoped);
// This is BAD ..., fixed in near future
// TimeToStr((Now-FBeginTime)*FFilesSize/iSizeCoped);
{ writeln(FloatToStr(Now));
writeln(sEstimated);}
Synchronize(@FFileOpDlg.UpdateDlg);
end;
end;
function TFileOpThread.DlgFileExist(const sMsg:String):Boolean; // result=true > rewrite file
begin
FAppend:=False;
Result:=False;
case MsgBox(Self,sMsg, FMyMsgButtons, msmbYes, msmbNo) of
mmrNo, mmrSkip:;
mmrRewrite:
begin
Result:=True;
end;
mmrRewriteAll:
begin
FReplaceAll:=True;
Result:=True;
end;
mmrAppend:
begin
FAppend:=True;
Result:=True;
end;
mmrSkipAll:
begin
FSkipAll:=True;
end;
else
Raise Exception.Create('bad handling msg result');
end; //case
end;
{Dialog for process symlink or real file/folder}
function TFileOpThread.DlgProcessSymLink(const sMsg:String):Boolean; // result=true > process symlink
begin
FAppend:=False;
Result:=False;
case MsgBox(Self, sMsg, FSymLinkBtns, msmbYes, msmbNo) of
mmrNo:;
mmrYes:
begin
Result:=True;
end;
mmrRewriteAll:
begin
FSymLinkAll:=True;
Result:=True;
end;
mmrSkipAll:
begin
FNotSymLinkAll:=True;
end;
else
Raise Exception.Create('bad handling msg result');
end; //case
end;
{/Dialog for process symlink or real file/folder}
Function TFileOpThread.GetCaptionLng:String;
begin
Result:='';
end;
procedure TFileOpThread.CorrectMask;
begin
DivFileName(sDstMask,FDstNameMask,FDstExtMask);
if FDstNameMask='' then
FDstNameMask:='*';
if FDstExtMask='' then
FDstExtMask:='.*';
end;
Function TFileOpThread.CorrectDstName(const sName:String):String;
var
i:Integer;
begin
Result:='';
for i:=1 to length(FDstNameMask) do
begin
if FDstNameMask[i]= '?' then
Result:=Result+sName[i]
else
if FDstNameMask[i]= '*' then
Result:=Result+Copy(sName,i,length(sName)-i+1)
else
Result:=Result+FDstNameMask[i];
end;
end;
Function TFileOpThread.CorrectDstExt(const sExt:String):String;
var
i:Integer;
begin
Result:='';
for i:=1 to length(FDstExtMask) do
begin
if FDstExtMask[i]= '?' then
Result:=Result+sExt[i]
else
if FDstExtMask[i]= '*' then
Result:=Result+Copy(sExt,i,length(sExt)-i+1)
else
Result:=Result+FDstExtMask[i];
end;
end;
end.