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

У меня есть комната с 60 компьютерами/устройствами (40 компьютеров и 20 осциллографов Windows CE), и я хотел бы знать, кто и каждый жив, используя ping. Сначала я написал стандартный пинг (см. Здесь Delphi Indy Ping Error 10040), который теперь отлично работает, но требует времени, когда большинство компьютеров находятся в автономном режиме.

Итак, я пытаюсь написать MultiThread Ping, но я очень борюсь с ним. Я видел только очень мало примеров в Интернете, и никто не соответствовал моим потребностям, поэтому я сам пытаюсь написать его.

Я использую 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.

Моя проблема в том, что она "кажется" работает, когда я раскомментирую "sleep (10)", и "кажется" не работает без него. Это, безусловно, означает, что я пропускаю точку в потоке, который я написал.

Иными словами. Когда Sleep (10) находится в коде. Каждый раз, когда я нажимал кнопку, чтобы проверить соединения, результат был правильным.

Без сна (10) он работает "больше всего" времени, но несколько раз результат неверен, давая мне эхо-пинг на автономных компьютерах и не пинговое эхо на онлайн-компьютере, равно как и ответ на пинг не был назначен к правильной нити.

Любые комментарии или помощь приветствуются.

----- РЕДАКТИРОВАТЬ/ВАЖНО -----

Как общее продолжение этого вопроса, @Darian Miller начал Проект Google Code здесь https://code.google.com/p/delphi-stackoverflow/, который является рабочей основой. Я отмечаю его ответ как "принятый ответ", но пользователи должны ссылаться на этот проект с открытым исходным кодом (весь кредит принадлежит ему), поскольку он, несомненно, будет расширен и обновлен в будущем.

+11
12 окт. '12 в 11:56
источник поделиться
4 ответа

Реми объяснил проблемы... Я хотел сделать это в 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;
+4
13 окт. '12 в 5:46
источник

Корневая проблема заключается в том, что 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.

+11
13 окт. '12 в 0:16
источник

Я не пробовал ваш код, так что это все гипотетически, но я думаю, что вы испортили потоки и получили классический 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-ненавистники утверждают, что она "скрывает" ошибки.

+1
12 окт. '12 в 12:41
источник
// 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 }
.
.
.
0
11 июл. '13 в 2:35
источник

Посмотрите другие вопросы по меткам или Задайте вопрос