Entwickler-Ecke :: Thema anzeigen - api ping und tracert

retnyg - Do 28.04.05 01:22
Titel: api ping und tracert

ein konsolen-ping programm, zum selber kompilieren 8)

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:

program _ping;

// simple ping program, using neither Indy nor icmp.dll, which doesnt give back
// the round trip time.
// author: retnyg @ http://krazz.net/retnyg

{$APPTYPE CONSOLE}
//{$define KOL}
uses
   {$ifdef KOL}
   kol,
   {$endif}
   winsock,
   windows;

function GetIPAddress(const HostName: string): string;
// from JCL
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;

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
  RTT : pointer):boolean; stdcall; external 'iphlpapi.dll';


function ping(host:string; var hopCount, RTT:DWORD; var ipAd:string):DWORD;
// by retnyg
// returns 0 is successfully, otherwise errorcode
var ip: DWORD;
begin
  result:=0;
  hopCount:=0;
  RTT:=0;
  ipAd := GetIPAddress(host);
  ip := inet_addr(@ipAd[1]);
  if not GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then result:=GetLastError;
end;

var
  host,ipad:string;
  kewlline: string[80];
  i:byte;
  code: dword;
  hopCount:dword;
  RTT:dword;
  finished:boolean=false;
  tid:dword;

procedure progress;
begin
  while not finished do begin
    write('.');
    sleep(100);
  end;
end;

begin
 {$ifdef KOL}
  useinputoutput;
 {$endif}
  writeln('simple ping application by retnyg');
  setlength(kewlline,80);
  for i:=1 to 80 do kewlline[i]:=#205;
  writeln(kewlline);
  if paramcount > 0 then begin
    host:=paramstr(1);
    write('pingin host    : ' + host + ' ');
    createthread(0,0,@progress,nil,0,tid);
    code := ping(host,hopcount,rtt,ipad);
    finished:=true;
    if code = 0 then begin
      writeln(' success!');
      if host <> ipAd then
        writeln('ipAddr         : '+ipAd);
      writeln('hops           : ', hopCount);
      writeln('roundtrip time : ', RTT, ' ms.');
    end else writeln(#13#10'Error: ', code);
  end else writeln('syntax: ping [hostname/ipadress]');
  readln;
end.

//edit: fortschrittsanzeige und ausgabe der ip-adresse eingebaut

////////////////////////////////////////////////////////////////////////////////////////
NEU: das ganze jetzt als unit inkl. traceRoute-Prozedur
und mit neuer ping-funktion (per ICMP.dll, liefert nun aber die RTT)
////////////////////////////////////////////////////////////////////////////////////////

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:

unit retPing;

{
 unit retPing, version 1.1
 author: retnyg @ www.krazz.net/retnyg
======================================

a unit to do Api-Style ping and traceroutes.

use preferrably the functions ICMPPingRTT,
which uses ICMP.dll and gives back the
round trip time; tracert to trace routes, and
DnsNameToIp to make something like www.xy.com a dword-ip.
there are also routines that use GetRttandHopCount
from iphlpapi.dll aswell. but shouldn't be necessary.

code partly taken from

http://delphi.about.com/od/internetintranet/l/aa081503a.htm
and
http://vbnet.mvps.org/index.html?code/internet/tracerthost.htm

}


interface
uses winsock, windows;

type
  USHORT = word;

   PIP_OPTION_INFORMATION  = ^IP_OPTION_INFORMATION ;
   IP_OPTION_INFORMATION  = record
     ttl         : UCHAR;   //         'Time To Live
     Tos         : UCHAR;   //       'Timeout
     Flags       : UCHAR;   //        'option flags
     OptionsSize : UCHAR;   //        '
     OptionsData : PUCHAR;  //        '
   end;

   PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
   ICMP_ECHO_REPLY = record
     Address       : cardinal; //        'replying address
     Status        : ULONG;    //        'reply status code
     RoundTripTime : ULONG;    //        'round-trip time, in milliseconds
     datasize      : USHORT;   //        'reply data size. Always an Int.
     Reserved      : USHORT;   //        'reserved for future use
     DataPointer   : Pointer;  //        'pointer to the data in Data below
     Options       : IP_OPTION_INFORMATION ; // 'reply options, used in tracert
     ReturnedData  : array[0..255] of char;  // 'the returned data follows the reply message. The data string must be sufficiently large enough to hold the returned data.
   end;

  ttracertCBfunc = procedure (hop, ip: dword; rtt: integer); stdcall;

procedure tracert(destIp: dword; cbFunc: ttracertCBfunc);
function GetIPAddress(const HostName: string): string;
function ICMPPing(Ip : DWORD) : boolean;   // returns true or false
function ICMPPingRTT(Ip : DWORD) : integer;// returns round trip time
function DNSNameToIp(host: string):DWORD;  // returns ip-adress as 4byte variable
function PingDW(ip: dword):integer;

function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll'
function IcmpSendEcho
   (IcmpHandle : THandle; DestinationAddress : In_Addr;
    RequestData : Pointer; RequestSize : Smallint;
    RequestOptions : pointer;
    ReplyBuffer : Pointer;
    ReplySize : DWORD;
    Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
    RTT : pointer):boolean; stdcall; external 'iphlpapi.dll';



implementation

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;


function ICMPPing(Ip : DWORD) : boolean;
var
 Handle : THandle;
 DW : DWORD;
 rep : array[1..128] of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then Exit;
  DW := IcmpSendEcho(Handle, in_addr(Ip), nil, 0, nil, @rep, 128, 0);
  Result := (DW <> 0);
  IcmpCloseHandle(Handle);
end;

function ICMPPingRTT(Ip : DWORD) : integer;
// returns roundtriptime if successfull
// otherwise -1
// -2 if a invalid host is entered
var
 Handle : THandle;
 DW : DWORD;
 echo: PICMP_ECHO_REPLY;

begin
  if (ip = 0) or (ip = $FFFFFFFF) then begin
    result := -2;
    exit;
  end;
  result := -1;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then Exit;
  new(echo);
  DW := IcmpSendEcho(Handle, in_addr(Ip), nil, 0, nil, echo, sizeof(ICMP_ECHO_REPLY)+8, 0);
  if (DW <> 0) and (echo^.Address  = Ip) then
     Result := echo^.RoundTripTime;
  IcmpCloseHandle(Handle);
  dispose(echo);
end;

// the 2 functions below use the GetRttandHopCount API

function ping(host:string; var hopCount, RTT:DWORD; var ipAd:string):DWORD;
var ip: DWORD;
begin
  result:=0;
  hopCount:=0;
  RTT:=0;
  ipAd := GetIPAddress(host);
  ip := inet_addr(@ipAd[1]);
  if IcmpPing(ip) then
    (if not GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then result:=GetLastError)
  else Result := GetLastError;
end;

function PingDW(ip: dword):integer;
var hopCount, RTT:DWORD;
begin
  result := -1;
  if IcmpPing(ip) then
    if GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then
     result:=RTT;
end;

function DNSNameToIp(host: string):DWORD;
begin
  host := GetIPAddress(host);
  result := inet_addr(@host[1]);
end;

procedure tracert(destIp: dword; cbFunc: ttracertCBfunc);
const maxhops = 30;
var h : thandle;
    hop, rtt, ip: dword;
    s:string;
    ipo: PIP_OPTION_INFORMATION ;
    echo: PICMP_ECHO_REPLY;
begin
    setlength(s,32);
    fillchar(pointer(s)^,32,ord('a'));
    new(ipo); new(echo);
    hop := 0;
    h := icmpCreateFile;
    while (ip <> destip) and (hop <= maxhops) do begin
      inc(hop);
      ipo.ttl := hop;
      if icmpSendEcho(h,in_addr(destip),@s[1],32,
         ipo,echo,sizeof(ICMP_ECHO_REPLY)+8,512) = 1
      then begin
           ip := echo.address;
           rtt := echo.RoundTripTime;
           cbfunc(hop, ip, rtt );
      end
      else begin
        ip := echo^.Address;
        cbfunc(hop, ip, -1 );
      end;
    end;
    icmpCloseHandle(h);
    dispose(ipo); dispose(echo);
end;
end.

die traceRt-prozedur kann man so nutzen:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

uses ..., retPing, winsock;

procedure cb(hop, ip: dword; rtt: integer); stdcall;
var s :string;
begin
   if rtt = -1 then s := '*' else s := inttostr(rtt);
   form1.memo1.lines.add(inttostr(hop) + ', ' + s + ', ' + inet_ntoa(in_addr(ip)));
   application.processmessages;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  memo1.clear;
  tracert(dnsnametoip('www.microsoft.com'),cb);
end;

die neue ping-funktion so:

Delphi-Quelltext

1:
2:
3:
4:

procedure TForm1.Button6Click(Sender: TObject);
begin
  memo1.Lines.add(inttostr(IcmpPingRTT(dnsnametoip('www.vol.at'))));
end;

Delete - Do 28.04.05 01:43

Vorschlag: Nimm gleich GetIpForwardTable und du hast ein einfaches Tracert nachgebaut. ;)

retnyg - Do 28.04.05 02:01

kommt noch, wenn es mich mal wieder in den fingern kribbelt ;)

retnyg - Sa 30.04.05 12:06

ich habe das mal für die noobs zusammengefasst:
4 schritte zum eigenen ping ohne zusatzkomponenten:

- winsock und windows in der uses-clause angeben

Delphi-Quelltext

1:	uses ... , windows, winsock;

- folgenden code einfügen (die eigentlich ping funktion)

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
    RTT : pointer):boolean; stdcall; external 'iphlpapi.dll';

function ping(host:string; var hopCount, RTT:DWORD; var ipAd:string):DWORD;

// by retnyg
// returns 0 is successfully, otherwise errorcode
// overwrites values hopcount, rtt, and ipad
// hopcount: number of hops
// rtt: roundtrip time
// ipAd: numerical ip-value, if used with a hostname

  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: DWORD;
begin
  result:=0;
  hopCount:=0;
  RTT:=0;
  ipAd := GetIPAddress(host);
  ip := inet_addr(@ipAd[1]);
  if not GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then result:=GetLastError;
end;

- die variablen deklarieren, welche die rückgabewerte der funktion aufnehmen:

Delphi-Quelltext

1:
2:
3:
4:
5:

var
  host,ipad:string;
  code: dword;
  hopCount:dword;
  RTT:dword;

- und zu guter letzt die ping prozedur starten und die zurückgegebenen werte auswerten

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:

begin
    host:='www.vol.at';
    code := ping(host,hopcount,rtt,ipad);
    if code = 0 then begin // ping kam an
        edit1.text:='ipAddr         : '+ipAd;
        edit2.text:='hops           : '+inttostr(hopCount);
        edit3.text:='roundtrip time : '+inttostr(RTT)+ ' ms.';
    end else showmessage(#13#10'Error: ' + inttostr(code));
end;

polydegmon - So 26.06.05 12:46
Titel: API Ping

Hallo retnyg,

ich habe Deine 4 Schritte ausgeführt. Nur warum dauert es so lange bis das ergebnis des Ping vorliegt.
Wenn ich 5 Server anping dann dauert es gut 40 Sekunden bis ein Ergebnis vorliegt.

Kann man das gaze beschleunigen?

retnyg - So 26.06.05 12:56

sind alle 5 server offline ?

retnyg - So 26.06.05 13:30

möglichkeit 1:
(1 form, 1 memo, 1 button mit click-ereignis)

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:

unit Unit1;

interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, winsock;

CONST WM_PINGCOMPLETE = WM_USER + 1337;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure WMPINGCOMPLETE(var msg: Tmessage); message WM_PINGCOMPLETE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
    RTT : pointer):boolean; stdcall; external 'iphlpapi.dll';

procedure pingthread(host:pchar); stdcall;

// by retnyg

  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);
begin
   if msg.LParam = 0 then
     memo1.lines.Add(inet_ntoa(in_addr(msg.WParam))+ ': offline')
   else
     memo1.lines.Add(inet_ntoa(in_addr(msg.WParam))+ ':'+ inttostr(msg.lparam) + ' ms')
end;


procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
    host: string;
    tid: cardinal;
begin
  for i := 1 to 254 do begin
    host := '192.168.64.' + inttostr(i);
    createthread(nil,0,@pingthread,@host[1],0,tid);
    application.ProcessMessages;
    sleep(40);
  end;
end;

end.

möglichkeit 2 folgt nach dem mittagessen

polydegmon - So 26.06.05 14:07
Titel: API Ping

danke für die schnelle antwort.
ich probier das gleich mal aus.

Kurzes Hintergrundwissen.
Ich lass alle 5 minuten unsere 260 Server in der Firma anpingen um zu überprüfen ob sie online oder offline sind.

Die Server werden in ein Stringgrid eingetragen und rechts neben dem Namen soll das Ergebnis eingetragen werden.

polydegmon - So 26.06.05 14:34
Titel: API Ping

so ich hab das jetzt mal so in mein Programm eingebaut.
Der code ist genauso wie du ihn geschrieben hast.
und er funktioniert. Und auch sehr schnell.
nur

wenn ich als host webseiten nehme. z.b ww.google.de und http://www.ebay.de oder ...

dann erhalte ich beim ersten durchlauf nur 1 antwort.
beim zweiten dritten 8 durchlauf erhalte ich dann von allen einen pong.
nur das dann viele die gleiche ip haben???
erst wenn ich das ganz 14 oder 15 mal mach sehen die ergebnisse gut aus.

:?:

Aber dafür ist er jetzt sehr schnell

retnyg - So 26.06.05 15:00

möglichkeit 2:

retPing.pas hat folgendes geschrieben:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:

unit retPing;

interface
uses winsock, windows;

function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcall; external 'icmp.dll'
function IcmpSendEcho
   (IcmpHandle : THandle; DestinationAddress : In_Addr;
    RequestData : Pointer; RequestSize : Smallint;
    RequestOptions : pointer;
    ReplyBuffer : Pointer;
    ReplySize : DWORD;
    Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
    RTT : pointer):boolean; stdcall; external 'iphlpapi.dll';

function GetIPAddress(const HostName: string): string;
function ICMPPing(Ip : DWORD) : boolean;
function DNSNameToIp(host: string):DWORD;
function PingDW(ip: dword):integer;


implementation

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;


function ICMPPing(Ip : DWORD) : boolean;
var
 Handle : THandle;
 DW : DWORD;
 rep : array[1..128] of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then Exit;
  DW := IcmpSendEcho(Handle, in_addr(Ip), nil, 0, nil, @rep, 128, 0);
  Result := (DW <> 0);
  IcmpCloseHandle(Handle);
end;

function ping(host:string; var hopCount, RTT:DWORD; var ipAd:string):DWORD;
var ip: DWORD;
begin
  result:=0;
  hopCount:=0;
  RTT:=0;
  ipAd := GetIPAddress(host);
  ip := inet_addr(@ipAd[1]);
  if IcmpPing(ip) then
    (if not GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then result:=GetLastError)
  else Result := GetLastError;
end;

function PingDW(ip: dword):integer;
var hopCount, RTT:DWORD;
begin
  result := -1;
  if IcmpPing(ip) then
    if GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then
     result:=RTT;
end;

function DNSNameToIp(host: string):DWORD;
begin
  host := GetIPAddress(host);
  result := inet_addr(@host[1]);
end;

end.

demo-programm:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:

unit Unit1;

interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, winsock, retping;

CONST WM_PINGCOMPLETE = WM_USER + 1337;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure WMPINGCOMPLETE(var msg: Tmessage); message WM_PINGCOMPLETE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure pingthread(host:dword); stdcall;
var RTT: DWORD;
begin
  rtt := pingDW(host);
  postmessage(form1.Handle,WM_PINGCOMPLETE,host,rtt)
end;

procedure TForm1.WMPINGCOMPLETE(var msg: tmessage);
begin
   if msg.LParam = -1 then
     memo1.lines.Add(inet_ntoa(in_addr(msg.WParam))+ ': offline')
   else
     memo1.lines.Add(inet_ntoa(in_addr(msg.WParam))+ ':'+ inttostr(msg.lparam) + ' ms')
end;


procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
    host: string;
    tids: array of cardinal;
    ip: pointer;
begin
  setlength(tids,255);
  for i := 1 to 254 do begin
    host := '192.168.64.' + inttostr(i);
    cardinal(ip):=DNSNameToIp(host);
    createthread(nil,0,@pingthread,ip,0,tids[i-1]);
    application.ProcessMessages;
    sleep(1);
  end;
end;

end.

besteht dein problem damit immer noch ?

retnyg - So 26.06.05 15:36

hier noch die möglichkeit, ne liste an hosts durchzupingen

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TForm1.Button1Click(Sender: TObject);
const hostlist:array [0..3] of string = (
   'www.google.at',
   'www.vol.at',
   'www.wasm.ru',
   'www.phrack.org');
var i : integer;
    host: string;
    tids: array of cardinal;
    ip: pointer;
begin
  memo1.Clear;
  setlength(tids,length(hostlist));
  for i := 0 to length(hostlist)-1 do begin
    cardinal(ip):=DNSNameToIp(hostlist[i]);
    createthread(nil,0,@pingthread,ip,0,tids[i]);
    application.ProcessMessages;
  end;
end;

bei vorigem demo-prog die button1click proc ersetzen

polydegmon - So 26.06.05 16:11
Titel: API PING

AHHH :D
nun kommen die richtigen IPs zurück
dann muss ich die nur noch nacheinander ins stringgrid kriegen.

danke

polydegmon - Di 28.06.05 09:08

Ich habe jetzt mal alle Versionen auf arbeit getestet und deine erste Version klappt dort am besten.
Und bringt die besten Resultate.

Jetzt ist meine Frage an welcher Steller deiner Funktion kann ich die Pufferlänge des Ping einstellen?

// by retnyg

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;  
    RTT : pointer):boolean; stdcall; external 'iphlpapi.dll';  

 
function ping(host:string; var hopCount, RTT:DWORD; var ipAd:string):DWORD;  

 
// by retnyg  
// returns 0 is successfully, otherwise errorcode  
// overwrites values hopcount, rtt, and ipad  
// hopcount: number of hops  
// rtt: roundtrip time  
// ipAd: numerical ip-value, if used with a hostname  

 
  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: DWORD;  
begin  
  result:=0;  
  hopCount:=0;  
  RTT:=0;  
  ipAd := GetIPAddress(host);  
  ip := inet_addr(@ipAd[1]);  
  if not GetRTTAndHopCount(ip, @hopCount, 30, @RTT) then result:=GetLastError;  
end; 
var  
  host,ipad:string;  
  code: dword;  
  hopCount:dword;  
  RTT:dword; 
begin  
    host:='www.vol.at';  
    code := ping(host,hopcount,rtt,ipad);  
    if code = 0 then begin // ping kam an  
        edit1.text:='ipAddr         : '+ipAd;  
        edit2.text:='hops           : '+inttostr(hopCount);  
        edit3.text:='roundtrip time : '+inttostr(RTT)+ ' ms.';  
    end else showmessage(#13#10'Error: ' + inttostr(code));  
end;

Moderiert von Gausi: Delphi-Tags hinzugefügt.

retnyg - Di 28.06.05 11:20

polydegmon hat folgendes geschrieben:

Jetzt ist meine Frage an welcher Steller deiner Funktion kann ich die Pufferlänge des Ping einstellen?

wofür brauchst du die ?
in der ersten funktion ists nicht möglich die puffergrösse zu ändern. du müsstest dazu die ICMPPing funktion aus der unit verwenden. und den aufruf von Suche im MSDN

ICMPSENDECHO anpassen

polydegmon - Mi 29.06.05 11:57
Titel: API Ping

Na es geht nur darum das nicht unbedingt mit 65500 byte die ganzen Pings rausgehen.
Unsere ca 200 Server werden alle 2 min angepingt und da möchte ich die last so klein wie irgend nötig halten.

kan ich bei deiner Funktion den Timeout verändern?

mfg

Poly

retnyg - Mi 29.06.05 17:43
Titel: Re: API Ping

polydegmon hat folgendes geschrieben:

der code bei möglichkeit 2 geht so vor: als erstes wird die icmp.dll-ping funktion aufgerufen, da sie ein schnelleres timeout hat. sie verwendet nur 128 bytes. kommt dann ein echo zurück wird die ping-funktion gestartet, die ich am anfang des threads gepostet habe, um die roundtrip time zu kriegen.
die benutzten funktionen habe keine möglichkeit, das timeout selber zu definieren.

CJ - Sa 16.07.05 20:48

Hallo retnyg,

in deiner Pink Möglichkeit 2 gehst du ja mit ner for-Schleife alle IP's (die hintere Zahl, also xxx.xxx.xxx.000)
durch.

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:

begin   
  setlength(tids,255);   
  for i := 1 to 254 do begin   
    host := '192.168.64.' + inttostr(i);   
    cardinal(ip):=DNSNameToIp(host);   
    createthread(nil,0,@pingthread,ip,0,tids[i-1]);   
    application.ProcessMessages;   
    sleep(1);   
  end;

Was muss ich jetzt ändern das ich nur eine IP anpinge, also zum Beispiel host := 192.168.64.44 ?
Also sprich die for-Schleife rausschmeißen und nur eine IP anpingen. Ich hab schon selber versucht das zu machen, wenn ich bei createthread dann tids rauslösche, sagt mir Delphi nicht genügend Werte sind vorhanden. Kannst du mir bitte helfen ?

Thx

retnyg - So 17.07.05 16:03

wenn du die unit retping.pas (bei möglichkeit 2 dabei) verwendest, brauchst du nur diesen code zu verwenden:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

uses ..., retping;

...

procedure TForm1.Button3Click(Sender: TObject);
var ip: cardinal;
    zeit: integer;
begin
   ip := DnsNameToIp('192.168.64.2');
   zeit := pingdw(ip);
   if zeit <> - 1 then
     showmessage('ping took ' + inttostr(zeit) + ' ms')
   else
     showmessage('could not reach target')
end;

CJ - So 17.07.05 20:30

Ich danke dir vielmals. :D

retnyg - Mo 18.07.05 01:23

neue version der retPing unit online, siehe ersten post
nun mit der möglichkeit nen traceroute zu machen

CJ - Mo 18.07.05 17:22

Moin nochmal,

ich hab da ein Problem: Ich habe deinen Code jetzt mal in mein Programm eingebaut, unter WinXP compiliert und es geht auch alles. Dann wollte ich es unter W2k testen, leider kommt die Meldung (Standard Windowsfehlermeldung) das "iphlpapi.dll" nicht gefunden werde
konnte im Ordner System32. :lol: Sie ist aber da ! Hab mir dann ne iphlpapi.dll aus'n Netz geladen und ins Programmverzeichnis gelegt, wieder iphlpapi.dll kann nicht gefunden werden. Kann sich das jemand erklären und mir helfen ? ;)

Thx

retnyg - Mo 18.07.05 18:12

möglicherweise kommt's auf die gross/kleinschreibung drauf an...
vielleicht heisst die datei bei win2k IPHLPAPI.DLL ?
ändere einfach mal die entsprechende zeile in der unit.

CJ - Mo 18.07.05 18:22

Zitat:

vielleicht heisst die datei bei win2k IPHLPAPI.DLL ?

Jupp da hast du recht. Ich werd das mal ausprobieren. Thx.

CJ - Di 19.07.05 12:39

So es geht munter weiter:

Ich hab jetzt iphlpapi.dll in Großbuchstaben umgewandelt und kompiliert. Wenn ich das Programm jetzt von meinem USB-Stick unter W2k starte, kommt wieder die Fehlermeldung nur jetzt das "IPHLPAPI nicht gefunden wurde", hat also nicht geholfen mit den Großbuchstaben. Wenn ich das Programm von der Festplatte starte, kommt ne andere Fehlermeldung, siehe Anhang. Was da bloß los ?

retnyg - Di 19.07.05 15:25

wie sich grade rausstellte stammte der fehler mit IPHLPAPI von einer falschen definition in einer dritt-unit :mrgreen:

CJ - Di 19.07.05 16:35

retnyg hat folgendes geschrieben:

wie sich grade rausstellte stammte der fehler mit IPHLPAPI von einer falschen definition in einer dritt-unit :mrgreen:

:oops: Ähem.... *hust* :mrgreen: Der tracert Befehl führt unter W2k trotzdem zu einem kompletten Systemabsturz...

renekr - Mo 14.04.08 13:41

Hi,
hat das ping schon jemand mal mit Vista getestet?
Ich bin soeben dabei und habe festgestellt das es nciht geht.

Kann mir ev. jemand helfen?

danke

ThomasLe - Di 28.10.08 09:40

ich habe probleme das mein programm samt Windows teilweise abstürtzt, und den fehler warscheinlich gefunden

Delphi-Quelltext

1:
2:
3:
4:

function ICMPPingRTT(Ip : DWORD) : integer;
...
DW := IcmpSendEcho(Handle, in_addr(Ip), nil, 0, nil, echo, sizeof(ICMP_ECHO_REPLY)+8, 0);
...

geändert

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

  PICMP_ECHO_REPLY = ^ICMP_ECHO_REPLY;
   ICMP_ECHO_REPLY = record
     Address       : cardinal; 
     Status        : ULONG;    
     RoundTripTime : ULONG;    
     datasize      : USHORT;   
     Reserved      : USHORT;   
     DataPointer   : Pointer;  
     Options       : IP_OPTION_INFORMATION ; 
     ReturnedData  : array[0..255] of char;  
     dummy         : array[0..7] of byte;    <<<<------
   end;

function ICMPPingRTT(Ip: DWORD; Timeout: cardinal) : integer;
...
DW := IcmpSendEcho(Handle, in_addr(Ip), nil, 0, nil, echo, sizeof(ICMP_ECHO_REPLY), Timeout);   //sizeof() +8
...

PS.
geht auch mit Vista Firewall

Moderiert von Narses: Delphi-Tags hinzugefügt