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

UPD: Further work on file source operations.

Browse source
This commit is contained in:
cobines 2009-07-19 12:16:46 +00:00
commit bc1df274e3
19 changed files with 844 additions and 495 deletions
Download patch file Download diff file Expand all files Collapse all files

47
src/doublecmd.lpi
View file

@ -59,7 +59,7 @@
<PackageName Value="viewerpackage"/>
</Item5>
</RequiredPackages>
<Units Count="72">
<Units Count="71">
<Unit0>
<Filename Value="doublecmd.lpr"/>
<IsPartOfProject Value="True"/>
@ -459,58 +459,53 @@
<UnitName Value="uMethodsList"/>
</Unit61>
<Unit62>
<Filename Value="newdesign\ufilesourcecopyinoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceCopyInOperation"/>
</Unit62>
<Unit63>
<Filename Value="newdesign\ufilesourcecopyoutoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceCopyOutOperation"/>
</Unit63>
<Unit64>
<Filename Value="newdesign\ufilesourcedeleteoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceDeleteOperation"/>
</Unit64>
<Unit65>
</Unit62>
<Unit63>
<Filename Value="newdesign\ufilesystemcopyoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSystemCopyOperation"/>
</Unit65>
<Unit66>
</Unit63>
<Unit64>
<Filename Value="ufileviewnotebook.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileViewNotebook"/>
</Unit66>
<Unit67>
</Unit64>
<Unit65>
<Filename Value="newdesign\uvirtualfilesource.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uVirtualFileSource"/>
</Unit67>
<Unit68>
</Unit65>
<Unit66>
<Filename Value="newdesign\urealfilesource.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uRealFileSource"/>
</Unit68>
<Unit69>
</Unit66>
<Unit67>
<Filename Value="newdesign\uoperationsmanager.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uOperationsManager"/>
</Unit69>
<Unit70>
</Unit67>
<Unit68>
<Filename Value="newdesign\uoperationthread.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uOperationThread"/>
</Unit70>
<Unit71>
</Unit68>
<Unit69>
<Filename Value="newdesign\fviewoperations.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmViewOperations"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fViewOperations"/>
</Unit71>
</Unit69>
<Unit70>
<Filename Value="newdesign\ufilesourcecopyoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceCopyOperation"/>
</Unit70>
</Units>
</ProjectOptions>
<CompilerOptions>

112
src/fFileOpDlg.pas
View file

@ -21,10 +21,13 @@ uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls,
uOperationsManager;
uOperationsManager, uFileSourceOperation;
type
TFileOpDlgLook = set of (fodl_from_lbl, fodl_to_lbl, fodl_first_pb, fodl_second_pb);
{ TfrmFileOp }
TfrmFileOp = class(TForm)
@ -45,10 +48,16 @@ type
private
{ Private declarations }
FOperationHandle: TOperationHandle;
FUpdateTimer: TTimer;
FUpdateTimer: TTimer; //<en Timer for updating statistics.
procedure OnUpdateTimer(Sender: TObject);
procedure InitializeControls(FileOpDlgLook: TFileOpDlgLook);
procedure InitializeCopyOperation(Operation: TFileSourceOperation);
procedure UpdateCopyOperation(Operation: TFileSourceOperation);
public
iProgress1Max: Integer;
iProgress1Pos: Integer;
@ -67,7 +76,9 @@ type
implementation
uses
fMain, dmCommonData, uFileOpThread, uFileSourceOperation, LCLProc;
fMain, dmCommonData, uFileOpThread, LCLProc, uLng,
uFileSourceOperationTypes,
uFileSourceCopyOperation;
procedure TfrmFileOp.btnCancelClick(Sender: TObject);
begin
@ -105,8 +116,11 @@ begin
end;
procedure TfrmFileOp.FormCreate(Sender: TObject);
var
Operation: TFileSourceOperation;
begin
Thread:= nil;
{
pbFirst.Position:= 0;
pbSecond.Position:= 0;
pbFirst.Max:= 1;
@ -115,17 +129,36 @@ begin
iProgress2Max:= 0;
iProgress1Pos:= 0;
iProgress2Pos:= 0;
}
lblFileNameFrom.Caption := '';
lblFileNameTo.Caption := '';
lblEstimated.Caption := '';
pbFirst.DoubleBuffered:= True;
pbSecond.DoubleBuffered:= True;
Self.DoubleBuffered:= True;
Operation := OperationsManager.GetOperationByHandle(FOperationHandle);
if Assigned(Operation) then
begin
case Operation.ID of
fsoCopyIn, fsoCopyOut:
InitializeCopyOperation(Operation);
else
begin
Caption := 'Unknown operation';
InitializeControls([fodl_first_pb]);
end;
end;
end;
FUpdateTimer := TTimer.Create(Self);
FUpdateTimer.Interval := 100;
FUpdateTimer.OnTimer := @OnUpdateTimer;
FUpdateTimer.Enabled := True;
pbFirst.Max := 100;
end;
procedure TfrmFileOp.FormShow(Sender: TObject);
@ -142,16 +175,37 @@ constructor TfrmFileOp.Create(OperationHandle: TOperationHandle);
begin
FOperationHandle := OperationHandle;
inherited Create(Application);
AutoSize := True;
end;
procedure TfrmFileOp.OnUpdateTimer(Sender: TObject);
var
Operation: TFileSourceOperation;
begin
Operation := OperationsManager.OperationByHandle[FOperationHandle];
Operation := OperationsManager.GetOperationByHandle(FOperationHandle);
if Assigned(Operation) then
begin
pbFirst.Position := Operation.Progress;
case Operation.ID of
fsoCopyOut:
UpdateCopyOperation(Operation);
else
// Operation not currently supported for display.
// Only show general progress.
pbFirst.Position := Operation.Progress;
end;
Caption := IntToStr(Operation.Progress) + '% ' + Hint;
{
// Estimate remaining time somehow (by progress or individual statistics).
if sEstimated <> lblEstimated.Caption then
begin
lblEstimated.Caption:= sEstimated;
lblEstimated.Invalidate;
end;
}
end
else
begin
@ -162,6 +216,50 @@ begin
end;
end;
procedure TfrmFileOp.InitializeControls(FileOpDlgLook: TFileOpDlgLook);
begin
lblFrom.Visible := fodl_from_lbl in FileOpDlgLook;
lblFileNameFrom.Visible := fodl_from_lbl in FileOpDlgLook;
lblTo.Visible := fodl_to_lbl in FileOpDlgLook;
lblFileNameTo.Visible := fodl_to_lbl in FileOpDlgLook;
pbFirst.Visible := fodl_first_pb in FileOpDlgLook;
pbSecond.Visible := fodl_second_pb in FileOpDlgLook;
end;
procedure TfrmFileOp.InitializeCopyOperation(Operation: TFileSourceOperation);
var
CopyOperation: TFileSourceCopyOperation;
begin
//CopyOperation := Operation as TFileSourceCopyOperation;
Caption := rsDlgCp;
InitializeControls([fodl_from_lbl, fodl_to_lbl, fodl_first_pb, fodl_second_pb]);
end;
procedure TfrmFileOp.UpdateCopyOperation(Operation: TFileSourceOperation);
var
CopyOperation: TFileSourceCopyOperation;
CopyStatistics: TFileSourceCopyOperationStatistics;
begin
CopyOperation := Operation as TFileSourceCopyOperation;
CopyStatistics := CopyOperation.RetrieveStatistics;
with CopyStatistics do
begin
lblFileNameFrom.Caption := CurrentFileFrom;
lblFileNameTo.Caption := CurrentFileTo;
if CurrentFileTotalBytes <> 0 then
pbFirst.Position := (CurrentFileDoneBytes * 100) div CurrentFileTotalBytes
else
pbFirst.Position := pbFirst.Max;
if TotalBytes <> 0 then
pbSecond.Position := (DoneBytes * 100) div TotalBytes
else
pbSecond.Position := pbSecond.Max;
end;
end;
procedure TfrmFileOp.ToggleProgressBarStyle;
begin
if (pbFirst.Style = pbstMarquee) and (pbSecond.Style = pbstMarquee) then

1
src/fmain.lfm
View file

@ -11,6 +11,7 @@ object frmMain: TfrmMain
Menu = mnuMain
OnActivate = FormActivate
OnClose = frmMainClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnDropFiles = FormDropFiles

12
src/fmain.pas
View file

@ -349,6 +349,7 @@ type
procedure dskToolButtonClick(Sender: TObject; NumberOfButton: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure FormWindowStateChange(Sender: TObject);
@ -761,6 +762,17 @@ begin
DestroyDrivesList(DrivesList);
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
if OperationsManager.OperationsCount > 0 then
begin
msgWarning('There are operations running!');
CanClose := False;
end
else
CanClose := True;
end;
procedure TfrmMain.FormDropFiles(Sender: TObject; const FileNames: array of String);
// This should not be needed for now as drag&drop should work through uDragDropEx.
{var

30
src/newdesign/fviewoperations.lfm
View file

@ -1,11 +1,12 @@
object frmViewOperations: TfrmViewOperations
Left = 295
Height = 246
Top = 181
Width = 634
Left = 192
Height = 259
Top = 192
Width = 644
Caption = 'frmViewOperations'
ClientHeight = 246
ClientWidth = 634
ClientHeight = 259
ClientWidth = 644
FormStyle = fsStayOnTop
OnCreate = FormCreate
LCLVersion = '0.9.27'
object lblOperationsCount: TLabel
@ -17,20 +18,21 @@ object frmViewOperations: TfrmViewOperations
ParentColor = False
end
object lblCount: TLabel
Left = 144
Left = 224
Height = 18
Top = 16
Width = 47
Caption = 'lblCount'
ParentColor = False
end
object lblProgress: TLabel
Left = 224
Height = 18
Top = 16
Width = 61
Caption = 'lblProgress'
ParentColor = False
object sboxOperations: TScrollBox
Left = 22
Height = 161
Top = 47
Width = 594
TabOrder = 0
OnDblClick = sboxOperationsDblClick
OnPaint = sboxOperationsPaint
end
object UpdateTimer: TTimer
Interval = 100

88
src/newdesign/fviewoperations.pas
View file

@ -14,12 +14,14 @@ type
{ TfrmViewOperations }
TfrmViewOperations = class(TForm)
lblProgress: TLabel;
lblCount: TLabel;
lblOperationsCount: TLabel;
sboxOperations: TScrollBox;
UpdateTimer: TTimer;
procedure FormCreate(Sender: TObject);
procedure OnUpdateTimer(Sender: TObject);
procedure sboxOperationsDblClick(Sender: TObject);
procedure sboxOperationsPaint(Sender: TObject);
private
procedure UpdateView(Operation: TFileSourceOperation);
@ -34,19 +36,30 @@ var
implementation
uses
uOperationsManager, lclproc;
uOperationsManager,
uFileSourceOperationTypes,
uFileSourceCopyOperation,
uLng, LCLProc, fFileOpDlg;
const
aRowHeight = 50;
{ TfrmViewOperations }
procedure TfrmViewOperations.FormCreate(Sender: TObject);
begin
lblCount.Caption := '0';
lblProgress.Caption := '0 %';
sboxOperations.AutoScroll := True;
sboxOperations.VertScrollBar.Visible := True;
OperationsManager.OnOperationAdded := @UpdateView;
OperationsManager.OnOperationRemoved := @UpdateView;
OperationsManager.OnOperationStarted := @UpdateView;
OperationsManager.OnOperationFinished := @UpdateView;
lblCount.Caption := IntToStr(OperationsManager.OperationsCount);
sboxOperations.Invalidate; // force redraw
end;
procedure TfrmViewOperations.OnUpdateTimer(Sender: TObject);
@ -58,10 +71,73 @@ begin
begin
// Timer is called from main thread, so it is safe
// to use reference to Operation from OperationsManager.
Operation := OperationsManager.OperationByIndex[i];
Operation := OperationsManager.GetOperationByIndex(i);
if Assigned(Operation) then
begin
lblProgress.Caption := IntToStr(Operation.Progress) + ' %';
sboxOperations.Invalidate; // force redraw
end;
end;
end;
procedure TfrmViewOperations.sboxOperationsDblClick(Sender: TObject);
var
OperationNumber: Integer;
CursorPos: TPoint;
Operation: TFileSourceOperation;
CopyDialog: TfrmFileOp;
begin
CursorPos := Mouse.CursorPos;
CursorPos := sboxOperations.ScreenToClient(CursorPos);
OperationNumber := CursorPos.Y div aRowHeight;
Operation := OperationsManager.GetOperationByIndex(OperationNumber);
if Assigned(Operation) then
begin
// Example for Copy operation for now.
if Operation is TFileSourceCopyOutOperation then
begin
CopyDialog := TfrmFileOp.Create(OperationsManager.GetHandleById(OperationNumber));
CopyDialog.Show;
end;
end;
end;
procedure TfrmViewOperations.sboxOperationsPaint(Sender: TObject);
var
Operation: TFileSourceOperation;
i: Integer;
OutString: String;
begin
for i := 0 to OperationsManager.OperationsCount - 1 do
begin
// Timer is called from main thread, so it is safe
// to use reference to Operation from OperationsManager.
Operation := OperationsManager.GetOperationByIndex(i);
if Assigned(Operation) then
begin
case Operation.ID of
fsoCopyIn, fsoCopyOut:
OutString := rsDlgCp;
else
OutString := 'Unknown operation';
end;
OutString := IntToStr(OperationsManager.GetHandleById(i)) + ': '
+ OutString + ' - '
+ IntToStr(Operation.Progress) + ' %';
sboxOperations.Canvas.Brush.Color := Canvas.Brush.Color;
sboxOperations.Canvas.Rectangle(0, 0 + (aRowHeight * i), sboxOperations.Width, aRowHeight + (aRowHeight * i));
sboxOperations.Canvas.TextOut(5, 5 + (aRowHeight * i), OutString);
sboxOperations.Caption := OutString;
sboxOperations.Canvas.Brush.Color := clHighlight;
sboxOperations.Canvas.FillRect(
5,
5 + (aRowHeight * i) + sboxOperations.Canvas.TextHeight('Pg'),
5 + (sboxOperations.Width - 10) * Operation.Progress div 100,
aRowHeight * (i + 1) - 5);
end;
end;
end;
@ -69,7 +145,7 @@ end;
procedure TfrmViewOperations.UpdateView(Operation: TFileSourceOperation);
begin
lblCount.Caption := IntToStr(OperationsManager.OperationsCount);
lblProgress.Caption := IntToStr(Operation.Progress) + ' %';
sboxOperations.Invalidate; // force redraw
end;
initialization

47
src/newdesign/ufilesourcecopyinoperation.pas
View file

@ -1,47 +0,0 @@
unit uFileSourceCopyInOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation;
type
{en
Operation that copies files from another file source into a file source of specific type
(to file system for TFileSystemCopyInOperation,
to network for TNetworkCopyInOperation, etc.).
Source file source must be a file system file source.
(Or is it enough if it's a file source with directly accessible files ? (DirectAccess flag))
Target file source should match the class type.
Example meaning of this operation:
- archive: pack
- network: upload
}
TFileSourceCopyInOperation = class(TFileSourceOperation)
public
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TFileSourceCopyInOperation.Create;
begin
inherited;
end;
destructor TFileSourceCopyInOperation.Destroy;
begin
inherited;
end;
end.

151
src/newdesign/ufilesourcecopyoperation.pas Normal file
View file

@ -0,0 +1,151 @@
unit uFileSourceCopyOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, syncobjs,
uFileSourceOperation,
uFileSourceOperationTypes;
type
// Statistics are the same for CopyIn and CopyOut operations.
TFileSourceCopyOperationStatistics = record
CurrentFileFrom: String;
CurrentFileTo: String;
CurrentFileTotalBytes: Int64;
CurrentFileDoneBytes: Int64;
TotalFiles: Int64;
DoneFiles: Int64;
TotalBytes: Int64;
DoneBytes: Int64;
end;
{en
Base class for CopyIn and CopyOut operations.
}
TFileSourceCopyOperation = class(TFileSourceOperation)
private
FStatistics: TFileSourceCopyOperationStatistics;
FStatisticsLock: TCriticalSection; //<en For synchronizing statistics.
protected
procedure UpdateStatistics(NewStatistics: TFileSourceCopyOperationStatistics);
public
constructor Create; override;
destructor Destroy; override;
function RetrieveStatistics: TFileSourceCopyOperationStatistics;
end;
{en
Operation that copies files from another file source into a file source of specific type
(to file system for TFileSystemCopyInOperation,
to network for TNetworkCopyInOperation, etc.).
Source file source must be a file system file source.
(Or is it enough if it's a file source with directly accessible files ? (DirectAccess flag))
Target file source should match the class type.
Example meaning of this operation:
- archive: pack
- network: upload
}
TFileSourceCopyInOperation = class(TFileSourceCopyOperation)
protected
function GetID: TFileSourceOperationType; override;
end;
{en
Operation that copies files into another file source from a file source of specific type
(from file system for TFileSystemCopyOutOperation,
from network for TNetworkCopyOutOperation, etc.).
Source file source should match the class type.
Target file source must be a file system file source.
(Or is it enough if it's a file source with directly accessible files ? (DirectAccess flag))
Example meaning of this operation:
- archive: unpack
- network: download
}
TFileSourceCopyOutOperation = class(TFileSourceCopyOperation)
protected
function GetID: TFileSourceOperationType; override;
end;
implementation
// -- TFileSourceCopyOperation ------------------------------------------------
constructor TFileSourceCopyOperation.Create;
begin
with FStatistics do
begin
CurrentFileFrom := '';
CurrentFileTo := '';
TotalFiles := 0;
DoneFiles := 0;
TotalBytes := 0;
DoneBytes := 0;
CurrentFileTotalBytes := 0;
CurrentFileDoneBytes := 0;
end;
FStatisticsLock := TCriticalSection.Create;
inherited Create;
end;
destructor TFileSourceCopyOperation.Destroy;
begin
inherited Destroy;
FreeAndNil(FStatisticsLock);
end;
procedure TFileSourceCopyOperation.UpdateStatistics(NewStatistics: TFileSourceCopyOperationStatistics);
begin
FStatisticsLock.Acquire;
try
Self.FStatistics := NewStatistics;
finally
FStatisticsLock.Release;
end;
end;
function TFileSourceCopyOperation.RetrieveStatistics: TFileSourceCopyOperationStatistics;
begin
FStatisticsLock.Acquire;
try
Result := Self.FStatistics;
finally
FStatisticsLock.Release;
end;
end;
// -- TFileSourceCopyInOperation ----------------------------------------------
function TFileSourceCopyInOperation.GetID: TFileSourceOperationType;
begin
Result := fsoCopyIn;
end;
// -- TFileSourceCopyOutOperation ---------------------------------------------
function TFileSourceCopyOutOperation.GetID: TFileSourceOperationType;
begin
Result := fsoCopyOut;
end;
end.

47
src/newdesign/ufilesourcecopyoutoperation.pas
View file

@ -1,47 +0,0 @@
unit uFileSourceCopyOutOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation;
type
{en
Operation that copies files into another file source from a file source of specific type
(from file system for TFileSystemCopyOutOperation,
from network for TNetworkCopyOutOperation, etc.).
Source file source should match the class type.
Target file source must be a file system file source.
(Or is it enough if it's a file source with directly accessible files ? (DirectAccess flag))
Example meaning of this operation:
- archive: unpack
- network: download
}
TFileSourceCopyOutOperation = class(TFileSourceOperation)
public
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TFileSourceCopyOutOperation.Create;
begin
inherited;
end;
destructor TFileSourceCopyOutOperation.Destroy;
begin
inherited;
end;
end.

85
src/newdesign/ufilesourcedeleteoperation.pas
View file

@ -1,38 +1,47 @@
unit uFileSourceDeleteOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation;
type
{en
Operation that deletes files from an arbitrary file source.
File source should match the class type.
}
TFileSourceDeleteOperation = class(TFileSourceOperation)
public
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TFileSourceDeleteOperation.Create;
begin
inherited;
end;
destructor TFileSourceDeleteOperation.Destroy;
begin
inherited;
end;
end.
unit uFileSourceDeleteOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes;
type
{en
Operation that deletes files from an arbitrary file source.
File source should match the class type.
}
TFileSourceDeleteOperation = class(TFileSourceOperation)
protected
function GetID: TFileSourceOperationType; override;
public
constructor Create; override;
destructor Destroy; override;
end;
implementation
constructor TFileSourceDeleteOperation.Create;
begin
inherited;
end;
destructor TFileSourceDeleteOperation.Destroy;
begin
inherited;
end;
function TFileSourceDeleteOperation.GetID: TFileSourceOperationType;
begin
Result := fsoDelete;
end;
end.

130
src/newdesign/ufilesourcelistoperation.pas
View file

@ -1,61 +1,69 @@
unit uFileSourceListOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFile;
type
TFileSourceListOperation = class(TFileSourceOperation)
protected
FFiles: TFiles;
function GetFiles: TFiles;
public
constructor Create; override;
destructor Destroy; override;
// Retrieves files and revokes ownership of TFiles list.
// The result of this function should be freed by the caller.
function ReleaseFiles: TFiles;
property Files: TFiles read GetFiles;
end;
implementation
constructor TFileSourceListOperation.Create;
begin
FFiles := TFiles.Create;
inherited Create;
end;
destructor TFileSourceListOperation.Destroy;
begin
inherited Destroy;
if Assigned(FFiles) then
FreeAndNil(FFiles);
end;
function TFileSourceListOperation.GetFiles: TFiles;
begin
Result := FFiles;
end;
function TFileSourceListOperation.ReleaseFiles: TFiles;
begin
Result := FFiles;
FFiles := nil; // revoke ownership
end;
end.
unit uFileSourceListOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uFile;
type
TFileSourceListOperation = class(TFileSourceOperation)
protected
FFiles: TFiles;
function GetFiles: TFiles;
function GetID: TFileSourceOperationType; override;
public
constructor Create; override;
destructor Destroy; override;
// Retrieves files and revokes ownership of TFiles list.
// The result of this function should be freed by the caller.
function ReleaseFiles: TFiles;
property Files: TFiles read GetFiles;
end;
implementation
constructor TFileSourceListOperation.Create;
begin
FFiles := TFiles.Create;
inherited Create;
end;
destructor TFileSourceListOperation.Destroy;
begin
inherited Destroy;
if Assigned(FFiles) then
FreeAndNil(FFiles);
end;
function TFileSourceListOperation.GetID: TFileSourceOperationType;
begin
Result := fsoList;
end;
function TFileSourceListOperation.GetFiles: TFiles;
begin
Result := FFiles;
end;
function TFileSourceListOperation.ReleaseFiles: TFiles;
begin
Result := FFiles;
FFiles := nil; // revoke ownership
end;
end.

240
src/newdesign/ufilesourceoperation.pas
View file

@ -1,100 +1,140 @@
unit uFileSourceOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
guidIFileSourceOperationUI = '{3BC28C8B-8A3E-4F71-8828-52483B8C057A}';
type
TFileSourceOperationState =
(fsosNotStarted, //<en before operation has started
fsosStarting, //<en responded to Start command
fsosRunning,
fsosPausing, //<en responded to Pause command
fsosPaused,
fsosStopping, //<en responded to Stop command
fsosStopped); //<en finished due to Stop command or on its own
TFileSourceOperationStopReason =
(fssrFinished, //<en normal finish
fssrAborted); //<en aborted due to Stop command (by user)
TFileSourceOperation = class
protected
FState: TFileSourceOperationState; // both must be synchronized
FStopReason: TFileSourceOperationStopReason;
{en
Should return a general progress (0-100) of the operation.
Specific statistics are returned by the individual operations.
It is only read from the main thread and written to by operation
executing thread, thus probably doesn't need synchronization.
}
function GetProgress: Integer; virtual abstract;
public
constructor Create; virtual;
{en
Tries to execute operation.
First immediately sets state to fsosStarting and after it is started to fsosRunning.
}
procedure Execute; virtual abstract;
{en
Tries to put operation into a paused state.
First immediately sets state to fsosPausing and after it is paused to fsosPaused.
}
procedure Pause; virtual abstract;
{en
Tries to stop operation.
First immediately sets state to fsosStopping and after it is stopped to fsosStopped.
}
procedure Stop; virtual abstract;
property Progress: Integer read GetProgress;
end;
{en
Interface used by each operation to communicate
with the main application and the user.
The operations are able to use different interfaces for communicating
(message boxes, logging in edit controls or file with no questions,
through console, ...).
When operation has no communication interface it runs silent by
any options it has set (for example: overwrite all or skip all).
}
IFileSourceOperationUI = interface [guidIFileSourceOperationUI]
{en If the operation should terminate.}
function Terminate: Boolean;
// While copying file exists. Ask what to do:
//function FileExists: what to do;
// FileReadOnly
// AskOverwrite
// etc.
end;
implementation
constructor TFileSourceOperation.Create;
begin
inherited Create;
FState := fsosNotStarted;
FStopReason := fssrFinished;
end;
end.
unit uFileSourceOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperationTypes;
const
guidIFileSourceOperationUI = '{3BC28C8B-8A3E-4F71-8828-52483B8C057A}';
type
TFileSourceOperationState =
(fsosNotStarted, //<en before operation has started
fsosStarting, //<en responded to Start command
fsosRunning,
fsosPausing, //<en responded to Pause command
fsosPaused,
fsosWaitingForFeedback, //<en waiting for a response from a user through the assigned UI
fsosStopping, //<en responded to Stop command
fsosStopped); //<en finished due to Stop command or on its own
TFileSourceOperationStopReason =
(fssrFinished, //<en normal finish
fssrAborted); //<en aborted due to Stop command (by user)
{en
Base class for each file source operation.
}
TFileSourceOperation = class
private
FProgress: Integer;
{en
Should return a general progress (0-100) of the operation.
Specific statistics are returned by the individual operations.
It is only read from the main thread and written to by operation
executing thread, thus probably doesn't need synchronization.
}
function GetProgress: Integer;
protected
FState: TFileSourceOperationState; // both must be synchronized
FStopReason: TFileSourceOperationStopReason;
procedure UpdateProgress(NewProgress: Integer);
{en
This should be set to the correct file operation type in each concrete descendant.
We rely on this when making a decision based on operation type. This way
it's easier to maintain different sorts of things we can do with operations
and statistics, without having to include knowledge of those things
in the operations classes hierarchy.
}
function GetID: TFileSourceOperationType; virtual abstract;
public
constructor Create; virtual;
destructor Destroy; override;
{en
Tries to execute operation.
First immediately sets state to fsosStarting and after it is started to fsosRunning.
}
procedure Execute; virtual abstract;
{en
Tries to put operation into a paused state.
First immediately sets state to fsosPausing and after it is paused to fsosPaused.
}
procedure Pause; virtual abstract;
{en
Tries to stop operation.
First immediately sets state to fsosStopping and after it is stopped to fsosStopped.
}
procedure Stop; virtual abstract;
property Progress: Integer read GetProgress;
property ID: TFileSourceOperationType read GetID;
end;
{en
Interface used by each operation to communicate
with the main application and the user.
The operations are able to use different interfaces for communicating
(message boxes, logging in edit controls or file with no questions,
through console, ...).
When operation has no communication interface it runs silent by
any options it has set (for example: overwrite all or skip all).
}
IFileSourceOperationUI = interface [guidIFileSourceOperationUI]
{en If the operation should terminate.}
function Terminate: Boolean;
// While copying file exists. Ask what to do:
//function FileExists: what to do;
// FileReadOnly
// AskOverwrite
// etc.
end;
implementation
constructor TFileSourceOperation.Create;
begin
FState := fsosNotStarted;
FStopReason := fssrFinished;
FProgress := 0;
inherited Create;
end;
destructor TFileSourceOperation.Destroy;
begin
inherited Destroy;
end;
function TFileSourceOperation.GetProgress: Integer;
begin
// Doesn't need synchronization.
Result := FProgress;
end;
procedure TFileSourceOperation.UpdateProgress(NewProgress: Integer);
begin
// Doesn't need synchronization.
FProgress := NewProgress;
end;
end.

258
src/newdesign/ufilesystemcopyoperation.pas
View file

@ -1,119 +1,139 @@
unit uFileSystemCopyOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceCopyInOperation,
uFileSourceCopyOutOperation,
uFileSystemFileSource,
uFileSource,
uFile;
type
{
Both operations are the same, just source and target reversed.
Implement them in terms of the same functions,
or have one use the other.
}
TFileSystemCopyInOperation = class(TFileSourceCopyInOperation)
private
FSourceFileSource: TFileSystemFileSource;
FTargetFileSource: TFileSystemFileSource;
FSourceFiles: TFiles;
FTargetFiles: TFiles;
public
constructor Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles); reintroduce;
procedure Execute; override;
end;
TFileSystemCopyOutOperation = class(TFileSourceCopyOutOperation)
private
FSourceFileSource: TFileSystemFileSource;
FTargetFileSource: TFileSystemFileSource;
FSourceFiles: TFiles;
FTargetFiles: TFiles;
FProgress: Integer;
protected
function GetProgress: Integer; override;
public
constructor Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles); reintroduce;
procedure Execute; override;
end;
implementation
// -- TFileSystemCopyInOperation ----------------------------------------------
constructor TFileSystemCopyInOperation.Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles);
begin
inherited Create;
FSourceFileSource := SourceFileSource;
FTargetFileSource := TargetFileSource;
FSourceFiles := SourceFiles;
FTargetFiles := TargetFiles;
end;
procedure TFileSystemCopyInOperation.Execute;
begin
end;
// -- TFileSystemCopyOutOperation ---------------------------------------------
constructor TFileSystemCopyOutOperation.Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles);
begin
inherited Create;
FSourceFileSource := SourceFileSource;
FTargetFileSource := TargetFileSource;
FSourceFiles := SourceFiles;
FTargetFiles := TargetFiles;
FProgress := 0;
end;
function TFileSystemCopyOutOperation.GetProgress: Integer;
begin
Result := FProgress;
end;
procedure TFileSystemCopyOutOperation.Execute;
var
i: Integer;
begin
// Some dummy long operation for now.
for i := 1 to 300 do
begin
Sleep(50);
FProgress := (i * 100) div 300;
end;
end;
end.
unit uFileSystemCopyOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceCopyOperation,
uFileSystemFileSource,
uFileSource,
uFile;
type
{
Both operations are the same, just source and target reversed.
Implement them in terms of the same functions,
or have one use the other.
}
TFileSystemCopyInOperation = class(TFileSourceCopyInOperation)
private
FSourceFileSource: TFileSystemFileSource;
FTargetFileSource: TFileSystemFileSource;
FSourceFiles: TFiles;
FTargetFiles: TFiles;
public
constructor Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles); reintroduce;
procedure Execute; override;
end;
TFileSystemCopyOutOperation = class(TFileSourceCopyOutOperation)
private
FSourceFileSource: TFileSystemFileSource;
FTargetFileSource: TFileSystemFileSource;
FSourceFiles: TFiles;
FTargetFiles: TFiles;
public
constructor Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles); reintroduce;
procedure Execute; override;
end;
implementation
// -- TFileSystemCopyInOperation ----------------------------------------------
constructor TFileSystemCopyInOperation.Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles);
begin
inherited Create;
FSourceFileSource := SourceFileSource;
FTargetFileSource := TargetFileSource;
FSourceFiles := SourceFiles;
FTargetFiles := TargetFiles;
end;
procedure TFileSystemCopyInOperation.Execute;
begin
end;
// -- TFileSystemCopyOutOperation ---------------------------------------------
constructor TFileSystemCopyOutOperation.Create(SourceFileSource: TFileSystemFileSource;
TargetFileSource: TFileSystemFileSource;
SourceFiles: TFiles;
TargetFiles: TFiles);
begin
inherited Create;
FSourceFileSource := SourceFileSource;
FTargetFileSource := TargetFileSource;
FSourceFiles := SourceFiles;
FTargetFiles := TargetFiles;
end;
procedure TFileSystemCopyOutOperation.Execute;
var
i: Integer;
Statistics: TFileSourceCopyOperationStatistics;
begin
// Get initialized statistics; then we change only what is needed.
Statistics := RetrieveStatistics;
with Statistics do
begin
TotalBytes := 300 * 50;
TotalFiles := 300;
end;
// Some dummy long operation for now.
for i := 1 to 300 do
begin
with Statistics do
begin
CurrentFileFrom := 'sourceFile_' + inttostr(i) +'.pas';
CurrentFileTo := 'targetFile_'+ inttostr(i)+ '.pas';
end;
UpdateStatistics(Statistics);
// Main work single step.
Sleep(50);
// Update overall progress.
// (should this be under the same lock as statistics?)
UpdateProgress((i * 100) div 300);
// Update specific statistics.
with Statistics do
begin
DoneFiles := DoneFiles + 1;
DoneBytes := DoneBytes + 50;
end;
end;
// Final statistics.
UpdateStatistics(Statistics);
UpdateProgress(100);
end;
end.

78
src/newdesign/uoperationsmanager.pas
View file

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, ExtCtrls, LCLIntf, syncobjs,
uOperationThread, uFileSourceOperation;
uOperationThread, uFileSourceOperation, lclproc;
type
@ -18,14 +18,25 @@ const
type
{en
Possible options when adding a new operation.
}
TOperationStartingState =
(ossDontStart, //<en Don't start automatically.
ossAutoStart, //<en Start automatically.
ossQueue); //<en Don't start automatically,
//<en unless there are no other operations working.
POperationsManagerEntry = ^TOperationsManagerEntry;
TOperationsManagerEntry = record
Thread : TOperationThread;
Operation: TFileSourceOperation;
Handle : TOperationHandle;
Thread : TOperationThread;
Operation : TFileSourceOperation;
Handle : TOperationHandle;
StartingState: TOperationStartingState;
end;
TOperationManagerEvent = procedure(Operation: TFileSourceOperation) of object;
{en
Manages file source operations.
Executes them, stores threads, allows querying active operations
@ -35,7 +46,7 @@ type
private
FOperations: TFPList; //<en List of TOperationsManagerEntry
FLock: TCriticalSection;
FNextUnusedHandle: TOperationHandle;
FLastUsedHandle: TOperationHandle;
// Events follow.
// (do this with multiple listeners, so many viewers can look through active operations).
@ -53,8 +64,6 @@ type
procedure ThreadTerminatedEvent(Sender: TObject);
function GetOperationsCount: Integer;
function GetOperationByIndex(Index: Integer): TFileSourceOperation;
function GetOperationByHandle(Handle: TOperationHandle): TFileSourceOperation;
function GetNextUnusedHandle: TOperationHandle;
@ -63,10 +72,18 @@ type
destructor Destroy; override;
function AddOperation(Operation: TFileSourceOperation;
StartImmediately: Boolean): TOperationHandle;
StartingState: TOperationStartingState): TOperationHandle;
{en
Operations retrieved this way can be safely used from the main GUI thread.
But they should not be stored for longer use, because they
may be destroyed by the Operations Manager when they finish.
}
function GetOperationByIndex(Index: Integer): TFileSourceOperation;
function GetOperationByHandle(Handle: TOperationHandle): TFileSourceOperation;
function GetHandleById(Index: Integer): TOperationHandle;
property OperationByIndex[Index: Integer]: TFileSourceOperation read GetOperationByIndex;
property OperationByHandle[Handle: TOperationHandle]: TFileSourceOperation read GetOperationByHandle;
property OperationsCount: Integer read GetOperationsCount;
// Events.
@ -85,7 +102,7 @@ constructor TOperationsManager.Create;
begin
FOperations := TFPList.Create;
FLock := TCriticalSection.Create;
FNextUnusedHandle := 1; // Start from 1.
FLastUsedHandle := 0;
FOnOperationAdded := nil;
FOnOperationRemoved := nil;
@ -106,7 +123,7 @@ begin
end;
function TOperationsManager.AddOperation(Operation: TFileSourceOperation;
StartImmediately: Boolean): TOperationHandle;
StartingState: TOperationStartingState): TOperationHandle;
var
Thread: TOperationThread;
Entry: POperationsManagerEntry;
@ -128,6 +145,7 @@ begin
Entry^.Operation := Operation;
Entry^.Thread := Thread;
Entry^.Handle := GetNextUnusedHandle;
Entry^.StartingState := StartingState;
FOperations.Add(Entry);
@ -141,7 +159,7 @@ begin
if Assigned(FOnOperationAdded) then
FOnOperationAdded(Operation);
if StartImmediately then
if StartingState = ossAutoStart then
begin
Thread.Resume;
@ -171,7 +189,7 @@ begin
if (Index >= 0) and (Index < FOperations.Count) then
begin
Entry := POperationsManagerEntry(FOperations.Items[Index]);
if Assigned(Entry) and Assigned(Entry^.Operation) then
if Assigned(Entry^.Operation) then
Result := Entry^.Operation;
end
else
@ -200,33 +218,45 @@ begin
end;
end;
function TOperationsManager.GetHandleById(Index: Integer): TOperationHandle;
var
Entry: POperationsManagerEntry = nil;
begin
if (Index >= 0) and (Index < FOperations.Count) then
begin
Entry := POperationsManagerEntry(FOperations.Items[Index]);
Result := Entry^.Handle;
end
else
Result := InvalidOperationHandle;
end;
function TOperationsManager.GetNextUnusedHandle: TOperationHandle;
begin
// Handles are consecutively incremented.
// Even if they overflow there is little probability that
// there will be that many operations.
Result := InterLockedIncrement(FNextUnusedHandle);
Result := InterLockedIncrement(FLastUsedHandle);
if Result = InvalidOperationHandle then
Result := InterLockedIncrement(FNextUnusedHandle);
Result := InterLockedIncrement(FLastUsedHandle);
end;
procedure TOperationsManager.ThreadTerminatedEvent(Sender: TObject);
var
Thread: TOperationThread;
Entry: POperationsManagerEntry = nil;
i: Integer;
Index: Integer = -1;
begin
// This function is executed from the main thread (through Synchronize).
// This function is executed from the GUI thread (through Synchronize).
Thread := Sender as TOperationThread;
// Search the terminated in the operations list.
for i := 0 to FOperations.Count - 1 do
// Search the terminated thread in the operations list.
for Index := 0 to FOperations.Count - 1 do
begin
Entry := POperationsManagerEntry(FOperations.Items[i]);
Entry := POperationsManagerEntry(FOperations.Items[Index]);
if Entry^.Thread = Thread then
begin
FOperations.Delete(i);
break;
end;
end;
@ -236,11 +266,13 @@ begin
if Assigned(FOnOperationFinished) then
FOnOperationFinished(Entry^.Operation);
FreeAndNil(Entry^.Thread);
FOperations.Delete(Index);
if Assigned(FOnOperationRemoved) then
FOnOperationRemoved(Entry^.Operation);
Entry^.Thread := nil; // Thread frees himself automatically on terminate.
// Here the operation should not be used anymore
// (by the thread and by any operations viewer).
FreeAndNil(Entry^.Operation);

4
src/newdesign/uoperationthread.pas
View file

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils,
uFileSourceOperation;
uFileSourceOperation, LCLProc;
type
@ -36,7 +36,7 @@ implementation
constructor TOperationThread.Create(CreateSuspended: Boolean; Operation: TFileSourceOperation);
begin
FreeOnTerminate := False;
FreeOnTerminate := True;
FOperation := Operation;
//FOperation.UI.Terminate := @CheckTerminated;

2
src/uacts.pas
View file

@ -1289,7 +1289,7 @@ begin
// Dummy operation for testing.
debugln('Starting copy operation');
Operation := TFileSystemCopyOutOperation.Create(nil,nil,nil,nil);
OperationHandle := OperationsManager.AddOperation(Operation, True);
OperationHandle := OperationsManager.AddOperation(Operation, ossAutoStart);
// The OperationHandle should now be passed to the dialog displaying progress.

3
src/udeletethread.pas
View file

@ -18,7 +18,8 @@ unit uDeleteThread;
interface
uses
uFileOpThread, uFileList, uTypes, SysUtils, LCLProc;
uFileOpThread, uFileList, uTypes, SysUtils, LCLProc,
fFileOpDlg;
type

2
src/ufileopthread.pas
View file

@ -23,8 +23,6 @@ uses
Classes, uFileList, fFileOpDlg, uTypes, uDescr, fMsg, uShowMsg {$IFNDEF NOFAKETHREAD}, uFakeThread{$ENDIF};
type
TFileOpDlgLook = set of (fodl_from_lbl, fodl_to_lbl, fodl_first_pb, fodl_second_pb);
{ TFileOpThread }
{$IFDEF NOFAKETHREAD}
TFileOpThread = class(TThread)

2
src/uwipethread.pas
View file

@ -46,7 +46,7 @@ unit uWipeThread;
interface
uses
uFileOpThread, uFileList, uTypes, SysUtils, LCLProc;
uFileOpThread, uFileList, uTypes, SysUtils, LCLProc, fFileOpDlg;
type