delphiindydelphi-6

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


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.


Solution

  • 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.