Delphi (XE2) Indy (10) Multithread Ping

La racine du problème est que les pings sont sans connexion de la circulation. Si vous avez plusieurs TIdIcmpClient objets d'interroger le réseau en même temps, un TIdIcmpClient instance peut recevoir une réponse qui appartient en réalité à un autre TIdIcmpClient instance. Vous essayez de tenir compte de cela dans votre boucle de fil, en vérifiant SequenceId valeurs, mais vous ne prenez pas en compte le fait que TIdIcmpClient déjà fait la même vérifier en interne. Il lit réseau réponses dans une boucle jusqu'à ce qu'il reçoit la réponse qu'il attend, ou jusqu'à ce que le ReceiveTimeout se produit. S'il reçoit une réponse, il n'attend pas, il suffit simplement de se défausse de cette réponse. Ainsi, si l'on TIdIcmpClient instance rejette une réponse d'un autre TIdIcmpClient instance attendais, cette réponse ne va pas être traités par votre code, et que d'autres TIdIcmpClient serez susceptibles de recevoir une autre TIdIcmpClient's réponse, et ainsi de suite. En ajoutant le Sleep()vous êtes à la baisse (mais pas éliminer) les chances que les pings se chevauchent les uns les autres.

Pour ce que vous tentez de le faire, vous ne serez pas en mesure d'utiliser TIdIcmpClient comme-est d'avoir plusieurs pings fonctionnent en parallèle, désolé. Il n'est tout simplement pas conçu pour cela. Il n'y a aucun moyen de différencier les données de réponse de la façon dont vous avez besoin. Vous aurez pour sérialiser vos fils, un seul thread peut appeler TIdIcmpClient.Ping() à la fois.

Si la sérialisation de l'pings n'est pas une option pour vous, vous pouvez essayer de copier des parties de TIdIcmpClientcode source dans votre propre code. 41 les threads en cours d'exécution - dispositif 40 fils et 1 réponse fil. Créer un socket unique que tous les threads partagent. Demandez à chaque appareil fil de préparer et d'envoyer ses requêtes ping au réseau à l'aide de cette prise. Alors la réponse de fil en continu la lecture des réponses à partir de la même prise de routage et à la appropriée de l'appareil de thread pour le traitement. C'est un peu plus de travail, mais il vous donnera les multiples ping parallélisme vous êtes à la recherche pour.

Si vous ne voulez pas aller à tout ce mal, une alternative est d'utiliser une application tierce qui prend déjà en charge le ping plusieurs machines en même temps, comme FREEPing.

// 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 }
.
.
.