On button click i create 3 task each with empty procedure and write into a console the time difference from the method call and the tasks list complete:
procedure TWinTest.BtnThreadTestClick(Sender: TObject);
var
aTasks: array of ITask;
aStart: Cardinal;
begin
aStart := GetTickCount;
Setlength(aTasks, 3);
aTasks[0] := TTask.Create(procedure() begin
end);
aTasks[0].Start;
aTasks[1] := TTask.Create(procedure() begin
end);
aTasks[1].Start;
aTasks[2] := TTask.Create(procedure() begin
end);
aTasks[2].Start;
TTask.WaitForAll(aTasks);
Writeln( GetTickCount - aStart, 'ms');
end;
The first call take 31 ms, the successive call take 0 ms.
Why the first call is slower than the successive? maybe delphi cache the thread and reuse it on the successive call?
Yes, task threads are cached (in a thread pool) by default. This is documented behavior:
Tutorial: Using Tasks from the Parallel Programming Library
This tutorial shows how to implement an application using tasks from the Parallel Programming Library (PPL). Tasks are units of work that are in a queue and start when the CPU time is available. Tasks can run operations in parallel. There is a master thread that manages this queue and allocates threads from the thread-pool to do work of the tasks. This thread-pool has a number of threads that depends on the number of CPUs that are available.
You can customize the behavior of the pooling by creating a TThreadPool object and pass it to the TTask constructor:
If desired, Create can also be given a parameter of TThreadPool from which the instance of TTask may draw the thread resources it needs. Without specifying an instance of TThreadPool, resources are drawn from a default based upon the CPU and threading capabilities of the platform.
Related
I am using CreateAnonymousThread for a worker task, and when I started with it I used Synchronize within the entire declaration as per documented examples, e.g:
procedure Txxx.RunWorker;
begin
FExecutionThread := TThread.CreateAnonymousThread(procedure ()
begin
TThread.Synchronize (TThread.CurrentThread,
procedure ()
begin
// Here before worker stuff
NotifyBeforeWorkerStuff;
end);
// Do worker stuff
TThread.Synchronize (TThread.CurrentThread,
procedure ()
begin
// Here after worker stuff
NotifyAfterWorkerStuff;
end);
end);
FExecutionThread.Start;
end;
end;
As you see, from within this thread I launch event notifications to various parts of my app including VCL forms (NotifyBeforeWorkerStuff etc).
Later, I saw that I could move Synchronize() more locally to each VCL form close to the point that actually required it for updating (non-safe) VCL controls:
procedure TSomeVCLForm.ReceiveNotification;
begin
TThread.Synchronize (TThread.CurrentThread,
procedure ()
begin
Label1.Caption := GetSomeStringFunction;
end);
end;
The worker thread then becomes simpler as long as I live with notifications being from either main or worker threads:
procedure Txxx.RunWorker;
begin
FExecutionThread := TThread.CreateAnonymousThread(procedure ()
begin
NotifyBeforeWorkerStuff;
// Do worker stuff
NotifyAfterWorkerStuff;
end);
FExecutionThread.Start;
end;
I have several questions about whether this is correct:
My notifications may be from the worker thread but also from the main thread (e.g derived from a button press). So, when 'ReceiveNotification' on a VCL form is called from the main thread, is it allowed to call TThread.Synchronize as above? The the XE8 docs imply not, but checking System.Classes this looks ok and it works fine.
Within 'ReceiveNotification' when Label1.Caption fetches the string from GetSomeStringFunction, is it correct that there is absolutely no need for locking within that function even when the call is from a worker thread?
Thanks for any advice.
The documentation says:
Warning: Do not call Synchronize from within the main thread. This can cause an infinite loop.
I think that documentation is simply wrong. The implementation in XE8 checks whether or not the current thread is the main thread. If it is then the method is executed directly.
No locking is required in ReceiveNotification because the call to GetSomeStringFunction is always performed on the main thread.
I just encountered a problem with a service I wrote some time ago. This service is meant to translate various programs by calling a multilizer application via CreateProcess. The problem is that once the checks of the given directories cleared and the actual translation method is called the cpu load will rise to about 15-20% and remain at this level even if all files have been processed. The OnStart-event of the service creates a non delayed thread which has an execute-method that looks like this:
procedure TTranslateThread.Execute;
var count : integer;
begin
sleep(ServiceObject.hInterval);
while not Terminated do
begin
Inc(Count);
if Count>= 10 then
begin
Count :=0;
if ServiceObject.CheckDirCount>0 then
begin
ServiceObject.TranslateService;
sleep(ServiceObject.hInterval);
end;
end;
end;
However I suppose the main cause of the problem lies in the way I have to call the multilizer. That is because the service has to wait for the multilizer to finish translating. I used WaitForSingleObject to wait for the multilizer to finish although I know it's kind of a bad idea. This is the method that calls the multilizer:
procedure WaitForML7(hName: string);
var
si: TStartupInfo;
pi: TProcessInformation;
hCreateOK: Boolean;
AParameterFinal,AFileName: String;
begin
AFileName := hMultilizerPath+'Ml7Build.exe';
AParameterFinal := 'b '+hName+'.exe.m7p';
FillChar(si,SizeOf(TStartupInfo),#0);
FillChar(pi,SizeOf(TProcessInformation),#0);
si.cb := SizeOf(TStartupInfo);
AParameterFinal := Format ('"%s" %s', [AFilename, TrimRight(AParameterFinal)]);
slog.Info('CreateProcess wird versucht');
hCReateOK := CreateProcess(nil,PChar(AParameterFinal), nil, nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
PChar(hMultilizerPath) ,si,pi);
if hCreateOK then
begin
slog.Error('Multilizeraufruf war erfolgreich für Prg: '+hName);
WaitForSingleObject(pi.hProcess,INFINITE);
end
else
begin
slog.Error('Aufruf war nicht erfolgreich -> keine Uebersetzung');
end;
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
I don't really understand why the processor load remains high even there is nothing more to do. Thanks in advance.
Your thread runs a busy loop.
while not Terminated do
begin
Inc(Count);
if Count>= 10 then
begin
Count :=0;
if ServiceObject.CheckDirCount>0 then
begin
ServiceObject.TranslateService;
sleep(ServiceObject.hInterval);
end;
end;
end;
Note that I've added the missing end from your code. I hope that's the only error you made, because obviously when you post code that is not the real code, it's plausible that the problem lies in the real code rather than the code you posted.
Anyway, suppose that CheckDirCount always evaluates to 0, then the loop looks like this:
while not Terminated do
begin
Inc(Count);
if Count>= 10 then
begin
Count :=0;
ServiceObject.CheckDirCount;
end;
end;
That is a busy loop. When you run a busy loop, the processor gets hot.
I don't really want to propose solutions to this because I don't know any of the details of what your program is doing. I'm just trying to answer the question of why your thread consumes CPU.
Your wait loop will run without waiting within a Sleep(), so will burn some CPU until Sleep() is reached. This is not a good implementation pattern.
A common solution is to use semaphores to notify the thread to wake up and handle the pending tasks. It won't use any CPU until the semaphore (e.g. TEvent) is triggered.
Take a look at TEvent documentation.
For more complex multi-thread content, consider using a dedicated library like OmniThreadLibrary. It features high-level lists and parallel processing, tuned and stable. Using such a library will save you plenty of time and money. Multi-threading programming can be very difficult to stabilize, so OmniThreadLibrary is worth a look.
In addition to David's answer:
your main execute block can be simplified, doing Sleep unconditionally to prevent a busy loop:
procedure TTranslateThread.Execute;
begin
while not Terminated do
begin
sleep(ServiceObject.hInterval);
if ServiceObject.CheckDirCount>0 then
ServiceObject.TranslateService;
end;
end;
Please note that you can avoid the sleep loop by using Shell notification events.
I am developing a single thread app with Delphi, which will do a time-consuming task, like this:
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
End;
When the loop starts, the application will lose responses to the end user. That is not very good. I also do not want to convert it into a multi-thread application because of its complexity, so I add Application.ProcessMessages accordingly,
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
Application.ProcessMessages;
End;
However, this time although the application will response to user operations, the time-consumed in the loop is much more than the original loop, about 10 times.
Is there a solution to make sure the application does not lose the response while do not increase the consumed time too much?
You really should use a worker thread. This is what threads are good for.
Using Application.ProcessMessages() is a band-aid, not a solution. Your app will still be unresponsive while DoTask() is doing its work, unless you litter DoTask() with additional calls to Application.ProcessMessages(). Plus, calling Application.ProcessMessages() directly introduces reentrant issues if you are not careful.
If you must call Application.ProcessMessages() directly, then don't call it unless there are messages actually waiting to be processed. You can use the Win32 API GetQueueStatus() function to detect that condition, for example:
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
if GetQueueStatus(QS_ALLINPUT) <> 0 then
Application.ProcessMessages;
End;
Otherwise, move the DoTask() loop into a thread (yeah yeah) and then have your main
loop use MsgWaitForMultipleObjects() to wait for the task thread to finish.
That still allows you to detect when to process messages, eg:
procedure TMyTaskThread.Execute;
begin
// time-consuming loop
for I := 0 to 1024 * 65536 do
begin
if Terminated then Exit;
DoTask();
end;
end;
var
MyThread: TMyTaskThread;
Ret: DWORD;
begin
...
MyThread := TMyTaskThread.Create;
repeat
Ret := MsgWaitForMultipleObjects(1, Thread.Handle, FALSE, INFINITE, QS_ALLINPUT);
if (Ret = WAIT_OBJECT_0) or (Ret = WAIT_FAILED) then Break;
if Ret = (WAIT_OBJECT_0+1) then Application.ProcessMessages;
until False;
MyThread.Terminate;
MyThread.WaitFor;
MyThread.Free;
...
end;
You say :
I also do not want to convert it into a multi-thread application
because of its complexity
I can take this to mean one of two things :
Your application is a sprawling mess of legacy code that is so huge and so badly written that encapsulating DoTask in a thread would mean an enormous amount of refactoring for which a viable business case cannot be made.
You feel that writing multithreaded code is too "complex" and you don't want to learn how to do it.
If the case is #2 then there is no excuse whatsoever - multithreading is the clear answer to this problem. It's not so scary to roll a method into a thread and you'll become a better developer for learning how to do it.
If the case is #1, and I leave this to you to decide, then I'll note that for the duration of the loop you will be calling Application.ProcessMessages 67 million times with this :
For I := 0 to 1024 * 65536 do
Begin
DoTask();
Application.ProcessMessages;
End;
The typical way that this crime is covered up is simply by not calling Application.ProcessMessages every time you run through the loop.
For I := 0 to 1024 * 65536 do
Begin
DoTask();
if I mod 1024 = 0 then Application.ProcessMessages;
End;
But if Application.ProcessMessages is actually taking ten times longer than DoTask() to execute then I really question how complex DoTask really is and whether it really is such a hard job to refactor it into a thread. If you fix this with ProcessMessages, you really should consider it a temporary solution.
Especially take care that using ProcessMessages means that you must make sure that all of your message handlers are re-entrant.
Application.ProcessMessages should be avoided. It can cause all sorts of strange things to your program. A must read: The Dark Side of Application.ProcessMessages in Delphi Applications.
In your case a thread is the solution, even though DoTask() may have to be refactored a bit to run in a thread.
Here is a simple example using an anonymous thread. (Requires Delphi-XE or newer).
uses
System.Classes;
procedure TForm1.MyButtonClick( Sender : TObject);
var
aThread : TThread;
begin
aThread :=
TThread.CreateAnonymousThread(
procedure
var
I: Integer;
begin
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
if TThread.CurrentThread.CheckTerminated then
Break;
DoTask();
End;
end
);
// Define a terminate thread event call
aThread.OnTerminate := Self.TaskTerminated;
aThread.Start;
// Thread is self freed on terminate by default
end;
procedure TForm1.TaskTerminated(Sender : TObject);
begin
// Thread is ready, inform the user
end;
The thread is self destroyed, and you can add a OnTerminate call to a method in your form.
Calling Application.ProcessMessages at every iteration will indeed slow down performance, and calling it every few times doesn't always work well if you can't predict how long each iteration will take, so I typically will use GetTickCount to time when 100 milliseconds have passed (1). This is long enough to not slow down performance too much, and fast enough to make the application appear responsive.
var
tc:cardinal;
begin
tc:=GetTickCount;
while something do
begin
if cardinal(GetTickCount-tc)>=100 then
begin
Application.ProcessMessages;
tc:=GetTickCount;
end;
DoSomething;
end;
end;
(1): not exactly 100 milliseconds, but somewhere close. There are more precise ways to measure time like QueryPerformanceTimer, but again this is more work and may hinder performance.
#user2704265, when you mention “application will lose responses to the end user”, do you mean that you want your user to continue working around in your application clicking and typing away? In that case - heed the previous answers and use threading.
If it’s good enough to provide feedback that your application is busy with a lengthy operation [and hasn't frozen] there are some options you can consider:
Dissable user input
Change the cursor to “busy”
Use a progressbar
Add a cancel button
Abiding to your request for a single threaded solution I recommend you start by disabling user input and change the cursor to “busy”.
procedure TForm1.ButtonDoLengthyTaskClick(Sender: TObject);
var i, j : integer;
begin
Screen.Cursor := crHourGlass;
//Disable user input capabilities
ButtonDoLengthyTask.Enabled := false;
Try
// time-consuming loop
For I := 0 to 1024 * 65536 do
Begin
DoTask();
// Calling Processmessages marginally increases the process time
// If we don't call and user clicks the disabled button while waiting then
// at the end of ButtonDoLengthyTaskClick the proc will be called again
// doubling the execution time.
Application.ProcessMessages;
End;
Finally
Screen.Cursor := crDefault;
ButtonDoLengthyTask.Enabled := true;
End;
End;
I'm in the process of updating a Delphi app from Indy 9 to Indy 10.
It's quite painful, as apparently a lot has changed.
I'm stuck at one step.
Here is the old code (working with Indy 9):
A Thread Pool is created and every thread of the pool is initialized and then started.
The individual threads create an indy http client (but it does not matter here).
TUrlThread = class(TIdThread)
...
var
i: Integer;
begin
// create the Pool and init it
Pool := TIdThreadMgrPool.Create(nil);
Pool.PoolSize := Options.RunningThreads;
Pool.ThreadClass:= TUrlThread;
// init threads and start them
for i := 1 to Options.RunningThreads do
begin
with (Pool.GetThread as TUrlThread) do
begin
Index := i;
Controler := Self;
Priority := Options.Priority;
Start;
end;
end;
The TIdThreadMgrPool class is gone with Indy 10.
I've looked for a replacement and TIdSchedulerOfThreadPool looks like a winner,
but I cannot get it running.
Here is the modified (Indy 10) code:
TUrlThread = class(TIdThreadWithTask)
...
var
i: Integer;
begin
// create the Pool and init it
Pool := TIdSchedulerOfThreadPool.Create(nil);
Pool.PoolSize := Options.RunningThreads;
Pool.ThreadClass:= TUrlThread;
// init threads and start them
for i := 1 to Options.RunningThreads do
begin
with (Pool.NewThread as TUrlThread) do
begin
Index := i;
Controler := Self;
Priority := Options.Priority;
Start;
end;
end;
I get an access violation exception here (this is indy code):
procedure TIdTask.DoBeforeRun;
begin
FBeforeRunDone := True;
BeforeRun;
end;
FBeforeRunDone is nil.
You are correct that TIdSchedulerOfThreadPool is Indy 10's replacement for TIdThreadMgrPool. However, what you are not taking into account is that the TIdScheduler architecture is quite a bit different than the TIdThreadMgr architecture.
In Indy 10, TIdThreadWithTask does not operate by itself. As its name implies, TIdThreadWithTask performs a Task, which is a TIdTask-derived object (such as TIdContext, which is Indy 10's replacement for TIdPeerThread) that gets associated with the thread. You are running threads without giving them tasks to perform, that is why you are experiencing crashes. In order to call Start() manually, you need to first create and assign a TIdTask-based object to the TIdThreadWithTask.Task property. TIdTCPServer handles that by calling TIdScheduler.AcquireYarn() to create a TIdYarn object that is linked to a TIdThreadWithTask object, then creates a TIdContext object and passes it to TIdScheduler.StartYarn(), which uses the TIdYarn to access the TIdThreadWithTask to assign its Task property before then calling Start() on it.
However, all is not lost. In both Indy 9 and 10, you really should not be calling TIdThread.Start() manually to begin with. TIdTCPServer handles that for you after accepting a new client connection, obtaining a thread from its ThreadMgr/Scheduler, and associating the client connection to the thread. You can initialize your thread properties as needed without actually running the threads immediately. The properties will take effect the first time the threads begin running at a later time.
Try this:
TUrlThread = class(TIdThread)
...
var
i: Integer;
begin
// create the Pool and init it
Pool := TIdThreadMgrPool.Create(nil);
Pool.PoolSize := Options.RunningThreads;
Pool.ThreadClass:= TUrlThread;
Pool.ThreadPriority := Options.Priority;
// init threads and start them
for i := 1 to Options.RunningThreads do
begin
with (Pool.GetThread as TUrlThread) do
begin
Index := i;
Controler := Self;
end;
end;
.
TUrlThread = class(TIdThreadWithTask)
...
var
i: Integer;
begin
// create the Pool and init it
Pool := TIdSchedulerOfThreadPool.Create(nil);
Pool.PoolSize := Options.RunningThreads;
Pool.ThreadClass:= TUrlThread;
Pool.ThreadPriority := Options.Priority;
// init threads and start them
for i := 1 to Options.RunningThreads do
begin
with (Pool.NewThread as TUrlThread) do
begin
Index := i;
Controler := Self;
end;
end;
Now, with that said, one last thing to watch out for. In both Indy 9 and 10, it is possible for threads to not be put back in the pool when finished, and for new threads to get added to the pool after your initialization code has run. The PoolSize is the minimum number of threads to keep in the pool, not an absolute count. More than PoolSize number of clients can connect to the server and it will happily create more threads for them at the time they are needed, thus bypassing your initialization code. In both versions, the best place to initalize your threads is in the TUrlThread constructor. Store your Controler pointer somewhere that the constructor can reach it when needed. And it does not make sense to assign an Index to each thread since the order of the threads in the pool changes dynamically over time.
In fact, your manual initialization code is actually the wrong approch in both versions for another reason. Both TIdThreadMgrPool.GetThread() and TIdSchedulerOfThreadPool.NewThread() do not add the new thread to the pool at all. Threads are added to the pool in both Indy 9 and 10 when a thread stops running and there is room to save the thread for reuse, and additionally in Indy 10 only when TIdTCPServer is starting up. So you are actually creating threads that are not actually doing anything and are not being tracked by the pool. All the more reason to re-design your initialization code in both versions so threads initialize themselves when they are created under normal conditions, rather than you hacking into the architecture to create them manually.
I poll a lot of devices in network (more than 300) by iterative ping.
The program polls the devices sequentially, so it's slow.
I'd like to enhance the speed of polling.
There some ways to do this in Delphi 7:
Each device has a thread doing ping. Manage threads manually.
Learn and use Indy 10. Need examples.
Use overlapped I/O based on window messages.
Use completion ports based on events.
What is faster, easier? Please, provide some examples or links for example.
Flooding the network with ICMP is not a good idea.
You might want to consider some kind of thread pool and queue up the ping requests and have a fixed number of threads doing the requests.
Personally I would go with IOCP. I'm using that very successfully for the transport implementation in NexusDB.
If you want to perform 300 send/receive cycles using blocking sockets and threads in parallel, you end up needing 300 threads.
With IOCP, after you've associated the sockets with the IOCP, you can perform the 300 send operations, and they will return instantly before the operation is completed. As the operations are completed, so called completion packages will be queued to the IOCP. You then have a pool of threads waiting on the IOCP, and the OS wakes them up as the completion packets come in. In reaction to completed send operations you can then perform the receive operations. The receive operations also return instantly and once actually completed get queued to the IOCP.
The real special thing about an IOCP is that it knows which threads belong to it and are currently processing completion packages. And the IOCP only wakes up new threads if the total number of active threads (not in a kernel mode wait state) is lower than the concurrency number of the IOCP (by default that equals the number of logical cores available on the machine). Also, if there are threads waiting for completion packages on the IOCP (which haven't been started yet despite completion packages being queued because the number of active threads was equal to the concurrancy number), the moment one of the threads that is currently processing a completion package enters a kernel mode wait state for any reason, one of the waiting threads is started.
Threads returning to the IOCP pick up completion packages in LIFO order. That is, if a thread is returning to the IOCP and there are completion packages still waiting, that thread directly picks up the next completion package, instead of being put into a wait state and the thread waiting for the longest time waking up.
Under optimal conditions, you will have a number of threads equal to the number of available cores running concurrently (one on each core), picking up the next completion package, processing it, returning to the IOCP and directly picking up the next completion package, all without ever entering a kernel mode wait state or a thread context switch having to take place.
If you would have 300 threads and blocking operations instead, not only would you waste at least 300 MB address space (for the reserved space for the stacks), but you would also have constant thread context switches as one thread enters a wait state (waiting for a send or receive to complete) and the next thread with a completed send or receive waking up. – Thorsten Engler 12 hours ago
Direct ICMP access is deprecated on windows. Direct access to the ICMP protocol on Windows is controlled. Due to malicious use of ICMP/ping/traceroute style raw sockets, I believe that on some versions of Windows you will need to use Windows own api. Windows XP, Vista, and Windows 7, in particular, don't let user programs access raw sockets.
I have used the canned-functionality in ICMP.dll, which is what some Delphi ping components do, but a comment below alerted me to the fact that this is considered "using an undocumented API interface".
Here's a sample of the main delphi ping component call itself:
function TICMP.ping: pIcmpEchoReply;
{var }
begin
// Get/Set address to ping
if ResolveAddress = True then begin
// Send packet and block till timeout or response
_NPkts := _IcmpSendEcho(_hICMP, _Address,
_pEchoRequestData, _EchoRequestSize,
#_IPOptions,
_pIPEchoReply, _EchoReplySize,
_TimeOut);
if _NPkts = 0 then begin
result := nil;
status := CICMP_NO_RESPONSE;
end else begin
result := _pIPEchoReply;
end;
end else begin
status := CICMP_RESOLVE_ERROR;
result := nil;
end;
end;
I believe that most modern Ping component implementations are going to be based on a similar bit of code to the one above, and I have used it to run this ping operation in a background thread, without any probems. (Demo program included in link below).
Full sample source code for the ICMP.DLL based demo is here.
UPDATE A more modern IPHLPAPI.DLL sample is found at About.com here.
Here's an article from Delphi3000 showing how to use IOCP to create a thread pool. I am not the author of this code, but the author's information is in the source code.
I'm re-posting the comments and code here:
Everyone by now should understand what
a thread is, the principles of threads
and so on. For those in need, the
simple function of a thread is to
separate processing from one thread to
another, to allow concurrent and
parallel execution. The main principle
of threads is just as simple, memory
allocated which is referenced between
threads must be marshalled to ensure
safety of access. There are a number
of other principles but this is really
the one to care about.
And on..
A thread safe queue will allow
multiple threads to add and remove,
push and pop values to and from the
queue safely on a First on First off
basis. With an efficient and well
written queue you can have a highly
useful component in developing
threaded applications, from helping
with thread safe logging, to
asynchronous processing of requests.
A thread pool is simply a thread or a
number of threads which are most
commonly used to manage a queue of
requests. For example a web server
which would have a continuous queue of
requests needing to be processed use
thread pools to manage the http
requests, or a COM+ or DCOM server
uses a thread pool to handle the rpc
requests. This is done so there is
less impact from the processing of one
request to another, say if you ran 3
requests synchronously and the first
request took 1 minute to complete, the
second two requests would not complete
for at least 1 minute adding on top
there own time to process, and for
most of the clients this is not
acceptable.
So how to do this..
Starting with the queue!!
Delphi does provides a TQueue object
which is available but is
unfortunately not thread safe nor
really too efficient, but people
should look at the Contnrs.pas file to
see how borland write there stacks and
queues. There are only two main
functions required for a queue, these
are add and remove/push and pop.
Add/push will add a value, pointer or
object to the end of a queue. And
remove/pop will remove and return the
first value in the queue.
You could derive from TQueue object
and override the protected methods and
add in critical sections, this will
get you some of the way, but I would
want my queue to wait until new
requests are in the queue, and put the
thread into a state of rest while it
waits for new requests. This could be
done by adding in Mutexes or signaling
events but there is an easier way. The
windows api provides an IO completion
queue which provides us with thread
safe access to a queue, and a state of
rest while waiting for new request in
the queue.
Implementing the Thread Pool
The thread pool is going to be very
simple and will manage x number of
threads desired and pass each queue
request to an event provided to be
processed. There is rarely a need to
implement a TThread class and your
logic to be implemented and
encapsulated within the execute event
of the class, thus a simple
TSimpleThread class can be created
which will execute any method in any
object within the context of another
thread. Once people understand this,
all you need to concern yourself with
is allocated memory.
Here is how it is implemented.
TThreadQueue and TThreadPool
implementation
(* Implemented for Delphi3000.com Articles, 11/01/2004
Chris Baldwin
Director & Chief Architect
Alive Technology Limited
http://www.alivetechnology.com
*)
unit ThreadUtilities;
uses Windows, SysUtils, Classes;
type
EThreadStackFinalized = class(Exception);
TSimpleThread = class;
// Thread Safe Pointer Queue
TThreadQueue = class
private
FFinalized: Boolean;
FIOQueue: THandle;
public
constructor Create;
destructor Destroy; override;
procedure Finalize;
procedure Push(Data: Pointer);
function Pop(var Data: Pointer): Boolean;
property Finalized: Boolean read FFinalized;
end;
TThreadExecuteEvent = procedure (Thread: TThread) of object;
TSimpleThread = class(TThread)
private
FExecuteEvent: TThreadExecuteEvent;
protected
procedure Execute(); override;
public
constructor Create(CreateSuspended: Boolean; ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
end;
TThreadPoolEvent = procedure (Data: Pointer; AThread: TThread) of Object;
TThreadPool = class(TObject)
private
FThreads: TList;
FThreadQueue: TThreadQueue;
FHandlePoolEvent: TThreadPoolEvent;
procedure DoHandleThreadExecute(Thread: TThread);
public
constructor Create( HandlePoolEvent: TThreadPoolEvent; MaxThreads: Integer = 1); virtual;
destructor Destroy; override;
procedure Add(const Data: Pointer);
end;
implementation
{ TThreadQueue }
constructor TThreadQueue.Create;
begin
//-- Create IO Completion Queue
FIOQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
FFinalized := False;
end;
destructor TThreadQueue.Destroy;
begin
//-- Destroy Completion Queue
if (FIOQueue <> 0) then
CloseHandle(FIOQueue);
inherited;
end;
procedure TThreadQueue.Finalize;
begin
//-- Post a finialize pointer on to the queue
PostQueuedCompletionStatus(FIOQueue, 0, 0, Pointer($FFFFFFFF));
FFinalized := True;
end;
(* Pop will return false if the queue is completed *)
function TThreadQueue.Pop(var Data: Pointer): Boolean;
var
A: Cardinal;
OL: POverLapped;
begin
Result := True;
if (not FFinalized) then
//-- Remove/Pop the first pointer from the queue or wait
GetQueuedCompletionStatus(FIOQueue, A, Cardinal(Data), OL, INFINITE);
//-- Check if we have finalized the queue for completion
if FFinalized or (OL = Pointer($FFFFFFFF)) then begin
Data := nil;
Result := False;
Finalize;
end;
end;
procedure TThreadQueue.Push(Data: Pointer);
begin
if FFinalized then
Raise EThreadStackFinalized.Create('Stack is finalized');
//-- Add/Push a pointer on to the end of the queue
PostQueuedCompletionStatus(FIOQueue, 0, Cardinal(Data), nil);
end;
{ TSimpleThread }
constructor TSimpleThread.Create(CreateSuspended: Boolean;
ExecuteEvent: TThreadExecuteEvent; AFreeOnTerminate: Boolean);
begin
FreeOnTerminate := AFreeOnTerminate;
FExecuteEvent := ExecuteEvent;
inherited Create(CreateSuspended);
end;
procedure TSimpleThread.Execute;
begin
if Assigned(FExecuteEvent) then
FExecuteEvent(Self);
end;
{ TThreadPool }
procedure TThreadPool.Add(const Data: Pointer);
begin
FThreadQueue.Push(Data);
end;
constructor TThreadPool.Create(HandlePoolEvent: TThreadPoolEvent;
MaxThreads: Integer);
begin
FHandlePoolEvent := HandlePoolEvent;
FThreadQueue := TThreadQueue.Create;
FThreads := TList.Create;
while FThreads.Count < MaxThreads do
FThreads.Add(TSimpleThread.Create(False, DoHandleThreadExecute, False));
end;
destructor TThreadPool.Destroy;
var
t: Integer;
begin
FThreadQueue.Finalize;
for t := 0 to FThreads.Count-1 do
TThread(FThreads[t]).Terminate;
while (FThreads.Count > 0) do begin
TThread(FThreads[0]).WaitFor;
TThread(FThreads[0]).Free;
FThreads.Delete(0);
end;
FThreadQueue.Free;
FThreads.Free;
inherited;
end;
procedure TThreadPool.DoHandleThreadExecute(Thread: TThread);
var
Data: Pointer;
begin
while FThreadQueue.Pop(Data) and (not TSimpleThread(Thread).Terminated) do begin
try
FHandlePoolEvent(Data, Thread);
except
end;
end;
end;
end.
As you can see it's quite straight
forward, and with this you can
implement very easily any queuing of
requests over threads and really any
type of requirement that requires
threading can be done using these
object and save you a lot of time and
effort.
You can use this to queue requests
from one thread to multiple threads,
or queue requests from multiple
threads down to one thread which makes
this quite a nice solution.
Here are some examples of using these
objects.
Thread safe logging
To allow multiple
threads to asynchronously write to a
log file.
uses Windows, ThreadUtilities,...;
type
PLogRequest = ^TLogRequest;
TLogRequest = record
LogText: String;
end;
TThreadFileLog = class(TObject)
private
FFileName: String;
FThreadPool: TThreadPool;
procedure HandleLogRequest(Data: Pointer; AThread: TThread);
public
constructor Create(const FileName: string);
destructor Destroy; override;
procedure Log(const LogText: string);
end;
implementation
(* Simple reuse of a logtofile function for example *)
procedure LogToFile(const FileName, LogString: String);
var
F: TextFile;
begin
AssignFile(F, FileName);
if not FileExists(FileName) then
Rewrite(F)
else
Append(F);
try
Writeln(F, DateTimeToStr(Now) + ': ' + LogString);
finally
CloseFile(F);
end;
end;
constructor TThreadFileLog.Create(const FileName: string);
begin
FFileName := FileName;
//-- Pool of one thread to handle queue of logs
FThreadPool := TThreadPool.Create(HandleLogRequest, 1);
end;
destructor TThreadFileLog.Destroy;
begin
FThreadPool.Free;
inherited;
end;
procedure TThreadFileLog.HandleLogRequest(Data: Pointer; AThread: TThread);
var
Request: PLogRequest;
begin
Request := Data;
try
LogToFile(FFileName, Request^.LogText);
finally
Dispose(Request);
end;
end;
procedure TThreadFileLog.Log(const LogText: string);
var
Request: PLogRequest;
begin
New(Request);
Request^.LogText := LogText;
FThreadPool.Add(Request);
end;
As this is logging to a file it will
process all requests down to a single
thread, but you could do rich email
notifications with a higher thread
count, or even better, process
profiling with what’s going on or
steps in your program which I will
demonstrate in another article as this
one has got quite long now.
For now I will leave you with this,
enjoy.. Leave a comment if there's
anything people are stuck with.
Chris
Do you need a response from every machine on the network, or are these 300 machines just a subset of the larger network?
If you need a response from every machine, you could consider using a broadcast address or multicast address for your echo request.
Please give a try on "chknodes" parallel ping for Linux which will send a single ping to all nodes of your network. It will do also dns reverse lookup and request http response if specified so. It's written completely in bash i.e. you can easily check it or modify it to your needs. Here is a printout of help:
chknodes -h
chknodes ---- fast parallel ping
chknodes [-l|--log] [-h|--help] [-H|--http] [-u|--uninstall] [-v|--version] [-V|--verbose]
-l | --log Log to file
-h | --help Show this help screen
-H | --http Check also http response
-n | --names Get also host names
-u | --uninstall Remove installation
-v | --version Show version
-V | --verbose Show each ip address pinged
You need to give execute right for it (like with any sh/bash script) in order to run it:
chmod +x chknodes
On the first run i.e.
./chknodes
it will suggest to install itself to /usr/local/bin/chknodes, after that giving just
chknodes
will be enough. You can find it here:
www.homelinuxpc.com/download/chknodes