1
2 unit uThreader;
3
4 interface
5
6 uses
7 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
8 Dialogs;
9
10
11 type
12 TBaseWorkerThread=class;
13
14 TInterThreadComm=record
15 tT:TBaseWorkerThread;
16 BufferLen:cardinal;
17 Reason:cardinal;
18 end;
19
20 TBaseWorkerThread=class
21 private
22 IsActive:longbool;
23 TId,ThreadH,CThreadH:cardinal;
24 StackS:cardinal;
25 CS,gCS:_RTL_CRITICAL_SECTION;
26 IsW:longbool;
27
28
29 protected
30 ThreadStartSnyc:cardinal;
31 procedure ThreadS ();stdcall;
32 procedure ThreadAPC ();stdcall;
33 function IsThreadB:longbool;
34
35 public
36 destructor Destroy;
37
38 //THREAD EVENTS!
39 procedure OnCreateThread;virtual;abstract;
40 procedure DoJob;virtual;abstract;
41 procedure OnJobDone;virtual;abstract;
42 procedure OnDestroyThread;virtual;abstract;
43 procedure
44 OnMainThreadNotify(Reason:cardinal;Buffer:pointer;BufferLength:cardinal);virtual;abs
45 tract;
46
47 property StackSize:cardinal read StackS write StackS;
48 property IsThreadBusy:longbool read IsThreadB;
49 property ThreadHandle:cardinal read ThreadH;
50 property ThreadId:cardinal read TId;
51
52 function StartThread ():longbool;virtual;
53 function StartWork ():longbool;virtual;
54 function
55 CallBackMainThread(Reason:cardinal;Buffer:pointer;BufferLength:cardinal):longbool;vi
56 rtual;
57
58 function DestroyWorkerThread:longbool;
59 procedure EnterSynchronize;
60 procedure LeaveSynchronize;
61 end;
62
63 procedure Tmr_Proc (Hwnd,uMsg,IdEvent,eTime:cardinal);stdcall;
64 procedure Usr_Proc (const Param:TInterThreadComm);stdcall;
65
66 implementation
67
68 { TBaseWorkerThreader }
69
70 function
71 TBaseWorkerThread.CallBackMainThread(Reason:cardinal;Buffer:pointer;BufferLength:car
72 dinal):longbool;
73 var
74 X:cardinal;
75 begin
76 X:=GlobalAlloc(0,12+BufferLength);
77 TInterThreadComm(pointer(x)^).tT:=Self;
78 TInterThreadComm(pointer(x)^).BufferLen :=BufferLength;
79 TInterThreadComm(pointer(x)^).Reason :=Reason;
80 if BufferLength<>0 then Copymemory(pointer(x+12),Buffer,BufferLength);
81 result:=QueueUserAPC(addr(Usr_Proc),CThreadH,X);
82 end;
83
84 destructor TBaseWorkerThread.Destroy;
85 begin
86 DestroyWorkerThread;
87 end;
88
89 function TBaseWorkerThread.DestroyWorkerThread: longbool;
90 begin
91 result:=false;
92 if ThreadHandle<>0 then
93 begin
94 TerminateThread(ThreadHandle,0);
95 DeleteCriticalSection(cS);DeleteCriticalSection(gcS);
96 OnDestroyThread;
97 CloseHandle(ThreadHandle);
98 CloseHandle(cThreadH);
99 ThreadH:=0;
100 cThreadH:=0;
101 TId:=0;
102 result:=true;
103 IsW:=false;
104 end;
105 end;
106
107
108
109 function TBaseWorkerThread.IsThreadB: longbool;
110 begin
111 EnterCriticalSection(cS);
112 result:=IsW;
113 LeaveCriticalSection(cS);
114 end;
115
116
117 procedure TBaseWorkerThread.EnterSynchronize;
118 begin
119 EnterCriticalSection(gCs);
120 end;
121
122 procedure TBaseWorkerThread.LeaveSynchronize;
123 begin
124 LeaveCriticalSection(gCs);
125 end;
126
127
128
129 function TBaseWorkerThread.StartThread(): longbool;
130 var
131 ThreadSA:procedure ()of object;stdcall;
132 cProcess:cardinal;
133 begin
134 result:=false;
135 if ThreadHandle<>0 then exit;
136 ThreadSA:=ThreadS;
137 ThreadStartSnyc:=CreateEvent(0,false,false,0);
138 ThreadH:=CreateThread(0,StackS,addr(ThreadSA),self,0,TId);
139 WaitForSingleObject(ThreadStartSnyc,INFINITE);
140 CloseHandle(ThreadStartSnyc);
141 result:=longbool(ThreadHandle);
142
143 if result then begin
144 InitializeCriticalSection(cs);InitializeCriticalSection(gcs);
145 if cardinal(TlsGetValue(200))=0 then
146 TlsSetValue(200,pointer(SetTimer(0,GetCurrentThreadId,0,addr(Tmr_Proc))));
147 cProcess:=OpenProcess(PROCESS_ALL_ACCESS,true,GetCurrentProcessId);
148 DuplicateHandle (cProcess,GetCurrentThread, cProcess,addr(CThreadH), $1F03FF,
149 true, 0);
150 CloseHandle(cProcess);
151 end;
152
153 end;
154
155 function TBaseWorkerThread.StartWork: longbool;
156 var
157 ThreadSA:procedure ()of object;stdcall;
158 begin
159 result:=false;
160 if ThreadH=0 then exit;
161 ThreadSA:=ThreadAPC;
162 result:=QueueUserAPC(addr(ThreadSA),ThreadH,cardinal(self));
163 end;
164
165 procedure TBaseWorkerThread.ThreadAPC;
166 begin
167 EnterCriticalSection(cS);
168 IsW:=true;
169 LeaveCriticalSection(cS);
170 DoJob;
171 end;
172
173 procedure TBaseWorkerThread.ThreadS();
174 begin
175 SetEvent(ThreadStartSnyc);
176 OnCreateThread;
177 while TRUE do begin
178 SleepEx(INFINITE,true);
179 EnterCriticalSection(cS);
180 IsW:=false;
181 LeaveCriticalSection(cS);
182 OnJobDone;
183 end;
184 end;
185
186
187 procedure Tmr_Proc (Hwnd,uMsg,IdEvent,eTime:cardinal);
188 begin
189 SleepEx(0,true);
190 end;
191
192 procedure Usr_Proc (const Param:TInterThreadComm);stdcall;
193 begin
194
195 Param.tT.OnMainThreadNotify(Param.Reason,pointer(cardinal(addr(Param))+12),Param.Buf
196 ferLen);
197 GlobalFree(cardinal(addr(Param)));
198 end;
199
200 end.
|