[英]Delphi (XE2) Indy (10) Multithread Ping
I have a room with 60 computers/devices (40 computers and 20 oscilloscopes Windows CE based) and I would like to know which and every one is alive using ping. 我有一间装有60台计算机/设备的房间(40台计算机和20台基于Windows CE的示波器),我想知道使用ping的每台设备都还活着。 First I wrote a standard ping (see here Delphi Indy Ping Error 10040 ), which is working fine now but takes ages when most computers are offline.
首先,我编写了一个标准的ping命令(请参阅此处, Delphi Indy Ping错误10040 ),该命令现在可以正常工作,但是大多数计算机都处于脱机状态会花费一些时间。
So what I am trying to do is to write a MultiThread Ping but I am quite struggling with it. 因此,我想做的是编写一个MultiThread Ping,但我对此颇为挣扎。 I have seen only very few examples over the internet and no one was matching my needs, that's why I try to write it myself.
我在互联网上仅看到很少的示例,没有人满足我的需求,这就是为什么我尝试自己编写它。
I use XE2 and Indy 10 and the form is only constitued of a memo and a button. 我使用XE2和Indy 10,并且表单仅由备忘录和按钮组成。
unit Main;
interface
uses
Winapi.Windows, System.SysUtils, System.Classes, Vcl.Forms,
IdIcmpClient, IdGlobal, Vcl.StdCtrls, Vcl.Controls;
type
TMainForm = class(TForm)
Memo1: TMemo;
ButtonStartPing: TButton;
procedure ButtonStartPingClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TMyPingThread = class(TThread)
private
fIndex : integer;
fIdIcmpClient: TIdIcmpClient;
procedure doOnPingReply;
protected
procedure Execute; override;
public
constructor Create(index: integer);
end;
var
MainForm: TMainForm;
ThreadCOunt : integer;
implementation
{$R *.dfm}
constructor TMyPingThread.Create(index: integer);
begin
inherited Create(false);
fIndex := index;
fIdIcmpClient := TIdIcmpClient.Create(nil);
fIdIcmpClient.ReceiveTimeout := 200;
fIdIcmpClient.PacketSize := 24;
fIdIcmpClient.Protocol := 1;
fIdIcmpClient.IPVersion := Id_IPv4;
//first computer is at adresse 211
fIdIcmpClient.Host := '128.178.26.'+inttostr(211+index-1);
self.FreeOnTerminate := true;
end;
procedure TMyPingThread.doOnPingReply;
begin
MainForm.Memo1.lines.add(inttostr(findex)+' '+fIdIcmpClient.ReplyStatus.Msg);
dec(ThreadCount);
if ThreadCount = 0 then
MainForm.Memo1.lines.add('--- End ---');
end;
procedure TMyPingThread.Execute;
begin
inherited;
try
fIdIcmpClient.Ping('',findex);
except
end;
while not Terminated do
begin
if fIdIcmpClient.ReplyStatus.SequenceId = findex then Terminate;
end;
Synchronize(doOnPingReply);
fIdIcmpClient.Free;
end;
procedure TMainForm.ButtonStartPingClick(Sender: TObject);
var
i: integer;
myPing : TMyPingThread;
begin
Memo1.Lines.Clear;
ThreadCount := 0;
for i := 1 to 40 do
begin
inc(ThreadCount);
myPing := TMyPingThread.Create(i);
//sleep(10);
end;
end;
end.
My problem is that it "seems" to work when I uncomment the "sleep(10)", and "seems" not to be working without it. 我的问题是,当我取消对“ sleep(10)”的注释时,它“似乎”可以工作,而如果没有注释,它似乎就无法工作。 This for sure means I am missing a point in the threading I have written.
这肯定意味着我在编写的线程中遗漏了一点。
In other words. 换一种说法。 When Sleep(10) is in the code.
在代码中使用Sleep(10)时。 Every time I clicked the button to get to check the connections the result was correct.
每次我单击按钮开始检查连接时,结果都是正确的。
Without the sleep(10), it is working "most" of the time but some times the result is wrong giving me a ping echo on offline computers and no ping echo on online computer, as is the ping reply was not assigned to the correct thread. 没有sleep(10),它在大多数时间都处于工作状态,但是有时结果是错误的,这使我在脱机计算机上发出ping回声,而在联机计算机上没有ping回声,因为ping答复未分配给正确的线。
Any comment or help is welcome. 欢迎任何评论或帮助。
----- EDIT / IMPORTANT ----- -----编辑/重要-----
As a general follow up of this question, @Darian Miller started a Google Code project here https://code.google.com/p/delphi-stackoverflow/ which is a working basis. 作为对该问题的一般跟进,@ Darian Miller 在此处 https://code.google.com/p/delphi-stackoverflow/启动了Google Code项目,这是一个有效的基础。 I mark his answer as the "accepted answer" but users should refer to this open source project (all the credit belongs to him) as it will surely be extended and updated in the future.
我将他的答案标记为“可接受的答案”,但是用户应参考此开源项目(所有功劳归他所有),因为将来肯定会对其进行扩展和更新。
The root problem is that pings are connectionless traffic. 根本问题是ping是无连接流量。 If you have multiple
TIdIcmpClient
objects pinging the network at the same time, one TIdIcmpClient
instance can receive a reply that actually belongs to another TIdIcmpClient
instance. 如果您有多个
TIdIcmpClient
对象同时对网络执行ping操作,则一个TIdIcmpClient
实例可以收到实际上属于另一个TIdIcmpClient
实例的答复。 You are trying to account for that in your thread loop, by checking SequenceId
values, but you are not taking into account that TIdIcmpClient
already does that same check internally. 您正在尝试通过检查
SequenceId
值来解决线程循环中的问题,但并未考虑TIdIcmpClient
已经在内部进行了相同的检查。 It reads network replies in a loop until it receives the reply it is expecting, or until the ReceiveTimeout
occurs. 它以循环方式读取网络答复,直到收到期望的答复,或者直到发生
ReceiveTimeout
。 If it receives a reply it is not expecting, it simply discards that reply. 如果收到不期望的答复,它只会丢弃该答复。 So, if one
TIdIcmpClient
instance discards a reply that another TIdIcmpClient
instance was expecting, that reply will not get processed by your code, and that other TIdIcmpClient
will likely receive another TIdIcmpClient
's reply instead, and so on. 因此,如果一个
TIdIcmpClient
实例放弃了另一个TIdIcmpClient
实例期望的答复,则该答复将不会被您的代码处理,而另一个TIdIcmpClient
可能会收到另一个TIdIcmpClient
的答复,依此类推。 By adding the Sleep()
, you are decreasing (but not eliminating) the chances that pings will overlap each other. 通过添加
Sleep()
,您将减少(但不消除)ping相互重叠的机会。
For what you are attempting to do, you won't be able to use TIdIcmpClient
as-is to have multiple pings running in parallel, sorry. 对于您要尝试执行的操作,您将无法按
TIdIcmpClient
使用TIdIcmpClient
来并行运行多个ping,抱歉。 It is simply not designed for that. 它根本不是为此目的而设计的。 There is no way for it to differentiate reply data the way you need it.
它没有办法按照您需要的方式区分答复数据。 You will have to serialize your threads so only one thread can call
TIdIcmpClient.Ping()
at a time. 您将必须序列化线程,以便一次只能有一个线程调用
TIdIcmpClient.Ping()
。
If serializing the pings is not an option for you, you can try copying portions of TIdIcmpClient
's source code into your own code. 如果您不能序列化ping命令,则可以尝试将
TIdIcmpClient
的部分源代码复制到自己的代码中。 Have 41 threads running - 40 device threads and 1 response thread. 有41个正在运行的线程-40个设备线程和1个响应线程。 Create a single socket that all of the threads share.
创建所有线程共享的单个套接字。 Have each device thread prepare and send its individual ping request to the network using that socket.
让每个设备线程准备并使用该套接字将其单独的ping请求发送到网络。 Then have the response thread continuously reading replies from that same socket and routing them back to the appropriate device thread for processing.
然后,使响应线程连续读取来自同一套接字的答复,并将其路由回适当的设备线程进行处理。 This is a bit more work, but it will give you the multiple-ping parallelism you are looking for.
这需要更多的工作,但是它将为您提供所需的多Ping并行性。
If you don't want to go to all that trouble, an alternative is to just use a third-party app that already supports pinging multiple machines at the same time, like FREEPing . 如果您不想解决所有麻烦,另一种方法是只使用已经支持同时ping多台计算机的第三方应用程序,例如FREEPing 。
Remy explained the problems... I've wanted to do this in Indy for a while so I posted a possible solution that I just put together to a new Google Code project instead of having a long comment here. 雷米(Remy)解释了这些问题...我已经在Indy中做了一段时间了,所以我发布了一个可能的解决方案,我将其整合到一个新的Google Code项目中,而无需在此处发表过多评论。 It's a first-stab sort of thing, let me know if you have some changes to integrate: https://code.google.com/p/delphi-vault/
这是最棘手的事情,如果您需要集成一些更改,请告诉我: https : //code.google.com/p/delphi-vault/
This code has two ways to Ping...multi-threaded clients as in your example, or with a simple callback procedure. 这段代码有两种方法可以Ping ...如您的示例中所示的多线程客户端,或使用简单的回调过程。 Written for Indy10 and later versions of Delphi.
为Indy10和更高版本的Delphi写。
Your code would end up using a TThreadedPing descendant defining a SynchronizedResponse method: 您的代码最终将使用TThreadedPing子孙定义了SynchronizedResponse方法:
TMyPingThread = class(TThreadedPing)
protected
procedure SynchronizedResponse(const ReplyStatus:TReplyStatus); override;
end;
And to fire off some client threads, the code becomes something like: 为了触发一些客户端线程,代码变为:
procedure TfrmThreadedPingSample.butStartPingClick(Sender: TObject);
begin
TMyPingThread.Create('www.google.com');
TMyPingThread.Create('127.0.0.1');
TMyPingThread.Create('www.shouldnotresolvetoanythingatall.com');
TMyPingThread.Create('127.0.0.1');
TMyPingThread.Create('www.microsoft.com');
TMyPingThread.Create('127.0.0.1');
end;
The threaded response is called in a synchronized method: 线程响应在同步方法中调用:
procedure TMyPingThread.SynchronizedResponse(const ReplyStatus:TReplyStatus);
begin
frmThreadedPingSample.Memo1.Lines.Add(TPingClient.FormatStandardResponse(ReplyStatus));
end;
I did not try your code, so that is all hypothetical, but i think you messed the threads and got classic race condition
. 我没有尝试过您的代码,因此所有假设都是这样,但是我认为您弄乱了线程并获得了经典的
race condition
。 I restate my advice to use AsyncCalls
or OmniThreadLibrary
- they are much simpler and would save you few attempts at "shooting your own foot". 我重申使用
AsyncCalls
或OmniThreadLibrary
建议-它们更简单,并且可以为您省去“ OmniThreadLibrary
自己的脚”的几次尝试。
Threads are made to minimize main-thread load. 线程被制成以最小化主线程负载。 Thread constructor should do minimal work of remembering parameters.
线程构造函数应该做最少的记住参数的工作。 Personally i'd moved idICMP creation into
.Execute
method. 我个人将idICMP创建移至
.Execute
方法。 If for any reason it would want to create its internal synchronization objects, like window and message queue or signal or whatever, i'd like it to happen already in a new spawned thread. 如果出于某种原因,它想创建其内部同步对象,例如窗口和消息队列或信号等,我希望它已经在新的生成线程中发生。
There is no sense for "inherited;" “继承”没有意义。 in .Execute.
在.Execute中 Better remove it.
最好将其删除。
Silencing all exceptions is bad style. 沉默所有异常是不好的风格。 You probably have errors - but have no way to know about them.
您可能有错误-但无法了解它们。 You should propagate them to main thread and display them.
您应该将它们传播到主线程并显示它们。 OTL and AC help you in that, while for tThread you have to do it manually.
OTL和AC可以帮助您,而对于tThread,则必须手动进行。 How to Handle Exceptions thrown in AsyncCalls function without calling .Sync?
如何处理AsyncCalls函数中引发的异常而不调用.Sync?
Exception logic is flawed. 异常逻辑有缺陷。 There is no point to have a loop if exception thrown - if no succesful Ping was set - then why waiting for response ?
如果抛出异常,就没有循环的可能-如果未设置成功的Ping-那么为什么要等待响应? You loop should go within same try-except frame as issuing ping.
您的循环应与发出ping的尝试帧相同。
Your doOnPingReply
executes AFTER fIdIcmpClient.Free
yet accesses fIdIcmpClient
's internals. 您的
doOnPingReply
执行doOnPingReply
之后fIdIcmpClient.Free
但仍访问fIdIcmpClient
的内部。 Tried changing .Free for FreeAndNil ? 尝试更改.Free for FreeAndNil吗? That is a classic mistake of using dead pointer after freeing it.
这是在释放死指针后使用死指针的经典错误。 The correct approach would be to:
正确的方法是:
5.1. 5.1。 either free the object in
doOnPingReply
要么在
doOnPingReply
释放对象
5.2. 5.2。 or copy all relevant data from
doOnPingReply
to TThread's private member vars before calling both Synchronize
and idICMP.Free
(and only use those vars in doOnPingReply
) 5.3. 或在调用
Synchronize
和idICMP.Free
之前将所有相关数据从doOnPingReply
复制到TThread的私有成员vars中(并且仅在doOnPingReply
使用这些vars)5.3。 only do fIdIcmpClient.Free
inside TMyThread.BeforeDestruction
or TMyThread.Destroy
. 只做
fIdIcmpClient.Free
内TMyThread.BeforeDestruction
或TMyThread.Destroy
。 Afterall, if you chosen to create the object in constructor - then you should free it in the matching language construct - destructor. 毕竟,如果您选择在构造函数中创建对象-那么您应该在匹配的语言构造-析构函数中释放它。
Since you do not keep references to the thread objects - that While not Terminated
loop seems redundant. 由于您不保留对线程对象的引用,因此,
While not Terminated
循环似乎是多余的。 Just make usual forever-loop and call break. 只需进行通常的永远循环并中断即可。
The aforementioned loop is CPU-hungry, it is like spin-loop. 前面提到的循环很耗CPU,就像自旋循环一样。 Please call
Sleep(0);
请致电
Sleep(0);
or Yield();
或
Yield();
inside loop to give other threads better chance to do their work. 内部循环,使其他线程有更好的机会进行工作。 Don't work agaisnt OS scheduler here - you are not in a speed-critical path, no reason to make
spinlock
here. 不要在这里使用可用的OS调度程序-您的速度并不严格,没有理由在此处进行
spinlock
。
Overall, i consider: 总的来说,我认为:
Funny, this is example of the bug that FreeAndNil
could expose and make obvious, while FreeAndNil-haters are claiming it "conceals" bugs. 有趣的是,这是
FreeAndNil
可能暴露并使其明显的错误的示例,而FreeAndNil-haters声称它“隐藏”了这些错误。
// This is my communication unit witch works well, no need to know its work but your
// ask is in the TPingThread class.
UNIT UComm;
INTERFACE
USES
Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls, Forms, Dialogs,
StdCtrls,IdIcmpClient, ComCtrls, DB, abcwav, SyncObjs, IdStack, IdException,
IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdContext,
UDM, UCommon;
TYPE
TNetworkState = (nsNone, nsLAN, nsNoLAN, nsNet, nsNoNet);
TDialerStatus = (dsNone, dsConnected, dsDisconnected, dsNotSync);
{ TBaseThread }
TBaseThread = Class(TThread)
Private
FEvent : THandle;
FEventOwned : Boolean;
Procedure ThreadTerminate(Sender: TObject); Virtual;
Public
Constructor Create(AEventName: String);
Property EventOwned: Boolean Read FEventOwned;
End;
.
.
.
{ TPingThread }
TPingThread = Class(TBaseThread)
Private
FReply : Boolean;
FTimeOut : Integer;
FcmpClient : TIdIcmpClient;
Procedure ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Protected
Procedure Execute; Override;
Procedure ThreadTerminate(Sender: TObject); Override;
Public
Constructor Create(AHostIP, AEventName: String; ATimeOut: Integer);
Property Reply: Boolean Read FReply;
End;
.
.
.
{ =============================================================================== }
IMPLEMENTATION
{$R *.dfm}
USES
TypInfo, WinSock, IdGlobal, UCounter, UGlobalInstance, URemoteDesktop;
{IdGlobal: For RawToBytes function 10/07/2013 04:18 }
{ TBaseThread }
//---------------------------------------------------------
Constructor TBaseThread.Create(AEventName: String);
Begin
SetLastError(NO_ERROR);
FEvent := CreateEvent(Nil, False, False, PChar(AEventName));
If GetLastError = ERROR_ALREADY_EXISTS
Then Begin
CloseHandle(FEvent);
FEventOwned := False;
End
Else If FEvent <> 0 Then
Begin
FEventOwned := True;
Inherited Create(True);
FreeOnTerminate := True;
OnTerminate := ThreadTerminate;
End;
End;
//---------------------------------------------------------
Procedure TBaseThread.ThreadTerminate(Sender: TObject);
Begin
CloseHandle(FEvent);
End;
{ TLANThread }
.
.
.
{ TPingThread }
//---------------------------------------------------------
Constructor TPingThread.Create(AHostIP: String; AEventName: String; ATimeOut: Integer);
Begin
Inherited Create(AEventName);
If Not EventOwned Then Exit;
FTimeOut := ATimeOut;
FcmpClient := TIdIcmpClient.Create(Nil);
With FcmpClient Do
Begin
Host := AHostIP;
ReceiveTimeOut := ATimeOut;
OnReply := ReplyEvent;
End;
End;
//---------------------------------------------------------
Procedure TPingThread.Execute;
Begin
Try
FcmpClient.Ping;
FReply := FReply And (WaitForSingleObject(FEvent, FTimeOut) = WAIT_OBJECT_0);
Except
FReply := False;
End;
End;
//---------------------------------------------------------
Procedure TPingThread.ReplyEvent(Sender: TComponent; Const AReplyStatus: TReplyStatus);
Begin
With AReplyStatus Do
FReply := (ReplyStatusType = rsEcho) And (BytesReceived <> 0);
SetEvent(FEvent);
End;
//---------------------------------------------------------
Procedure TPingThread.ThreadTerminate(Sender: TObject);
Begin
FreeAndNil(FcmpClient);
Inherited;
End;
{ TNetThread }
.
.
.
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.