source: trunk/Packages/synapse/source/lib/pingsend.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 21.2 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 004.000.002 |
3|==============================================================================|
4| Content: PING sender |
5|==============================================================================|
6| Copyright (c)1999-2010, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{:@abstract(ICMP PING implementation.)
46Allows create PING and TRACEROUTE. Or you can diagnose your network.
47
48This unit using IpHlpApi (on WinXP or higher) if available. Otherwise it trying
49 to use RAW sockets.
50
51Warning: For use of RAW sockets you must have some special rights on some
52 systems. So, it working allways when you have administator/root rights.
53 Otherwise you can have problems!
54
55Note: This unit is NOT portable to .NET!
56 Use native .NET classes for Ping instead.
57}
58
59{$IFDEF FPC}
60 {$MODE DELPHI}
61{$ENDIF}
62{$Q-}
63{$R-}
64{$H+}
65
66{$IFDEF CIL}
67 Sorry, this unit is not for .NET!
68{$ENDIF}
69//old Delphi does not have MSWINDOWS define.
70{$IFDEF WIN32}
71 {$IFNDEF MSWINDOWS}
72 {$DEFINE MSWINDOWS}
73 {$ENDIF}
74{$ENDIF}
75
76{$IFDEF UNICODE}
77 {$WARN IMPLICIT_STRING_CAST OFF}
78 {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
79{$ENDIF}
80
81unit pingsend;
82
83interface
84
85uses
86 SysUtils,
87 synsock, blcksock, synautil, synafpc, synaip
88{$IFDEF MSWINDOWS}
89 , windows
90{$ENDIF}
91 ;
92
93const
94 ICMP_ECHO = 8;
95 ICMP_ECHOREPLY = 0;
96 ICMP_UNREACH = 3;
97 ICMP_TIME_EXCEEDED = 11;
98//rfc-2292
99 ICMP6_ECHO = 128;
100 ICMP6_ECHOREPLY = 129;
101 ICMP6_UNREACH = 1;
102 ICMP6_TIME_EXCEEDED = 3;
103
104type
105 {:List of possible ICMP reply packet types.}
106 TICMPError = (
107 IE_NoError,
108 IE_Other,
109 IE_TTLExceed,
110 IE_UnreachOther,
111 IE_UnreachRoute,
112 IE_UnreachAdmin,
113 IE_UnreachAddr,
114 IE_UnreachPort
115 );
116
117 {:@abstract(Implementation of ICMP PING and ICMPv6 PING.)}
118 TPINGSend = class(TSynaClient)
119 private
120 FSock: TICMPBlockSocket;
121 FBuffer: Ansistring;
122 FSeq: Integer;
123 FId: Integer;
124 FPacketSize: Integer;
125 FPingTime: Integer;
126 FIcmpEcho: Byte;
127 FIcmpEchoReply: Byte;
128 FIcmpUnreach: Byte;
129 FReplyFrom: string;
130 FReplyType: byte;
131 FReplyCode: byte;
132 FReplyError: TICMPError;
133 FReplyErrorDesc: string;
134 FTTL: Byte;
135 Fsin: TVarSin;
136 function Checksum(Value: AnsiString): Word;
137 function Checksum6(Value: AnsiString): Word;
138 function ReadPacket: Boolean;
139 procedure TranslateError;
140 procedure TranslateErrorIpHlp(value: integer);
141 function InternalPing(const Host: string): Boolean;
142 function InternalPingIpHlp(const Host: string): Boolean;
143 function IsHostIP6(const Host: string): Boolean;
144 procedure GenErrorDesc;
145 public
146 {:Send ICMP ping to host and count @link(pingtime). If ping OK, result is
147 @true.}
148 function Ping(const Host: string): Boolean;
149 constructor Create;
150 destructor Destroy; override;
151 published
152 {:Size of PING packet. Default size is 32 bytes.}
153 property PacketSize: Integer read FPacketSize Write FPacketSize;
154
155 {:Time between request and reply.}
156 property PingTime: Integer read FPingTime;
157
158 {:From this address is sended reply for your PING request. It maybe not your
159 requested destination, when some error occured!}
160 property ReplyFrom: string read FReplyFrom;
161
162 {:ICMP type of PING reply. Each protocol using another values! For IPv4 and
163 IPv6 are used different values!}
164 property ReplyType: byte read FReplyType;
165
166 {:ICMP code of PING reply. Each protocol using another values! For IPv4 and
167 IPv6 are used different values! For protocol independent value look to
168 @link(ReplyError)}
169 property ReplyCode: byte read FReplyCode;
170
171 {:Return type of returned ICMP message. This value is independent on used
172 protocol!}
173 property ReplyError: TICMPError read FReplyError;
174
175 {:Return human readable description of returned packet type.}
176 property ReplyErrorDesc: string read FReplyErrorDesc;
177
178 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
179 property Sock: TICMPBlockSocket read FSock;
180
181 {:TTL value for ICMP query}
182 property TTL: byte read FTTL write FTTL;
183 end;
184
185{:A very useful function and example of its use would be found in the TPINGSend
186 object. Use it to ping to any host. If successful, returns the ping time in
187 milliseconds. Returns -1 if an error occurred.}
188function PingHost(const Host: string): Integer;
189
190{:A very useful function and example of its use would be found in the TPINGSend
191 object. Use it to TraceRoute to any host.}
192function TraceRouteHost(const Host: string): string;
193
194implementation
195
196type
197 {:Record for ICMP ECHO packet header.}
198 TIcmpEchoHeader = packed record
199 i_type: Byte;
200 i_code: Byte;
201 i_checkSum: Word;
202 i_Id: Word;
203 i_seq: Word;
204 TimeStamp: integer;
205 end;
206
207 {:record used internally by TPingSend for compute checksum of ICMPv6 packet
208 pseudoheader.}
209 TICMP6Packet = packed record
210 in_source: TInAddr6;
211 in_dest: TInAddr6;
212 Length: integer;
213 free0: Byte;
214 free1: Byte;
215 free2: Byte;
216 proto: Byte;
217 end;
218
219{$IFDEF MSWINDOWS}
220const
221 DLLIcmpName = 'iphlpapi.dll';
222type
223 TIP_OPTION_INFORMATION = record
224 TTL: Byte;
225 TOS: Byte;
226 Flags: Byte;
227 OptionsSize: Byte;
228 OptionsData: PAnsiChar;
229 end;
230 PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
231
232 TICMP_ECHO_REPLY = record
233 Address: TInAddr;
234 Status: integer;
235 RoundTripTime: integer;
236 DataSize: Word;
237 Reserved: Word;
238 Data: pointer;
239 Options: TIP_OPTION_INFORMATION;
240 end;
241 PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
242
243 TICMPV6_ECHO_REPLY = record
244 Address: TSockAddrIn6;
245 Status: integer;
246 RoundTripTime: integer;
247 end;
248 PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
249
250 TIcmpCreateFile = function: integer; stdcall;
251 TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
252 TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
253 ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
254 RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
255 ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
256 TIcmp6CreateFile = function: integer; stdcall;
257 TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
258 ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
259 RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
260 ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
261
262var
263 IcmpDllHandle: TLibHandle = 0;
264 IcmpHelper4: boolean = false;
265 IcmpHelper6: boolean = false;
266 IcmpCreateFile: TIcmpCreateFile = nil;
267 IcmpCloseHandle: TIcmpCloseHandle = nil;
268 IcmpSendEcho2: TIcmpSendEcho2 = nil;
269 Icmp6CreateFile: TIcmp6CreateFile = nil;
270 Icmp6SendEcho2: TIcmp6SendEcho2 = nil;
271{$ENDIF}
272{==============================================================================}
273
274constructor TPINGSend.Create;
275begin
276 inherited Create;
277 FSock := TICMPBlockSocket.Create;
278 FSock.Owner := self;
279 FTimeout := 5000;
280 FPacketSize := 32;
281 FSeq := 0;
282 Randomize;
283 FTTL := 128;
284end;
285
286destructor TPINGSend.Destroy;
287begin
288 FSock.Free;
289 inherited Destroy;
290end;
291
292function TPINGSend.ReadPacket: Boolean;
293begin
294 FBuffer := FSock.RecvPacket(Ftimeout);
295 Result := FSock.LastError = 0;
296end;
297
298procedure TPINGSend.GenErrorDesc;
299begin
300 case FReplyError of
301 IE_NoError:
302 FReplyErrorDesc := '';
303 IE_Other:
304 FReplyErrorDesc := 'Unknown error';
305 IE_TTLExceed:
306 FReplyErrorDesc := 'TTL Exceeded';
307 IE_UnreachOther:
308 FReplyErrorDesc := 'Unknown unreachable';
309 IE_UnreachRoute:
310 FReplyErrorDesc := 'No route to destination';
311 IE_UnreachAdmin:
312 FReplyErrorDesc := 'Administratively prohibited';
313 IE_UnreachAddr:
314 FReplyErrorDesc := 'Address unreachable';
315 IE_UnreachPort:
316 FReplyErrorDesc := 'Port unreachable';
317 end;
318end;
319
320function TPINGSend.IsHostIP6(const Host: string): Boolean;
321var
322 f: integer;
323begin
324 f := AF_UNSPEC;
325 if IsIp(Host) then
326 f := AF_INET
327 else
328 if IsIp6(Host) then
329 f := AF_INET6;
330 synsock.SetVarSin(Fsin, host, '0', f,
331 IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4);
332 result := Fsin.sin_family = AF_INET6;
333end;
334
335function TPINGSend.Ping(const Host: string): Boolean;
336var
337 b: boolean;
338begin
339 FPingTime := -1;
340 FReplyFrom := '';
341 FReplyType := 0;
342 FReplyCode := 0;
343 FReplyError := IE_Other;
344 GenErrorDesc;
345 FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
346{$IFDEF MSWINDOWS}
347 b := IsHostIP6(host);
348 if not(b) and IcmpHelper4 then
349 result := InternalPingIpHlp(host)
350 else
351 if b and IcmpHelper6 then
352 result := InternalPingIpHlp(host)
353 else
354 result := InternalPing(host);
355{$ELSE}
356 result := InternalPing(host);
357{$ENDIF}
358end;
359
360function TPINGSend.InternalPing(const Host: string): Boolean;
361var
362 IPHeadPtr: ^TIPHeader;
363 IpHdrLen: Integer;
364 IcmpEchoHeaderPtr: ^TICMPEchoHeader;
365 t: Boolean;
366 x: cardinal;
367 IcmpReqHead: string;
368begin
369 Result := False;
370 FSock.TTL := FTTL;
371 FSock.Bind(FIPInterface, cAnyPort);
372 FSock.Connect(Host, '0');
373 if FSock.LastError <> 0 then
374 Exit;
375 FSock.SizeRecvBuffer := 60 * 1024;
376 if FSock.IP6used then
377 begin
378 FIcmpEcho := ICMP6_ECHO;
379 FIcmpEchoReply := ICMP6_ECHOREPLY;
380 FIcmpUnreach := ICMP6_UNREACH;
381 end
382 else
383 begin
384 FIcmpEcho := ICMP_ECHO;
385 FIcmpEchoReply := ICMP_ECHOREPLY;
386 FIcmpUnreach := ICMP_UNREACH;
387 end;
388 IcmpEchoHeaderPtr := Pointer(FBuffer);
389 with IcmpEchoHeaderPtr^ do
390 begin
391 i_type := FIcmpEcho;
392 i_code := 0;
393 i_CheckSum := 0;
394 FId := System.Random(32767);
395 i_Id := FId;
396 TimeStamp := GetTick;
397 Inc(FSeq);
398 i_Seq := FSeq;
399 if fSock.IP6used then
400 i_CheckSum := CheckSum6(FBuffer)
401 else
402 i_CheckSum := CheckSum(FBuffer);
403 end;
404 FSock.SendString(FBuffer);
405 // remember first 8 bytes of ICMP packet
406 IcmpReqHead := Copy(FBuffer, 1, 8);
407 x := GetTick;
408 repeat
409 t := ReadPacket;
410 if not t then
411 break;
412 if fSock.IP6used then
413 begin
414{$IFNDEF MSWINDOWS}
415 IcmpEchoHeaderPtr := Pointer(FBuffer);
416{$ELSE}
417//WinXP SP1 with networking update doing this think by another way ;-O
418// FBuffer := StringOfChar(#0, 4) + FBuffer;
419 IcmpEchoHeaderPtr := Pointer(FBuffer);
420// IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply;
421{$ENDIF}
422 end
423 else
424 begin
425 IPHeadPtr := Pointer(FBuffer);
426 IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
427 IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
428 end;
429 //check for timeout
430 if TickDelta(x, GetTick) > FTimeout then
431 begin
432 t := false;
433 Break;
434 end;
435 //it discard sometimes possible 'echoes' of previosly sended packet
436 //or other unwanted ICMP packets...
437 until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
438 and ((IcmpEchoHeaderPtr^.i_id = FId)
439 or (Pos(IcmpReqHead, FBuffer) > 0));
440 if t then
441 begin
442 FPingTime := TickDelta(x, GetTick);
443 FReplyFrom := FSock.GetRemoteSinIP;
444 FReplyType := IcmpEchoHeaderPtr^.i_type;
445 FReplyCode := IcmpEchoHeaderPtr^.i_code;
446 TranslateError;
447 Result := True;
448 end;
449end;
450
451function TPINGSend.Checksum(Value: AnsiString): Word;
452var
453 CkSum: integer;
454 Num, Remain: Integer;
455 n, i: Integer;
456begin
457 Num := Length(Value) div 2;
458 Remain := Length(Value) mod 2;
459 CkSum := 0;
460 i := 1;
461 for n := 0 to Num - 1 do
462 begin
463 CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
464 inc(i, 2);
465 end;
466 if Remain <> 0 then
467 CkSum := CkSum + Ord(Value[Length(Value)]);
468 CkSum := (CkSum shr 16) + (CkSum and $FFFF);
469 CkSum := CkSum + (CkSum shr 16);
470 Result := Word(not CkSum);
471end;
472
473function TPINGSend.Checksum6(Value: AnsiString): Word;
474const
475 IOC_OUT = $40000000;
476 IOC_IN = $80000000;
477 IOC_INOUT = (IOC_IN or IOC_OUT);
478 IOC_WS2 = $08000000;
479 SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
480var
481 ICMP6Ptr: ^TICMP6Packet;
482 s: AnsiString;
483 b: integer;
484 ip6: TSockAddrIn6;
485 x: integer;
486begin
487 Result := 0;
488{$IFDEF MSWINDOWS}
489 s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
490 ICMP6Ptr := Pointer(s);
491 x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
492 @FSock.RemoteSin, SizeOf(FSock.RemoteSin),
493 @ip6, SizeOf(ip6), @b, nil, nil);
494 if x <> -1 then
495 ICMP6Ptr^.in_dest := ip6.sin6_addr
496 else
497 ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
498 ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
499 ICMP6Ptr^.Length := synsock.htonl(Length(Value));
500 ICMP6Ptr^.proto := IPPROTO_ICMPV6;
501 Result := Checksum(s);
502{$ENDIF}
503end;
504
505procedure TPINGSend.TranslateError;
506begin
507 if fSock.IP6used then
508 begin
509 case FReplyType of
510 ICMP6_ECHOREPLY:
511 FReplyError := IE_NoError;
512 ICMP6_TIME_EXCEEDED:
513 FReplyError := IE_TTLExceed;
514 ICMP6_UNREACH:
515 case FReplyCode of
516 0:
517 FReplyError := IE_UnreachRoute;
518 3:
519 FReplyError := IE_UnreachAddr;
520 4:
521 FReplyError := IE_UnreachPort;
522 1:
523 FReplyError := IE_UnreachAdmin;
524 else
525 FReplyError := IE_UnreachOther;
526 end;
527 else
528 FReplyError := IE_Other;
529 end;
530 end
531 else
532 begin
533 case FReplyType of
534 ICMP_ECHOREPLY:
535 FReplyError := IE_NoError;
536 ICMP_TIME_EXCEEDED:
537 FReplyError := IE_TTLExceed;
538 ICMP_UNREACH:
539 case FReplyCode of
540 0:
541 FReplyError := IE_UnreachRoute;
542 1:
543 FReplyError := IE_UnreachAddr;
544 3:
545 FReplyError := IE_UnreachPort;
546 13:
547 FReplyError := IE_UnreachAdmin;
548 else
549 FReplyError := IE_UnreachOther;
550 end;
551 else
552 FReplyError := IE_Other;
553 end;
554 end;
555 GenErrorDesc;
556end;
557
558procedure TPINGSend.TranslateErrorIpHlp(value: integer);
559begin
560 case value of
561 11000, 0:
562 FReplyError := IE_NoError;
563 11013:
564 FReplyError := IE_TTLExceed;
565 11002:
566 FReplyError := IE_UnreachRoute;
567 11003:
568 FReplyError := IE_UnreachAddr;
569 11005:
570 FReplyError := IE_UnreachPort;
571 11004:
572 FReplyError := IE_UnreachAdmin;
573 else
574 FReplyError := IE_Other;
575 end;
576 GenErrorDesc;
577end;
578
579function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
580{$IFDEF MSWINDOWS}
581var
582 PingIp6: boolean;
583 PingHandle: integer;
584 r: integer;
585 ipo: TIP_OPTION_INFORMATION;
586 RBuff: Ansistring;
587 ip4reply: PICMP_ECHO_REPLY;
588 ip6reply: PICMPV6_ECHO_REPLY;
589 ip6: TSockAddrIn6;
590begin
591 Result := False;
592 PingIp6 := Fsin.sin_family = AF_INET6;
593 if pingIp6 then
594 PingHandle := Icmp6CreateFile
595 else
596 PingHandle := IcmpCreateFile;
597 if PingHandle <> -1 then
598 begin
599 try
600 ipo.TTL := FTTL;
601 ipo.TOS := 0;
602 ipo.Flags := 0;
603 ipo.OptionsSize := 0;
604 ipo.OptionsData := nil;
605 setlength(RBuff, 4096);
606 if pingIp6 then
607 begin
608 FillChar(ip6, sizeof(ip6), 0);
609 r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
610 PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
611 if r > 0 then
612 begin
613 RBuff := #0 + #0 + RBuff;
614 ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
615 FPingTime := ip6reply^.RoundTripTime;
616 ip6reply^.Address.sin6_family := AF_INET6;
617 FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address));
618 TranslateErrorIpHlp(ip6reply^.Status);
619 Result := True;
620 end;
621 end
622 else
623 begin
624 r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
625 PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
626 if r > 0 then
627 begin
628 ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
629 FPingTime := ip4reply^.RoundTripTime;
630 FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr));
631 TranslateErrorIpHlp(ip4reply^.Status);
632 Result := True;
633 end;
634 end
635 finally
636 IcmpCloseHandle(PingHandle);
637 end;
638 end;
639end;
640{$ELSE}
641begin
642 result := false;
643end;
644{$ENDIF}
645
646{==============================================================================}
647
648function PingHost(const Host: string): Integer;
649begin
650 with TPINGSend.Create do
651 try
652 Result := -1;
653 if Ping(Host) then
654 if ReplyError = IE_NoError then
655 Result := PingTime;
656 finally
657 Free;
658 end;
659end;
660
661function TraceRouteHost(const Host: string): string;
662var
663 Ping: TPingSend;
664 ttl : byte;
665begin
666 Result := '';
667 Ping := TPINGSend.Create;
668 try
669 ttl := 1;
670 repeat
671 ping.TTL := ttl;
672 inc(ttl);
673 if ttl > 30 then
674 Break;
675 if not ping.Ping(Host) then
676 begin
677 Result := Result + cAnyHost+ ' Timeout' + CRLF;
678 continue;
679 end;
680 if (ping.ReplyError <> IE_NoError)
681 and (ping.ReplyError <> IE_TTLExceed) then
682 begin
683 Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
684 break;
685 end;
686 Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
687 until ping.ReplyError = IE_NoError;
688 finally
689 Ping.Free;
690 end;
691end;
692
693{$IFDEF MSWINDOWS}
694initialization
695begin
696 IcmpHelper4 := false;
697 IcmpHelper6 := false;
698 IcmpDllHandle := LoadLibrary(DLLIcmpName);
699 if IcmpDllHandle <> 0 then
700 begin
701 IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile');
702 IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle');
703 IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2');
704 Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile');
705 Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2');
706 IcmpHelper4 := assigned(IcmpCreateFile)
707 and assigned(IcmpCloseHandle)
708 and assigned(IcmpSendEcho2);
709 IcmpHelper6 := assigned(Icmp6CreateFile)
710 and assigned(Icmp6SendEcho2);
711 end;
712end;
713
714finalization
715begin
716 FreeLibrary(IcmpDllHandle);
717end;
718{$ENDIF}
719
720end.
Note: See TracBrowser for help on using the repository browser.