CONST
WM_PINGCOMPLETE = WM_USER + 1337;
...
var
Form1: TForm1;
r:integer;
...
function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
RTT : pointer):boolean;
stdcall;
external '
iphlpapi.dll';
var
speed: integer;
procedure pingthread(host:pchar);
stdcall;
function GetIPAddress(
const HostName:
string):
string;
var
R: Integer;
WSAData: TWSAData;
HostEnt: PHostEnt;
Host:
string;
SockAddr: TSockAddrIn;
begin
Result := '
';
R := WSAStartup($0101, WSAData);
if R = 0
then
try
Host := HostName;
if Host = '
'
then
begin
SetLength(Host, MAX_PATH);
GetHostName(@Host[1], MAX_PATH);
end;
HostEnt := GetHostByName(@Host[1]);
if HostEnt <>
nil then
begin
SockAddr.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
Result := inet_ntoa(SockAddr.sin_addr);
end;
finally
WSACleanup;
end;
end;
var ip, RTT, hopcount: DWORD;
ipAD:
string;
begin
hopCount:=0;
RTT:=0;
ipAd := GetIPAddress(host);
ip := inet_addr(@ipAd[1]);
if not GetRTTAndHopCount(
ip, @hopCount, 30, @RTT)
then
postmessage(Form1.Handle,WM_PINGCOMPLETE,
ip,0)
else
postmessage(Form1.Handle,WM_PINGCOMPLETE,
ip,rtt+1);
end;
procedure TForm1.WMPINGCOMPLETE(
var msg: tmessage);
function IPAddrToName(IPAddr:
string):
string;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <>
nil
then
Result := StrPas(Hostent^.h_name)
else
Result := '
Router';
end;
begin
if msg.LParam = 0
then
begin
StringGrid.RowCount := StringGrid.RowCount +1;
StringGrid.Cells[0,r] := inet_ntoa(in_addr(msg.WParam));
StringGrid.Cells[1,r] := IPAddrToName(inet_ntoa(in_addr(msg.WParam)));
StringGrid.Cells[2,r] := '
offline';
end
else
begin
StringGrid.RowCount := StringGrid.RowCount +1;
speed := (msg.LParam * 100)
div (msg.LParam * msg.LParam);
StringGrid.Cells[0,r] := inet_ntoa(in_addr(msg.WParam));
StringGrid.Cells[1,r] := IPAddrToName(inet_ntoa(in_addr(msg.WParam)));
StringGrid.Cells[2,r] := inttostr(speed) + '
MBit/s (' + inttostr(msg.lparam) + '
ms)';
end;
r := r+1;
end;
...
procedure TForm1.ButtonClick(Sender: TObject);
var
strkind, host:
string;
tid: cardinal;
buffer:
array [0..255]
of char;
begin
StringGrid.RowCount := 1;
r := 0;
for i := 1
to 255
do
begin
host := '
192.168.1.' + inttostr(i);
StatusBar.Panels[0].Text := '
ping '+host;
createthread(
nil,0,@pingthread,@host[1],0,tid);
application.ProcessMessages;
sleep(30);
end;
end;