mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-28 10:02:14 +00:00
UPD: Restored moving files for filesystem; make Copy and Move operations share code.
This commit is contained in:
parent
910bcc4bee
commit
7f0f77a612
16 changed files with 1963 additions and 944 deletions
|
|
@ -59,7 +59,7 @@
|
|||
<PackageName Value="viewerpackage"/>
|
||||
</Item5>
|
||||
</RequiredPackages>
|
||||
<Units Count="89">
|
||||
<Units Count="91">
|
||||
<Unit0>
|
||||
<Filename Value="doublecmd.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
|
@ -600,6 +600,16 @@
|
|||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="uFileSourceCalcStatisticsOperation"/>
|
||||
</Unit88>
|
||||
<Unit89>
|
||||
<Filename Value="newdesign\ufilesourcemoveoperation.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="uFileSourceMoveOperation"/>
|
||||
</Unit89>
|
||||
<Unit90>
|
||||
<Filename Value="newdesign\ufilesystemmoveoperation.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="uFileSystemMoveOperation"/>
|
||||
</Unit90>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
|
|
|
|||
|
|
@ -469,6 +469,7 @@ type
|
|||
// procedure RenameFile(srcFileList: TFileList; dstFramePanel: TFileView; sDestPath: String);
|
||||
// procedure CopyFile(srcFileList: TFileList; dstFramePanel: TFileView; sDestPath: String);
|
||||
procedure RenameFile(sDestPath:String); // this is for F6 and Shift+F6
|
||||
procedure MoveFile(sDestPath:String);
|
||||
procedure CopyFile(sDestPath:String); // this is for F5 and Shift+F5
|
||||
procedure GetDestinationPathAndMask(EnteredPath: String; BaseDir: String;
|
||||
out DestPath, DestMask: String);
|
||||
|
|
@ -524,7 +525,7 @@ uses
|
|||
fExtractDlg, fLinker, fSplitter, LCLProc, uOSUtils, uOSForms, uPixMapManager,
|
||||
fColumnsSetConf, uDragDropEx, StrUtils, uKeyboard, WSExtCtrls, uFileSorting,
|
||||
uFileSystemFileSource, fViewOperations,
|
||||
uFileSourceOperationTypes, uFileSourceCopyOperation, uFileSystemCopyOperation,
|
||||
uFileSourceOperationTypes, uFileSourceCopyOperation, uFileSourceMoveOperation,
|
||||
fFileOpDlg
|
||||
{$IFDEF LCLQT}
|
||||
, qtwidgets, qtobjects
|
||||
|
|
@ -1935,6 +1936,94 @@ begin
|
|||
RunCopyThread(srcFileList, sDestPath, sDstMaskTemp, blDropReadOnlyFlag);
|
||||
end;
|
||||
}
|
||||
|
||||
procedure TfrmMain.MoveFile(sDestPath:String);
|
||||
var
|
||||
sDstMaskTemp: String;
|
||||
TargetFileSource: TFileSource = nil;
|
||||
SourceFiles: TFiles = nil;
|
||||
Operation: TFileSourceMoveOperation;
|
||||
OperationHandle: TOperationHandle;
|
||||
ProgressDialog: TfrmFileOp;
|
||||
bMove: Boolean;
|
||||
begin
|
||||
// Only allow moving within the same file source.
|
||||
if (ActiveFrame.FileSource.InheritsFrom(NotActiveFrame.FileSource.ClassType) or
|
||||
NotActiveFrame.FileSource.InheritsFrom(ActiveFrame.FileSource.ClassType)) and
|
||||
(ActiveFrame.FileSource.CurrentAddress = NotActiveFrame.FileSource.CurrentAddress) and
|
||||
(fsoMove in ActiveFrame.FileSource.GetOperationsTypes) and
|
||||
(fsoMove in NotActiveFrame.FileSource.GetOperationsTypes) then
|
||||
begin
|
||||
bMove := True;
|
||||
end
|
||||
else if ((fsoCopyOut in ActiveFrame.FileSource.GetOperationsTypes) and
|
||||
(fsoCopyIn in NotActiveFrame.FileSource.GetOperationsTypes)) then
|
||||
begin
|
||||
bMove := False; // copy + delete through temporary file system
|
||||
msgWarning(rsMsgNotImplemented);
|
||||
Exit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
msgWarning(rsMsgErrNotSupported);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SourceFiles := ActiveFrame.SelectedFiles; // free at Thread end by thread
|
||||
try
|
||||
if SourceFiles.Count = 0 then
|
||||
Exit;
|
||||
|
||||
with TfrmMoveDlg.Create(Application) do
|
||||
begin
|
||||
try
|
||||
if (SourceFiles.Count = 1) and
|
||||
(not (SourceFiles[0].IsDirectory or SourceFiles[0].IsLinkToDirectory))
|
||||
then
|
||||
edtDst.Text := sDestPath + ExtractFileName(SourceFiles[0].Name)
|
||||
else
|
||||
edtDst.Text := sDestPath + '*.*';
|
||||
|
||||
lblMoveSrc.Caption := GetFileDlgStr(rsMsgRenSel, rsMsgRenFlDr, SourceFiles);
|
||||
if ShowModal = mrCancel then
|
||||
Exit;
|
||||
|
||||
GetDestinationPathAndMask(edtDst.Text, SourceFiles.Path, sDestPath, sDstMaskTemp);
|
||||
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
if bMove then
|
||||
begin
|
||||
Operation := ActiveFrame.FileSource.CreateMoveOperation(
|
||||
SourceFiles, sDestPath) as TFileSourceMoveOperation;
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
Operation.RenameMask := sDstMaskTemp;
|
||||
|
||||
// Start operation.
|
||||
OperationHandle := OperationsManager.AddOperation(Operation, ossAutoQueue);
|
||||
|
||||
ProgressDialog := TfrmFileOp.Create(OperationHandle);
|
||||
ProgressDialog.Show;
|
||||
end
|
||||
else
|
||||
msgWarning(rsMsgNotImplemented);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Use CopyOut, CopyIn operations.
|
||||
end;
|
||||
|
||||
finally
|
||||
if Assigned(SourceFiles) then
|
||||
FreeAndNil(SourceFiles);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmMain.RenameFile(sDestPath:String);
|
||||
var
|
||||
fl:TFileList;
|
||||
|
|
@ -2005,7 +2094,7 @@ var
|
|||
blDropReadOnlyFlag : Boolean;
|
||||
TargetFileSource: TFileSource = nil;
|
||||
SourceFiles: TFiles = nil;
|
||||
Operation: TFileSourceOperation;
|
||||
Operation: TFileSourceCopyOperation;
|
||||
OperationHandle: TOperationHandle;
|
||||
ProgressDialog: TfrmFileOp;
|
||||
begin
|
||||
|
|
@ -2061,11 +2150,12 @@ begin
|
|||
Operation := ActiveFrame.FileSource.CreateCopyOutOperation(
|
||||
TargetFileSource,
|
||||
SourceFiles,
|
||||
sDestPath,
|
||||
sDstMaskTemp);
|
||||
sDestPath) as TFileSourceCopyOperation;
|
||||
|
||||
if Assigned(Operation) then
|
||||
begin
|
||||
Operation.RenameMask := sDstMaskTemp;
|
||||
|
||||
// Start operation.
|
||||
OperationHandle := OperationsManager.AddOperation(Operation, ossAutoQueue);
|
||||
|
||||
|
|
|
|||
|
|
@ -67,12 +67,12 @@ type
|
|||
function CreateListOperation: TFileSourceOperation; virtual;
|
||||
function CreateCopyInOperation(var SourceFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation; virtual;
|
||||
TargetPath: String): TFileSourceOperation; virtual;
|
||||
function CreateCopyOutOperation(var TargetFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation; virtual;
|
||||
TargetPath: String): TFileSourceOperation; virtual;
|
||||
function CreateMoveOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation; virtual;
|
||||
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; virtual;
|
||||
function CreateWipeOperation(var FilesToWipe: TFiles): TFileSourceOperation; virtual;
|
||||
function CreateCreateDirectoryOperation(DirectoryPath: String): TFileSourceOperation; virtual;
|
||||
|
|
@ -191,16 +191,20 @@ end;
|
|||
|
||||
function TFileSource.CreateCopyInOperation(var SourceFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TFileSource.CreateCopyOutOperation(var TargetFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function TFileSource.CreateMoveOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -40,6 +40,8 @@ type
|
|||
FTargetFileSource: TFileSource;
|
||||
FSourceFiles: TFiles;
|
||||
FTargetPath: String;
|
||||
FRenameMask: String;
|
||||
FDropReadOnlyAttribute: Boolean;
|
||||
|
||||
protected
|
||||
procedure UpdateStatistics(var NewStatistics: TFileSourceCopyOperationStatistics);
|
||||
|
|
@ -63,12 +65,14 @@ type
|
|||
constructor Create(var aSourceFileSource: TFileSource;
|
||||
var aTargetFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String;
|
||||
aRenameMask: String); virtual reintroduce;
|
||||
aTargetPath: String); virtual reintroduce;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
function RetrieveStatistics: TFileSourceCopyOperationStatistics;
|
||||
|
||||
property RenameMask: String read FRenameMask write FRenameMask;
|
||||
property DropReadOnlyAttribute: Boolean read FDropReadOnlyAttribute write FDropReadOnlyAttribute;
|
||||
end;
|
||||
|
||||
{en
|
||||
|
|
@ -121,8 +125,7 @@ uses
|
|||
constructor TFileSourceCopyOperation.Create(var aSourceFileSource: TFileSource;
|
||||
var aTargetFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String;
|
||||
aRenameMask: String);
|
||||
aTargetPath: String);
|
||||
begin
|
||||
with FStatistics do
|
||||
begin
|
||||
|
|
@ -159,6 +162,9 @@ begin
|
|||
FSourceFiles := theSourceFiles;
|
||||
theSourceFiles := nil;
|
||||
FTargetPath := aTargetPath;
|
||||
|
||||
FRenameMask := '';
|
||||
FDropReadOnlyAttribute := False;
|
||||
end;
|
||||
|
||||
destructor TFileSourceCopyOperation.Destroy;
|
||||
|
|
|
|||
173
src/newdesign/ufilesourcemoveoperation.pas
Normal file
173
src/newdesign/ufilesourcemoveoperation.pas
Normal file
|
|
@ -0,0 +1,173 @@
|
|||
unit uFileSourceMoveOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, syncobjs,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationTypes,
|
||||
uFileSource,
|
||||
uFile,
|
||||
uFileSourceCopyOperation;
|
||||
|
||||
type
|
||||
|
||||
TFileSourceMoveOperationStatistics = TFileSourceCopyOperationStatistics;
|
||||
|
||||
{en
|
||||
Operation that moves or renames files within the same file source
|
||||
(for example: in the same archive, in the same ftp server).
|
||||
}
|
||||
TFileSourceMoveOperation = class(TFileSourceOperation)
|
||||
|
||||
private
|
||||
FStatistics: TFileSourceMoveOperationStatistics;
|
||||
FStatisticsAtStartTime: TFileSourceMoveOperationStatistics;
|
||||
FStatisticsLock: TCriticalSection; //<en For synchronizing statistics.
|
||||
FFileSource: TFileSource;
|
||||
FSourceFiles: TFiles;
|
||||
FTargetPath: String;
|
||||
FRenameMask: String;
|
||||
|
||||
protected
|
||||
function GetID: TFileSourceOperationType; override;
|
||||
|
||||
procedure UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
|
||||
procedure UpdateStatisticsAtStartTime; override;
|
||||
|
||||
property FileSource: TFileSource read FFileSource;
|
||||
property SourceFiles: TFiles read FSourceFiles;
|
||||
property TargetPath: String read FTargetPath;
|
||||
|
||||
public
|
||||
{en
|
||||
@param(aFileSource
|
||||
File source within which the operation should take place.
|
||||
Class takes ownership of the pointer.)
|
||||
@param(SourceFiles
|
||||
Files which are to be moved.
|
||||
Class takes ownership of the pointer.)
|
||||
}
|
||||
constructor Create(var aFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String); virtual reintroduce;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
function RetrieveStatistics: TFileSourceMoveOperationStatistics;
|
||||
|
||||
property RenameMask: String read FRenameMask write FRenameMask;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uDCUtils;
|
||||
|
||||
// -- TFileSourceMoveOperation ------------------------------------------------
|
||||
|
||||
constructor TFileSourceMoveOperation.Create(var aFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String);
|
||||
begin
|
||||
with FStatistics do
|
||||
begin
|
||||
CurrentFileFrom := '';
|
||||
CurrentFileTo := '';
|
||||
|
||||
TotalFiles := 0;
|
||||
DoneFiles := 0;
|
||||
TotalBytes := 0;
|
||||
DoneBytes := 0;
|
||||
CurrentFileTotalBytes := 0;
|
||||
CurrentFileDoneBytes := 0;
|
||||
BytesPerSecond := 0;
|
||||
RemainingTime := 0;
|
||||
end;
|
||||
|
||||
FStatisticsLock := TCriticalSection.Create;
|
||||
|
||||
inherited Create(aFileSource, aFileSource);
|
||||
|
||||
FFileSource := aFileSource;
|
||||
aFileSource := nil;
|
||||
FSourceFiles := theSourceFiles;
|
||||
theSourceFiles := nil;
|
||||
FTargetPath := aTargetPath;
|
||||
|
||||
FRenameMask := '';
|
||||
end;
|
||||
|
||||
destructor TFileSourceMoveOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
|
||||
if Assigned(FStatisticsLock) then
|
||||
FreeAndNil(FStatisticsLock);
|
||||
if Assigned(FSourceFiles) then
|
||||
FreeAndNil(FSourceFiles);
|
||||
if Assigned(FFileSource) then
|
||||
FreeAndNil(FFileSource);
|
||||
end;
|
||||
|
||||
procedure TFileSourceMoveOperation.UpdateStatistics(var NewStatistics: TFileSourceMoveOperationStatistics);
|
||||
begin
|
||||
FStatisticsLock.Acquire;
|
||||
try
|
||||
// Check if the value by which we calculate progress and remaining time has changed.
|
||||
if FStatistics.DoneBytes <> NewStatistics.DoneBytes then
|
||||
begin
|
||||
with NewStatistics do
|
||||
begin
|
||||
RemainingTime :=
|
||||
EstimateRemainingTime(FStatisticsAtStartTime.DoneBytes,
|
||||
DoneBytes,
|
||||
TotalBytes,
|
||||
StartTime,
|
||||
SysUtils.Now,
|
||||
BytesPerSecond);
|
||||
|
||||
// Update overall progress.
|
||||
if TotalBytes <> 0 then
|
||||
UpdateProgress((DoneBytes * 100) div TotalBytes);
|
||||
end;
|
||||
end;
|
||||
|
||||
FStatistics := NewStatistics;
|
||||
|
||||
finally
|
||||
FStatisticsLock.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFileSourceMoveOperation.UpdateStatisticsAtStartTime;
|
||||
begin
|
||||
FStatisticsLock.Acquire;
|
||||
try
|
||||
Self.FStatisticsAtStartTime := Self.FStatistics;
|
||||
finally
|
||||
FStatisticsLock.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFileSourceMoveOperation.RetrieveStatistics: TFileSourceMoveOperationStatistics;
|
||||
begin
|
||||
// Statistics have to be synchronized because there are multiple values
|
||||
// and they all have to be consistent at every moment.
|
||||
FStatisticsLock.Acquire;
|
||||
try
|
||||
Result := Self.FStatistics;
|
||||
finally
|
||||
FStatisticsLock.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFileSourceMoveOperation.GetID: TFileSourceOperationType;
|
||||
begin
|
||||
Result := fsoMove;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -50,6 +50,15 @@ type
|
|||
procedure(Operation: TFileSourceOperation;
|
||||
Event: TFileSourceOperationEvent) of object;
|
||||
|
||||
TAskQuestionFunction =
|
||||
function(Msg: String; Question: String;
|
||||
PossibleResponses: array of TFileSourceOperationUIResponse;
|
||||
DefaultOKResponse: TFileSourceOperationUIResponse;
|
||||
DefaultCancelResponse: TFileSourceOperationUIResponse
|
||||
) : TFileSourceOperationUIResponse of object;
|
||||
TAbortOperationFunction = procedure of object;
|
||||
TCheckOperationStateFunction = procedure of object;
|
||||
|
||||
{en
|
||||
Base class for each file source operation.
|
||||
}
|
||||
|
|
@ -230,7 +239,7 @@ type
|
|||
}
|
||||
procedure CheckOperationState;
|
||||
|
||||
procedure RaiseAbortOperation;
|
||||
class procedure RaiseAbortOperation;
|
||||
|
||||
property Thread: TThread read FThread;
|
||||
|
||||
|
|
@ -861,7 +870,7 @@ begin
|
|||
// else We have no UIs assigned - cannot ask question.
|
||||
end;
|
||||
|
||||
procedure TFileSourceOperation.RaiseAbortOperation;
|
||||
class procedure TFileSourceOperation.RaiseAbortOperation;
|
||||
begin
|
||||
raise EFileSourceOperationAborting.Create;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -32,11 +32,11 @@ uses
|
|||
|
||||
const
|
||||
ResponseToButton: array[TFileSourceOperationUIResponse] of TMyMsgButton =
|
||||
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend,
|
||||
(msmbOK, msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone, msmbAppend, msmbCopyInto,
|
||||
msmbRewrite, msmbRewriteAll, msmbSkip, msmbSkipAll, msmbAll, msmbRetry, msmbAbort);
|
||||
|
||||
ResultToResponse: array[TMyMsgResult] of TFileSourceOperationUIResponse =
|
||||
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend,
|
||||
(fsourOk, fsourNo, fsourYes, fsourCancel, fsourNone, fsourAppend, fsourCopyInto,
|
||||
fsourRewrite, fsourRewriteAll, fsourSkip, fsourSkipAll, fsourAll, fsourRetry, fsourAbort);
|
||||
|
||||
constructor TFileSourceOperationMessageBoxesUI.Create;
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@ type
|
|||
fsoList,
|
||||
fsoCopyIn,
|
||||
fsoCopyOut,
|
||||
fsoMove, // Move/rename files within the same file source.
|
||||
fsoDelete,
|
||||
fsoWipe,
|
||||
fsoCreateDirectory,
|
||||
|
|
|
|||
|
|
@ -16,7 +16,8 @@ type
|
|||
fsourYes,
|
||||
fsourCancel,
|
||||
fsourNone,
|
||||
fsourAppend,
|
||||
fsourAppend, // for files
|
||||
fsourCopyInto, // for directories
|
||||
fsourRewrite,
|
||||
fsourRewriteAll,
|
||||
fsourSkip,
|
||||
|
|
|
|||
|
|
@ -7,14 +7,12 @@ interface
|
|||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceCopyOperation,
|
||||
uFileSystemFileSource,
|
||||
uFileSource,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationOptions,
|
||||
uFileSourceOperationUI,
|
||||
uFile,
|
||||
uFileSystemFile,
|
||||
uDescr;
|
||||
uFileSystemUtil;
|
||||
|
||||
type
|
||||
{
|
||||
|
|
@ -31,8 +29,7 @@ type
|
|||
constructor Create(var aSourceFileSource: TFileSource;
|
||||
var aTargetFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String;
|
||||
aRenameMask: String); override;
|
||||
aTargetPath: String); override;
|
||||
|
||||
procedure MainExecute; override;
|
||||
|
||||
|
|
@ -41,36 +38,26 @@ type
|
|||
TFileSystemCopyOutOperation = class(TFileSourceCopyOutOperation)
|
||||
|
||||
private
|
||||
FBuffer: Pointer;
|
||||
FBufferSize: LongWord;
|
||||
FFullSourceFilesTree: TFileSystemFiles; // source files including all files/dirs in subdirectories
|
||||
FOperationHelper: TFileSystemOperationHelper;
|
||||
FSourceFilesTree: TFileTree; // source files including all files/dirs in subdirectories
|
||||
FStatistics: TFileSourceCopyOperationStatistics; // local copy of statistics
|
||||
FRenameMask: String;
|
||||
FRenameNameMask, FRenameExtMask: String;
|
||||
FDescription: TDescription;
|
||||
|
||||
// Options.
|
||||
FCheckFreeSpace: Boolean;
|
||||
FSkipAllBigFiles: Boolean;
|
||||
FDropReadOnlyFlag: Boolean;
|
||||
FSymLinkOption: TFileSourceOperationOptionSymLink;
|
||||
FFileExistsOption: TFileSourceOperationOptionFileExists;
|
||||
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
|
||||
|
||||
protected
|
||||
function ProcessFile(aFile: TFileSystemFile; AbsoluteTargetFileName: String): Boolean;
|
||||
|
||||
// ProcessFileNoQuestions (when we're sure the targets don't exist)
|
||||
|
||||
function CopyFile(const SourceFileName, TargetFileName: String; bAppend: Boolean): Boolean;
|
||||
function ShowError(sMessage: String): TFileSourceOperationUIResponse;
|
||||
|
||||
public
|
||||
constructor Create(var aSourceFileSource: TFileSource;
|
||||
var aTargetFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String;
|
||||
aRenameMask: String); override;
|
||||
aTargetPath: String); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
|
|
@ -82,18 +69,16 @@ type
|
|||
implementation
|
||||
|
||||
uses
|
||||
uOSUtils, uDCUtils, uFileProcs, uLng,
|
||||
uFileSystemUtil, strutils, uClassesEx, FileUtil, LCLProc, uGlobs, uLog;
|
||||
uOSUtils, FileUtil, LCLProc, uGlobs;
|
||||
|
||||
// -- TFileSystemCopyInOperation ----------------------------------------------
|
||||
|
||||
constructor TFileSystemCopyInOperation.Create(var aSourceFileSource: TFileSource;
|
||||
var aTargetFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String;
|
||||
aRenameMask: String);
|
||||
aTargetPath: String);
|
||||
begin
|
||||
inherited Create(aSourceFileSource, aTargetFileSource, theSourceFiles, aTargetPath, aRenameMask);
|
||||
inherited Create(aSourceFileSource, aTargetFileSource, theSourceFiles, aTargetPath);
|
||||
end;
|
||||
|
||||
procedure TFileSystemCopyInOperation.MainExecute;
|
||||
|
|
@ -105,12 +90,10 @@ end;
|
|||
constructor TFileSystemCopyOutOperation.Create(var aSourceFileSource: TFileSource;
|
||||
var aTargetFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String;
|
||||
aRenameMask: String);
|
||||
aTargetPath: String);
|
||||
begin
|
||||
FBuffer := nil;
|
||||
FFullSourceFilesTree := nil;
|
||||
FRenameMask := aRenameMask;
|
||||
FSourceFilesTree := nil;
|
||||
FOperationHelper := nil;
|
||||
|
||||
// Here we can read global settings if there are any.
|
||||
FSymLinkOption := fsooslNone;
|
||||
|
|
@ -118,501 +101,71 @@ begin
|
|||
FDirExistsOption := fsoodeNone;
|
||||
FCheckFreeSpace := True;
|
||||
FSkipAllBigFiles := False;
|
||||
FDropReadOnlyFlag := False;
|
||||
|
||||
if gProcessComments then
|
||||
FDescription := TDescription.Create(True)
|
||||
else
|
||||
FDescription := nil;
|
||||
|
||||
inherited Create(aSourceFileSource, aTargetFileSource, theSourceFiles, aTargetPath, aRenameMask);
|
||||
inherited Create(aSourceFileSource, aTargetFileSource, theSourceFiles, aTargetPath);
|
||||
end;
|
||||
|
||||
destructor TFileSystemCopyOutOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
|
||||
if Assigned(FBuffer) then
|
||||
begin
|
||||
FreeMem(FBuffer);
|
||||
FBuffer := nil;
|
||||
end;
|
||||
if Assigned(FSourceFilesTree) then
|
||||
FreeAndNil(FSourceFilesTree);
|
||||
|
||||
if Assigned(FDescription) then
|
||||
begin
|
||||
FDescription.SaveDescription;
|
||||
FreeAndNil(FDescription);
|
||||
end;
|
||||
|
||||
if Assigned(FFullSourceFilesTree) then
|
||||
FreeAndNil(FFullSourceFilesTree);
|
||||
if Assigned(FOperationHelper) then
|
||||
FreeAndNil(FOperationHelper);
|
||||
end;
|
||||
|
||||
procedure TFileSystemCopyOutOperation.Initialize;
|
||||
var
|
||||
TreeBuilder: TFileSystemTreeBuilder;
|
||||
begin
|
||||
SplitFileMask(FRenameMask, FRenameNameMask, FRenameExtMask);
|
||||
|
||||
// Get initialized statistics; then we change only what is needed.
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
FillAndCount(SourceFiles as TFileSystemFiles,
|
||||
FFullSourceFilesTree,
|
||||
FStatistics.TotalFiles,
|
||||
FStatistics.TotalBytes); // gets full list of files (recursive)
|
||||
TreeBuilder := TFileSystemTreeBuilder.Create(
|
||||
@AskQuestion,
|
||||
@CheckOperationState);
|
||||
try
|
||||
// disable follow links temporarily
|
||||
TreeBuilder.SymLinkOption := fsooslDontFollow;
|
||||
|
||||
// Create destination path if it doesn't exist.
|
||||
if not mbDirectoryExists(TargetPath) then
|
||||
mbForceDirectory(TargetPath);
|
||||
TreeBuilder.BuildFromFiles(SourceFiles as TFileSystemFiles);
|
||||
FSourceFilesTree := TreeBuilder.ReleaseTree;
|
||||
FStatistics.TotalFiles := TreeBuilder.FilesCount;
|
||||
FStatistics.TotalBytes := TreeBuilder.FilesSize;
|
||||
finally
|
||||
FreeAndNil(TreeBuilder);
|
||||
end;
|
||||
|
||||
FBufferSize := gCopyBlockSize;
|
||||
GetMem(FBuffer, FBufferSize);
|
||||
if Assigned(FOperationHelper) then
|
||||
FreeAndNil(FOperationHelper);
|
||||
|
||||
FDescription.Clear;
|
||||
FOperationHelper := TFileSystemOperationHelper.Create(
|
||||
@AskQuestion,
|
||||
@RaiseAbortOperation,
|
||||
@CheckOperationState,
|
||||
@UpdateStatistics,
|
||||
Thread,
|
||||
fsohmCopy,
|
||||
SourceFiles.Path,
|
||||
TargetPath,
|
||||
FStatistics);
|
||||
|
||||
FOperationHelper.RenameMask := RenameMask;
|
||||
FOperationHelper.DropReadOnlyAttribute := DropReadOnlyAttribute;
|
||||
FOperationHelper.Initialize;
|
||||
end;
|
||||
|
||||
procedure TFileSystemCopyOutOperation.MainExecute;
|
||||
var
|
||||
aFile: TFileSystemFile;
|
||||
iTotalDiskSize, iFreeDiskSize: Int64;
|
||||
bProceed: Boolean;
|
||||
TargetName: String;
|
||||
OldDoneBytes: Int64; // for if there was an error
|
||||
CurrentFileIndex: Integer;
|
||||
begin
|
||||
for CurrentFileIndex := 0 to FFullSourceFilesTree.Count - 1 do
|
||||
begin
|
||||
aFile := FFullSourceFilesTree[CurrentFileIndex] as TFileSystemFile;
|
||||
|
||||
TargetName := GetAbsoluteTargetFileName(aFile,
|
||||
SourceFiles.Path,
|
||||
TargetPath,
|
||||
FRenameNameMask,
|
||||
FRenameExtMask);
|
||||
|
||||
with FStatistics do
|
||||
begin
|
||||
CurrentFileFrom := aFile.Path + aFile.Name;
|
||||
CurrentFileTo := TargetName;
|
||||
CurrentFileTotalBytes := aFile.Size;
|
||||
CurrentFileDoneBytes := 0;
|
||||
end;
|
||||
|
||||
UpdateStatistics(FStatistics);
|
||||
|
||||
bProceed := True;
|
||||
|
||||
{ Check disk free space }
|
||||
if FCheckFreeSpace = True then
|
||||
begin
|
||||
GetDiskFreeSpace(TargetPath, iFreeDiskSize, iTotalDiskSize);
|
||||
if aFile.Size > iFreeDiskSize then
|
||||
begin
|
||||
if FSkipAllBigFiles = True then
|
||||
begin
|
||||
bProceed:= False;
|
||||
end
|
||||
else
|
||||
begin
|
||||
case AskQuestion('', rsMsgNoFreeSpaceCont,
|
||||
[fsourYes, fsourAll, fsourNo, fsourSkip, fsourSkipAll],
|
||||
fsourYes, fsourNo) of
|
||||
fsourNo:
|
||||
RaiseAbortOperation;
|
||||
|
||||
fsourSkip:
|
||||
bProceed := False;
|
||||
|
||||
fsourAll:
|
||||
FCheckFreeSpace := False;
|
||||
|
||||
fsourSkipAll:
|
||||
begin
|
||||
bProceed := False;
|
||||
FSkipAllBigFiles := True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// If there will be an error in ProcessFile the DoneBytes value
|
||||
// will be inconsistent, so remember it here.
|
||||
OldDoneBytes := FStatistics.DoneBytes;
|
||||
|
||||
if bProceed then
|
||||
begin
|
||||
bProceed := ProcessFile(aFile, TargetName);
|
||||
end;
|
||||
|
||||
with FStatistics do
|
||||
begin
|
||||
DoneFiles := DoneFiles + 1;
|
||||
|
||||
// Correct statistics if file not correctly processed.
|
||||
if not bProceed then
|
||||
begin
|
||||
DoneBytes := OldDoneBytes + aFile.Size;
|
||||
end;
|
||||
|
||||
UpdateStatistics(FStatistics);
|
||||
end;
|
||||
|
||||
CheckOperationState;
|
||||
end;
|
||||
FOperationHelper.ProcessTree(FSourceFilesTree);
|
||||
end;
|
||||
|
||||
procedure TFileSystemCopyOutOperation.Finalize;
|
||||
begin
|
||||
end;
|
||||
|
||||
function TFileSystemCopyOutOperation.ProcessFile(
|
||||
aFile: TFileSystemFile; AbsoluteTargetFileName: String): Boolean;
|
||||
var
|
||||
sDstName: String;
|
||||
bIsFolder,
|
||||
bIsSymLink: Boolean;
|
||||
iAttr: TFileAttrs;
|
||||
sMsg: String;
|
||||
bAppend: Boolean = False;
|
||||
begin
|
||||
// Check if copying to the same file.
|
||||
if CompareFilenames(aFile.Path + aFile.Name, AbsoluteTargetFileName) = 0 then
|
||||
Exit(False);
|
||||
|
||||
if aFile.IsLink then
|
||||
begin
|
||||
// use sDstName as link target
|
||||
sDstName:= ReadSymLink(aFile.Path + aFile.Name); // use sLinkTo ?
|
||||
if sDstName <> '' then
|
||||
begin
|
||||
sDstName:= GetAbsoluteFileName(aFile.Path, sDstName);
|
||||
// DebugLn('ReadSymLink := ' + sDstName);
|
||||
|
||||
iAttr := mbFileGetAttr(AbsoluteTargetFileName);
|
||||
if iAttr <> faInvalidAttributes then // file exists
|
||||
begin
|
||||
bIsFolder:= FPS_ISDIR(iAttr);
|
||||
bIsSymLink:= FPS_ISLNK(iAttr);
|
||||
|
||||
case FFileExistsOption of
|
||||
fsoofeSkip: Exit(False);
|
||||
fsoofeNone:
|
||||
begin
|
||||
sMsg := IfThen(bIsFolder and not bIsSymLink, rsMsgFolderExistsRwrt, rsMsgFileExistsRwrt);
|
||||
sMsg := Format(sMsg, [AbsoluteTargetFileName]);
|
||||
|
||||
case AskQuestion(sMsg, '',
|
||||
[fsourRewrite, fsourSkip, fsourRewriteAll, fsourSkipAll],
|
||||
fsourRewrite, fsourSkip) of
|
||||
fsourSkip: Exit(False);
|
||||
fsourRewrite: ; //continue
|
||||
fsourRewriteAll:
|
||||
begin
|
||||
FFileExistsOption := fsoofeOverwrite;
|
||||
//continue
|
||||
end;
|
||||
fsourSkipAll:
|
||||
begin
|
||||
FFileExistsOption := fsoofeSkip;
|
||||
Exit(False);
|
||||
end;
|
||||
end; //case
|
||||
end;
|
||||
// else continue
|
||||
end;
|
||||
|
||||
if bIsFolder and bIsSymLink then // symlink to folder
|
||||
mbRemoveDir(AbsoluteTargetFileName)
|
||||
else if bIsFolder then // folder
|
||||
DelTree(AbsoluteTargetFileName)
|
||||
else // file
|
||||
mbDeleteFile(AbsoluteTargetFileName);
|
||||
end; // mbFileExists
|
||||
|
||||
if not CreateSymlink(sDstName, AbsoluteTargetFileName) then
|
||||
DebugLn('Symlink error');
|
||||
end
|
||||
else
|
||||
DebugLn('Error reading link');
|
||||
Result:= True;
|
||||
end
|
||||
else if aFile.IsDirectory then
|
||||
begin
|
||||
if not mbDirectoryExists(AbsoluteTargetFileName) then
|
||||
mbForceDirectory(AbsoluteTargetFileName);
|
||||
// if preserve attrs/times - set them here
|
||||
Result:= True;
|
||||
end
|
||||
else
|
||||
begin // files and other stuff
|
||||
Result:= False;
|
||||
|
||||
iAttr := mbFileGetAttr(AbsoluteTargetFileName);
|
||||
if iAttr <> faInvalidAttributes then // file exists
|
||||
begin
|
||||
if FPS_ISLNK(iAttr) then
|
||||
begin
|
||||
case FFileExistsOption of
|
||||
fsoofeSkip: Exit(False);
|
||||
fsoofeNone:
|
||||
begin
|
||||
sMsg := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
|
||||
case AskQuestion(sMsg, '',
|
||||
[fsourRewrite, fsourSkip, fsourRewriteAll, fsourSkipAll],
|
||||
fsourRewrite, fsourSkip) of
|
||||
fsourSkip: Exit(False);
|
||||
fsourRewrite: ; //continue
|
||||
fsourRewriteAll:
|
||||
begin
|
||||
FFileExistsOption := fsoofeOverwrite;
|
||||
//continue
|
||||
end;
|
||||
fsourSkipAll:
|
||||
begin
|
||||
FFileExistsOption := fsoofeSkip;
|
||||
Exit(False);
|
||||
end;
|
||||
end; //case
|
||||
end;
|
||||
end;
|
||||
|
||||
mbDeleteFile(AbsoluteTargetFileName);
|
||||
end // FPS_ISLNK
|
||||
else if FPS_ISDIR(iAttr) then
|
||||
begin
|
||||
// what if directory exists? ask if copy into it?
|
||||
end
|
||||
else // file
|
||||
begin
|
||||
case FFileExistsOption of
|
||||
fsoofeSkip: Exit(False);
|
||||
fsoofeAppend:
|
||||
bAppend := True;
|
||||
fsoofeNone:
|
||||
begin
|
||||
sMsg := Format(rsMsgFileExistsRwrt, [AbsoluteTargetFileName]);
|
||||
case AskQuestion(sMsg, '',
|
||||
[fsourRewrite, fsourSkip, fsourRewriteAll, fsourSkipAll, fsourAppend],
|
||||
fsourRewrite, fsourSkip) of
|
||||
fsourSkip: Exit(False);
|
||||
fsourRewrite: ; //continue
|
||||
fsourRewriteAll:
|
||||
begin
|
||||
FFileExistsOption := fsoofeOverwrite;
|
||||
//continue
|
||||
end;
|
||||
fsourSkipAll:
|
||||
begin
|
||||
FFileExistsOption := fsoofeSkip;
|
||||
Exit(False);
|
||||
end;
|
||||
fsourAppend:
|
||||
begin
|
||||
//FFileExistsOption := fsoofeAppend; - append all
|
||||
bAppend := True;
|
||||
end;
|
||||
end; //case
|
||||
end;
|
||||
end; //case
|
||||
|
||||
// if not bAppend then mbDeleteFile(AbsoluteTargetFileName);
|
||||
end;
|
||||
end; // file exists
|
||||
|
||||
Result:= Self.CopyFile(aFile.Path + aFile.Name, AbsoluteTargetFileName, bAppend);
|
||||
|
||||
// process comments if need
|
||||
if Result and gProcessComments then
|
||||
FDescription.CopyDescription(aFile.Path + aFile.Name, AbsoluteTargetFileName);
|
||||
|
||||
if Result = True then
|
||||
begin
|
||||
// write log success
|
||||
if (log_cp_mv_ln in gLogOptions) and (log_success in gLogOptions) then
|
||||
begin
|
||||
logWrite(Thread, Format(rsMsgLogSuccess+rsMsgLogCopy,
|
||||
[aFile.Path + aFile.Name+' -> '+AbsoluteTargetFileName]), lmtSuccess);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// write log error
|
||||
if (log_cp_mv_ln in gLogOptions) and (log_errors in gLogOptions) then
|
||||
begin
|
||||
logWrite(Thread, Format(rsMsgLogError+rsMsgLogCopy,
|
||||
[aFile.Path + aFile.Name+' -> '+AbsoluteTargetFileName]), lmtError);
|
||||
end;
|
||||
end;
|
||||
end; // files and other stuff
|
||||
end;
|
||||
|
||||
function TFileSystemCopyOutOperation.CopyFile(const SourceFileName, TargetFileName: String; bAppend: Boolean): Boolean;
|
||||
var
|
||||
SourceFile, TargetFile: TFileStreamEx;
|
||||
iTotalDiskSize, iFreeDiskSize: Int64;
|
||||
bRetryRead, bRetryWrite: Boolean;
|
||||
BytesRead, BytesToRead, BytesWrittenTry, BytesWritten: Int64;
|
||||
TotalBytesToRead: Int64 = 0;
|
||||
begin
|
||||
Result:= False;
|
||||
BytesToRead := FBufferSize;
|
||||
SourceFile := nil;
|
||||
TargetFile := nil; // for safety exception handling
|
||||
try
|
||||
try
|
||||
SourceFile := TFileStreamEx.Create(SourceFileName, fmOpenRead or fmShareDenyNone);
|
||||
if bAppend then
|
||||
begin
|
||||
TargetFile:= TFileStreamEx.Create(TargetFileName, fmOpenReadWrite);
|
||||
TargetFile.Seek(0,soFromEnd); // seek to end
|
||||
end
|
||||
else
|
||||
begin
|
||||
TargetFile:= TFileStreamEx.Create(TargetFileName, fmCreate);
|
||||
end;
|
||||
|
||||
TotalBytesToRead := SourceFile.Size;
|
||||
|
||||
while TotalBytesToRead > 0 do
|
||||
begin
|
||||
// Without the following line the reading is very slow
|
||||
// if it tries to read past end of file.
|
||||
if TotalBytesToRead < BytesToRead then
|
||||
BytesToRead := TotalBytesToRead;
|
||||
|
||||
repeat
|
||||
try
|
||||
bRetryRead := False;
|
||||
BytesRead := SourceFile.Read(FBuffer^, BytesToRead);
|
||||
|
||||
if (BytesRead = 0) then
|
||||
Raise EReadError.Create(mbSysErrorMessage(GetLastOSError));
|
||||
|
||||
TotalBytesToRead := TotalBytesToRead - BytesRead;
|
||||
BytesWritten := 0;
|
||||
|
||||
repeat
|
||||
try
|
||||
bRetryWrite := False;
|
||||
BytesWrittenTry := TargetFile.Write((FBuffer + BytesWritten)^, BytesRead);
|
||||
BytesWritten := BytesWritten + BytesWrittenTry;
|
||||
if BytesWrittenTry = 0 then
|
||||
begin
|
||||
Raise EWriteError.Create(mbSysErrorMessage(GetLastOSError));
|
||||
end
|
||||
else if BytesWritten < BytesRead then
|
||||
begin
|
||||
bRetryWrite := True; // repeat and try to write the rest
|
||||
end;
|
||||
except
|
||||
on E: EWriteError do
|
||||
begin
|
||||
{ Check disk free space }
|
||||
GetDiskFreeSpace(TargetPath, iFreeDiskSize, iTotalDiskSize);
|
||||
if BytesRead > iFreeDiskSize then
|
||||
begin
|
||||
case AskQuestion(rsMsgNoFreeSpaceRetry, '',
|
||||
[fsourYes, fsourNo, fsourSkip],
|
||||
fsourYes, fsourNo) of
|
||||
fsourYes:
|
||||
bRetryWrite := True;
|
||||
fsourNo:
|
||||
RaiseAbortOperation;
|
||||
fsourSkip:
|
||||
Exit;
|
||||
end; // case
|
||||
end
|
||||
else
|
||||
begin
|
||||
case AskQuestion(rsMsgErrEWrite + ' ' + TargetFileName + ':',
|
||||
E.Message,
|
||||
[fsourRetry, fsourSkip, fsourAbort],
|
||||
fsourRetry, fsourSkip) of
|
||||
fsourRetry:
|
||||
bRetryWrite := True;
|
||||
fsourAbort:
|
||||
RaiseAbortOperation;
|
||||
fsourSkip:
|
||||
Exit;
|
||||
end; // case
|
||||
end;
|
||||
|
||||
end; // on do
|
||||
end; // except
|
||||
until not bRetryWrite;
|
||||
except
|
||||
on E: EReadError do
|
||||
begin
|
||||
case AskQuestion(rsMsgErrERead + ' ' + SourceFileName + ':',
|
||||
E.Message,
|
||||
[fsourRetry, fsourSkip, fsourAbort],
|
||||
fsourRetry, fsourSkip) of
|
||||
fsourRetry:
|
||||
bRetryRead := True;
|
||||
fsourAbort:
|
||||
RaiseAbortOperation;
|
||||
fsourSkip:
|
||||
Exit;
|
||||
end; // case
|
||||
end;
|
||||
end;
|
||||
until not bRetryRead;
|
||||
|
||||
with FStatistics do
|
||||
begin
|
||||
CurrentFileDoneBytes := CurrentFileDoneBytes + BytesRead;
|
||||
DoneBytes := DoneBytes + BytesRead;
|
||||
|
||||
UpdateStatistics(FStatistics);
|
||||
end;
|
||||
|
||||
CheckOperationState; // check pause and stop
|
||||
end;//while
|
||||
|
||||
finally
|
||||
if assigned(SourceFile) then
|
||||
FreeAndNil(SourceFile);
|
||||
if assigned(TargetFile) then
|
||||
begin
|
||||
FreeAndNil(TargetFile);
|
||||
if TotalBytesToRead > 0 then
|
||||
// There was some error, because not all of the file has been copied.
|
||||
// Delete the not completed target file.
|
||||
mbDeleteFile(TargetFileName);
|
||||
end;
|
||||
end;
|
||||
// copy file attributes
|
||||
Result:= FileCopyAttr(SourceFileName, TargetFileName, FDropReadOnlyFlag);
|
||||
//if Preserve_attr
|
||||
except
|
||||
on EFCreateError do
|
||||
begin
|
||||
ShowError(rsMsgLogError + rsMsgErrECreate + ' - ' + TargetFileName);
|
||||
end;
|
||||
on EFOpenError do
|
||||
begin
|
||||
ShowError(rsMsgLogError + rsMsgErrEOpen + ' - ' + SourceFileName);
|
||||
end;
|
||||
on EWriteError do
|
||||
begin
|
||||
ShowError(rsMsgLogError + rsMsgErrEWrite + ' - ' + TargetFileName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFileSystemCopyOutOperation.ShowError(sMessage: String): TFileSourceOperationUIResponse;
|
||||
begin
|
||||
if gSkipFileOpError then
|
||||
begin
|
||||
logWrite(Thread, sMessage, lmtError, True);
|
||||
Result := fsourSkip;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := AskQuestion(sMessage, '', [fsourSkip, fsourCancel], fsourSkip, fsourCancel);
|
||||
if Result = fsourCancel then
|
||||
RaiseAbortOperation;
|
||||
end;
|
||||
if Assigned(FOperationHelper) then
|
||||
FreeAndNil(FOperationHelper);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -46,12 +46,12 @@ type
|
|||
function CreateListOperation: TFileSourceOperation; override;
|
||||
function CreateCopyInOperation(var SourceFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation; override;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateCopyOutOperation(var TargetFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation; override;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateMoveOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation; override;
|
||||
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; override;
|
||||
function CreateWipeOperation(var FilesToWipe: TFiles): TFileSourceOperation; override;
|
||||
function CreateCreateDirectoryOperation(DirectoryPath: String): TFileSourceOperation; override;
|
||||
|
|
@ -69,6 +69,7 @@ uses
|
|||
uFileSystemFile,
|
||||
uFileSystemListOperation,
|
||||
uFileSystemCopyOperation,
|
||||
uFileSystemMoveOperation,
|
||||
uFileSystemDeleteOperation,
|
||||
uFileSystemWipeOperation,
|
||||
uFileSystemCreateDirectoryOperation,
|
||||
|
|
@ -106,6 +107,7 @@ begin
|
|||
Result := [fsoList,
|
||||
fsoCopyIn,
|
||||
fsoCopyOut,
|
||||
fsoMove,
|
||||
fsoDelete,
|
||||
fsoWipe,
|
||||
fsoCreateDirectory,
|
||||
|
|
@ -170,28 +172,35 @@ end;
|
|||
|
||||
function TFileSystemFileSource.CreateCopyInOperation(var SourceFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: TFileSystemFileSource;
|
||||
begin
|
||||
TargetFileSource := Self.Clone;
|
||||
Result := TFileSystemCopyInOperation.Create(
|
||||
SourceFileSource, TargetFileSource,
|
||||
SourceFiles, TargetPath, RenameMask);
|
||||
SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TFileSystemFileSource.CreateCopyOutOperation(var TargetFileSource: TFileSource;
|
||||
var SourceFiles: TFiles;
|
||||
TargetPath: String;
|
||||
RenameMask: String): TFileSourceOperation;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
SourceFileSource: TFileSystemFileSource;
|
||||
begin
|
||||
SourceFileSource := Self.Clone;
|
||||
Result := TFileSystemCopyOutOperation.Create(
|
||||
SourceFileSource, TargetFileSource,
|
||||
SourceFiles, TargetPath, RenameMask);
|
||||
SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TFileSystemFileSource.CreateMoveOperation(var SourceFiles: TFiles;
|
||||
TargetPath: String): TFileSourceOperation;
|
||||
var
|
||||
TargetFileSource: TFileSystemFileSource;
|
||||
begin
|
||||
TargetFileSource := Self.Clone;
|
||||
Result := TFileSystemMoveOperation.Create(TargetFileSource, SourceFiles, TargetPath);
|
||||
end;
|
||||
|
||||
function TFileSystemFileSource.CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation;
|
||||
|
|
|
|||
132
src/newdesign/ufilesystemmoveoperation.pas
Normal file
132
src/newdesign/ufilesystemmoveoperation.pas
Normal file
|
|
@ -0,0 +1,132 @@
|
|||
unit uFileSystemMoveOperation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
uFileSourceMoveOperation,
|
||||
uFileSource,
|
||||
uFileSourceOperation,
|
||||
uFileSourceOperationOptions,
|
||||
uFile,
|
||||
uFileSystemFile,
|
||||
uFileSystemUtil;
|
||||
|
||||
type
|
||||
TFileSystemMoveOperation = class(TFileSourceMoveOperation)
|
||||
|
||||
private
|
||||
FOperationHelper: TFileSystemOperationHelper;
|
||||
FSourceFilesTree: TFileTree; // source files including all files/dirs in subdirectories
|
||||
FStatistics: TFileSourceMoveOperationStatistics; // local copy of statistics
|
||||
|
||||
// Options.
|
||||
FCheckFreeSpace: Boolean;
|
||||
FSkipAllBigFiles: Boolean;
|
||||
FSymLinkOption: TFileSourceOperationOptionSymLink;
|
||||
FFileExistsOption: TFileSourceOperationOptionFileExists;
|
||||
FDirExistsOption: TFileSourceOperationOptionDirectoryExists;
|
||||
FCorrectSymlinks: Boolean;
|
||||
|
||||
protected
|
||||
|
||||
public
|
||||
constructor Create(var aFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String); override;
|
||||
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Initialize; override;
|
||||
procedure MainExecute; override;
|
||||
procedure Finalize; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
uOSUtils, FileUtil, LCLProc, uGlobs;
|
||||
|
||||
constructor TFileSystemMoveOperation.Create(var aFileSource: TFileSource;
|
||||
var theSourceFiles: TFiles;
|
||||
aTargetPath: String);
|
||||
begin
|
||||
FSourceFilesTree := nil;
|
||||
FOperationHelper := nil;
|
||||
|
||||
// Here we can read global settings if there are any.
|
||||
FSymLinkOption := fsooslNone;
|
||||
FFileExistsOption := fsoofeNone;
|
||||
FDirExistsOption := fsoodeNone;
|
||||
FCheckFreeSpace := True;
|
||||
FSkipAllBigFiles := False;
|
||||
FCorrectSymlinks := False;
|
||||
|
||||
inherited Create(aFileSource, theSourceFiles, aTargetPath);
|
||||
end;
|
||||
|
||||
destructor TFileSystemMoveOperation.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
|
||||
if Assigned(FSourceFilesTree) then
|
||||
FreeAndNil(FSourceFilesTree);
|
||||
|
||||
if Assigned(FOperationHelper) then
|
||||
FreeAndNil(FOperationHelper);
|
||||
end;
|
||||
|
||||
procedure TFileSystemMoveOperation.Initialize;
|
||||
var
|
||||
TreeBuilder: TFileSystemTreeBuilder;
|
||||
begin
|
||||
// Get initialized statistics; then we change only what is needed.
|
||||
FStatistics := RetrieveStatistics;
|
||||
|
||||
TreeBuilder := TFileSystemTreeBuilder.Create(
|
||||
@AskQuestion,
|
||||
@CheckOperationState);
|
||||
try
|
||||
// In move operation don't follow symlinks.
|
||||
TreeBuilder.SymLinkOption := fsooslDontFollow;
|
||||
TreeBuilder.BuildFromFiles(SourceFiles as TFileSystemFiles);
|
||||
FSourceFilesTree := TreeBuilder.ReleaseTree;
|
||||
FStatistics.TotalFiles := TreeBuilder.FilesCount;
|
||||
FStatistics.TotalBytes := TreeBuilder.FilesSize;
|
||||
finally
|
||||
FreeAndNil(TreeBuilder);
|
||||
end;
|
||||
|
||||
if Assigned(FOperationHelper) then
|
||||
FreeAndNil(FOperationHelper);
|
||||
|
||||
FOperationHelper := TFileSystemOperationHelper.Create(
|
||||
@AskQuestion,
|
||||
@RaiseAbortOperation,
|
||||
@CheckOperationState,
|
||||
@UpdateStatistics,
|
||||
Thread,
|
||||
fsohmMove,
|
||||
SourceFiles.Path,
|
||||
TargetPath,
|
||||
FStatistics);
|
||||
|
||||
FOperationHelper.RenameMask := RenameMask;
|
||||
FOperationHelper.Initialize;
|
||||
end;
|
||||
|
||||
procedure TFileSystemMoveOperation.MainExecute;
|
||||
begin
|
||||
FOperationHelper.ProcessTree(FSourceFilesTree);
|
||||
end;
|
||||
|
||||
procedure TFileSystemMoveOperation.Finalize;
|
||||
begin
|
||||
if Assigned(FOperationHelper) then
|
||||
FreeAndNil(FOperationHelper);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
File diff suppressed because it is too large
Load diff
776
src/uShowMsg.pas
776
src/uShowMsg.pas
|
|
@ -1,388 +1,388 @@
|
|||
{
|
||||
Seksi Commander
|
||||
----------------------------
|
||||
Implementing of Showing messages with localization
|
||||
|
||||
Licence : GNU GPL v 2.0
|
||||
Author : radek.cervinka@centrum.cz
|
||||
|
||||
contributors:
|
||||
|
||||
Koblov Alexander (Alexx2000@mail.ru)
|
||||
}
|
||||
|
||||
unit uShowMsg;
|
||||
|
||||
{$MODE Delphi}{$H+}
|
||||
|
||||
interface
|
||||
uses
|
||||
Forms, Classes;
|
||||
|
||||
type
|
||||
TMyMsgResult=(mmrOK, mmrNo, mmrYes, mmrCancel, mmrNone,
|
||||
mmrAppend, mmrRewrite, mmrRewriteAll, mmrSkip, mmrSkipAll,
|
||||
mmrAll, mmrRetry, mrAbort);
|
||||
|
||||
TMyMsgButton=(msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone,
|
||||
msmbAppend, msmbRewrite, msmbRewriteAll, msmbSkip, msmbSkipAll,
|
||||
msmbAll, msmbRetry, msmbAbort);
|
||||
|
||||
|
||||
{ TDlgOpThread }
|
||||
|
||||
TDlgOpThread = class
|
||||
private
|
||||
procedure ShowInTheThread;
|
||||
protected
|
||||
FThread : TThread;
|
||||
FMsg : String;
|
||||
FButtons: array of TMyMsgButton;
|
||||
FButDefault,
|
||||
FButEscape : TMyMsgButton;
|
||||
FDlgResult : TMyMsgResult;
|
||||
public
|
||||
constructor Create(Thread : TThread);
|
||||
destructor Destroy;override;
|
||||
function Show(const sMsg:String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton) : TMyMsgResult;
|
||||
end;
|
||||
|
||||
function msgYesNo(const sMsg:String):Boolean; overload;
|
||||
function msgYesNo(Thread: TThread; const sMsg:String):Boolean; overload;
|
||||
|
||||
function msgYesNoCancel(const sMsg:String):TMyMsgResult; overload;
|
||||
function msgYesNoCancel(Thread: TThread; const sMsg:String):TMyMsgResult; overload;
|
||||
|
||||
procedure msgOK(const sMsg:String); overload;
|
||||
procedure msgOK(Thread: TThread; const sMsg: String); overload;
|
||||
|
||||
procedure msgWarning(const sMsg: String); overload;
|
||||
procedure msgWarning(Thread: TThread; const sMsg: String); overload;
|
||||
|
||||
procedure msgError(const sMsg: String); overload;
|
||||
procedure msgError(Thread: TThread; const sMsg: String); overload;
|
||||
|
||||
function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
|
||||
function MsgBox(Thread: TThread;const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
|
||||
|
||||
function MsgTest:TMyMsgResult;
|
||||
function ShowInputComboBox(const sCaption, sPrompt : String; var slValueList : TStringList;
|
||||
var sValue : String) : Boolean;
|
||||
procedure msgLoadLng;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils, StdCtrls, Graphics, math, fMsg, uLng, Buttons, Controls, uLog, uGlobs;
|
||||
|
||||
const
|
||||
cMsgName='Double Commander';
|
||||
|
||||
var
|
||||
cLngButton:Array[TMyMsgButton] of String;
|
||||
|
||||
{ TDlgOpThread }
|
||||
|
||||
procedure TDlgOpThread.ShowInTheThread;
|
||||
begin
|
||||
FDlgResult := MsgBox(FMsg, FButtons, FButDefault, FButEscape);
|
||||
end;
|
||||
|
||||
constructor TDlgOpThread.Create(Thread : TThread);
|
||||
begin
|
||||
FThread := Thread;
|
||||
end;
|
||||
|
||||
destructor TDlgOpThread.Destroy;
|
||||
begin
|
||||
FButtons := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDlgOpThread.Show(const sMsg: String;
|
||||
const Buttons: array of TMyMsgButton; ButDefault,
|
||||
ButEscape: TMyMsgButton) : TMyMsgResult;
|
||||
var
|
||||
I : Integer;
|
||||
begin
|
||||
FMsg := sMsg;
|
||||
|
||||
SetLength(FButtons, SizeOf(Buttons));
|
||||
for I := Low(Buttons) to High(Buttons) do
|
||||
FButtons[I] := Buttons[I];
|
||||
|
||||
FButDefault := ButDefault;
|
||||
FButEscape := ButEscape;
|
||||
|
||||
FThread.Synchronize(FThread, ShowInTheThread);
|
||||
|
||||
Result := FDlgResult;
|
||||
end;
|
||||
|
||||
{ This is workaround for autosize}
|
||||
function MeasureText(Canvas:TCanvas; const sText:String):Integer;
|
||||
var
|
||||
xEnter:Integer;
|
||||
begin
|
||||
xEnter:=Pos(#10, sText);
|
||||
if xEnter>0 then
|
||||
Result:=Canvas.TextWidth(Copy(sText,1, xEnter))
|
||||
else
|
||||
Result:=Canvas.TextWidth(sText);
|
||||
end;
|
||||
|
||||
procedure SetMsgBoxParams(var frmMsg : TfrmMsg; const sMsg:String;
|
||||
const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton);
|
||||
var
|
||||
iIndex:Integer;
|
||||
begin
|
||||
frmMsg.Position:=poScreenCenter;
|
||||
frmMsg.BorderStyle := bsSingle;
|
||||
frmMsg.BorderIcons := [biSystemMenu, biMinimize];
|
||||
|
||||
if (High(Buttons)+1)>=3 then
|
||||
frmMsg.Width:=(cButtonWidth+cButtonSpace)*3+cButtonSpace
|
||||
else
|
||||
frmMsg.Width:=(cButtonWidth+cButtonSpace)*(High(Buttons)+1)+cButtonSpace;
|
||||
frmMsg.Height:=(High(Buttons) div 3)*40+90;
|
||||
|
||||
|
||||
frmMsg.Caption:=cMsgName;
|
||||
with frmMsg.lblMsg do
|
||||
begin
|
||||
Caption:=sMsg;
|
||||
Top:=15;
|
||||
AutoSize:=True;
|
||||
// Anchors:=[akTop];
|
||||
Width:=MeasureText(frmMsg.Canvas, sMsg); // workaround
|
||||
if Width>frmMsg.Width then
|
||||
frmMsg.Width:=Width+2*cButtonSpace;
|
||||
Left:=(frmMsg.Width-Width) div 2;
|
||||
end;
|
||||
|
||||
for iIndex:=0 to High(Buttons) do
|
||||
begin
|
||||
With TButton.Create(frmMsg) do
|
||||
begin
|
||||
Caption:=cLngButton[Buttons[iIndex]];
|
||||
Parent:=frmMsg;
|
||||
Width:=cButtonWidth;
|
||||
Height := 32;
|
||||
Tag:=iIndex;
|
||||
OnCLick:=frmMsg.ButtonClick;
|
||||
OnMouseDown:=frmMsg.MouseDownEvent;
|
||||
if (High(Buttons)+1)>=3 then
|
||||
Left:=(iIndex mod 3)*(cButtonWidth+cButtonSpace)+(frmMsg.Width-(3*cButtonWidth+2*cButtonSpace)) div 2
|
||||
else
|
||||
Left:=iIndex*(cButtonWidth+cButtonSpace)+(frmMsg.Width-((High(Buttons)+1)*cButtonWidth+High(Buttons)*cButtonSpace)) div 2;
|
||||
|
||||
Top:=(iIndex div 3)*(Height+5)+50;
|
||||
if Buttons[iIndex]=ButDefault then
|
||||
Default:=True;
|
||||
if Buttons[iIndex]=ButEscape then
|
||||
frmMsg.Escape:=iIndex;
|
||||
{ if iIndex=0 then
|
||||
SetFocus; }
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function MsgBox(const sMsg:String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
|
||||
var
|
||||
frmMsg:TfrmMsg;
|
||||
begin
|
||||
frmMsg:=TfrmMsg.Create(Application);
|
||||
try
|
||||
|
||||
SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
|
||||
|
||||
frmMsg.ShowModal;
|
||||
if (frmMsg.iSelected)=-1 then
|
||||
Result:=mmrNone
|
||||
else
|
||||
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
|
||||
finally
|
||||
frmMsg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function MsgBox(Thread: TThread; const sMsg: String;
|
||||
const Buttons: array of TMyMsgButton; ButDefault,
|
||||
ButEscape: TMyMsgButton): TMyMsgResult;
|
||||
var
|
||||
DlgOpThread : TDlgOpThread;
|
||||
begin
|
||||
Result := mmrNone;
|
||||
try
|
||||
DlgOpThread := TDlgOpThread.Create(Thread);
|
||||
Result := DlgOpThread.Show(sMsg, Buttons, ButDefault, ButEscape);
|
||||
finally
|
||||
DlgOpThread.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function MsgTest:TMyMsgResult;
|
||||
begin
|
||||
Result:= MsgBox('test language of msg subsystem'#10'Second line',[msmbOK, msmbNO, msmbYes, msmbCancel, msmbNone,
|
||||
msmbAppend, msmbRewrite, msmbRewriteAll],msmbOK, msmbNO);
|
||||
end;
|
||||
|
||||
function msgYesNo(const sMsg:String):Boolean;
|
||||
begin
|
||||
Result:= MsgBox(sMsg,[msmbYes, msmbNo], msmbYes, msmbNo )= mmrYes;
|
||||
end;
|
||||
|
||||
function msgYesNo(Thread: TThread; const sMsg: String): Boolean;
|
||||
begin
|
||||
Result:= MsgBox(Thread, sMsg,[msmbYes, msmbNo], msmbYes, msmbNo )= mmrYes;
|
||||
end;
|
||||
|
||||
function msgYesNoCancel(const sMsg:String):TMyMsgResult;
|
||||
begin
|
||||
Result:= MsgBox(sMsg,[msmbYes, msmbNo, msmbCancel], msmbYes, msmbNo);
|
||||
end;
|
||||
|
||||
function msgYesNoCancel(Thread: TThread; const sMsg: String): TMyMsgResult;
|
||||
begin
|
||||
Result:= MsgBox(Thread, sMsg,[msmbYes, msmbNo, msmbCancel], msmbYes, msmbNo);
|
||||
end;
|
||||
|
||||
procedure msgOK(const sMsg:String);
|
||||
begin
|
||||
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK);
|
||||
end;
|
||||
|
||||
procedure msgOK(Thread: TThread; const sMsg: String);
|
||||
begin
|
||||
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK);
|
||||
end;
|
||||
|
||||
procedure msgError(const sMsg: String);
|
||||
begin
|
||||
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK);
|
||||
end;
|
||||
|
||||
procedure msgError(Thread: TThread; const sMsg: String);
|
||||
begin
|
||||
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK)
|
||||
end;
|
||||
|
||||
procedure msgWarning(const sMsg: String);
|
||||
begin
|
||||
if gShowWarningMessages then
|
||||
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK)
|
||||
else
|
||||
begin
|
||||
if gLogWindow then // if log window enabled then write error to it
|
||||
logWrite(sMsg, lmtError)
|
||||
else
|
||||
Beep;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure msgWarning(Thread: TThread; const sMsg: String);
|
||||
begin
|
||||
if gShowWarningMessages then
|
||||
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK)
|
||||
else
|
||||
begin
|
||||
if gLogWindow then // if log window enabled then write error to it
|
||||
logWrite(Thread, sMsg, lmtError)
|
||||
else
|
||||
Beep;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ShowInputComboBox(const sCaption, sPrompt : String; var slValueList : TStringList;
|
||||
var sValue : String) : Boolean;
|
||||
var
|
||||
frmDialog : TForm;
|
||||
lblPrompt : TLabel;
|
||||
cbValue : TComboBox;
|
||||
bbtnOK,
|
||||
bbtnCancel : TBitBtn;
|
||||
begin
|
||||
Result := False;
|
||||
frmDialog := TForm.CreateNew(nil, 0);
|
||||
with frmDialog do
|
||||
begin
|
||||
BorderStyle := bsDialog;
|
||||
Position := poScreenCenter;
|
||||
AutoSize := True;
|
||||
Height := 120;
|
||||
ChildSizing.TopBottomSpacing := 8;
|
||||
ChildSizing.LeftRightSpacing := 8;
|
||||
Caption := sCaption;
|
||||
lblPrompt := TLabel.Create(frmDialog);
|
||||
with lblPrompt do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Caption := sPrompt;
|
||||
Top := 6;
|
||||
Left := 6;
|
||||
end;
|
||||
cbValue := TComboBox.Create(frmDialog);
|
||||
with cbValue do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Items.Assign(slValueList);
|
||||
Text := sValue;
|
||||
Left := 6;
|
||||
AnchorToNeighbour(akTop, 6, lblPrompt);
|
||||
Constraints.MinWidth := max(280, Screen.Width div 4);
|
||||
end;
|
||||
bbtnCancel := TBitBtn.Create(frmDialog);
|
||||
with bbtnCancel do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Kind := bkCancel;
|
||||
Cancel := True;
|
||||
Left := 6;
|
||||
Width:= 90;
|
||||
Anchors := [akTop, akRight];
|
||||
AnchorToNeighbour(akTop, 18, cbValue);
|
||||
AnchorSide[akRight].Control := cbValue;
|
||||
AnchorSide[akRight].Side := asrRight;
|
||||
end;
|
||||
bbtnOK := TBitBtn.Create(frmDialog);
|
||||
with bbtnOK do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Kind := bkOk;
|
||||
Default := True;
|
||||
Width:= 90;
|
||||
Anchors := [akTop, akRight];
|
||||
AnchorToNeighbour(akTop, 18, cbValue);
|
||||
AnchorToNeighbour(akRight, 6, bbtnCancel);
|
||||
end;
|
||||
ShowModal;
|
||||
if ModalResult = mrOK then
|
||||
begin
|
||||
if slValueList.IndexOf(cbValue.Text) < 0 then
|
||||
slValueList.Add(cbValue.Text);
|
||||
sValue := cbValue.Text;
|
||||
Result := True;
|
||||
end;
|
||||
Free;
|
||||
end; // with frmDialog
|
||||
end;
|
||||
|
||||
procedure msgLoadLng;
|
||||
var
|
||||
I: TMyMsgButton;
|
||||
s: String;
|
||||
xPos: Integer;
|
||||
begin
|
||||
s:= rsDlgButtons;
|
||||
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
|
||||
begin
|
||||
xPos:=Pos(';',s);
|
||||
cLngButton[I]:=Copy(s,1,xPos-1);
|
||||
with Application.MainForm.Canvas do
|
||||
if TextWidth(cLngButton[I]) >= (cButtonWidth - 8) then
|
||||
cButtonWidth:= TextWidth(cLngButton[I]) + 8;
|
||||
Delete(s,1,xPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
Seksi Commander
|
||||
----------------------------
|
||||
Implementing of Showing messages with localization
|
||||
|
||||
Licence : GNU GPL v 2.0
|
||||
Author : radek.cervinka@centrum.cz
|
||||
|
||||
contributors:
|
||||
|
||||
Koblov Alexander (Alexx2000@mail.ru)
|
||||
}
|
||||
|
||||
unit uShowMsg;
|
||||
|
||||
{$MODE Delphi}{$H+}
|
||||
|
||||
interface
|
||||
uses
|
||||
Forms, Classes;
|
||||
|
||||
type
|
||||
TMyMsgResult=(mmrOK, mmrNo, mmrYes, mmrCancel, mmrNone,
|
||||
mmrAppend, mmrCopyInto, mmrRewrite, mmrRewriteAll, mmrSkip, mmrSkipAll,
|
||||
mmrAll, mmrRetry, mrAbort);
|
||||
|
||||
TMyMsgButton=(msmbOK, msmbNo, msmbYes, msmbCancel, msmbNone,
|
||||
msmbAppend, msmbCopyInto, msmbRewrite, msmbRewriteAll, msmbSkip, msmbSkipAll,
|
||||
msmbAll, msmbRetry, msmbAbort);
|
||||
|
||||
|
||||
{ TDlgOpThread }
|
||||
|
||||
TDlgOpThread = class
|
||||
private
|
||||
procedure ShowInTheThread;
|
||||
protected
|
||||
FThread : TThread;
|
||||
FMsg : String;
|
||||
FButtons: array of TMyMsgButton;
|
||||
FButDefault,
|
||||
FButEscape : TMyMsgButton;
|
||||
FDlgResult : TMyMsgResult;
|
||||
public
|
||||
constructor Create(Thread : TThread);
|
||||
destructor Destroy;override;
|
||||
function Show(const sMsg:String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton) : TMyMsgResult;
|
||||
end;
|
||||
|
||||
function msgYesNo(const sMsg:String):Boolean; overload;
|
||||
function msgYesNo(Thread: TThread; const sMsg:String):Boolean; overload;
|
||||
|
||||
function msgYesNoCancel(const sMsg:String):TMyMsgResult; overload;
|
||||
function msgYesNoCancel(Thread: TThread; const sMsg:String):TMyMsgResult; overload;
|
||||
|
||||
procedure msgOK(const sMsg:String); overload;
|
||||
procedure msgOK(Thread: TThread; const sMsg: String); overload;
|
||||
|
||||
procedure msgWarning(const sMsg: String); overload;
|
||||
procedure msgWarning(Thread: TThread; const sMsg: String); overload;
|
||||
|
||||
procedure msgError(const sMsg: String); overload;
|
||||
procedure msgError(Thread: TThread; const sMsg: String); overload;
|
||||
|
||||
function MsgBox(const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
|
||||
function MsgBox(Thread: TThread;const sMsg: String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape: TMyMsgButton): TMyMsgResult; overload;
|
||||
|
||||
function MsgTest:TMyMsgResult;
|
||||
function ShowInputComboBox(const sCaption, sPrompt : String; var slValueList : TStringList;
|
||||
var sValue : String) : Boolean;
|
||||
procedure msgLoadLng;
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
SysUtils, StdCtrls, Graphics, math, fMsg, uLng, Buttons, Controls, uLog, uGlobs;
|
||||
|
||||
const
|
||||
cMsgName='Double Commander';
|
||||
|
||||
var
|
||||
cLngButton:Array[TMyMsgButton] of String;
|
||||
|
||||
{ TDlgOpThread }
|
||||
|
||||
procedure TDlgOpThread.ShowInTheThread;
|
||||
begin
|
||||
FDlgResult := MsgBox(FMsg, FButtons, FButDefault, FButEscape);
|
||||
end;
|
||||
|
||||
constructor TDlgOpThread.Create(Thread : TThread);
|
||||
begin
|
||||
FThread := Thread;
|
||||
end;
|
||||
|
||||
destructor TDlgOpThread.Destroy;
|
||||
begin
|
||||
FButtons := nil;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TDlgOpThread.Show(const sMsg: String;
|
||||
const Buttons: array of TMyMsgButton; ButDefault,
|
||||
ButEscape: TMyMsgButton) : TMyMsgResult;
|
||||
var
|
||||
I : Integer;
|
||||
begin
|
||||
FMsg := sMsg;
|
||||
|
||||
SetLength(FButtons, SizeOf(Buttons));
|
||||
for I := Low(Buttons) to High(Buttons) do
|
||||
FButtons[I] := Buttons[I];
|
||||
|
||||
FButDefault := ButDefault;
|
||||
FButEscape := ButEscape;
|
||||
|
||||
FThread.Synchronize(FThread, ShowInTheThread);
|
||||
|
||||
Result := FDlgResult;
|
||||
end;
|
||||
|
||||
{ This is workaround for autosize}
|
||||
function MeasureText(Canvas:TCanvas; const sText:String):Integer;
|
||||
var
|
||||
xEnter:Integer;
|
||||
begin
|
||||
xEnter:=Pos(#10, sText);
|
||||
if xEnter>0 then
|
||||
Result:=Canvas.TextWidth(Copy(sText,1, xEnter))
|
||||
else
|
||||
Result:=Canvas.TextWidth(sText);
|
||||
end;
|
||||
|
||||
procedure SetMsgBoxParams(var frmMsg : TfrmMsg; const sMsg:String;
|
||||
const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton);
|
||||
var
|
||||
iIndex:Integer;
|
||||
begin
|
||||
frmMsg.Position:=poScreenCenter;
|
||||
frmMsg.BorderStyle := bsSingle;
|
||||
frmMsg.BorderIcons := [biSystemMenu, biMinimize];
|
||||
|
||||
if (High(Buttons)+1)>=3 then
|
||||
frmMsg.Width:=(cButtonWidth+cButtonSpace)*3+cButtonSpace
|
||||
else
|
||||
frmMsg.Width:=(cButtonWidth+cButtonSpace)*(High(Buttons)+1)+cButtonSpace;
|
||||
frmMsg.Height:=(High(Buttons) div 3)*40+90;
|
||||
|
||||
|
||||
frmMsg.Caption:=cMsgName;
|
||||
with frmMsg.lblMsg do
|
||||
begin
|
||||
Caption:=sMsg;
|
||||
Top:=15;
|
||||
AutoSize:=True;
|
||||
// Anchors:=[akTop];
|
||||
Width:=MeasureText(frmMsg.Canvas, sMsg); // workaround
|
||||
if Width>frmMsg.Width then
|
||||
frmMsg.Width:=Width+2*cButtonSpace;
|
||||
Left:=(frmMsg.Width-Width) div 2;
|
||||
end;
|
||||
|
||||
for iIndex:=0 to High(Buttons) do
|
||||
begin
|
||||
With TButton.Create(frmMsg) do
|
||||
begin
|
||||
Caption:=cLngButton[Buttons[iIndex]];
|
||||
Parent:=frmMsg;
|
||||
Width:=cButtonWidth;
|
||||
Height := 32;
|
||||
Tag:=iIndex;
|
||||
OnCLick:=frmMsg.ButtonClick;
|
||||
OnMouseDown:=frmMsg.MouseDownEvent;
|
||||
if (High(Buttons)+1)>=3 then
|
||||
Left:=(iIndex mod 3)*(cButtonWidth+cButtonSpace)+(frmMsg.Width-(3*cButtonWidth+2*cButtonSpace)) div 2
|
||||
else
|
||||
Left:=iIndex*(cButtonWidth+cButtonSpace)+(frmMsg.Width-((High(Buttons)+1)*cButtonWidth+High(Buttons)*cButtonSpace)) div 2;
|
||||
|
||||
Top:=(iIndex div 3)*(Height+5)+50;
|
||||
if Buttons[iIndex]=ButDefault then
|
||||
Default:=True;
|
||||
if Buttons[iIndex]=ButEscape then
|
||||
frmMsg.Escape:=iIndex;
|
||||
{ if iIndex=0 then
|
||||
SetFocus; }
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function MsgBox(const sMsg:String; const Buttons: array of TMyMsgButton; ButDefault, ButEscape:TMyMsgButton):TMyMsgResult;
|
||||
var
|
||||
frmMsg:TfrmMsg;
|
||||
begin
|
||||
frmMsg:=TfrmMsg.Create(Application);
|
||||
try
|
||||
|
||||
SetMsgBoxParams(frmMsg, sMsg, Buttons, ButDefault, ButEscape);
|
||||
|
||||
frmMsg.ShowModal;
|
||||
if (frmMsg.iSelected)=-1 then
|
||||
Result:=mmrNone
|
||||
else
|
||||
Result:=TMyMsgResult(Buttons[frmMsg.iSelected]);
|
||||
finally
|
||||
frmMsg.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function MsgBox(Thread: TThread; const sMsg: String;
|
||||
const Buttons: array of TMyMsgButton; ButDefault,
|
||||
ButEscape: TMyMsgButton): TMyMsgResult;
|
||||
var
|
||||
DlgOpThread : TDlgOpThread;
|
||||
begin
|
||||
Result := mmrNone;
|
||||
try
|
||||
DlgOpThread := TDlgOpThread.Create(Thread);
|
||||
Result := DlgOpThread.Show(sMsg, Buttons, ButDefault, ButEscape);
|
||||
finally
|
||||
DlgOpThread.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function MsgTest:TMyMsgResult;
|
||||
begin
|
||||
Result:= MsgBox('test language of msg subsystem'#10'Second line',[msmbOK, msmbNO, msmbYes, msmbCancel, msmbNone,
|
||||
msmbAppend, msmbRewrite, msmbRewriteAll],msmbOK, msmbNO);
|
||||
end;
|
||||
|
||||
function msgYesNo(const sMsg:String):Boolean;
|
||||
begin
|
||||
Result:= MsgBox(sMsg,[msmbYes, msmbNo], msmbYes, msmbNo )= mmrYes;
|
||||
end;
|
||||
|
||||
function msgYesNo(Thread: TThread; const sMsg: String): Boolean;
|
||||
begin
|
||||
Result:= MsgBox(Thread, sMsg,[msmbYes, msmbNo], msmbYes, msmbNo )= mmrYes;
|
||||
end;
|
||||
|
||||
function msgYesNoCancel(const sMsg:String):TMyMsgResult;
|
||||
begin
|
||||
Result:= MsgBox(sMsg,[msmbYes, msmbNo, msmbCancel], msmbYes, msmbNo);
|
||||
end;
|
||||
|
||||
function msgYesNoCancel(Thread: TThread; const sMsg: String): TMyMsgResult;
|
||||
begin
|
||||
Result:= MsgBox(Thread, sMsg,[msmbYes, msmbNo, msmbCancel], msmbYes, msmbNo);
|
||||
end;
|
||||
|
||||
procedure msgOK(const sMsg:String);
|
||||
begin
|
||||
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK);
|
||||
end;
|
||||
|
||||
procedure msgOK(Thread: TThread; const sMsg: String);
|
||||
begin
|
||||
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK);
|
||||
end;
|
||||
|
||||
procedure msgError(const sMsg: String);
|
||||
begin
|
||||
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK);
|
||||
end;
|
||||
|
||||
procedure msgError(Thread: TThread; const sMsg: String);
|
||||
begin
|
||||
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK)
|
||||
end;
|
||||
|
||||
procedure msgWarning(const sMsg: String);
|
||||
begin
|
||||
if gShowWarningMessages then
|
||||
MsgBox(sMsg,[msmbOK],msmbOK, msmbOK)
|
||||
else
|
||||
begin
|
||||
if gLogWindow then // if log window enabled then write error to it
|
||||
logWrite(sMsg, lmtError)
|
||||
else
|
||||
Beep;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure msgWarning(Thread: TThread; const sMsg: String);
|
||||
begin
|
||||
if gShowWarningMessages then
|
||||
MsgBox(Thread, sMsg,[msmbOK],msmbOK, msmbOK)
|
||||
else
|
||||
begin
|
||||
if gLogWindow then // if log window enabled then write error to it
|
||||
logWrite(Thread, sMsg, lmtError)
|
||||
else
|
||||
Beep;
|
||||
end;
|
||||
end;
|
||||
|
||||
function ShowInputComboBox(const sCaption, sPrompt : String; var slValueList : TStringList;
|
||||
var sValue : String) : Boolean;
|
||||
var
|
||||
frmDialog : TForm;
|
||||
lblPrompt : TLabel;
|
||||
cbValue : TComboBox;
|
||||
bbtnOK,
|
||||
bbtnCancel : TBitBtn;
|
||||
begin
|
||||
Result := False;
|
||||
frmDialog := TForm.CreateNew(nil, 0);
|
||||
with frmDialog do
|
||||
begin
|
||||
BorderStyle := bsDialog;
|
||||
Position := poScreenCenter;
|
||||
AutoSize := True;
|
||||
Height := 120;
|
||||
ChildSizing.TopBottomSpacing := 8;
|
||||
ChildSizing.LeftRightSpacing := 8;
|
||||
Caption := sCaption;
|
||||
lblPrompt := TLabel.Create(frmDialog);
|
||||
with lblPrompt do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Caption := sPrompt;
|
||||
Top := 6;
|
||||
Left := 6;
|
||||
end;
|
||||
cbValue := TComboBox.Create(frmDialog);
|
||||
with cbValue do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Items.Assign(slValueList);
|
||||
Text := sValue;
|
||||
Left := 6;
|
||||
AnchorToNeighbour(akTop, 6, lblPrompt);
|
||||
Constraints.MinWidth := max(280, Screen.Width div 4);
|
||||
end;
|
||||
bbtnCancel := TBitBtn.Create(frmDialog);
|
||||
with bbtnCancel do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Kind := bkCancel;
|
||||
Cancel := True;
|
||||
Left := 6;
|
||||
Width:= 90;
|
||||
Anchors := [akTop, akRight];
|
||||
AnchorToNeighbour(akTop, 18, cbValue);
|
||||
AnchorSide[akRight].Control := cbValue;
|
||||
AnchorSide[akRight].Side := asrRight;
|
||||
end;
|
||||
bbtnOK := TBitBtn.Create(frmDialog);
|
||||
with bbtnOK do
|
||||
begin
|
||||
Parent := frmDialog;
|
||||
Kind := bkOk;
|
||||
Default := True;
|
||||
Width:= 90;
|
||||
Anchors := [akTop, akRight];
|
||||
AnchorToNeighbour(akTop, 18, cbValue);
|
||||
AnchorToNeighbour(akRight, 6, bbtnCancel);
|
||||
end;
|
||||
ShowModal;
|
||||
if ModalResult = mrOK then
|
||||
begin
|
||||
if slValueList.IndexOf(cbValue.Text) < 0 then
|
||||
slValueList.Add(cbValue.Text);
|
||||
sValue := cbValue.Text;
|
||||
Result := True;
|
||||
end;
|
||||
Free;
|
||||
end; // with frmDialog
|
||||
end;
|
||||
|
||||
procedure msgLoadLng;
|
||||
var
|
||||
I: TMyMsgButton;
|
||||
s: String;
|
||||
xPos: Integer;
|
||||
begin
|
||||
s:= rsDlgButtons;
|
||||
for I:= Low(TMyMsgButton) to High(TMyMsgButton) do
|
||||
begin
|
||||
xPos:=Pos(';',s);
|
||||
cLngButton[I]:=Copy(s,1,xPos-1);
|
||||
with Application.MainForm.Canvas do
|
||||
if TextWidth(cLngButton[I]) >= (cButtonWidth - 8) then
|
||||
cButtonWidth:= TextWidth(cLngButton[I]) + 8;
|
||||
Delete(s,1,xPos);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -1316,6 +1316,7 @@ begin
|
|||
// Selection validation in RenameFile.
|
||||
frmMain.RenameFile(frmMain.NotActiveFrame.CurrentPath);
|
||||
}
|
||||
frmmain.MoveFile(frmMain.NotActiveFrame.CurrentPath);
|
||||
end;
|
||||
|
||||
procedure TActs.cm_MakeDir(param:string);
|
||||
|
|
@ -2453,13 +2454,13 @@ begin
|
|||
TargetFileSource := ActiveFrame.FileSource.Clone;
|
||||
Operation := SourceFileSource.CreateCopyOutOperation(
|
||||
TargetFileSource, Files,
|
||||
ActiveFrame.CurrentPath, '*.*');
|
||||
ActiveFrame.CurrentPath);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Operation := ActiveFrame.FileSource.CreateCopyInOperation(
|
||||
SourceFileSource, Files,
|
||||
ActiveFrame.CurrentPath, '*.*');
|
||||
ActiveFrame.CurrentPath);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ resourcestring
|
|||
rsMsgPopUpHotAdd = '&Add %s';
|
||||
rsMsgPopUpHotCnf = '&Configure';
|
||||
rsMsgCloseLockedTab = 'This tab (%s) is locked! Close anyway?';
|
||||
rsDlgButtons = '&OK;&No;&Yes;&Cancel;Non&e;A&ppend;&Rewrite;Rewrite &All;&Skip;S&kip All;A≪Re&try;Ab&ort;';
|
||||
rsDlgButtons = '&OK;&No;&Yes;&Cancel;Non&e;A&ppend;Copy &Into;&Rewrite;Rewrite &All;&Skip;S&kip All;A≪Re&try;Ab&ort;';
|
||||
rsSpaceMsg = 'Files: %d, Dirs: %d, Size: %s (%s bytes)';
|
||||
rsSelectDir = 'Select a directory';
|
||||
rsMarkPlus = 'Select mask';
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue