300分 请教 ping 程序，循环检测计算机的在线问题？？？？？？？

Question

我在用delphi 编写ping 的程序以监测内部局域网的在线情况，我想编写一个可以自动检测，并且自动循环的小程序，不停的对局域网内部机器进行ping检测不断的更新“当前在线计算机”数据库，
请问各位大哥 如何能做到让程序不停的自动检测，还有就是在监测到完成一遍检测后再次不停的检测 程序稳定性的问题。
还有个问题就是我想让它在后台运行应该怎么做，高分请教！！

Answer 1

建立一个定时器，每隔几秒钟Ping一次

Answer 2

建立一个定时器，每隔几秒钟Ping一次

Answer 3

建立一个线程在后台每隔几秒钟Ping一次

Answer 4

我不想用定时器，自动检测 ping 完以后再继续运行，该如何做；

Answer 5

Ping一下是很快的，如果你不断的Ping人家，
会造成整个网络堵塞，对方会死机的！！！
所以必须控制时间！

Answer 6

我写的//返回的Ping一个Url所需时间
//需要一个TCPClient组件，再NetFast里面
function TThreadPing.PingHost(Url:String):String;
var
Str:String;
i:Integer;
BefTime,AftTime:TTime;
Hour, Min, Sec, MSec: Word;
S:String;
R:real;begin
R:=0;
Str:=Url; if StrLower(Pchar(Copy(Url,1,3)))='htt' then
  begin
  Str:=Copy(Url,8,Length(Url));
  Str:=Copy(Str,1,Pos('/',Str)-1);
  end
 else
 if StrLower(Pchar(Copy(Url,1,3)))='ftp' then
  begin
  Str:=Copy(Url,7,Length(Url));
  Str:=Copy(Str,1,Length(Str)-Pos(Str,'/'));
  end;
   for i := 1 to 4 do
  with FTCPClient do
  begin
  BefTime:=Now;
  RemoteHost:=Str;
  RemotePort:='80';
  try
  Connect;
    try
    AftTime:=Now;
    DecodeTime(AftTime-BefTime, Hour, Min, Sec, MSec);
    R:=Sec+MsEc/1000;
    finally
    Disconnect;
    end;
  except on E: Exception do
    R:=-1;  end;
  end;result:=Format('%.3f',[R]);
end;

Answer 7

别人写的procedure TForm1.Button1Click(Sender: TObject);
var
  buf : String;
begin
  Buf := 'Hello';
  IdIcmpClient1.host := 'pop.163.com';
  IdIcmpClient1.Port := 110;
  IdIcmpClient1.Ping(buf,1000);
  Memo1.Lines.Add('After Ping : ' + buf);
end;procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
  Memo1.Lines.Add( AReplyStatus.FromIpAddress);
end;

Answer 8

如果别人的防火墙禁止ping,主机在线，你也ping不到他。 用winsock 函数就好一些，一般的防火墙不能禁止

Answer 9

正如楼上所讲，如果防火墙禁止了Ping，就不能用Ping。所以我写的就是通过WinSock连接，而不是直接Ping。请参看我上面贴的程序。

Answer 10

dancedog(猪熔鸡)我编译了几次都没有通过，能不能再详细一点。
谢谢

Answer 11

报什么错误？
记得需要一个放置TCPClient组件（它再NetFast页里面）

Answer 12

当然我写的是Internet环境中的，如果局域网内，就更简单点//返回的Ping一个Url所需时间
//需要一个TCPClient组件，再NetFast里面
function TThreadPing.PingHost(Url:String):String;
var
Str:String;
i:Integer;
BefTime,AftTime:TTime;
Hour, Min, Sec, MSec: Word;
S:String;
R,temp:real;begin
R:=0;
Str:=Url;
 //下面一段不需要
 
 //if StrLower(Pchar(Copy(Url,1,3)))='htt' then
  //begin
  //Str:=Copy(Url,8,Length(Url));
  //Str:=Copy(Str,1,Pos('/',Str)-1);
  //end
 //else
// if StrLower(Pchar(Copy(Url,1,3)))='ftp' then
 // begin
 // Str:=Copy(Url,7,Length(Url));
 // Str:=Copy(Str,1,Length(Str)-Pos(Str,'/'));
 // end;
 
  temp:=0;
  for i := 1 to 4 do
  with FTCPClient do
  begin
  BefTime:=Now;
  RemoteHost:=Str;
  RemotePort:='80';
  try
  Connect;
    try
    AftTime:=Now;
    DecodeTime(AftTime-BefTime, Hour, Min, Sec, MSec);
    temp:=temp+Sec+MsEc/1000;
    
    finally
    Disconnect;
    end;
  except on E: Exception do
    R:=-1;  end;
  end;result:=Format('%.3f',[R:=temp/i]);
end;
我即时修改过的地方，还没有编译检查。但应该没错～～

Answer 13

我明白楼主为什么不能编译通过了～～～
可以这样定义
function PingHost(Url:String):String;但是因为在Ping的时候，为了不占用主线程的资源，
我用了一个线程来执行我的Ping操作。这个线程的定义如下：  TThreadPing = class(TThread) { 声明线程类 }
  private
  FListView:TsuiListView;//这里定义了一个ListView
  FTcpClient:TTcpClient;//这里定义了一个TcpClient
  function PingHost(Url:String):String;
  protected
    procedure Execute; override;
    procedure DoExec(FListView:TsuiListView); virtual; abstract;
  public
    constructor Create(Tcpclient:TTcpClient;lvServer:TsuiListView); { 线程构造器 }
  end;  TPing =Class (TThreadPing)
  protected
    procedure DoExec(FListView:TsuiListView); override;
  end;var
 P1:TPing;
procedure TPing.DoExec(FListView:TsuiListView);{ 执行线程的方法 }var
i:Integer;
begin  for i:=0 to FListView.Items.Count-1 do
   begin
    FListView.Items.Item[i].Focused:=true;
    FListView.Items.Item[i].SubItems[0]:=PingHost(FListView.Items.Item[0].SubItems.Strings[1])+'ms';
   end;   if Terminated then Exit;
end;procedure TThreadPing.Execute;{ 执行线程的方法 }
begin
DoExec(FListView);end;
constructor TThreadPing.Create(Tcpclient:TTcpClient;lvServer:TsuiListView);
begin
  FListView:=lvServer;//这里的lvServer是你自己窗体上的ListView的Name
  FTcpClient:=TcpClient;//这里的TcpClient是你自己窗体上的TcpClient的Name
 //上面两句的意思就是把“窗体类”下面的两个控件，赋给“线程类”下面的两个变量
  FreeOnTerminate := true;
  inherited Create(false);
end;
procedure TFrmServer.btnTestPingClick(Sender: TObject);
begin
if Self.btnTestPing.Caption='测试速度' then
  P1 := TPing.Create(TcpClient1,lvServer)
else
 if Self.btnTestPing.Caption='停止测试' then
  if P1.Suspended then P1.Resume else P1.Suspend;end;有什么问题就把你的代码贴上来。

Answer 14

dancedog(猪熔鸡)  大哥TCPClient组件，我在NetFast里面怎么找不到，不过在 internet里面找到一个TcpClient1
不晓得是不是这个
还是有很多问题，要不你先把两段整个完整的代码都贴一下吧，
不好意思，我实在是 菜的很了，

Answer 15

9494，嘿嘿，我真是误人子弟啊～～确实在Internet页下面
就是那个TcpClient我的代码都贴出来了。
要说明的是我的窗体Name是FrmServer，
有一个Button，其Name是btnTestPing，
还有一个ListView，其Name是lvServerlvServer有两列，第一列是你要ping的机器名，第二列是其IP地址。
（怎么构造lvServer里面的值，不是本贴讨论的内容，
  现在假设lvServer里面已经有若干数据了）类，及其属性、方法的定义我都贴出来了。

Answer 16

    procedure DoExec(FListView:TsuiListView); virtual; abstract;
  public
    constructor Create(Tcpclient:TTcpClient;lvServer:TsuiListView); { 线程构造器 }
  end;  TPing =Class (TThreadPing)
  protected
    procedure DoExec(FListView:TsuiListView); override;    此处报错，
  end;var
 P1:TPing;  此处报错，.......dancedog(猪熔鸡)  大哥
能不能把整个程序完整的贴出来
老是有一些错误，

Answer 17

为什么老是有些错误，是因为我用的控件和你用的有一点点差别～～～你注意到没有，你报错的地方，FListView:TsuiListView ，这里的TsuiListView
是一个第三方的控件，所以Delphi编译会提醒你，没有找到.dcu之类的错误。
是吧？你把TsuiListView改成TListView就可以啦～下面那个错误，也是因为这里的错误，连带引起的。修改这里，下面也就不会错啦。

Answer 18

有些东西不要直接拷贝我的代码，我用的一些控件及其命名和你不一样，
就比如TForm的Name，我是FrmServer，而你如果没改的话，那就是Form1
我用了TsuiListView（第三方的控件），而你肯定是Delphi自带的TListview，
你不要胡乱一气拷贝，我不提倡这种做法。

Answer 19

dancedog(猪熔鸡) 
可能是TsuiListView（第三方的控件） 的原因

Answer 20

是啊，就是它，我说过啦嘛，你看看我上面说的。TsuiListView是个第三方控件，
你用普通的TListView代替就可以啦～～～～祝你成功！