Author: Erwin Molendijk
Ever wanted to fire up some threads in your application, let them do some time
consuming stuff and then report the results to the user? This caused some
synchronisation trouble, didn't it? Shutting down your app while threads where
still running, updating the user interface...
Here is a unit that will give a good bases to avoid all kinds of multi threading
trouble.
Answer:
1 { -----------------------------------------------------------------------
2 Newer version and test bench can be found here:
3 http://codecentral.borland.com/codecentral/ccweb.exe/listing?id=17700
4 -----------------------------------------------------------------------
5
6 Smart Thread Lib
7 Version 1.01
8 Copyright (c) 2002 by DelphiFactory Netherlands BV
9
10 What is it:
11 Provides an easy way to use threads.
12
13 Usage:
14 Create your threads as TSmartThreads and manage them
15 using the SmartThreadManager global object.
16
17 For more information about threads in delphi:
18 http://www.pergolesi.demon.co.uk/prog/threads/ToC.html
19
20 For example on how to use this unit for with a Indy blocking
21 socket TCP/IP client:
22 "SmartThreadLib example: Using blocking Indy sockets in a thread" article
23 }
24
25 unit SmartThreadLib;
26
27 { Defining the DefaultMessageHandler causes the messages send
28 by the threads to be displayed on screen if no OnMessage handler
29 is assigned. This is only for debugging purposes (as GUI routines should
30 not be located in this unit). }
31 {$DEFINE DefaultMessageHandler}
32
33 interface
34
35 uses
36 SysUtils, Classes, Contnrs
37 {$IFDEF DefaultMessageHandler}
38 , QDialogs
39 {$ENDIF}
40 ;
41
42 resourcestring
43 SForcedStop = 'Thread ''%s'' forced to stop';
44
45 { EThreadForcedShutdown exception will be raised inside a thread when
46 it has to stop running. }
47 type
48 EThreadForcedShutdown = class(Exception);
49
50 { The ThreadMessageEvent is called by a smart thread but within the
51 context of the main thread and provides the ability to easily show messages
52 to the user. }
53 type
54 TThreadMessageEvent = procedure(Sender: TObject; const AMessage: string) of
55 object;
56
57 { The SmartThread.
58 Usage:
59 1. Create a descendent class.
60 2. Override the SmartExecute.
61 3. Call Check from within SmartExecute on a regular base. This
62 routine will raise an EThreadForcedShutdown exception if the thread
63 has to stop. The exception is handled by this base class, you do
64 not need to handle it.
65
66 Additional tips:
67 - You can use the Msg() procedure to show messages to the user without
68 having to worry about synchronisation problems.
69 - You can override GetMustStop() to add additional checks that could
70 cause a thread to do a forced shutdown.
71 - SmartExecute is started directly after calling Create()
72 - The thread is FreeOnTerminate.
73 - SmartThreads are based on the idea that threads are independant. You
74 should not keep a pointer to the new thread, because you can never know
75 if this pointer is still valid.
76 Instead let your threads communicate using a global object. As an
77 example se the SmartThreadManager.
78 }
79 type
80 TSmartThread = class(TThread)
81 private
82 FMsg: string;
83 procedure DoMessage;
84 protected
85 function GetMustStop: Boolean; virtual;
86 procedure Msg(const Msg: string); virtual;
87 procedure Check;
88
89 procedure Execute; override;
90 procedure SmartExecute; virtual;
91 public
92 constructor Create; virtual;
93 property MustStop: Boolean read GetMustStop;
94 end;
95
96 { The SmartThreadManager: Global object that manages all TSmartThread's.
97
98 The SmartThreads register themselfs at this manager before
99 executing, and unregister just before destroying itself.
100
101 - SmartThreads are based on the idea that threads are independant. You
102 should not keep a pointer to the new thread, because you can never know
103 if this pointer is still valid. Instead let your threads communicate
104 using a global object. The manager provides an event called OnMessage.
105 The threads can trigger this event by calling their Msg() method. The
106 OnMessage event runs in the context of the main thread. So screen updates
107 can be performed. The Sender parameter is the thread which has send the
108 message. This thread is guarantied to exist and is in suspended mode during
109 the execution of the eventhandler.
110 (If 'DefaultMessageHandler' is defined during compilation, the message will
111 be displayed automaticly when no handler is assigned.)
112
113 - Set ShutDown to True to shutdown all the smart threads.
114
115 - ThreadCount returns the number of currently running smart threads
116
117 - All threads are terminated automaticaly when the manager is destroyed.
118 The manager is created and destroyed by the initialization and
119 finalization section in this unit.
120 }
121 type
122 TSmartThreadManager = class
123 private
124 FThreadListSync: TMultiReadExclusiveWriteSynchronizer;
125 FShutDownSync: TMultiReadExclusiveWriteSynchronizer;
126 FThreadList: TObjectList;
127 FShutDown: Boolean;
128 FOnMessage: TThreadMessageEvent;
129 function GetShutDown: Boolean;
130 procedure SetShutDown(const Value: Boolean);
131 function GetThreadCount: Integer;
132 protected
133 procedure RegisterThread(AThread: TSmartThread);
134 procedure UnregisterThread(AThread: TSmartThread);
135 procedure DoMessage(Sender: TObject; AMessage: string);
136 public
137 constructor Create;
138 destructor Destroy; override;
139
140 procedure LimitThreadCount(Max: Integer);
141
142 property ThreadCount: Integer read GetThreadCount;
143 property Shutdown: Boolean read GetShutDown write SetShutDown;
144 property OnMessage: TThreadMessageEvent read FOnMessage write FOnMessage;
145 end;
146
147 var
148 SmartThreadManager: TSmartThreadManager;
149
150 implementation
151
152 { TSmartThread }
153
154 procedure TSmartThread.Check;
155 begin
156 // raise exception when the thread needs to stop
157 if MustStop then
158 raise EThreadForcedShutdown.CreateFmt(SForcedStop, [Self.ClassName]);
159 end;
160
161 constructor TSmartThread.Create;
162 begin
163 // create in suspended mode
164 inherited Create(True);
165 // init
166 FreeOnTerminate := True;
167
168 // register at the manager
169 SmartThreadManager.RegisterThread(Self);
170
171 // run the thread
172 Suspended := False;
173 end;
174
175 procedure TSmartThread.DoMessage;
176 { Call this method using Synchronize(DoMessage)
177 to make sure that we are running in the context of the main thread }
178 begin
179 // Notify the manager about the message
180 SmartThreadManager.DoMessage(Self, FMsg);
181 end;
182
183 procedure TSmartThread.Execute;
184 begin
185 try
186 try
187 // Perform code to be implemented by descendant class
188 SmartExecute;
189 except
190 // ignore forced shutdown exceptions
191 on E: EThreadForcedShutdown do {nothing}
192 ;
193 end;
194 finally
195 // unregister at the manager
196 SmartThreadManager.UnregisterThread(Self);
197 end;
198 // After unregistering the smart thread should shutdown
199 // as fast as possible and do not perform any more tasks.
200 end;
201
202 function TSmartThread.GetMustStop: Boolean;
203 begin
204 // We must stop if the thread is marked as terminated
205 // or if the manager wants to shutdown
206 Result := Terminated or SmartThreadManager.Shutdown;
207 end;
208
209 procedure TSmartThread.Msg(const Msg: string);
210 begin
211 // save message for later use by DoMessage
212 FMsg := Msg;
213 // call the DoMessage in the context of the main thread
214 Synchronize(DoMessage);
215 end;
216
217 procedure TSmartThread.SmartExecute;
218 begin
219 // do nothing, method can be implemented by descendant
220 end;
221
222 { TSmartThreadManager }
223
224 constructor TSmartThreadManager.Create;
225 begin
226 inherited Create;
227 // init
228 FShutdownSync := TMultiReadExclusiveWriteSynchronizer.Create;
229 FThreadListSync := TMultiReadExclusiveWriteSynchronizer.Create;
230 FThreadList := TObjectList.Create(False);
231 end;
232
233 destructor TSmartThreadManager.Destroy;
234 begin
235 // manager is shutting down - cause al threads to stop
236 SetShutDown(True);
237
238 // wait for all threads to have stopped
239 LimitThreadCount(0);
240
241 // now we can cleanup
242 FThreadList.Free;
243 FThreadListSync.Free;
244 FShutDownSync.Free;
245
246 inherited Destroy;
247 end;
248
249 procedure TSmartThreadManager.DoMessage(Sender: TObject; AMessage: string);
250 const
251 SMsg = '%s message: ''%s''';
252 begin
253 // Call eventhandler
254 if Assigned(FOnMessage) then
255 FOnMessage(Sender, AMessage)
256 {$IFDEF DefaultMessageHandler}
257 else // if there is no eventhandler, display the message on screen
258 ShowMessage(Format(SMsg, [Sender.ClassName, AMessage]));
259 {$ENDIF}
260 end;
261
262 function TSmartThreadManager.GetShutDown: Boolean;
263 { ThreadSafe
264 Returns the Shutdown flag
265 }
266 begin
267 FShutdownSync.BeginRead;
268 try
269 Result := FShutDown;
270 finally
271 FShutdownSync.EndRead;
272 end;
273 end;
274
275 function TSmartThreadManager.GetThreadCount: Integer;
276 { ThreadSafe
277 Returns the number of running smart threads
278 }
279 begin
280 FThreadListSync.BeginRead;
281 try
282 Result := FThreadList.Count;
283 finally
284 FThreadListSync.EndRead;
285 end;
286 end;
287
288 procedure TSmartThreadManager.LimitThreadCount(Max: Integer);
289 { Should only be called in the context of the main thread.
290
291 Returns until the number of runnning smart threads is
292 equal or lower then the Max parameter.
293 }
294 begin
295 while GetThreadCount > Max do
296 if not CheckSynchronize then
297 Sleep(100);
298 end;
299
300 procedure TSmartThreadManager.RegisterThread(AThread: TSmartThread);
301 { Thread safe
302 Is called by the TSmartThread.Create constructor to register
303 a new smart thread.
304 }
305 begin
306 FThreadListSync.BeginWrite;
307 try
308 if FThreadList.IndexOf(AThread) = -1 then
309 FThreadList.Add(AThread);
310 finally
311 FThreadListSync.EndWrite;
312 end;
313 end;
314
315 procedure TSmartThreadManager.SetShutDown(const Value: Boolean);
316 { Thread Safe
317 Set the shutdown flag.
318 }
319 begin
320 // make sure this is an different value
321 if Value <> GetShutDown then
322 begin
323 FShutdownSync.BeginWrite;
324 try
325 // set new value
326 FShutDown := Value;
327 finally
328 FShutdownSync.EndWrite;
329 end;
330 end;
331 end;
332
333 procedure TSmartThreadManager.UnregisterThread(AThread: TSmartThread);
334 { Thread Safe
335 Called by TSmartThread.Execute after the TSmartThread.SmartExecute
336 has finished (or an exception was raised). it unregisters the thread.
337 }
338 begin
339 FThreadListSync.BeginWrite;
340 try
341 FThreadList.Remove(AThread)
342 finally
343 FThreadListSync.EndWrite;
344 end;
345 end;
346
347 initialization
348 // fire up the manager
349 SmartThreadManager := TSmartThreadManager.Create;
350 finalization
351 // going down
352 SmartThreadManager.Free;
353 end.
|