在另一个线程中引发异常

Question

如何在Delphi中的另一个线程中引发异常？我有线程1和线程2,我想在线程1中引发异常并在线程2中捕获它.

编辑

我现在可以看到我最初的解释令人困惑.我想要做的是从线程1初始化线程2中的异常引发.因此引发异常并在线程2中捕获,但是此过程由线程1控制.假设我有一个主线程创建一个工作线程.我需要一种机制来优雅地从主线程中停止工作线程,但由于某些原因,这里无关紧要,我不能使用TThread.Terminate/Terminated模式.所以我认为,如果我可以启动(注入？)从主线程中提取工作线程,则可以将其用作停止信号.

Answer 1

您可以从Rob的回答这里Delphi线程异常机制或这篇Embarcadero文章中获得启发。

Answer 2

下面是一段向其他线程引发异常的示例代码。它用于SuspendThread停止线程、GetThreadContext读取线程的寄存器、更改EIP（指令指针）、使用SetThreadContext然后ResumeThread重新启动线程。有用！

UKil螺纹单位

精心包装以供重复使用，提供AbortThread()例程：

unit UKillThread;

interface

uses Classes, Windows, SysUtils;

procedure AbortThread(const Th: TThread);

implementation

// Exception to be raized on thread abort.
type EThreadAbort = class(EAbort);

// Procedure to raize the exception. Needs to be a simple, parameterless procedure
// to simplify pointing the thread to this routine.
procedure RaizeThreadAbort;
begin
  raise EThreadAbort.Create('Thread was aborted using AbortThread()');
end;

procedure AbortThread(const Th: TThread);
const AlignAt = SizeOf(DWORD); // Undocumented; Apparently the memory used for _CONTEXT needs to be aligned on DWORD boundary
var Block:array[0..SizeOf(_CONTEXT)+512] of Byte; // The _CONTEXT structure is probably larger then what Delphi thinks it should be. Unless I provide enough padding space, GetThreadContext fails
    ThContext: PContext;
begin
  SuspendThread(Th.Handle);
  ZeroMemory(@Block, SizeOf(Block));
  ThContext := PContext(((Integer(@Block) + AlignAt - 1) div AlignAt) * AlignAt);
  ThContext.ContextFlags := CONTEXT_FULL;
  if not GetThreadContext(Th.Handle, ThContext^) then
    RaiseLastOSError;
  ThContext.Eip := Cardinal(@RaizeThreadAbort); // Change EIP so we can redirect the thread to our error-raizing routine
  SetThreadContext(Th.Handle, ThContext^);
  ResumeThread(Th.Handle);
end;

end.

演示项目

使用方法如下AbortThread：

program Project23;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  Windows,
  UKillThread;

var Th: TThread;

type
  TTestThread = class(TThread)
  public
    procedure Execute;override;
  end;

{ TTestTrehad }

procedure TTestThread.Execute;
var N: Integer;
begin
  try
    N := 1;
    while not Terminated do
    begin
      WriteLn(N);
      Inc(N);
      Sleep(1000);
    end;
  except on E:Exception do
    WriteLn(E.ClassName + ' / ' + E.Message);
  end;
end;

begin
  Th := TTestThread.Create(False);
  WriteLn('Press ENTER to raize exception in Thread');
  ReadLn;
  AbortThread(Th);
  WriteLn('Press ENTER to exit');
  ReadLn;
end.

免责声明

在实际使用之前，请确保您了解此代码的用途。这绝不是正确Terminate - Terminated逻辑（即协作线程关闭）的替代品，但它是TerminateThread(). 这是在.NET Thread.Abort()方法之后建模的。我不知道实际的 .NET 方法是如何实现的，但仍然要阅读它，因为使用此代码的潜在问题是类似的：

• 该方法实际上并不终止线程，而是EAbort在线程上下文中引发派生异常。线程的代码可能会捕获异常。这是不太可能的，因为EAbort不应该处理异常。
• 该方法可能随时停止线程。它可能会在处理某个finally部分或设置新的异常帧时停止线程。即使您的线程使用正确的try-finally块，如果在分配资源之后但在将资源分配给变量之前引发异常，也可能会导致内存或资源泄漏。
• 如果线程在通常紧随其后的线程之后EnterCriticalSection或之前立即被中断，则代码可能会导致死锁try-finally。EnterCriticalSection 的 MSDN 页面提到："If a thread terminates while it has ownership of a critical section, the state of the critical section is undefined.". 这让我感到惊讶，我直觉地期望当拥有的线程终止时关键部分会被“释放”，但显然事实并非如此。