Multithreading 在TThread Execute中引发异常？

我刚刚意识到我的异常不会在我的线程中显示给用户

首先，我在我的线程中使用了这个函数来引发异常，但它不起作用：

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

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

我四处寻找解决方案，我发现：

这两个都不适合我

这是我的线程单元：

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.

unit-uCheckForUpdateThread；
接口
使用
Windows、IdBaseComponent、IdComponent、IdTCPConnection、IdTCPClient、，
IdHTTP、GlobalFuncs、类、HtmlExtractor、SysUtils、表单；
类型
TUpdaterThread=class（TThread）
私有的
文件抓取器：THtmlExtractor；
HTTP:TIdHttp；
阿普梅杰，
小修，
近似值：整数；
UpdateText:string；
VersionStr:string；
ExceptionContext：字符串；
feexception：异常；
程序处理异常；
程序同步更新；
程序同步完成；
公众的
构造函数创建；
受保护的
程序处理异常；事实上的
程序执行；推翻
结束；
实施
使用
乌敏；
{TUpdaterThread}
构造函数TUpdaterThread.Create；
开始
继承创建（False）；
结束；
过程TUpdaterThread.Execute；
开始
继承；
FreeOnTerminate:=真；
如果终止，则
出口
FileGrabber:=THtmlExtractor.Create；
HTTP:=TIdHTTP.Create（nil）；
尝试
尝试
文件抓取器http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
E上除外：例外
开始
UpdateText:=“更新xSky时出错！”；
ExceptionContext:='错误：找不到远程文件！请重新启动xSky并重试！另外，请确保您已连接到Internet，并且您的防火墙没有阻止xSky！'；
手部异常；
结束；
结束；
尝试
AppMajor:=stroint（FileGrabber.ExtractValue（'AppMajor['，']'）；
AppMinor:=stroint（FileGrabber.ExtractValue（'AppMinor['，']'）；
AppRelease:=stroint（FileGrabber.ExtractValue（'AppRelease[['，']'））；
E上除外：例外
开始
手部异常；
结束；
结束；
如果（应用程序版本大调<应用程序大调）或（应用程序版本小调<应用程序小调）或（应用程序版本发布<应用程序大调），则
开始
VersionStr:=格式（“%d.%d.%d”，[AppMajor，AppMinor，AppRelease]）；
UpdateText:=“下载版本”+VersionStr；
同步（SyncUpdateBL）；
结束；
最后
免费的；
HTTP.Free；
结束；
同步（SyncFinalize）；
结束；
过程TUpdaterThread.SyncFinalize；
开始
DoTransition（frmMain.TransSearcher3，frmMain.gbLogin，True，500）；
结束；
过程TUpdaterThread.SyncUpdateLbl；
开始
frmMain.lblCheckingForUpdates.Caption:=UpdateText；
结束；
过程TUpdaterThread.HandleException；
开始
FEException:=异常（ExceptObject）；
尝试
同步（DoHandleException）；
最后
FEException:=零；
结束；
结束；
过程TUpdaterThread.DoHandleException；
开始
应用程序。ShowException（feException）；
结束；
结束。

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

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

编辑：最终是Cosmin的解决方案起了作用-最初没有起作用的原因是，我没有添加ErrMsg变量，而是将该变量包含的任何内容放入了Synchronize中，这不会起作用，但我不知道为什么。我在没有其他想法的情况下意识到了这一点，我只是在处理解决方案时弄糟了是的

和往常一样，我是开玩笑的

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

它很好用。也许你应该看看

编辑：

你没有按照你指出的链接告诉我们的去做。检查我的链接，你就会知道怎么做

编辑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;

---

线程不会自动将异常传播到其他线程中，所以您必须自己处理它

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，这种方法很有用

---

请注意，如果不引发捕获的异常，则需要销毁该异常，否则将导致内存泄漏。

以下是我对该问题的非常简短的“看法”。它仅适用于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;

---

我以前使用过使用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;

---

关于多层次开发，您需要了解一些非常重要的内容：

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

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

• 他们可以对共享数据或对象进行操作。这可能会导致并发问题“竞争条件”，因此您需要能够帮助他们“很好地共享数据”。这就引出了下一点
• 他们可以通过usi“相互发出信号”

  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;
  

  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;