Вот пример кода, который вызывает исключение в другом потоке.Он использует SuspendThread для остановки потока, GetThreadContext для чтения регистров потока, изменяет EIP (указатель инструкции), использует SetThreadContext, а затем ResumeThread для перезапуска потока.Это работает!
Блок UKilThread
Удобно упакован для блока повторного использования, который обеспечивает подпрограмму 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, который обычно следует.Страница MSDN для EnterCriticalSection упоминает: "If a thread terminates while it has ownership of a critical section, the state of the critical section is undefined.".Это стало для меня неожиданностью, я бы интуитивно ожидал, что критическая секция будет «освобождена», когда завершается поток-владелец, но, очевидно, это не так.