source: Network/synapse/pingsend.pas

Last change on this file was 300, checked in by chronos, 13 years ago
  • Added: Synapse library with package file. Cryptlib units are not included in package file list.
File size: 20.9 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 004.000.000 |
3|==============================================================================|
4| Content: PING sender |
5|==============================================================================|
6| Copyright (c)1999-2007, 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-2007. |
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
70unit pingsend;
71
72interface
73
74uses
75 SysUtils,
76 synsock, blcksock, synautil, synafpc, synaip
77{$IFDEF WIN32}
78 , windows
79{$ENDIF}
80 ;
81
82const
83 ICMP_ECHO = 8;
84 ICMP_ECHOREPLY = 0;
85 ICMP_UNREACH = 3;
86 ICMP_TIME_EXCEEDED = 11;
87//rfc-2292
88 ICMP6_ECHO = 128;
89 ICMP6_ECHOREPLY = 129;
90 ICMP6_UNREACH = 1;
91 ICMP6_TIME_EXCEEDED = 3;
92
93type
94 {:List of possible ICMP reply packet types.}
95 TICMPError = (
96 IE_NoError,
97 IE_Other,
98 IE_TTLExceed,
99 IE_UnreachOther,
100 IE_UnreachRoute,
101 IE_UnreachAdmin,
102 IE_UnreachAddr,
103 IE_UnreachPort
104 );
105
106 {:@abstract(Implementation of ICMP PING and ICMPv6 PING.)}
107 TPINGSend = class(TSynaClient)
108 private
109 FSock: TICMPBlockSocket;
110 FBuffer: string;
111 FSeq: Integer;
112 FId: Integer;
113 FPacketSize: Integer;
114 FPingTime: Integer;
115 FIcmpEcho: Byte;
116 FIcmpEchoReply: Byte;
117 FIcmpUnreach: Byte;
118 FReplyFrom: string;
119 FReplyType: byte;
120 FReplyCode: byte;
121 FReplyError: TICMPError;
122 FReplyErrorDesc: string;
123 FTTL: Byte;
124 Fsin: TVarSin;
125 function Checksum(Value: string): Word;
126 function Checksum6(Value: string): Word;
127 function ReadPacket: Boolean;
128 procedure TranslateError;
129 procedure TranslateErrorIpHlp(value: integer);
130 function InternalPing(const Host: string): Boolean;
131 function InternalPingIpHlp(const Host: string): Boolean;
132 function IsHostIP6(const Host: string): Boolean;
133 procedure GenErrorDesc;
134 public
135 {:Send ICMP ping to host and count @link(pingtime). If ping OK, result is
136 @true.}
137 function Ping(const Host: string): Boolean;
138 constructor Create;
139 destructor Destroy; override;
140 published
141 {:Size of PING packet. Default size is 32 bytes.}
142 property PacketSize: Integer read FPacketSize Write FPacketSize;
143
144 {:Time between request and reply.}
145 property PingTime: Integer read FPingTime;
146
147 {:From this address is sended reply for your PING request. It maybe not your
148 requested destination, when some error occured!}
149 property ReplyFrom: string read FReplyFrom;
150
151 {:ICMP type of PING reply. Each protocol using another values! For IPv4 and
152 IPv6 are used different values!}
153 property ReplyType: byte read FReplyType;
154
155 {:ICMP code of PING reply. Each protocol using another values! For IPv4 and
156 IPv6 are used different values! For protocol independent value look to
157 @link(ReplyError)}
158 property ReplyCode: byte read FReplyCode;
159
160 {:Return type of returned ICMP message. This value is independent on used
161 protocol!}
162 property ReplyError: TICMPError read FReplyError;
163
164 {:Return human readable description of returned packet type.}
165 property ReplyErrorDesc: string read FReplyErrorDesc;
166
167 {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
168 property Sock: TICMPBlockSocket read FSock;
169
170 {:TTL value for ICMP query}
171 property TTL: byte read FTTL write FTTL;
172 end;
173
174{:A very useful function and example of its use would be found in the TPINGSend
175 object. Use it to ping to any host. If successful, returns the ping time in
176 milliseconds. Returns -1 if an error occurred.}
177function PingHost(const Host: string): Integer;
178
179{:A very useful function and example of its use would be found in the TPINGSend
180 object. Use it to TraceRoute to any host.}
181function TraceRouteHost(const Host: string): string;
182
183implementation
184
185type
186 {:Record for ICMP ECHO packet header.}
187 TIcmpEchoHeader = record
188 i_type: Byte;
189 i_code: Byte;
190 i_checkSum: Word;
191 i_Id: Word;
192 i_seq: Word;
193 TimeStamp: integer;
194 end;
195
196 {:record used internally by TPingSend for compute checksum of ICMPv6 packet
197 pseudoheader.}
198 TICMP6Packet = record
199 in_source: TInAddr6;
200 in_dest: TInAddr6;
201 Length: integer;
202 free0: Byte;
203 free1: Byte;
204 free2: Byte;
205 proto: Byte;
206 end;
207
208{$IFDEF WIN32}
209const
210 DLLIcmpName = 'iphlpapi.dll';
211type
212 TIP_OPTION_INFORMATION = packed record
213 TTL: Byte;
214 TOS: Byte;
215 Flags: Byte;
216 OptionsSize: Byte;
217 OptionsData: PChar;
218 end;
219 PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
220
221 TICMP_ECHO_REPLY = packed record
222 Address: TInAddr;
223 Status: integer;
224 RoundTripTime: integer;
225 DataSize: Word;
226 Reserved: Word;
227 Data: pointer;
228 Options: TIP_OPTION_INFORMATION;
229 end;
230 PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
231
232 TICMPV6_ECHO_REPLY = packed record
233 Address: TSockAddrIn6;
234 Status: integer;
235 RoundTripTime: integer;
236 end;
237 PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
238
239 TIcmpCreateFile = function: integer; stdcall;
240 TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
241 TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
242 ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
243 RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
244 ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
245 TIcmp6CreateFile = function: integer; stdcall;
246 TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
247 ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
248 RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
249 ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
250
251var
252 IcmpDllHandle: TLibHandle = 0;
253 IcmpHelper4: boolean = false;
254 IcmpHelper6: boolean = false;
255 IcmpCreateFile: TIcmpCreateFile = nil;
256 IcmpCloseHandle: TIcmpCloseHandle = nil;
257 IcmpSendEcho2: TIcmpSendEcho2 = nil;
258 Icmp6CreateFile: TIcmp6CreateFile = nil;
259 Icmp6SendEcho2: TIcmp6SendEcho2 = nil;
260{$ENDIF}
261{==============================================================================}
262
263constructor TPINGSend.Create;
264begin
265 inherited Create;
266 FSock := TICMPBlockSocket.Create;
267 FTimeout := 5000;
268 FPacketSize := 32;
269 FSeq := 0;
270 Randomize;
271 FTTL := 128;
272end;
273
274destructor TPINGSend.Destroy;
275begin
276 FSock.Free;
277 inherited Destroy;
278end;
279
280function TPINGSend.ReadPacket: Boolean;
281begin
282 FBuffer := FSock.RecvPacket(Ftimeout);
283 Result := FSock.LastError = 0;
284end;
285
286procedure TPINGSend.GenErrorDesc;
287begin
288 case FReplyError of
289 IE_NoError:
290 FReplyErrorDesc := '';
291 IE_Other:
292 FReplyErrorDesc := 'Unknown error';
293 IE_TTLExceed:
294 FReplyErrorDesc := 'TTL Exceeded';
295 IE_UnreachOther:
296 FReplyErrorDesc := 'Unknown unreachable';
297 IE_UnreachRoute:
298 FReplyErrorDesc := 'No route to destination';
299 IE_UnreachAdmin:
300 FReplyErrorDesc := 'Administratively prohibited';
301 IE_UnreachAddr:
302 FReplyErrorDesc := 'Address unreachable';
303 IE_UnreachPort:
304 FReplyErrorDesc := 'Port unreachable';
305 end;
306end;
307
308function TPINGSend.IsHostIP6(const Host: string): Boolean;
309var
310 f: integer;
311begin
312 f := AF_UNSPEC;
313 if IsIp(Host) then
314 f := AF_INET
315 else
316 if IsIp6(Host) then
317 f := AF_INET6;
318 synsock.SetVarSin(Fsin, host, '0', f,
319 IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4);
320 result := Fsin.sin_family = AF_INET6;
321end;
322
323function TPINGSend.Ping(const Host: string): Boolean;
324var
325 b: boolean;
326begin
327 FPingTime := -1;
328 FReplyFrom := '';
329 FReplyType := 0;
330 FReplyCode := 0;
331 FReplyError := IE_Other;
332 GenErrorDesc;
333 FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
334{$IFDEF WIN32}
335 b := IsHostIP6(host);
336 if not(b) and IcmpHelper4 then
337 result := InternalPingIpHlp(host)
338 else
339 if b and IcmpHelper6 then
340 result := InternalPingIpHlp(host)
341 else
342 result := InternalPing(host);
343{$ELSE}
344 result := InternalPing(host);
345{$ENDIF}
346end;
347
348function TPINGSend.InternalPing(const Host: string): Boolean;
349var
350 IPHeadPtr: ^TIPHeader;
351 IpHdrLen: Integer;
352 IcmpEchoHeaderPtr: ^TICMPEchoHeader;
353 t: Boolean;
354 x: cardinal;
355 IcmpReqHead: string;
356begin
357 Result := False;
358 FSock.TTL := FTTL;
359 FSock.Bind(FIPInterface, cAnyPort);
360 FSock.Connect(Host, '0');
361 if FSock.LastError <> 0 then
362 Exit;
363 FSock.SizeRecvBuffer := 60 * 1024;
364 if FSock.IP6used then
365 begin
366 FIcmpEcho := ICMP6_ECHO;
367 FIcmpEchoReply := ICMP6_ECHOREPLY;
368 FIcmpUnreach := ICMP6_UNREACH;
369 end
370 else
371 begin
372 FIcmpEcho := ICMP_ECHO;
373 FIcmpEchoReply := ICMP_ECHOREPLY;
374 FIcmpUnreach := ICMP_UNREACH;
375 end;
376 IcmpEchoHeaderPtr := Pointer(FBuffer);
377 with IcmpEchoHeaderPtr^ do
378 begin
379 i_type := FIcmpEcho;
380 i_code := 0;
381 i_CheckSum := 0;
382 FId := System.Random(32767);
383 i_Id := FId;
384 TimeStamp := GetTick;
385 Inc(FSeq);
386 i_Seq := FSeq;
387 if fSock.IP6used then
388 i_CheckSum := CheckSum6(FBuffer)
389 else
390 i_CheckSum := CheckSum(FBuffer);
391 end;
392 FSock.SendString(FBuffer);
393 // remember first 8 bytes of ICMP packet
394 IcmpReqHead := Copy(FBuffer, 1, 8);
395 x := GetTick;
396 repeat
397 t := ReadPacket;
398 if not t then
399 break;
400 if fSock.IP6used then
401 begin
402{$IFNDEF WIN32}
403 IcmpEchoHeaderPtr := Pointer(FBuffer);
404{$ELSE}
405//WinXP SP1 with networking update doing this think by another way ;-O
406// FBuffer := StringOfChar(#0, 4) + FBuffer;
407 IcmpEchoHeaderPtr := Pointer(FBuffer);
408// IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply;
409{$ENDIF}
410 end
411 else
412 begin
413 IPHeadPtr := Pointer(FBuffer);
414 IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
415 IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
416 end;
417 //check for timeout
418 if TickDelta(x, GetTick) > FTimeout then
419 begin
420 t := false;
421 Break;
422 end;
423 //it discard sometimes possible 'echoes' of previosly sended packet
424 //or other unwanted ICMP packets...
425 until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
426 and ((IcmpEchoHeaderPtr^.i_id = FId)
427 or (Pos(IcmpReqHead, FBuffer) > 0));
428 if t then
429 begin
430 FPingTime := TickDelta(x, GetTick);
431 FReplyFrom := FSock.GetRemoteSinIP;
432 FReplyType := IcmpEchoHeaderPtr^.i_type;
433 FReplyCode := IcmpEchoHeaderPtr^.i_code;
434 TranslateError;
435 Result := True;
436 end;
437end;
438
439function TPINGSend.Checksum(Value: string): Word;
440var
441 CkSum: integer;
442 Num, Remain: Integer;
443 n, i: Integer;
444begin
445 Num := Length(Value) div 2;
446 Remain := Length(Value) mod 2;
447 CkSum := 0;
448 i := 1;
449 for n := 0 to Num - 1 do
450 begin
451 CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
452 inc(i, 2);
453 end;
454 if Remain <> 0 then
455 CkSum := CkSum + Ord(Value[Length(Value)]);
456 CkSum := (CkSum shr 16) + (CkSum and $FFFF);
457 CkSum := CkSum + (CkSum shr 16);
458 Result := Word(not CkSum);
459end;
460
461function TPINGSend.Checksum6(Value: string): Word;
462const
463 IOC_OUT = $40000000;
464 IOC_IN = $80000000;
465 IOC_INOUT = (IOC_IN or IOC_OUT);
466 IOC_WS2 = $08000000;
467 SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
468var
469 ICMP6Ptr: ^TICMP6Packet;
470 s: string;
471 b: integer;
472 ip6: TSockAddrIn6;
473 x: integer;
474begin
475 Result := 0;
476{$IFDEF WIN32}
477 s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
478 ICMP6Ptr := Pointer(s);
479 x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
480 @FSock.RemoteSin, SizeOf(FSock.RemoteSin),
481 @ip6, SizeOf(ip6), @b, nil, nil);
482 if x <> -1 then
483 ICMP6Ptr^.in_dest := ip6.sin6_addr
484 else
485 ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
486 ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
487 ICMP6Ptr^.Length := synsock.htonl(Length(Value));
488 ICMP6Ptr^.proto := IPPROTO_ICMPV6;
489 Result := Checksum(s);
490{$ENDIF}
491end;
492
493procedure TPINGSend.TranslateError;
494begin
495 if fSock.IP6used then
496 begin
497 case FReplyType of
498 ICMP6_ECHOREPLY:
499 FReplyError := IE_NoError;
500 ICMP6_TIME_EXCEEDED:
501 FReplyError := IE_TTLExceed;
502 ICMP6_UNREACH:
503 case FReplyCode of
504 0:
505 FReplyError := IE_UnreachRoute;
506 3:
507 FReplyError := IE_UnreachAddr;
508 4:
509 FReplyError := IE_UnreachPort;
510 1:
511 FReplyError := IE_UnreachAdmin;
512 else
513 FReplyError := IE_UnreachOther;
514 end;
515 else
516 FReplyError := IE_Other;
517 end;
518 end
519 else
520 begin
521 case FReplyType of
522 ICMP_ECHOREPLY:
523 FReplyError := IE_NoError;
524 ICMP_TIME_EXCEEDED:
525 FReplyError := IE_TTLExceed;
526 ICMP_UNREACH:
527 case FReplyCode of
528 0:
529 FReplyError := IE_UnreachRoute;
530 1:
531 FReplyError := IE_UnreachAddr;
532 3:
533 FReplyError := IE_UnreachPort;
534 13:
535 FReplyError := IE_UnreachAdmin;
536 else
537 FReplyError := IE_UnreachOther;
538 end;
539 else
540 FReplyError := IE_Other;
541 end;
542 end;
543 GenErrorDesc;
544end;
545
546procedure TPINGSend.TranslateErrorIpHlp(value: integer);
547begin
548 case value of
549 11000, 0:
550 FReplyError := IE_NoError;
551 11013:
552 FReplyError := IE_TTLExceed;
553 11002:
554 FReplyError := IE_UnreachRoute;
555 11003:
556 FReplyError := IE_UnreachAddr;
557 11005:
558 FReplyError := IE_UnreachPort;
559 11004:
560 FReplyError := IE_UnreachAdmin;
561 else
562 FReplyError := IE_Other;
563 end;
564 GenErrorDesc;
565end;
566
567function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
568{$IFDEF WIN32}
569var
570 PingIp6: boolean;
571 PingHandle: integer;
572 r: integer;
573 ipo: TIP_OPTION_INFORMATION;
574 RBuff: string;
575 ip4reply: PICMP_ECHO_REPLY;
576 ip6reply: PICMPV6_ECHO_REPLY;
577 ip6: TSockAddrIn6;
578begin
579 Result := False;
580 PingIp6 := Fsin.sin_family = AF_INET6;
581 if pingIp6 then
582 PingHandle := Icmp6CreateFile
583 else
584 PingHandle := IcmpCreateFile;
585 if PingHandle <> -1 then
586 begin
587 try
588 ipo.TTL := FTTL;
589 ipo.TOS := 0;
590 ipo.Flags := 0;
591 ipo.OptionsSize := 0;
592 ipo.OptionsData := nil;
593 setlength(RBuff, 4096);
594 if pingIp6 then
595 begin
596 FillChar(ip6, sizeof(ip6), 0);
597 r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
598 Pchar(FBuffer), length(FBuffer), @ipo, pchar(RBuff), length(RBuff), FTimeout);
599 if r > 0 then
600 begin
601 RBuff := #0 + #0 + RBuff;
602 ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
603 FPingTime := ip6reply^.RoundTripTime;
604 ip6reply^.Address.sin6_family := AF_INET6;
605 FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address));
606 TranslateErrorIpHlp(ip6reply^.Status);
607 Result := True;
608 end;
609 end
610 else
611 begin
612 r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
613 Pchar(FBuffer), length(FBuffer), @ipo, pchar(RBuff), length(RBuff), FTimeout);
614 if r > 0 then
615 begin
616 ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
617 FPingTime := ip4reply^.RoundTripTime;
618 FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr));
619 TranslateErrorIpHlp(ip4reply^.Status);
620 Result := True;
621 end;
622 end
623 finally
624 IcmpCloseHandle(PingHandle);
625 end;
626 end;
627end;
628{$ELSE}
629begin
630 result := false;
631end;
632{$ENDIF}
633
634{==============================================================================}
635
636function PingHost(const Host: string): Integer;
637begin
638 with TPINGSend.Create do
639 try
640 Result := -1;
641 if Ping(Host) then
642 if ReplyError = IE_NoError then
643 Result := PingTime;
644 finally
645 Free;
646 end;
647end;
648
649function TraceRouteHost(const Host: string): string;
650var
651 Ping: TPingSend;
652 ttl : byte;
653begin
654 Result := '';
655 Ping := TPINGSend.Create;
656 try
657 ttl := 1;
658 repeat
659 ping.TTL := ttl;
660 inc(ttl);
661 if ttl > 30 then
662 Break;
663 if not ping.Ping(Host) then
664 begin
665 Result := Result + cAnyHost+ ' Timeout' + CRLF;
666 continue;
667 end;
668 if (ping.ReplyError <> IE_NoError)
669 and (ping.ReplyError <> IE_TTLExceed) then
670 begin
671 Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
672 break;
673 end;
674 Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
675 until ping.ReplyError = IE_NoError;
676 finally
677 Ping.Free;
678 end;
679end;
680
681{$IFDEF WIN32}
682initialization
683begin
684 IcmpHelper4 := false;
685 IcmpHelper6 := false;
686 IcmpDllHandle := LoadLibrary(DLLIcmpName);
687 if IcmpDllHandle <> 0 then
688 begin
689 IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile');
690 IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle');
691 IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2');
692 Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile');
693 Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2');
694 IcmpHelper4 := assigned(IcmpCreateFile)
695 and assigned(IcmpCloseHandle)
696 and assigned(IcmpSendEcho2);
697 IcmpHelper6 := assigned(Icmp6CreateFile)
698 and assigned(Icmp6SendEcho2);
699 end;
700end;
701
702finalization
703begin
704 FreeLibrary(IcmpDllHandle);
705end;
706{$ENDIF}
707
708end.
Note: See TracBrowser for help on using the repository browser.