Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
TBaseWorkerThread Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
Ancestor threader class 02-Aug-04
Category
System
Language
Delphi All Versions
Views
234
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
Fuckar, vanja
Reference URL:
TBaseWorkerThread
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC