multithreading - 在 TThread 执行中引发异常？

Question

我刚刚意识到我的异常没有在我的线程中显示给用户！

起初我在我的线程中使用它来引发异常，但它不起作用：

except on E:Exception do
begin
  raise Exception.Create('Error: ' + E.Message);
end;

IDE 向我显示了异常，但我的应用程序没有！

我四处寻找解决方案，这就是我发现的：

Delphi线程异常机制

http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_22039681.html

这些都不适合我。

这是我的线程单元：

unit uCheckForUpdateThread;

interface

uses
  Windows, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, GlobalFuncs, Classes, HtmlExtractor, SysUtils, Forms;

type
  TUpdaterThread = class(TThread)
  private
    FileGrabber : THtmlExtractor;
    HTTP : TIdHttp;
    AppMajor,
    AppMinor,
    AppRelease : Integer;
    UpdateText : string;
    VersionStr : string;
    ExceptionText : string;
    FException: Exception;
    procedure DoHandleException;
    procedure SyncUpdateLbl;
    procedure SyncFinalize;
  public
    constructor Create;

  protected
    procedure HandleException; virtual;

    procedure Execute; override;
  end;

implementation

uses
  uMain;

{ TUpdaterThread }

constructor TUpdaterThread.Create;
begin
  inherited Create(False);
end;

procedure TUpdaterThread.Execute;
begin
  inherited;
  FreeOnTerminate := True;

  if Terminated then
    Exit;

  FileGrabber           := THtmlExtractor.Create;
  HTTP                  := TIdHTTP.Create(nil);
  try
    try
      FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
    except on E: Exception do
    begin
      UpdateText := 'Error while updating xSky!';
      ExceptionText := 'Error: Cannot find remote file! Please restart xSky and try again! Also, make sure you are connected to the Internet, and that your Firewall is not blocking xSky!';
      HandleException;
    end;
    end;

    try
      AppMajor      := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
      AppMinor      := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
      AppRelease    := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
    except on E:Exception do
    begin
      HandleException;
    end;
    end;

    if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then
    begin
      VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
      UpdateText := 'Downloading Version ' + VersionStr;
      Synchronize(SyncUpdateLbl);
    end;

  finally
    FileGrabber.Free;
    HTTP.Free;
  end;
  Synchronize(SyncFinalize);
end;

procedure TUpdaterThread.SyncFinalize;
begin
  DoTransition(frmMain.TransSearcher3, frmMain.gbLogin, True, 500);
end;

procedure TUpdaterThread.SyncUpdateLbl;
begin
  frmMain.lblCheckingForUpdates.Caption := UpdateText;
end;

procedure TUpdaterThread.HandleException;
begin
  FException := Exception(ExceptObject);
  try
    Synchronize(DoHandleException);
  finally
    FException := nil;
  end;
end;

procedure TUpdaterThread.DoHandleException;
begin
  Application.ShowException(FException);
end;

end.

如果您需要更多信息，请告诉我。

同样：IDE 捕获所有异常，但我的程序没有显示它们。

编辑：这是 Cosmin 的解决方案最终奏效了 - 最初没有奏效的原因是因为我没有添加 ErrMsg 变量，而是我只是将变量包含的任何内容放入 Synchronize 中，这是行不通的，但是我不知道为什么。当我没有其他想法时，我意识到了这一点，我只是搞砸了解决方案。

和往常一样，笑话在我身上。=P

score 13 · Accepted Answer

关于多线程开发，您需要了解一些非常重要的事情：

每个线程都有自己的调用堆栈，就好像它们是单独的程序一样。这包括程序的主线程。

线程只能以特定方式相互交互：

它们可以对共享数据或对象进行操作。这可能导致并发问题“竞争条件”，因此您需要能够帮助他们“很好地共享数据”。这将我们带到了下一点。
它们可以使用各种操作系统支持例程“相互发送信号”。其中包括：
- 互斥体
- 关键部分
- 活动
最后，您可以向其他线程发送消息。假设线程以某种方式被编写为消息接收器。

注意：请注意，严格来说线程不能直接调用其他线程。例如，如果线程 A 尝试直接调用线程 B，那将是线程 A 调用堆栈上的一步！

这将我们带到了问题的主题：“我的线程中没有引发异常”

这样做的原因是所有异常都是：

记录错误
并展开调用堆栈。<-- 注意：你的 TThread 实例不能展开主线程的调用栈，也不能任意中断主线程的执行。

因此 TThread 不会自动向您的主应用程序报告异常。

您必须明确决定如何处理线程中的错误，并相应地实施。

解决方案

第一步与在单线程应用程序中相同。您需要确定错误的含义以及线程应如何反应。
- 线程应该继续处理吗？
- 线程应该中止吗？
- 是否应该记录/报告错误？
- 错误需要用户决定吗？<-- 这是迄今为止最难实现的，所以我们暂时跳过它。
一旦确定了这一点，请实施适当的异常处理程序。
TIP: Make sure the exception doesn't escape the thread. The OS won't like you if it does.
如果您需要主程序（线程）向用户报告错误，您有几种选择。
- 如果线程被编写为返回结果对象，那么很容易：进行更改，以便它可以在出现问题时返回该对象中的错误。
- 向主线程发送消息以报告错误。请注意，主线程已经实现了消息循环，因此您的应用程序将在处理该消息时立即报告错误。

编辑：指定要求的代码示例。

如果您只想通知用户，那么Cosmind Prund 的答案应该适用于 Delphi 2010。旧版本的 Delphi 需要更多的工作。以下在概念上类似于杰夫自己的答案，但没有错误：

procedure TUpdaterThread.ShowException;
begin
  MessageDlg(FExceptionMessage, mtError, [mbOk], 0);
end;

procedure TUpdaterThread.Execute;
begin
  try

    raise Exception.Create('Test Exception');
    //The code for your thread goes here
    //
    //

  except
    //Based on your requirement, the except block should be the outer-most block of your code
    on E: Exception do
    begin
      FExceptionMessage := 'Exception: '+E.ClassName+'. '+E.Message;
      Synchronize(ShowException);
    end;
  end;
end;

对杰夫自己的回答进行了一些重要的更正，包括他的问题中显示的实现：

仅当您的线程在... 循环中实现时，调用Terminate才有意义。while not Terminated do看看这个Terminate方法实际上做了什么。

调用 toExit是一种不必要的浪费，但您这样做可能是因为您的下一个错误。

在您的问题中，您将每个步骤都单独包装起来try...except以处理异常。这是绝对的禁忌！通过这样做，您假装即使发生了异常，也一切正常。您的线程尝试下一步，但实际上保证会失败！这不是处理异常的方法！

score 9 · Accepted Answer

这是我对这个问题的非常非常简短的“看法”。它仅适用于 Delphi 2010+（因为该版本引入了匿名方法）。与已经发布的更复杂的方法不同，我只显示错误消息，仅此而已。

procedure TErrThread.Execute;
var ErrMsg: string;
begin
  try
    raise Exception.Create('Demonstration purposes exception');
  except on E:Exception do
    begin
      ErrMsg := E.ClassName + ' with message ' + E.Message;
      // The following could be all written on a single line to be more copy-paste friendly  
      Synchronize(
        procedure
        begin
          ShowMessage(ErrMsg);
        end
      );
    end;
  end;
end;

score 6 · Accepted Answer

线程不会自动将异常传播到其他线程。所以你必须自己处理。

Rafael 概述了一种方法，但还有其他方法。Rafael 指出的解决方案是通过将异常编组到主线程中来同步处理异常。

在我自己对线程的一种使用中，线程池，线程捕获并接管异常的所有权。这允许控制线程随意处理它们。

代码看起来像这样。

procedure TMyThread.Execute;
begin
  Try
    DoStuff;
  Except
    on Exception do begin
      FExceptAddr := ExceptAddr;
      FException := AcquireExceptionObject;
      //FBugReport := GetBugReportCallStackEtcFromMadExceptOrSimilar.
    end;
  End;
end;

如果控制线程选择引发异常，它可以这样做：

raise Thread.FException at Thread.FExceptAddr;

有时您的代码可能无法调用 Synchronize，例如某些 DLL，这种方法很有用。

请注意，如果您不引发捕获的异常，则需要将其销毁，否则会出现内存泄漏。

score 3 · Accepted Answer

出色地，

没有你的源代码会很难，但我已经测试过了：

如何处理 TThread 对象中的异常

它工作正常。也许你应该看看它。

编辑：

您没有遵循您指出的链接告诉我们要做的事情。检查我的链接，你会看到如何做到这一点。

编辑2：

试试看，告诉我它是否有效：

 TUpdaterThread= class(TThread)
 private
   FException: Exception;
   procedure DoHandleException;
 protected
   procedure Execute; override;
   procedure HandleException; virtual;
 end;

procedure TUpdaterThread.Execute;
begin
  inherited;
  FreeOnTerminate := True;
  if Terminated then
    Exit;
  FileGrabber := THtmlExtractor.Create;
  HTTP := TIdHTTP.Create(Nil);
  try
    Try
      FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
    Except
      HandleException;
    End;
    Try
      AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
      AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
      AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
    Except
      HandleException;
    End;
    if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then begin
      VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
      UpdateText := 'Downloading Version ' + VersionStr;
      Synchronize(SyncUpdateLbl);
    end;
  finally
    FileGrabber.Free;
    HTTP.Free;
  end;
  Synchronize(SyncFinalize);

end;

procedure TUpdaterThread.HandleException;
begin
  FException := Exception(ExceptObject);
  try
    Synchronize(DoHandleException);
  finally
    FException := nil;
  end;
end;

procedure TMyThread.DoHandleException;
begin
  Application.ShowException(FException);
end;

编辑 3：

您说您无法捕获 EIdHTTPProtocolException。但它对我有用。试试这个示例，自己看看：

procedure TUpdaterThread.Execute;
begin
  Try
    raise EIdHTTPProtocolException.Create('test');
  Except
    HandleException;
  End;
end;

score 2 · Accepted Answer

我以前使用 TWMCopyData 使用 SendMessge 进行线程间通信，所以我认为以下应该有效：

Const MyAppThreadError = WM_APP + 1;

constructor TUpdaterThread.Create(ErrorRecieverHandle: THandle);
begin
    Inherited Create(False);
    FErrorRecieverHandle := Application.Handle;
end;

procedure TUpdaterThread.Execute;
var
    cds: TWMCopyData;
begin
  try
     DoStuff;
  except on E:Exception do
    begin
        cds.dwData := 0;
        cds.cbData := Length(E.message) * SizeOf(Char);
        cds.lpData := Pointer(@E.message[1]);         
        SendMessage(FErrorRecieverHandle, MyAppThreadError, LPARAM(@cds), 0);
    end;
  end;
end;

我只用它来发送简单的数据类型或字符串，但我确信它可以根据需要发送更多信息。

您需要Self.Handle在创建线程的表单中添加到构造函数并在创建它的表单中处理消息

procedure HandleUpdateError(var Message:TMessage); message MyAppThreadError;
var
    StringValue: string;
    CopyData : TWMCopyData; 
begin
    CopyData := TWMCopyData(Msg);
    SetLength(StringValue, CopyData.CopyDataStruct.cbData div SizeOf(Char));
    Move(CopyData.CopyDataStruct.lpData^, StringValue[1], CopyData.CopyDataStruct.cbData);
    Message.Result := 0;
    ShowMessage(StringValue);
end;

score 1 · Accepted Answer

奇怪的是大家都回答了这个问题，却没有发现明显的问题：鉴于后台线程中引发的异常是异步的，并且可以随时发生，这意味着从后台线程显示异常会随机弹出一个对话框对用户来说，很可能会显示一个与用户目前正在做的事情无关的异常。我怀疑这样做可能会增强用户体验。

multithreading - 在 TThread 执行中引发异常？

6 回答 6

解决方案

Related

Reference