UPD: Restored moving files for filesystem; make Copy and Move operations share code.

This commit is contained in:
cobines 2009-08-16 05:20:34 +00:00
commit 7f0f77a612
16 changed files with 1963 additions and 944 deletions

View file

@ -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>

View file

@ -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);

View file

@ -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;

View file

@ -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;

View 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.

View file

@ -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;

View file

@ -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;

View file

@ -15,6 +15,7 @@ type
fsoList,
fsoCopyIn,
fsoCopyOut,
fsoMove, // Move/rename files within the same file source.
fsoDelete,
fsoWipe,
fsoCreateDirectory,

View file

@ -16,7 +16,8 @@ type
fsourYes,
fsourCancel,
fsourNone,
fsourAppend,
fsourAppend, // for files
fsourCopyInto, // for directories
fsourRewrite,
fsourRewriteAll,
fsourSkip,

View file

@ -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.

View file

@ -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;

View 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

View file

@ -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.

View file

@ -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;

View file

@ -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&ll;Re&try;Ab&ort;';
rsDlgButtons = '&OK;&No;&Yes;&Cancel;Non&e;A&ppend;Copy &Into;&Rewrite;Rewrite &All;&Skip;S&kip All;A&ll;Re&try;Ab&ort;';
rsSpaceMsg = 'Files: %d, Dirs: %d, Size: %s (%s bytes)';
rsSelectDir = 'Select a directory';
rsMarkPlus = 'Select mask';