我怎样才能PING线程，读取Delphi 6中的OnReply事件？

Question

TIdIcmpClient我对 Delphi 6 和 Indy 的组件有疑问。

在编译以下代码时，我在标记行 (51) 中收到此消息：

FPing.OnReply := OnPingReply;

[错误] fire.pas(51)：不兼容的类型：“TComponent”和“TIdIcmpClient”

我应该如何修复它？

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.

我预计它是可以编译的，但我不明白为什么不能编译。

Answer 1

您的事件处理程序被声明为错误。参数ASender需要是TComponent而不是TIdIcmpClient，并且AReplyStatus参数需要是const：

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

话虽如此，在这种情况下您根本不需要使用该OnReply事件。 TIdIcmpClient同步操作，因此您可以在方法退出TIdIcmpClient.ReplyStatus后简单地使用该属性TIdIcmpClient.Ping()：

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

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

  ...
end;

此外，在工作线程中访问 UI 控件时，必须与主 UI 线程同步。您可以使用TThread.Synchronize()方法来实现这一点。

而且，您不需要调用Application.ProcessMessages()工作线程。这样做不会对主 UI 线程产生影响。

话虽如此，尝试更多类似这样的事情：

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.