Delphi:将异常捕获到TTask中并引发到主线程

Question

我想捕获从主窗体/主线程引发到 TTask 的异常

var
    aTasks: array of ITask;
begin
    Setlength(aTasks, 2);

    aTasks[0] := TTask.Create(procedure begin
        raise Exception.Create('Error1');
    end);
    aTasks[0].Start;

    aTasks[1] := TTask.Create(procedure begin
        raise Exception.Create('Error2');
    end);
    aTasks[1].Start;

    TTask.WaitForAll(aTasks);
end;

进入主窗体(主线程)我看到这个:

我 try catch 异常并重新引发到主线程

var
    aTasks: array of ITask;
begin
    Setlength(aTasks, 2);

    aTasks[0] := TTask.Create(procedure begin
        try
            raise Exception.Create('Error1');
        except on E : Exception do 
            begin
                TThread.Queue(TThread.CurrentThread, procedure
                begin
                    raise E;
                end);
            end;
        end;
    end);
    aTasks[0].Start;

    aTasks[1] := TTask.Create(procedure begin
        try
            raise Exception.Create('Error2');
        except on E : Exception do 
            begin
                TThread.Queue(TThread.CurrentThread, procedure
                begin
                    raise E;
                end);
            end;
        end;
    end);
    aTasks[1].Start;

    TTask.WaitForAll(aTasks);

end;

但在主窗体中我看到了这个:

如何捕获并重新引发线程异常到主线程？

更新

也许我已经找到了使用AcquireExceptionObject的正确方法:

var
    aTasks: array of ITask;
begin
  Setlength(aTasks, 2);

  aTasks[0] := TTask.Create(procedure
  var
      CapturedException : Exception;
  begin
      try
          raise Exception.Create('Error1');
      except
          CapturedException := AcquireExceptionObject;
          TThread.Queue(TThread.CurrentThread, procedure begin
              raise CapturedException;
          end);
      end;
  end);
  aTasks[0].Start;

  aTasks[1] := TTask.Create(procedure
  var
      CapturedException : Exception;
  begin
      try
          raise Exception.Create('Error2');
      except
          CapturedException := AcquireExceptionObject;
          TThread.Queue(TThread.CurrentThread, procedure begin
              raise CapturedException;
          end);
      end;
  end);
  aTasks[1].Start;

  TTask.WaitForAll(aTasks);
end;  

现在我看到了正确的错误:

这是将错误传播到主线程的标准方法吗？

Answer 1

TTask.WaitForAll() 等待所有指定任务完成。如果其中任何任务由于未捕获的异常而结束，WaitForAll() 会收集所有异常并引发 EAggregateException进入你的代码:

procedure TForm4.Button1Click(Sender: TObject);
var ar : TArray<iTask>;
begin
  SetLength(ar, 3);
  ar[0] := TTask.Run(procedure begin
    TTask.CurrentTask.Wait(100);
    raise Exception.Create('Error Message');
  end);
  ar[1] := TTask.Run(procedure begin
    TTask.CurrentTask.Wait(100);
    raise Exception.Create('Another Error Message');
  end);
  ar[2] := TTask.Run(procedure begin
    TTask.CurrentTask.Wait(100);
    raise Exception.Create('A Third Error Message');
  end);

  try
    TTask.WaitForAll(ar);
  except
     on E: EAggregateException do ShowMessage(E.ToString);
  end;
//
//  [Dialog Content]
//  One or more errors occurred
//  Error Message
//  Another Error Message
//  A Third Error Message
//  [OK]
end;

EAggregateException如果您想直接访问各个异常，则具有公共(public) Count 和 InnerExceptions[] 属性。