unit ThreadAbort;
interface
uses
Windows, SysUtils, Classes;
{ These functions raise the given exception inside the given thread.
The underscore variant simply returns False/True to indicate the success or
failure of the action, while the other two raise an EOSError on that.
}
function _RaiseInThread(Which: THandle; E:
Exception): Boolean;
procedure RaiseInThread(Which: THandle; E:
Exception);
overload;
procedure RaiseInThread(Which: TThread; E:
Exception);
overload;
{ These functions raise an EThreadAbort exception inside the given thread.
}
type
EThreadAbort =
class(
Exception);
procedure AbortThread(Which: THandle;
const Message:
string = '
');
overload;
procedure AbortThread(Which: TThread;
const Message:
string = '
');
overload;
implementation
{ Raise an exception in the given thread.
}
function _RaiseInThread(Which: THandle; E:
Exception): Boolean;
var
Context: TContext;
procedure Push(c: DWORD);
begin
Dec(Context.Esp, SizeOf(DWORD));
PCardinal(Context.Esp)^ := c;
end;
begin
if Which = GetCurrentThread
then
raise E;
Result := False;
if SuspendThread(Which) = DWORD(-1)
then
Exit;
try
Context.ContextFlags := CONTEXT_CONTROL
or CONTEXT_INTEGER;
if not GetThreadContext(Which, Context)
then
Exit;
{ The following lines are copied from System.pas / _RaiseExcept,
which (sadly) cannot be called directly. It uses the same calling
convention since Delphi 3 (Delphi 2 uses a different signature).
}
Push(Context.Esp);
Push(Context.Ebp);
Push(Context.Edi);
Push(Context.Esi);
Push(Context.Ebx);
Push(DWORD(E));
{ pass class argument }
Push(Context.Eip);
{ pass address argument }
Push(Context.Esp);
{ pass pointer to arguments }
Push(7);
{ there are seven arguments }
Push(1);
{ cNonContinuable: we can't continue execution }
Push($0EEDFADE);
{ cDelphiException: our magic exception code }
Push(Context.Eip);
{ pass the return address }
{$IFDEF CONDITIONALEXPRESSIONS} // Delphi 6+
Context.Eip := DWORD(RaiseExceptionProc);
{$ELSE}
Context.Eip := DWORD(@RaiseException);
{$ENDIF}
if SetThreadContext(Which, Context)
then
Result := True;
finally
if ResumeThread(Which) = DWORD(-1)
then
Result := False;
end;
end;
procedure RaiseInThread(Which: THandle; E:
Exception);
begin
if not _RaiseInThread(Which, E)
then
RaiseLastOSError;
end;
procedure RaiseInThread(Which: TThread; E:
Exception);
begin
RaiseInThread(Which.Handle, E);
end;
procedure AbortThread(Which: THandle;
const Message:
string);
begin
RaiseInThread(Which, EThreadAbort.Create(
Message));
end;
procedure AbortThread(Which: TThread;
const Message:
string);
begin
AbortThread(Which.Handle,
Message);
end;
end.