Migrating from Indy 9 to 10 with Delphi, TIdSchedulerOfThreadPool initialization - delphi

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.

Related

Delphi: TTask seem slow only the first time

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.

TIdTcpServer connection limiting

I want to restrict the number of incoming connections that a TIdTcpServer can take, but the rule I need to apply is a little complex, so I don't think the MaxConnections property will work for me.
I have an application running N servers, each using a different protocol on a different port. I need to limit the total number of clients across all N servers. So for example, with 16 servers, and 16 clients allowed, I would allow one client on each, or 16 all on a single server.
It's possible I could manipulate the MaxConnections dynamically to fix this (e.g. set them all to zero when I determine we're 'full', and back to 16 or whatever when we're not full, but this feels a little too tricksy.
Is there some kind of virtual IsConnectionAllowed method that I can override with my own logic, or a suitable place in the connection process where I can raise an exception if I determine the limit has been exceeded?
Create a new component - TIdTCPServerCollection for example - which is the "owner" of all server components.
In this component, declare a thread-safe property which stores the available - currently unused - connection count.
In the server connect and disconnect logic, decrement / increment this variable, and set MaxConnections to reflect the new limit.
One option might be to implement a custom TIdScheduler class that derives from one of the TIdSchedulerofThread... components and override its virtual AcquireYarn() method to either:
raise an EAbort exception if the scheduler's ActiveYarns list has reached the max allowed number of connections. This might cause too tight a loop in TIdTCPServer listening threads, though. To mitigate that, you could put a small timer in the method and only raise the exception if the list remains maxed out for a short period of time.
block the calling thread (the TIdTCPServer listening thread) until the ActiveYarns has fewer yarns than your max connection limit, then call the inherited method to return a new TIdYarn object normally.
For example:
type
TMyScheduler = class(TIdSchedulerOfThreadDefault)
public
function AcquireYarn: TIdYarn; override;
end;
function TMyScheduler.AcquireYarn: TIdYarn;
begin
if not ActiveYarns.IsCountLessThan(SomeLimit) then
begin
Sleep(1000);
if not ActiveYarns.IsCountLessThan(SomeLimit) then
Abort;
end;
Result := inherited;
end;
Then assign a single instance of this class to the Scheduler property of all the servers. TIdTCPServer calls AcquireYarn() before accepting a new client connection.
Another option, for Windows only, would be to derive a new TIdStack class from TIdStackWindows and override its virtual Accept() method to use Winsock's WSAAccept() function instead of its accept() function. WSAAccept() allows you to assign a callback function that decides whether a new client is accepted or rejected based on criteria passed to the callback (QOS, etc). That callback could check a global counter you maintain for how many active connections are running (or just sum up all of the servers' active Contexts counts), and then return CF_REJECT if the limit has been reached, otherwise return CF_ACCEPT. You could then use the SetStackClass() function in the IdStack unit to assign your class as the active Stack for all Indy socket connections.
For example:
type
TMyStack = class(TIdStackWindows)
public
function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override;
end;
function MyAcceptCallback(lpCallerId: LPWSABUF; lpCallerData: LPWSABUF; lpSQOS, pGQOS: LPQOS; lpCalleeId, lpCalleeData: LPWSABUF; g: PGROUP; dwCallbackData: DWORD_PTR): Integer; stdcall;
begin
if NumActiveConnections >= SomeLimit then
Result := CF_REJECT
else
Result := CF_ACCEPT;
end;
function TMyStack.Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle;
var
LSize: Integer;
LAddr: SOCKADDR_STORAGE;
begin
LSize := SizeOf(LAddr);
//Result := IdWinsock2.accept(ASocket, IdWinsock2.PSOCKADDR(#LAddr), #LSize);
Result := IdWinsock2.WSAAccept(ASocket, IdWinsock2.PSOCKADDR(#LAddr), #LSize, #MyAcceptCallback, 0);
if Result <> INVALID_SOCKET then begin
case LAddr.ss_family of
Id_PF_INET4: begin
VIP := TranslateTInAddrToString(PSockAddrIn(#LAddr)^.sin_addr, Id_IPv4);
VPort := ntohs(PSockAddrIn(#LAddr)^.sin_port);
VIPVersion := Id_IPv4;
end;
Id_PF_INET6: begin
VIP := TranslateTInAddrToString(PSockAddrIn6(#LAddr)^.sin6_addr, Id_IPv6);
VPort := ntohs(PSockAddrIn6(#LAddr)^.sin6_port);
VIPVersion := Id_IPv6;
end;
else begin
CloseSocket(Result);
Result := INVALID_SOCKET;
IPVersionUnsupported;
end;
end;
end;
end;
initialization
SetStackClass(TMyStack);
This way, Indy will never see any rejected client connections at all, and you do not have to worry about implementing any other hacks inside of TIdTCPServer or its various dependencies. Everything will work normally and simply block as expected whenever TIdStack.Accept() does not return an accepted client.

Delphi: How to prevent a single thread app from losing responses?

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;

Indy, Acces Violatio when too many connections

I have three questions:
is it possible to destroy IdTCPServer by to many connection?
I tried to test my application and when I have several connections - it works very good (even several days) but when sometimes number of connection increases application gives acess violation. I wrote application similates 50 clients sending data constantly (with only sleep(200)). And in this situation IdTCPServer gives exceptions?
My application reseives information from clients by onExecute event and modyfies databases table using
TidNotify and TIdSync classes. I believe it protects crosses connections threads?
Sending information to clients is doing by TTimer (it is only now, I'll change it to other thread).
Have I use in this situation special protection or something like that is enough:
type
PClient = ^TClient;
TClient = record
Activity_time:TDateTime;
AContext: TIdContext;
end;
...
list := server.Contexts.LockList;
try
for i := 0 to list.Count - 1 do
with TIdContext(list[i]) do
begin
if SecondsBetween(now(), PClient(data)^.activity_time) > 6 then
begin
Connection.IOHandler.Close;
Continue;
end;
try
Connection.IOHandler.writeln('E:');
Except
Connection.IOHandler.Close;
end;
end;
finally
server.Contexts.UnlockList;
end;
2.Is a simple way to refuse connection when server is to busy (I think my database isn't complicated (100 rows, only one row is modyfied by one connection) but maybe here is a way to keep stability of server?
3.I know that this question was repeating many times but I didn't find satisfying answer: how to protect application to avoid message exception: "Connection closed gracefully" and "Connection reset by peer"?
Thank You for all advices
is it possible to destroy IdTCPServer by to many connection?
You are asking the wrong question, because you are not actually destroying TIdTCPServer itself, you are simply closing idle connections from an outside thread. That kind of logic can be (and should be) handled inside of the OnExecute event instead, where it is safest to access the connection, eg:
type
PClient = ^TClient;
TClient = record
Activity_time: TDateTime;
Heartbeat_time: TDateTime;
AContext: TIdContext;
end;
procedure TForm1.serverConnect(AContext: TIdContext);
var
Client: PClient;
begin
New(Client);
Client^.Activity_time := Now();
Client^.Heartbeat_time := Client^.Activity_time;
AContext.Data := TObject(Client);
end;
procedure TForm1.serverDisconnect(AContext: TIdContext);
var
Client: PClient;
begin
Client := PClient(AContext.Data);
AContext.Data := nil;
if Client <> nil then Dispose(Client);
end;
procedure TForm1.serverExecute(AContext: TIdContext);
var
Client: PClient;
dtNow: TDateTime;
begin
Client := PClient(AContext.Data);
dtNow := Now();
if SecondsBetween(dtNow, Client^.Activity_time) > 6 then
begin
AContext.Connection.Disconnect;
Exit;
end;
if SecondsBetween(dtNow, Client^.Heartbeat_time) > 2 then
begin
AContext.Connection.IOHandler.WriteLn('E:');
Client^.Heartbeat_time := dtNow;
end;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if not AContext.Connection.IOHandler.CheckForDataOnSource(100) then
Exit;
end;
// process incoming data as needed ...
Client^.Activity_time := Now();
end;
Is a simple way to refuse connection when server is to busy (I think my database isn't complicated (100 rows, only one row is modyfied by one connection) but maybe here is a way to keep stability of server?
The current architecture does not allow for refusing connections from being accepted. You can let the server accept connections normally and then close accepted connections when needed. You can do that in the OnConnect event, or you can set the server's MaxConnection property to a low non-zero number to allow the server to auto-disconnect new connections for you without wasting resources creating new TIdContext objects and threads for them.
Another option is to call the server's StopListening() method when the server is busy, so that new connections cannot reach the server anymore, and then call the server's StartListening() method when you are ready to accept new clients again. Existing clients who are already connected should not be affected, though I have not actually tried that myself yet.
I know that this question was repeating many times but I didn't find satisfying answer: how to protect application to avoid message exception: "Connection closed gracefully" and "Connection reset by peer"?
You should not avoid them. Let them happen, they are normal errors. If they are happening inside of the server's events, just let the server handle them normally for you. That is how TIdTCServer is designed to be used. If they are happening outside of the server's events, such as in your timer, then just wrap the socket operation(s) in a try/except block and move on.

What's the best way to ping many network devices in parallel?

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

Resources