
在delphi中使用tidicmpclient控件可以非常简单的实现图形界面的ping!
新建一个工程,命名为pinggui.dpr,窗口命名为“frmping”,加入如下组件:
lstreplies: tlistbox;
icmp: tidicmpclient;
panel1: tpanel;
btnping: tbutton;
edthost: tedit;
spnping: tspinedit;
label1: tlabel;
完整源代码如下:
unit main;
interface
uses
windows, messages, graphics, controls, forms, dialogs, stdctrls, extctrls,
sysutils, classes, idicmpclient, idbasecomponent, idcomponent, idrawbase, idrawclient,
spin;
type
tfrmping = class(tform)
lstreplies: tlistbox;
icmp: tidicmpclient;
panel1: tpanel;
btnping: tbutton;
edthost: tedit;
spnping: tspinedit;
label1: tlabel;
procedure btnpingclick(sender: tobject);
procedure icmpreply(asender: tcomponent; const replystatus: treplystatus);
private
public
end;
var
frmping: tfrmping;
implementation
{$r *.dfm}
procedure tfrmping.btnpingclick(sender: tobject);
var
i: integer;
begin
icmp.onreply := icmpreply;
icmp.receivetimeout := 1000;
btnping.enabled := false; try
icmp.host := edthost.text;
for i := 1 to spnping.value do begin
icmp.ping;
application.processmessages;
end;
finally btnping.enabled := true; end;
end;
procedure tfrmping.icmpreply(asender: tcomponent; const replystatus: treplystatus);
var
stime: string;
begin
// todo: check for error on ping reply (replystatus.msgtype?)
if (replystatus.msroundtriptime = 0) then
stime := '<1'
else
stime := '=';
lstreplies.items.add(format('%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',
[replystatus.bytesreceived,
replystatus.fromipaddress,
replystatus.sequenceid,
replystatus.timetolive,
stime,
replystatus.msroundtriptime]));
end;
end.