1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:

unit WorkerThread;

interface

uses Classes, SysUtils;

type
  TAPCMethod = procedure of object; stdcall;

  TWorkerThread = class;

  TErrorEvent = procedure(Sender: TWorkerThread; E: Exception);

  TWorkerThread = class
  private
    FThread: TThread;
    FOnError: TErrorEvent;
    function GetHandle: THandle;
  public
    property OnError: TErrorEvent read FOnError write FOnError;
    property ThreadHandle: THandle read GetHandle;
    procedure Queue(Method: TAPCMethod);
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses Windows;

type
  TThreadWorker = class(TThread)
  protected
    FThread: TWorkerThread;
    procedure Void; stdcall;
  public
    constructor Create(AThread: TWorkerThread);
    procedure QueueAPC(Method: TAPCMethod);
    procedure Execute; override;
    destructor Destroy; override;
  end;

procedure TThreadWorker.Execute;
begin
  repeat
    try
      SleepEx(INFINITE, True);
    except
      on E: Exception do
        if Assigned(FThread.FOnError) then
          FThread.FOnError(FThread, E);
    end;
  until Terminated;
end;

constructor TThreadWorker.Create(AThread: TWorkerThread);
begin
  FThread := AThread;
  inherited Create(False);
end;

destructor TThreadWorker.Destroy;
begin
  if (ThreadID <> 0) and not Finished and not ExternalThread then
  begin
    Terminate;
    QueueAPC(Void);
  end;
  inherited;
end;

procedure TThreadWorker.Void;
begin
end;

procedure TThreadWorker.QueueAPC(Method: TAPCMethod);
begin
  if not QueueUserAPC(TMethod(Method).Code, Handle, Cardinal(TMethod(Method).Data)) then
    RaiseLastOSError;
end;

{ TWorkerThread }

constructor TWorkerThread.Create;
begin
  FThread := TThreadWorker.Create(Self);
end;

destructor TWorkerThread.Destroy;
begin
  FThread.Free;
  inherited;
end;

function TWorkerThread.GetHandle: THandle;
begin
  Result := FThread.Handle;
end;

procedure TWorkerThread.Queue(Method: TAPCMethod);
begin
  TThreadWorker(FThread).QueueAPC(Method);
end;

end.