Delphi正确使用任务的方法

Question

情境

为了更好地理解PPL和Task的工作原理，我尝试编写了一个非常简单的程序。当您点击一个按钮时，会在ListBox中填充磁盘上的目录列表。

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;

你可以在上面看到maths文件夹并不是很大，执行该任务大约需要3秒钟。该任务的声明如下：

type
  TForm3 = class(TForm)
    ListBox1: TListBox;
    //... other published things var ...
  private
    proc: ITask;
  public
    //... public var ...
  end;

---

问题

当我使用例如C:\Users\albertoWinVM\Documents这样的路径来工作时，我有很多文件夹，程序要花费长达3分钟才能填满ListBox。

如果我关闭程序（而任务仍在运行），只有上面的代码，从我在网上阅读所了解的来看，任务仍将继续运行，直到它完成。我理解得对吗？

procedure TForm3.FormDestroy(Sender: TObject);
begin
 proc.Cancel;
end;

我认为添加这段代码可以提高程序的安全性。这样就足够了吗？

- Alberto Miola

Answer 1

TTask 运行在一个工作线程中。如示所示，你的 Task 代码不是线程安全的。当访问 UI 控件时，你必须与主 UI 线程同步。

你没有正确地管理你的 proc 变量。你在你的 Button1Click() 方法中声明了一个本地的 proc 变量，但是你的 TForm3 类的成员也有一个 proc 变量。该方法正在将新任务分配给本地变量，类成员从未被赋值。

而且，仅仅调用TTask上的Cancel()是不够的。你的任务过程需要定期检查是否已取消任务，以便可以停止其工作（取消TDirectory.GetDirectories()的唯一方法是使它的谓词筛选器引发异常）。

由于TDirectory.GetDirectories()直到所有目录都被找到并存储在返回的列表中才退出，如果你需要更负责任的任务和更快的 UI 结果，或者只想减少内存使用量，你应该使用手动循环中的FindFirst()/FindNext()，然后你可以根据需要在循环迭代之间更新UI并检查取消。

有了这些说法，尝试使用以下示例代码：

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;

- Remy Lebeau

---

对于大型目录列表（或任何大型列表），批量更新用户界面可能非常有用。任务可以累积几十个项目，然后使用BeginUpdate和EndUpdate在列表框上进行批量更新 - 更新每个项目可能会影响性能。这还自然地产生了一个很好的间隔，以便调用CheckCanceled，以便.Cancel能够及时使proc.Wait()返回。 - J...

我在发帖之前考虑过这个问题，但涉及到内存管理和对象所有权的问题。不过，我已经更新了我的答案。 - Remy Lebeau

没想到你更新了你的答案 - 只是把它留给OP作为一个想法。我也没有在我的答案中包含它，原因相同；一切都变得非常复杂。无论如何+1！ - J...

好的，现在我对TTask有了更好的理解，同时感谢您提供比GetDirectories()更好的方法。 - Alberto Miola

我相信你的编辑破坏了代码...将批处理变量传递给匿名方法，然后立即重置其值。 - Darian Miller

@DarianMiller，我已经更新了我的代码来修复那个问题。 - Remy Lebeau

Answer 2

在除主线程之外的线程中，您不能操作UI对象。您必须同步访问这些对象。当多个线程同时尝试操作UI对象时，各种意外（即：糟糕）情况开始发生。

例如-提取您打算在结果目录列表中执行的工作，并将其放入单独的方法中：

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;

然后，让您的任务队列在长时间运行的工作完成时将此方法排队到UI线程执行：

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;

这��一来，您的任务只会操作私有数据，当任务完成时，它将把数据返回到主线程 - 不会互相干扰。

取消线程时，仅调用 ITask.Cancel 是不够的，您必须等待其完成。最好的做法是，您的任务应定期调用 .CheckCanceled，以便在外部取消时及时完成。如果任务已被取消，CheckCanceled 将引发 EOperationCancelled，因此您应该尽快处理并退出。像 @Remy 建议的那样搜索，这样做会更容易，因为您可以在每个循环迭代中检查是否已取消。

- J...