SITUATION
To better understand the PPL and how a Task
works I tried to make a very easy program in which, once you have clicked a button, a ListBox
is filled with a list of directories in the disk.
procedure TForm3.Button1Click(Sender: TObject);
var proc: ITask;
begin
//Show that something is going to happen
Button1.Caption := 'Process...';
proc := TTask.Create(
procedure
var strPath: string;
sl: TStringDynArray;
begin
if (DirectoryExists('C:\Users\albertoWinVM\Documents\uni\maths')) then
begin
ListBox1.Items.Clear;
sl := TDirectory.GetDirectories('C:\Users\albertoWinVM\Documents\uni\maths',
TSearchOption.soAllDirectories, nil);
for strPath in sl do
begin
ListBox1.Items.Add(strPath);
end;
//At the end of the task, I restore the original caption of the button
Button1.Caption := 'Go';
Label1.Caption := 'Finished';
end;
end
);
proc.Start;
end;
The folder maths
you can see above is not very huge and the task takes about 3 seconds to execute. The task is declared as follows:
type
TForm3 = class(TForm)
ListBox1: TListBox;
//... other published things var ...
private
proc: ITask;
public
//... public var ...
end;
PROBLEM
When I work (for example) with C:\Users\albertoWinVM\Documents
I have a very big amount of folders and the program takes up to 3 minutes before filling the ListBox.
If I closed the program (while the task is still running) having only the code above, from what I have understood reading online, the task will still run until he hasn't finished. Am I correct?
procedure TForm3.FormDestroy(Sender: TObject);
begin
proc.Cancel;
end;
I thought that I could add this code to improve the safety of the program. Is that enough?
TTask
runs in a worker thread. As shown, your Task code is not thread-safe. You must sync with the main UI thread when accessing UI controls.
You are not managing your proc
variable correctly. You have a proc
variable declared as a member of your TForm3
class, but you also have a local proc
variable declared in your Button1Click()
method. The method is assigning the new task to the local variable, the class member is never being assigned.
And no, it is not enough to just call Cancel()
on the TTask
. Your task procedure needs to periodically check if the task has been cancelled so it can stop its work (the only way to cancel TDirectory.GetDirectories()
is to have its predicate filter raise an exception).
Since TDirectory.GetDirectories()
does not exit until all directories have been located and stored in the returned list, if you need a more responsible task and a faster UI result, or if you just want to reduce memory usage, you should use FindFirst()
/FindNext()
in a manual loop instead, then you can update the UI and check for cancel in between loop iterations as needed.
With that said, try something more like this:
type
TForm3 = class(TForm)
ListBox1: TListBox;
//...
private
proc: ITask;
procedure AddToListBox(batch: TStringDynArray);
procedure TaskFinished;
public
//...
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
if Assigned(proc) then
begin
ShowMessage('Task is already running');
Exit;
end;
//Show that something is going to happen
Button1.Caption := 'Process...';
proc := TTask.Create(
procedure
var
strFolder: string;
sr: TSearchRec;
batch: TStringDynArray;
numInBatch: Integer;
begin
try
strFolder := 'C:\Users\albertoWinVM\Documents\uni\maths\';
if FindFirst(strFolder + '*.*', faAnyFile, sr) = 0 then
try
TThread.Queue(nil, ListBox1.Items.Clear);
batch := nil;
repeat
Form3.proc.CheckCanceled;
if (sr.Attr and faDirectory) <> 0 then
begin
if (sr.Name <> '.') and (sr.Name <> '..') then
begin
if not Assigned(batch) then
begin
SetLength(batch, 25);
numInBatch := 0;
end;
batch[numInBatch] := strFolder + sr.Name;
Inc(numInBatch);
if numInBatch = Length(batch) then
begin
AddToListBox(batch);
batch := nil;
numInBatch := 0;
end;
end;
end;
until FindNext(sr) <> 0;
finally
FindClose(sr);
end;
if numInBatch > 0 then
begin
SetLength(batch, numInBatch)
AddToListBox(batch);
end;
finally
TThread.Queue(nil, TaskFinished);
end;
end
);
proc.Start;
end;
procedure TForm3.AddToListBox(batch: TStringDynArray);
begin
TThread.Queue(nil,
procedure
begin
ListBox1.Items.AddStrings(batch);
end
end);
end;
procedure TForm3.TaskFinished;
begin
proc := nil;
Button1.Caption := 'Go';
Label1.Caption := 'Finished';
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
if Assigned(proc) then
begin
proc.Cancel;
repeat
if not proc.Wait(1000) then
CheckSynchronize;
until proc = nil;
end;
end;
You cannot manipulate UI objects in threads other than the main thread. You must synchronize access to these objects. All types of unexpected (ie: bad) things start to happen when you have multiple threads trying to operate on UI objects simultaneously.
For example - extract the work you intend to do with the resulting directory listing once you have it and put it into a separate method :
procedure TForm1.UpdateDirectoryList(AList : TStringDynArray);
var
strPath : string;
begin
ListBox1.Items.BeginUpdate;
ListBox1.Items.Clear;
for strPath in AList do ListBox1.Items.Add(strPath);
ListBox1.Items.EndUpdate;
Button1.Caption := 'Go';
Label1.Caption := 'Finished';
end;
Then, have your task queue this method for the UI thread to execute when it completes its long-running work :
procedure TForm1.Button1Click(Sender: TObject);
var proc: ITask;
begin
Button1.Caption := 'Process...';
ListBox1.Items.Clear;
proc := TTask.Create(
procedure
var
sl: TStringDynArray;
begin
if (DirectoryExists('C:\Users\albertoWinVM\Documents\uni\maths')) then
begin
sl := TDirectory.GetDirectories('C:\Users\albertoWinVM\Documents\uni\maths',
TSearchOption.soAllDirectories, nil);
TThread.Queue(nil, procedure
begin
UpdateDirectoryList(sl);
end);
end;
end);
proc.Start;
end;
This way, your task is operating solely on private data which it then returns to the main thread when it is complete - nobody steps on each others toes.
When cancelling the thread it is not enough to simply call ITask.Cancel
- you must wait for it to finish. Ideally, your task should periodically call .CheckCanceled
so that it can finish in a timely manner if and when it is cancelled externally. CheckCanceled
will raise EOperationCancelled
if the task has been cancelled so you should handle that and exit as soon as possible. If you search as @Remy has suggested, this becomes much easier since you have opportunity at each loop iteration to check for cancellation.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With