Delphi (XE2) Indy (10) Многопоточный пинг

Ответ 1

Реми объяснил проблемы... Я хотел сделать это в Indy на некоторое время, поэтому я опубликовал возможное решение, которое я только что собрал в новый проект Google Code, вместо того, чтобы иметь длинный комментарий здесь. Это первая вещь, дайте мне знать, если у вас есть какие-то изменения для интеграции: https://code.google.com/p/delphi-vault/

Этот код имеет два способа для Ping... многопоточных клиентов, как в вашем примере, или с простой процедурой обратного вызова. Написано для Indy10 и более поздних версий Delphi.

В результате ваш код будет использовать потомки TThreadedPing, определяющие метод SynchronizedResponse:

  TMyPingThread = class(TThreadedPing)
  protected
    procedure SynchronizedResponse(const ReplyStatus:TReplyStatus); override;
  end;

И чтобы отключить некоторые потоки клиентов, код будет выглядеть примерно так:

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;

Ответ на резьбу вызывается синхронным методом:

procedure TMyPingThread.SynchronizedResponse(const ReplyStatus:TReplyStatus);
begin
  frmThreadedPingSample.Memo1.Lines.Add(TPingClient.FormatStandardResponse(ReplyStatus));
end;

Ответ 2

Корневая проблема заключается в том, что pings - это трафик без установления соединения. Если у вас есть несколько объектов TIdIcmpClient, которые пингоруют сеть в одно и то же время, один экземпляр TIdIcmpClient может получить ответ, который фактически принадлежит другому экземпляру TIdIcmpClient. Вы пытаетесь объяснить это в своем потоковом цикле, проверяя значения SequenceId, но вы не принимаете во внимание, что TIdIcmpClient уже выполняет ту же проверку внутри. Он считывает сетевые ответы в цикле, пока не получит ожидаемый ответ, или пока не произойдет ReceiveTimeout. Если он получает ответ, который он не ожидает, он просто отбрасывает ответ. Таким образом, если один экземпляр TIdIcmpClient отбрасывает ответ, ожидаемый другим экземпляром TIdIcmpClient, этот ответ не будет обрабатываться вашим кодом, а другой TIdIcmpClient скорее всего получит другой ответ TIdIcmpClient и т.д.). Добавляя Sleep(), вы уменьшаете (но не устраняете) вероятность того, что пинг будет перекрывать друг друга.

Для того, что вы пытаетесь сделать, вы не сможете использовать TIdIcmpClient as-is для одновременного запуска нескольких пингов, извините. Он просто не предназначен для этого. Невозможно отличить данные ответа так, как вам нужно. Вам придется сериализовать свои потоки, чтобы только один поток мог вызывать TIdIcmpClient.Ping() за раз.

Если сериализация pings не является для вас вариантом, вы можете попробовать скопировать части исходного кода TIdIcmpClient в свой собственный код. Есть 41 поток - 40 потоков устройств и 1 ответная нить. Создайте единый сокет, который разделяет все потоки. Подготовьте каждый поток устройств и отправьте его индивидуальный запрос ping в сеть с помощью этого сокета. Затем следует, чтобы поток ответов непрерывно читал ответы из того же самого сокета и перенаправлял их обратно к соответствующему потоку устройства для обработки. Это немного больше работы, но это даст вам многократный ping parallelism, который вы ищете.

Если вы не хотите идти на все эти проблемы, альтернатива заключается в том, чтобы просто использовать стороннее приложение, которое уже поддерживает одновременное пинирование нескольких машин, например FREEPing.

Ответ 3

Я не пробовал ваш код, так что это все гипотетически, но я думаю, что вы испортили потоки и получили классический race condition. Повторяю мой совет по использованию AsyncCalls или OmniThreadLibrary - они намного проще и сэкономит вам несколько попыток "стрелять собственной ногой".

• Создаются потоки, чтобы минимизировать нагрузку на основной поток. Конструктор потоков должен выполнять минимальную работу по запоминанию параметров. Лично я переместил создание idICMP в метод .Execute. Если по какой-либо причине он захочет создать свои внутренние объекты синхронизации, такие как окно и очередь сообщений или сигнал или что-то еще, я бы хотел, чтобы это произошло уже в новом порожденном потоке.

• Нет смысла "унаследовать"; в .Execute. Лучше удалите его.

• Отключение всех исключений - плохой стиль. Вероятно, у вас есть ошибки, но вы не можете узнать о них. Вы должны распространять их в основной поток и отображать их. OTL и AC помогут вам в этом, а для tThread вам нужно сделать это вручную. Как обращаться с исключениями, запущенными в функции AsyncCalls без вызова .Sync?

• Логика исключения ошибочна. Нет смысла иметь цикл, если выбрано исключение - если не был установлен успешный Ping, то почему ждать ответа? Вы должны зайти в один и тот же блок try-except, выдавая ping.

• Ваш doOnPingReply выполняет ПОСЛЕ fIdIcmpClient.Free, но обращается к внутренним элементам fIdIcmpClient. Пробовал меняться. Свободно для FreeAndNil? Это классическая ошибка использования мертвого указателя после его освобождения. Правильный подход будет заключаться в следующем:
  5.1. либо освободите объект в doOnPingReply
  5.2. или скопируйте все релевантные данные из doOnPingReply в TThread private member vars перед вызовом Synchronize и idICMP.Free (и используйте только те вары в doOnPingReply), 5.3. только fIdIcmpClient.Free внутри TMyThread.BeforeDestruction или TMyThread.Destroy. В конце концов, если вы решили создать объект в конструкторе, тогда вы должны освободить его в подходящей языковой конструкции - деструкторе.

• Так как вы не сохраняете ссылки на объекты потока - цикл While not Terminated кажется лишним. Просто сделайте обычный forever-loop и break.

• Вышеупомянутый цикл - голодный процессор, он похож на спиновый цикл. Пожалуйста, вызовите Sleep(0); или Yield(); внутри цикла, чтобы дать другим потокам больше шансов выполнить свою работу. Не работайте с планировщиком OSA AGISNIS - вы не находитесь в критическом для скорости пути, без причины сделать spinlock здесь.

В целом, я считаю:

• 4 и 5 как важные ошибки для вас
• 1 и 3 как потенциальная возможность может повлиять или, может быть, нет. Вам лучше "играть безопасно", а не делать рискованные вещи и расследовать, будут ли они работать или нет.
• 2 и 7 - плохой стиль, 2 относительно языка и 7 относительно платформы.
• 6 либо у вас есть планы продлить ваше приложение, либо вы нарушили принцип YAGNI, не знаю.
• Придерживание сложного TThread вместо OTL или AsyncCalls - стратегических ошибок. Не кладите грачей на взлетно-посадочную полосу, используйте простые инструменты.

Забавный, это пример ошибки, которую FreeAndNil может выявить и сделать очевидной, в то время как FreeAndNil-ненавистники утверждают, что она "скрывает" ошибки.

Ответ 4

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