How can I do PING threads, reading OnReply event in Delphi 6?

Question

I have a problem with Delphi 6 and Indy's TIdIcmpClient component.

I get this message when compiling the following code, in the marked line (51):

FPing.OnReply := OnPingReply;

[Error] fire.pas(51): Incompatible types: 'TComponent' and 'TIdIcmpClient'

How should I fix it?

unit fire;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyThread = class(TThread)
  private
    FIndex: Integer;
    FPing:  TIdIcmpClient;
    FIP: string;
  protected
    procedure Execute; override;
    procedure OnPingReply(ASender: TIdIcmpClient;  AReplyStatus: TReplyStatus);
  public
    constructor Create(AIndex: Integer);
    destructor Destroy; override;
  end;

constructor TMyThread.Create(AIndex: Integer);
begin
  inherited Create(False);
  FIndex := AIndex;
  FIP := '192.168.1.' + IntToStr(FIndex + 1);
  FPing := TIdIcmpClient.Create(nil);
  FPing.Host:=FIP;
  FPing.ReceiveTimeout:=1500;
  FPing.OnReply := OnPingReply;
end;

destructor TMyThread.Destroy;
begin
  FPing.Free;
  inherited;
end;

//var// icmp:array[0..10] of TIdIcmpClient;
 //   ip:string;

procedure TMyThread.Execute; // aici e ce face thread-ul
var
  i: Integer;
begin
  FPing.Ping;

//  ICMP.Ping('a',1000);
//  Sleep(1300);
//  form1.memo1.lines.add(IntToStr(findex)+' '+ICMP.ReplyStatus.fromipaddress);

  for i := 1 to 1 do
  begin
// 'findex' este indexul thread-ului din matrice
    form1.memo1.lines.add(inttostr(findex)+' Thread running...');
    application.ProcessMessages;
    Sleep(1000);
  end;
end;

procedure TMyThread.OnPingReply(ASender: TIdIcmpClient;  AReplyStatus: TReplyStatus);
begin
  if AReplyStatus.BytesReceived > 0 then
    form1.memo1.Lines.add(FIP+ ' is reachable')
  else
    form1.memo1.Lines.add(FIP+ ' is not reachable: ');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyThreads: array[0..10] of TMyThread;
//  icmp:array[0..10] of TIdIcmpClient;
  i: Integer;

begin
 { for i := 0 to 10 do  //10 fire
  begin
    icmp[i]:=tidicmpclient.create(nil);
    icmp[i].ReceiveTimeout:=1200;
    ip:=Format('%s.%d', ['192.168.1', i]);
    ICMP[i].Host :=ip;
  end;     }

  for i := 0 to 10 do  //10 fire
  begin
    MyThreads[i] := TMyThread.Create(i);
    MyThreads[i].Resume;
    application.ProcessMessages;
  end;
//  Readln;
  for i := 0 to 10 do
  begin
    MyThreads[i].Free;
//    icmp[i].Free;
  end;
end;

end.

I expected it to be compilable, but I don't see the reason why it is not.

Answer 1

Your event handler is declared wrong. The ASender parameter needs to be TComponent rather than TIdIcmpClient, and the AReplyStatus parameter needs to be const:

procedure OnPingReply(ASender: TComponent; const AReplyStatus: TReplyStatus);

That being said, you don't need to use the OnReply event at all in this situation. TIdIcmpClient operates synchronously, so you can simply use the TIdIcmpClient.ReplyStatus property after the TIdIcmpClient.Ping() method exits:

procedure TMyThread.Execute; // aici e ce face thread-ul
var
  ...
begin
  FPing.Ping;

  if FPing.ReplyStatus.BytesReceived > 0 then
    ...
  else
    ...

  ...
end;

Also, you must synchronize with the main UI thread when accessing UI controls in a worker thread. You can use TThread.Synchronize() method for that.

And, you do not need to call Application.ProcessMessages() in a worker thread. Doing so will have no effect on the main UI thread.

With all of that said, try something more like this:

unit fire;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure AddText(const AText: String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TMyThread = class(TThread)
  private
    FIndex: Integer;
    FPing:  TIdIcmpClient;
    FIP: string;
    FText: String;
    procedure AddTextToUI(const AText: String);
    procedure DoSyncText;
  protected
    procedure Execute; override;
  public
    constructor Create(AIndex: Integer);
    destructor Destroy; override;
  end;

constructor TMyThread.Create(AIndex: Integer);
begin
  inherited Create(False);
  FIndex := AIndex;
  FIP := '192.168.1.' + IntToStr(FIndex + 1);
  FPing := TIdIcmpClient.Create(nil);
  FPing.Host := FIP;
  FPing.ReceiveTimeout := 1500;
end;

destructor TMyThread.Destroy;
begin
  FPing.Free;
  inherited;
end;

procedure TMyThread.AddTextToUI(const AText: String);
begin
  FText := AText;
  Synchronize(DoSyncText);
end;

procedure TMyThread.DoSyncText;
begin
  Form1.AddText(FText);
end;

procedure TMyThread.Execute; // aici e ce face thread-ul
begin
  AddTextToUI(IntToStr(FIndex) + ' Thread running...');

  try
    FPing.Ping;
  except
    AddTextToUI('Error pinging ' + FIP);
    Exit;
  end;

  if FPing.ReplyStatus.BytesReceived > 0 then
    AddTextToUI(FIP + ' is reachable')
  else
    AddTextToUI(FIP + ' is not reachable');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyThreads: array[0..10] of TMyThread;
  I: Integer;
begin
  for I := Low(MyThreads) to High(MyThreads) do  //10 fire
  begin
    MyThreads[I] := TMyThread.Create(I);
  end;

  for I := Low(MyThreads) to High(MyThreads) do
  begin
    MyThreads[i].WaitFor;
    MyThreads[i].Free;
  end;
end;

procedure TForm1.AddText(const AText: String);
begin
  Memo1.Lines.Add(AText);
end;

end.