Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Delphi correct use of tasks

Tags:

delphi

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?

like image 791
Alberto Miola Avatar asked Sep 19 '16 15:09

Alberto Miola


2 Answers

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;
like image 76
Remy Lebeau Avatar answered Nov 16 '22 15:11

Remy Lebeau


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.

like image 33
J... Avatar answered Nov 16 '22 15:11

J...