Delphi实现多个ipping测试

Question

TTimer要用这么多？有没想过优化一下。。都写进一个Timer里应该不是很难。
嫌卡的话试下多线程吧，继承TThread也好，直接用API也好。

Answer 1

都试过了，用多线程会不准确，如果30个ping操作都放一个Timer里面的话界面将会卡没反应的。

Answer 2

都试过了，用多线程会不准确，如果30个ping操作都放一个Timer里面的话界面将会卡没反应的。有没有尝试过多线程同步，又或者在TTimer过程里适当加一些application.ProcessMessages;呢？
我总有一种感觉，就是多线程应该是这个问题的最佳解决方案。。多线程的话能不能15个ping依次在一个线程进行呢。这样不会乱了

Answer 3

都试过了，用多线程会不准确，如果30个ping操作都放一个Timer里面的话界面将会卡没反应的。有没有尝试过多线程同步，又或者在TTimer过程里适当加一些application.ProcessMessages;呢？
我总有一种感觉，就是多线程应该是这个问题的最佳解决方案。。多线程的话能不能15个ping依次在一个线程进行呢。这样不会乱了application.ProcessMessages;一直加着的，是这样的，如果用多线程，TIdIcmpClien.ping操作在线程里面循环的ping，ping之后的消息回调函数写在窗体程序中的，这样界面是不卡，但是会乱掉，不能同步，一同步的话窗口就废了，什么也没有，卡爆，不知道是什么原因，而且TIdIcmpClien也没法放到进程里面去。

Answer 4

一个TTimer，每隔5秒创建15个线程，每个线程传地址id
ping之后发消息或者用synchronize
发自定义消息，postmessage给主窗口，参数用id和ping结果
synchronize调用，也是传id和ping结果，怎么会乱掉呢？

Answer 5

部分代码如下：
unit itrsUnit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg,
  Winsock, Buttons, Provider, ComCtrls, CheckLst, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient;
type
 TItrsForm = class(TForm)
  ...
    StaticText1: TStaticText; StaticText2: TStaticText;... StaticText30: TStaticText;
    ICMP1: TIdIcmpClient; ICMP2: TIdIcmpClient;...ICMP30: TIdIcmpClient; 
  ...
procedure ICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
 procedure ICMP2Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);
 ...
 procedure ICMP30Reply(ASender: TComponent; const AReplyStatus: TReplyStatus);var
  ItrsForm: TItrsForm;
  s: Integer;implementation{$R *.dfm}
uses 
  UnitThread1,UnitThread2,UnitThread3,UnitThread4,UnitThread5,UnitThread6,
  UnitThread7,UnitThread8,UnitThread9,UnitThread10,UnitThread11,UnitThread12,
  UnitThread13,UnitThread14,UnitThread15,UnitThread16,UnitThread17,UnitThread18,UnitThread19,
  UnitThread20,UnitThread21,UnitThread22,UnitThread23,UnitThread24,UnitThread25,UnitThread26,
  UnitThread27,UnitThread28,UnitThread29,UnitThread30;//30个线程类的引用
 
procedure TItrsForm.startButtonClick(Sender: TObject);
var
  myThread1: TMyThread;
  myThread2: TMyThread2;
  ...
  myThread30: TMyThread30;
begin
  myThread := TMyThread.Create;
   myThread.HostIP:='192.168.1.101';
    myThread.Resume; // 开始执行线程    myThread2 := TMyThread2.Create;
    myThread2.HostIP:='192.168.1.102';
    myThread2.Resume;
   .....
 myThread30 := TMyThread2.Create;
    myThread30.HostIP:='192.168.1.130';
    myThread30.Resume;
end;/////30个线程类主要这样写的
unit UnitThread;interfaceuses
  Windows, Classes,
  itrsUnit,IdIcmpClient;type
  TMyThread 1= class(TThread)
  private
    FHostIP: string;
    procedure GetHostIP(const Value: string);
    { Private declarations }
  protected
    procedure Execute; override;
  public
    property HostIP: string read FHostIP write GetHostIP;
    function IpPing（FHostIP：string）：boolean;
    constructor Create(b: Boolean = True);
  end;implementationfunction TMyThread1.IpPing(FHostIP): Boolean;
begin
Result := True;   
While (s=0) do//s=0为开始标志，s=1表示结束ping
  begin
   try
    ItrsForm.ICMP1.Host:=FHostIP;
    ItrsForm.ICMP1.Ping();
    Sleep(3000);     
    end;
  end;
end;constructor TMyThread1.Create(b: Boolean = True);
begin
  inherited Create(b);
  Self.FreeOnTerminate := True;
end;MyThread1.Execute;
begin
  IpPing(FHostIP );
end;
procedure TMyThread1.GetHostIP(const Value: string);
begin
  FHostIP := Value;
end;end.
//这样写下来测试发现各个ping的结果相互影响，完全不准确，错在哪呢？

Answer 6

itrsUnit中回调函数如下：
procedure TItrsForm.ICMPReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
begin
    if s=0 then
     begin
     if((AReplyStatus.BytesReceived >0) and (AReplyStatus.TimeToLive >0)) and (AReplyStatus.MsRoundTripTime < t) and (AReplyStatus.FromIpAddress <> '') and (AReplyStatus.FromIpAddress <> '0.0.0.0')then
       begin
           ItrsForm.StaticText1.Color:=TColor(clLime);//能ping通显示绿色
       end
      else
       begin
       ItrsForm.StaticText1.Color:=TColor(clRed);//不能ping通显示红色
       end;
       end;
end;

Answer 7

//界面中
type
  TIPAddr = record
    IP: string;
    Sender: TStaticText;
  end;  TShowStatus = procedure(AIndex: Integer; AStatus: TReplyStatus) of object;  TForm1 = class(TForm)
  private
    procedure ShowStatus(AIndex: Integer; AStatus: TReplyStatus);
  end;var
  IPAddr: array[0..29] of TIPAddr;
//初始化，IP地址和TStaticText对应.....
 IPAddr[0].IP := '192.168.1.100';
 IPAddr[0].Sender := StaticText1;ShowStatus(AIndex: Integer; AStatus: TReplyStatus);
begin
if((AReplyStatus.BytesReceived >0) and (AReplyStatus.TimeToLive >0)) and (AReplyStatus.MsRoundTripTime < t) and (AReplyStatus.FromIpAddress <> '') and (AReplyStatus.FromIpAddress <> '0.0.0.0')then
  IPAddr[AIndex].Sender.Color = clLime
else
   IPAddr[AIndex].Sender.Color = clRed;
end;OnTime();
var
  i: Integer;
begin
  Time1.Enable := False;
  for i := Low(IPAddr) to High(IPAddr) do
    TMyThread.Create(IPAddr[i].IP, i, ShowStatus);
  Time1.Enable := True;
end;
//线程类
TMyThread = class(TThread)
private
  FIP: string;
  FIndex: Integer;
  FStatus: TReplyStatus;
  FMethod: TShowStatus;
  procedure ShowReplyStatus();
protect
  procedure Execute(); override;
public
  constructor Create(AIP: string; AIndex: Integer; AMethod: TShowStatus);
end;Create(AIP: string; AIndex: Integer; AMethod: TShowStatus);
begin
  inherited Create(False);
  FreeOnTerminated := True;
  FIP := AIP;
  FIndex := AIndex;
  FMethod := AMethod;
end;Execute();
begin
  with TIdIcmpClient.Create(nil) do
  try
    Host := FIP;
    Ping();
    FStatus := ReplyStatus;
    Synchronize(ShowReplyStatus);
  finally
    Free;
  end;
end;ShowReplyStatus();
begin
  if Assigned(FMethod) then
    FMethod(FIndex, FStatus);
end;

Answer 8

调试后发现还是不行，ping不通的ip全返回通过的，调试后代码如下：
//itrsUnit.pas
unit itrsUnit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg,
  Winsock, Buttons, Provider, ComCtrls, CheckLst, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient;type
    IPAddrList = ^TIPAddr;
    TIPAddr = record
     IP: string;
     Sender: TStaticText;
    end;    TShowStatus = procedure(AIndex: Integer; AStatus: TReplyStatus) of object;    TItrsForm = class(TForm)
    startButton: TButton;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    Button1: TButton;
    Timer1: TTimer;
    
    procedure startButtonClick(Sender: TObject);
    procedure endClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);  private
    procedure ShowStatus(AIndex: Integer; AStatus: TReplyStatus);
  public
    { Public declarations }
end;var
  ItrsForm: TItrsForm;
  s: Integer; 
  IPAddr: array[0..2] of TIPAddr;
implementation{$R *.dfm}
uses
  UnitThread;procedure TItrsForm.ShowStatus(AIndex: Integer; AStatus: TReplyStatus);
begin
if((AStatus.BytesReceived >0) and (AStatus.TimeToLive >0))
  and (AStatus.FromIpAddress <> '') and (AStatus.FromIpAddress <> '0.0.0.0') then
  IPAddr[AIndex].Sender.Color := clLime
else
   IPAddr[AIndex].Sender.Color := clRed;
end;procedure TItrsForm.Timer1Timer(Sender: TObject);
var
  i: Integer;
begin
 if s=0 then
  begin
    Timer1.Enabled := False;
    for i := Low(IPAddr) to High(IPAddr) do
      TMyThread.Create(IPAddr[i].IP, i, ShowStatus);
    Timer1.Enabled := True;  
  end;
end;procedure TItrsForm.startButtonClick(Sender: TObject);
begin
    startButton.Enabled:=False;
    Button1.Enabled:=true;
    s:=0;  //执行(s=0)或停止(s=1)标志    IPAddr[0].IP := '192.168.1.101';
  IPAddr[0].Sender := StaticText1;
  IPAddr[1].IP := '192.168.1.102';
  IPAddr[1].Sender := StaticText2;
  IPAddr[2].IP := '192.168.1.103';
  IPAddr[2].Sender := StaticText3;
    {IPAddr := (
      (IP:'192.168.1.101';Sender:StaticText1),
      (IP:'192.168.1.102';Sender:StaticText2),
      (IP:'192.168.1.103';Sender:StaticText3)
    );}
    Timer1.Enabled := True;
end;procedure TItrsForm.endClick(Sender: TObject);
begin
   startButton.Enabled:=True;
   Button1.Enabled:=false;
   s := 1;
   
   ItrsForm.StaticText1.Color:=TColor(clBlack);
   ItrsForm.StaticText2.Color:=TColor(clBlack);
   ItrsForm.StaticText3.Color:=TColor(clBlack);   Timer1.Enabled := false;end;
end.
//UnitThread.pas
unit UnitThread;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  Winsock, Buttons, Provider, ComCtrls,IdIcmpClient,
  itrsUnit;type
  TMyThread = class(TThread)
  ICMP: TIdIcmpClient;
  private
    FIP: string;
    FIndex: Integer;
    FStatus: TReplyStatus;
    FMethod: TShowStatus;
    procedure ShowReplyStatus();
  protected
    procedure Execute; override;
  public
    constructor Create(AIP: string; AIndex: Integer; AMethod: TShowStatus);
  end;var
 CS: TRTLCriticalSection;implementation
constructor TMyThread.Create(AIP: string; AIndex: Integer; AMethod: TShowStatus);
begin
  inherited Create(False);
  Self.FreeOnTerminate := True;
  FIP := AIP;
  FIndex := AIndex;
  FMethod := AMethod;
end;procedure TMyThread.Execute;
begin
  with TIdIcmpClient.Create(nil) do
  try
    Host := FIP;
    Ping();
    FStatus := ReplyStatus;
    Synchronize(ShowReplyStatus);
  finally
    Free;
  end;
end;
               procedure TMyThread.ShowReplyStatus();
begin
  if Assigned(FMethod) then
    FMethod(FIndex, FStatus);  
end;end.

Answer 9

procedure TMyThread.Execute;
begin
  with TIdIcmpClient.Create(nil) do
  try
    Host := FIP;
    Ping();
    FStatus := ReplyStatus;
    Synchronize(ShowReplyStatus);
  finally
    Free;
  end;
end;
TIdIcmpClient有个OnReply响应方法，这样直接获取的ReplyStatus状态值好像都是有返回字节的

Answer 10

这个控件没用过，你在线程里定义一个ICMPReply，然后赋值给TIdIcmpClient的OnReply，在ICMPReply里执行    
    FStatus := AReplyStatus;
    Synchronize(ShowReplyStatus);

Answer 11

这个控件没用过，你在线程里定义一个ICMPReply，然后赋值给TIdIcmpClient的OnReply，在ICMPReply里执行    
    FStatus := AReplyStatus;
    Synchronize(ShowReplyStatus);也不正确啊