Autor |
Beitrag |
retnyg
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: Do 28.04.05 01:22
ein konsolen-ping programm, zum selber kompilieren
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;
{$APPTYPE CONSOLE} uses {$ifdef KOL} kol, {$endif} winsock, windows;
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 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; 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)
////////////////////////////////////////////////////////////////////////////////////////
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;
interface uses winsock, windows;
type USHORT = word;
PIP_OPTION_INFORMATION = ^IP_OPTION_INFORMATION ; IP_OPTION_INFORMATION = record ttl : UCHAR; Tos : UCHAR; Flags : UCHAR; OptionsSize : UCHAR; OptionsData : PUCHAR; end;
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; 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; function ICMPPingRTT(Ip : DWORD) : integer;function DNSNameToIp(host: string):DWORD; 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; 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;
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; |
Zuletzt bearbeitet von retnyg am Mi 12.10.05 17:35, insgesamt 4-mal bearbeitet
|
|
Luckie
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Do 28.04.05 01:43
Vorschlag: Nimm gleich GetIpForwardTable und du hast ein einfaches Tracert nachgebaut. 
|
|
retnyg 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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)
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;
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 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
|
Verfasst: 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: So 26.06.05 13:30
möglichkeit 1:
(1 form, 1 memo, 1 button mit click-ereignis)
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 public 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;
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
|
Verfasst: 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
|
Verfasst: 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: So 26.06.05 15:00
möglichkeit 2:
retPing.pas hat folgendes geschrieben: |
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:
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 public 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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
_________________ 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
|
Verfasst: So 26.06.05 16:11
Titel: API PING
AHHH
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
|
Verfasst: 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
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;
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 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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 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
|
Verfasst: 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: Mi 29.06.05 17:43
Titel: Re: API Ping
polydegmon 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
|
Verfasst: 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 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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; |
_________________ 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
|
Verfasst: So 17.07.05 20:30
Ich danke dir vielmals. 
|
|
retnyg 
      
Beiträge: 2754
SNES, GB, GBA, CPC, A500, 486/66, P4/3.0HT: NintendOS, AmigaOS, DoS
Delphi 5, Delphi 7
|
Verfasst: 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...
|
|
|