Autor Beitrag
retnyg
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: Do 28.04.05 01:22 
ein konsolen-ping programm, zum selber kompilieren 8)

ausblenden volle Höhe 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; stdcallexternal 'iphlpapi.dll';


function ping(host:stringvar 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)

////////////////////////////////////////////////////////////////////////////////////////

ausblenden volle Höhe 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..255of 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; stdcallexternal 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcallexternal 'icmp.dll'
function IcmpSendEcho
   (IcmpHandle : THandle; DestinationAddress : In_Addr;
    RequestData : Pointer; RequestSize : Smallint;
    RequestOptions : pointer;
    ReplyBuffer : Pointer;
    ReplySize : DWORD;
    Timeout : DWORD) : DWORD; stdcallexternal 'icmp.dll';

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
    RTT : pointer):boolean; stdcallexternal '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..128of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then Exit;
  DW := IcmpSendEcho(Handle, in_addr(Ip), nil0nil, @rep, 1280);
  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 = 0or (ip = $FFFFFFFFthen begin
    result := -2;
    exit;
  end;
  result := -1;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then Exit;
  new(echo);
  DW := IcmpSendEcho(Handle, in_addr(Ip), nil0nil, echo, sizeof(ICMP_ECHO_REPLY)+80);
  if (DW <> 0and (echo^.Address  = Ip) then
     Result := echo^.RoundTripTime;
  IcmpCloseHandle(Handle);
  dispose(echo);
end;

// the 2 functions below use the GetRttandHopCount API

function ping(host:stringvar 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:
ausblenden 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:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
procedure TForm1.Button6Click(Sender: TObject);
begin
  memo1.Lines.add(inttostr(IcmpPingRTT(dnsnametoip('www.vol.at'))));
end;


Zuletzt bearbeitet von retnyg am Mi 12.10.05 17:35, insgesamt 4-mal bearbeitet
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1



BeitragVerfasst: Do 28.04.05 01:43 
Vorschlag: Nimm gleich GetIpForwardTable und du hast ein einfaches Tracert nachgebaut. ;)
retnyg Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: Do 28.04.05 02:01 
kommt noch, wenn es mich mal wieder in den fingern kribbelt ;)

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
retnyg Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: 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
ausblenden Delphi-Quelltext
1:
uses  ... , windows, winsock;					


- folgenden code einfügen (die eigentlich ping funktion)
ausblenden volle Höhe 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; stdcallexternal 'iphlpapi.dll';

function ping(host:stringvar 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:
ausblenden 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
ausblenden 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;

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
polydegmon
Hält's aus hier
Beiträge: 9

XP Pro
Delphi 7 Pro
BeitragVerfasst: 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 Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: So 26.06.05 12:56 
sind alle 5 server offline ?

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
retnyg Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: So 26.06.05 13:30 
möglichkeit 1:
(1 form, 1 memo, 1 button mit click-ereignis)
ausblenden volle Höhe 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; stdcallexternal '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

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
polydegmon
Hält's aus hier
Beiträge: 9

XP Pro
Delphi 7 Pro
BeitragVerfasst: 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
Hält's aus hier
Beiträge: 9

XP Pro
Delphi 7 Pro
BeitragVerfasst: 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 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 Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: So 26.06.05 15:00 
möglichkeit 2:
retPing.pas hat folgendes geschrieben:

ausblenden volle Höhe 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; stdcallexternal 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; stdcallexternal 'icmp.dll'
function IcmpSendEcho
   (IcmpHandle : THandle; DestinationAddress : In_Addr;
    RequestData : Pointer; RequestSize : Smallint;
    RequestOptions : pointer;
    ReplyBuffer : Pointer;
    ReplySize : DWORD;
    Timeout : DWORD) : DWORD; stdcallexternal 'icmp.dll';

function GetRTTAndHopCount(DestIpAddress:DWORD; HopCount :pointer; MaxHops: DWORD;
    RTT : pointer):boolean; stdcallexternal '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..128of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then Exit;
  DW := IcmpSendEcho(Handle, in_addr(Ip), nil0nil, @rep, 1280);
  Result := (DW <> 0);
  IcmpCloseHandle(Handle);
end;

function ping(host:stringvar 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:
ausblenden volle Höhe 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 ?

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
retnyg Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: So 26.06.05 15:36 
hier noch die möglichkeit, ne liste an hosts durchzupingen
ausblenden 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..3of 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

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
polydegmon
Hält's aus hier
Beiträge: 9

XP Pro
Delphi 7 Pro
BeitragVerfasst: 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
Hält's aus hier
Beiträge: 9

XP Pro
Delphi 7 Pro
BeitragVerfasst: 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

ausblenden volle Höhe 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; stdcallexternal 'iphlpapi.dll';  

 
function ping(host:stringvar 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 user profile iconGausi: Delphi-Tags hinzugefügt.
retnyg Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: Di 28.06.05 11:20 
user profile iconpolydegmon 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

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
polydegmon
Hält's aus hier
Beiträge: 9

XP Pro
Delphi 7 Pro
BeitragVerfasst: 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 Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: Mi 29.06.05 17:43 
Titel: Re: API Ping
user profile iconpolydegmon hat folgendes geschrieben:
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

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.

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
CJ
Hält's aus hier
Beiträge: 19



BeitragVerfasst: 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.
ausblenden 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 Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: 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:
ausblenden 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;

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...
CJ
Hält's aus hier
Beiträge: 19



BeitragVerfasst: So 17.07.05 20:30 
Ich danke dir vielmals. :D
retnyg Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2754

SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
BeitragVerfasst: Mo 18.07.05 01:23 
neue version der retPing unit online, siehe ersten post
nun mit der möglichkeit nen traceroute zu machen

_________________
es gibt leute, die sind genetisch nicht zum programmieren geschaffen.
in der regel haben diese leute die regel...