721 lines
21 KiB
Plaintext
721 lines
21 KiB
Plaintext
{==============================================================================|
|
|
| Project : Ararat Synapse | 004.000.002 |
|
|
|==============================================================================|
|
|
| Content: PING sender |
|
|
|==============================================================================|
|
|
| Copyright (c)1999-2010, Lukas Gebauer |
|
|
| All rights reserved. |
|
|
| |
|
|
| Redistribution and use in source and binary forms, with or without |
|
|
| modification, are permitted provided that the following conditions are met: |
|
|
| |
|
|
| Redistributions of source code must retain the above copyright notice, this |
|
|
| list of conditions and the following disclaimer. |
|
|
| |
|
|
| Redistributions in binary form must reproduce the above copyright notice, |
|
|
| this list of conditions and the following disclaimer in the documentation |
|
|
| and/or other materials provided with the distribution. |
|
|
| |
|
|
| Neither the name of Lukas Gebauer nor the names of its contributors may |
|
|
| be used to endorse or promote products derived from this software without |
|
|
| specific prior written permission. |
|
|
| |
|
|
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
|
|
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
|
|
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
|
|
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
|
|
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
|
|
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
|
|
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
|
|
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
|
|
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
|
|
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
|
|
| DAMAGE. |
|
|
|==============================================================================|
|
|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
|
|
| Portions created by Lukas Gebauer are Copyright (c)2000-2010. |
|
|
| All Rights Reserved. |
|
|
|==============================================================================|
|
|
| Contributor(s): |
|
|
|==============================================================================|
|
|
| History: see HISTORY.HTM from distribution package |
|
|
| (Found at URL: http://www.ararat.cz/synapse/) |
|
|
|==============================================================================}
|
|
|
|
{:@abstract(ICMP PING implementation.)
|
|
Allows create PING and TRACEROUTE. Or you can diagnose your network.
|
|
|
|
This unit using IpHlpApi (on WinXP or higher) if available. Otherwise it trying
|
|
to use RAW sockets.
|
|
|
|
Warning: For use of RAW sockets you must have some special rights on some
|
|
systems. So, it working allways when you have administator/root rights.
|
|
Otherwise you can have problems!
|
|
|
|
Note: This unit is NOT portable to .NET!
|
|
Use native .NET classes for Ping instead.
|
|
}
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE DELPHI}
|
|
{$ENDIF}
|
|
{$Q-}
|
|
{$R-}
|
|
{$H+}
|
|
|
|
{$IFDEF CIL}
|
|
Sorry, this unit is not for .NET!
|
|
{$ENDIF}
|
|
//old Delphi does not have MSWINDOWS define.
|
|
{$IFDEF WIN32}
|
|
{$IFNDEF MSWINDOWS}
|
|
{$DEFINE MSWINDOWS}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF UNICODE}
|
|
{$WARN IMPLICIT_STRING_CAST OFF}
|
|
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
|
|
{$ENDIF}
|
|
|
|
unit pingsend;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
synsock, blcksock, synautil, synafpc, synaip
|
|
{$IFDEF MSWINDOWS}
|
|
, windows
|
|
{$ENDIF}
|
|
;
|
|
|
|
const
|
|
ICMP_ECHO = 8;
|
|
ICMP_ECHOREPLY = 0;
|
|
ICMP_UNREACH = 3;
|
|
ICMP_TIME_EXCEEDED = 11;
|
|
//rfc-2292
|
|
ICMP6_ECHO = 128;
|
|
ICMP6_ECHOREPLY = 129;
|
|
ICMP6_UNREACH = 1;
|
|
ICMP6_TIME_EXCEEDED = 3;
|
|
|
|
type
|
|
{:List of possible ICMP reply packet types.}
|
|
TICMPError = (
|
|
IE_NoError,
|
|
IE_Other,
|
|
IE_TTLExceed,
|
|
IE_UnreachOther,
|
|
IE_UnreachRoute,
|
|
IE_UnreachAdmin,
|
|
IE_UnreachAddr,
|
|
IE_UnreachPort
|
|
);
|
|
|
|
{:@abstract(Implementation of ICMP PING and ICMPv6 PING.)}
|
|
TPINGSend = class(TSynaClient)
|
|
private
|
|
FSock: TICMPBlockSocket;
|
|
FBuffer: Ansistring;
|
|
FSeq: Integer;
|
|
FId: Integer;
|
|
FPacketSize: Integer;
|
|
FPingTime: Integer;
|
|
FIcmpEcho: Byte;
|
|
FIcmpEchoReply: Byte;
|
|
FIcmpUnreach: Byte;
|
|
FReplyFrom: string;
|
|
FReplyType: byte;
|
|
FReplyCode: byte;
|
|
FReplyError: TICMPError;
|
|
FReplyErrorDesc: string;
|
|
FTTL: Byte;
|
|
Fsin: TVarSin;
|
|
function Checksum(Value: AnsiString): Word;
|
|
function Checksum6(Value: AnsiString): Word;
|
|
function ReadPacket: Boolean;
|
|
procedure TranslateError;
|
|
procedure TranslateErrorIpHlp(value: integer);
|
|
function InternalPing(const Host: string): Boolean;
|
|
function InternalPingIpHlp(const Host: string): Boolean;
|
|
function IsHostIP6(const Host: string): Boolean;
|
|
procedure GenErrorDesc;
|
|
public
|
|
{:Send ICMP ping to host and count @link(pingtime). If ping OK, result is
|
|
@true.}
|
|
function Ping(const Host: string): Boolean;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
published
|
|
{:Size of PING packet. Default size is 32 bytes.}
|
|
property PacketSize: Integer read FPacketSize Write FPacketSize;
|
|
|
|
{:Time between request and reply.}
|
|
property PingTime: Integer read FPingTime;
|
|
|
|
{:From this address is sended reply for your PING request. It maybe not your
|
|
requested destination, when some error occured!}
|
|
property ReplyFrom: string read FReplyFrom;
|
|
|
|
{:ICMP type of PING reply. Each protocol using another values! For IPv4 and
|
|
IPv6 are used different values!}
|
|
property ReplyType: byte read FReplyType;
|
|
|
|
{:ICMP code of PING reply. Each protocol using another values! For IPv4 and
|
|
IPv6 are used different values! For protocol independent value look to
|
|
@link(ReplyError)}
|
|
property ReplyCode: byte read FReplyCode;
|
|
|
|
{:Return type of returned ICMP message. This value is independent on used
|
|
protocol!}
|
|
property ReplyError: TICMPError read FReplyError;
|
|
|
|
{:Return human readable description of returned packet type.}
|
|
property ReplyErrorDesc: string read FReplyErrorDesc;
|
|
|
|
{:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
|
|
property Sock: TICMPBlockSocket read FSock;
|
|
|
|
{:TTL value for ICMP query}
|
|
property TTL: byte read FTTL write FTTL;
|
|
end;
|
|
|
|
{:A very useful function and example of its use would be found in the TPINGSend
|
|
object. Use it to ping to any host. If successful, returns the ping time in
|
|
milliseconds. Returns -1 if an error occurred.}
|
|
function PingHost(const Host: string): Integer;
|
|
|
|
{:A very useful function and example of its use would be found in the TPINGSend
|
|
object. Use it to TraceRoute to any host.}
|
|
function TraceRouteHost(const Host: string): string;
|
|
|
|
implementation
|
|
|
|
type
|
|
{:Record for ICMP ECHO packet header.}
|
|
TIcmpEchoHeader = packed record
|
|
i_type: Byte;
|
|
i_code: Byte;
|
|
i_checkSum: Word;
|
|
i_Id: Word;
|
|
i_seq: Word;
|
|
TimeStamp: integer;
|
|
end;
|
|
|
|
{:record used internally by TPingSend for compute checksum of ICMPv6 packet
|
|
pseudoheader.}
|
|
TICMP6Packet = packed record
|
|
in_source: TInAddr6;
|
|
in_dest: TInAddr6;
|
|
Length: integer;
|
|
free0: Byte;
|
|
free1: Byte;
|
|
free2: Byte;
|
|
proto: Byte;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
const
|
|
DLLIcmpName = 'iphlpapi.dll';
|
|
type
|
|
TIP_OPTION_INFORMATION = record
|
|
TTL: Byte;
|
|
TOS: Byte;
|
|
Flags: Byte;
|
|
OptionsSize: Byte;
|
|
OptionsData: PAnsiChar;
|
|
end;
|
|
PIP_OPTION_INFORMATION = ^TIP_OPTION_INFORMATION;
|
|
|
|
TICMP_ECHO_REPLY = record
|
|
Address: TInAddr;
|
|
Status: integer;
|
|
RoundTripTime: integer;
|
|
DataSize: Word;
|
|
Reserved: Word;
|
|
Data: pointer;
|
|
Options: TIP_OPTION_INFORMATION;
|
|
end;
|
|
PICMP_ECHO_REPLY = ^TICMP_ECHO_REPLY;
|
|
|
|
TICMPV6_ECHO_REPLY = record
|
|
Address: TSockAddrIn6;
|
|
Status: integer;
|
|
RoundTripTime: integer;
|
|
end;
|
|
PICMPV6_ECHO_REPLY = ^TICMPV6_ECHO_REPLY;
|
|
|
|
TIcmpCreateFile = function: integer; stdcall;
|
|
TIcmpCloseHandle = function(handle: integer): boolean; stdcall;
|
|
TIcmpSendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
|
|
ApcContext: pointer; DestinationAddress: TInAddr; RequestData: pointer;
|
|
RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
|
|
ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
|
|
TIcmp6CreateFile = function: integer; stdcall;
|
|
TIcmp6SendEcho2 = function(handle: integer; Event: pointer; ApcRoutine: pointer;
|
|
ApcContext: pointer; SourceAddress: PSockAddrIn6; DestinationAddress: PSockAddrIn6;
|
|
RequestData: pointer; RequestSize: integer; RequestOptions: PIP_OPTION_INFORMATION;
|
|
ReplyBuffer: pointer; ReplySize: integer; Timeout: Integer): integer; stdcall;
|
|
|
|
var
|
|
IcmpDllHandle: TLibHandle = 0;
|
|
IcmpHelper4: boolean = false;
|
|
IcmpHelper6: boolean = false;
|
|
IcmpCreateFile: TIcmpCreateFile = nil;
|
|
IcmpCloseHandle: TIcmpCloseHandle = nil;
|
|
IcmpSendEcho2: TIcmpSendEcho2 = nil;
|
|
Icmp6CreateFile: TIcmp6CreateFile = nil;
|
|
Icmp6SendEcho2: TIcmp6SendEcho2 = nil;
|
|
{$ENDIF}
|
|
{==============================================================================}
|
|
|
|
constructor TPINGSend.Create;
|
|
begin
|
|
inherited Create;
|
|
FSock := TICMPBlockSocket.Create;
|
|
FSock.Owner := self;
|
|
FTimeout := 5000;
|
|
FPacketSize := 32;
|
|
FSeq := 0;
|
|
Randomize;
|
|
FTTL := 128;
|
|
end;
|
|
|
|
destructor TPINGSend.Destroy;
|
|
begin
|
|
FSock.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TPINGSend.ReadPacket: Boolean;
|
|
begin
|
|
FBuffer := FSock.RecvPacket(Ftimeout);
|
|
Result := FSock.LastError = 0;
|
|
end;
|
|
|
|
procedure TPINGSend.GenErrorDesc;
|
|
begin
|
|
case FReplyError of
|
|
IE_NoError:
|
|
FReplyErrorDesc := '';
|
|
IE_Other:
|
|
FReplyErrorDesc := 'Unknown error';
|
|
IE_TTLExceed:
|
|
FReplyErrorDesc := 'TTL Exceeded';
|
|
IE_UnreachOther:
|
|
FReplyErrorDesc := 'Unknown unreachable';
|
|
IE_UnreachRoute:
|
|
FReplyErrorDesc := 'No route to destination';
|
|
IE_UnreachAdmin:
|
|
FReplyErrorDesc := 'Administratively prohibited';
|
|
IE_UnreachAddr:
|
|
FReplyErrorDesc := 'Address unreachable';
|
|
IE_UnreachPort:
|
|
FReplyErrorDesc := 'Port unreachable';
|
|
end;
|
|
end;
|
|
|
|
function TPINGSend.IsHostIP6(const Host: string): Boolean;
|
|
var
|
|
f: integer;
|
|
begin
|
|
f := AF_UNSPEC;
|
|
if IsIp(Host) then
|
|
f := AF_INET
|
|
else
|
|
if IsIp6(Host) then
|
|
f := AF_INET6;
|
|
synsock.SetVarSin(Fsin, host, '0', f,
|
|
IPPROTO_UDP, SOCK_DGRAM, Fsock.PreferIP4);
|
|
result := Fsin.sin_family = AF_INET6;
|
|
end;
|
|
|
|
function TPINGSend.Ping(const Host: string): Boolean;
|
|
var
|
|
b: boolean;
|
|
begin
|
|
FPingTime := -1;
|
|
FReplyFrom := '';
|
|
FReplyType := 0;
|
|
FReplyCode := 0;
|
|
FReplyError := IE_Other;
|
|
GenErrorDesc;
|
|
FBuffer := StringOfChar(#55, SizeOf(TICMPEchoHeader) + FPacketSize);
|
|
{$IFDEF MSWINDOWS}
|
|
b := IsHostIP6(host);
|
|
if not(b) and IcmpHelper4 then
|
|
result := InternalPingIpHlp(host)
|
|
else
|
|
if b and IcmpHelper6 then
|
|
result := InternalPingIpHlp(host)
|
|
else
|
|
result := InternalPing(host);
|
|
{$ELSE}
|
|
result := InternalPing(host);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TPINGSend.InternalPing(const Host: string): Boolean;
|
|
var
|
|
IPHeadPtr: ^TIPHeader;
|
|
IpHdrLen: Integer;
|
|
IcmpEchoHeaderPtr: ^TICMPEchoHeader;
|
|
t: Boolean;
|
|
x: cardinal;
|
|
IcmpReqHead: string;
|
|
begin
|
|
Result := False;
|
|
FSock.TTL := FTTL;
|
|
FSock.Bind(FIPInterface, cAnyPort);
|
|
FSock.Connect(Host, '0');
|
|
if FSock.LastError <> 0 then
|
|
Exit;
|
|
FSock.SizeRecvBuffer := 60 * 1024;
|
|
if FSock.IP6used then
|
|
begin
|
|
FIcmpEcho := ICMP6_ECHO;
|
|
FIcmpEchoReply := ICMP6_ECHOREPLY;
|
|
FIcmpUnreach := ICMP6_UNREACH;
|
|
end
|
|
else
|
|
begin
|
|
FIcmpEcho := ICMP_ECHO;
|
|
FIcmpEchoReply := ICMP_ECHOREPLY;
|
|
FIcmpUnreach := ICMP_UNREACH;
|
|
end;
|
|
IcmpEchoHeaderPtr := Pointer(FBuffer);
|
|
with IcmpEchoHeaderPtr^ do
|
|
begin
|
|
i_type := FIcmpEcho;
|
|
i_code := 0;
|
|
i_CheckSum := 0;
|
|
FId := System.Random(32767);
|
|
i_Id := FId;
|
|
TimeStamp := GetTick;
|
|
Inc(FSeq);
|
|
i_Seq := FSeq;
|
|
if fSock.IP6used then
|
|
i_CheckSum := CheckSum6(FBuffer)
|
|
else
|
|
i_CheckSum := CheckSum(FBuffer);
|
|
end;
|
|
FSock.SendString(FBuffer);
|
|
// remember first 8 bytes of ICMP packet
|
|
IcmpReqHead := Copy(FBuffer, 1, 8);
|
|
x := GetTick;
|
|
repeat
|
|
t := ReadPacket;
|
|
if not t then
|
|
break;
|
|
if fSock.IP6used then
|
|
begin
|
|
{$IFNDEF MSWINDOWS}
|
|
IcmpEchoHeaderPtr := Pointer(FBuffer);
|
|
{$ELSE}
|
|
//WinXP SP1 with networking update doing this think by another way ;-O
|
|
// FBuffer := StringOfChar(#0, 4) + FBuffer;
|
|
IcmpEchoHeaderPtr := Pointer(FBuffer);
|
|
// IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply;
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin
|
|
IPHeadPtr := Pointer(FBuffer);
|
|
IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
|
|
IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
|
|
end;
|
|
//check for timeout
|
|
if TickDelta(x, GetTick) > FTimeout then
|
|
begin
|
|
t := false;
|
|
Break;
|
|
end;
|
|
//it discard sometimes possible 'echoes' of previosly sended packet
|
|
//or other unwanted ICMP packets...
|
|
until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
|
|
and ((IcmpEchoHeaderPtr^.i_id = FId)
|
|
or (Pos(IcmpReqHead, FBuffer) > 0));
|
|
if t then
|
|
begin
|
|
FPingTime := TickDelta(x, GetTick);
|
|
FReplyFrom := FSock.GetRemoteSinIP;
|
|
FReplyType := IcmpEchoHeaderPtr^.i_type;
|
|
FReplyCode := IcmpEchoHeaderPtr^.i_code;
|
|
TranslateError;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
function TPINGSend.Checksum(Value: AnsiString): Word;
|
|
var
|
|
CkSum: integer;
|
|
Num, Remain: Integer;
|
|
n, i: Integer;
|
|
begin
|
|
Num := Length(Value) div 2;
|
|
Remain := Length(Value) mod 2;
|
|
CkSum := 0;
|
|
i := 1;
|
|
for n := 0 to Num - 1 do
|
|
begin
|
|
CkSum := CkSum + Synsock.HtoNs(DecodeInt(Value, i));
|
|
inc(i, 2);
|
|
end;
|
|
if Remain <> 0 then
|
|
CkSum := CkSum + Ord(Value[Length(Value)]);
|
|
CkSum := (CkSum shr 16) + (CkSum and $FFFF);
|
|
CkSum := CkSum + (CkSum shr 16);
|
|
Result := Word(not CkSum);
|
|
end;
|
|
|
|
function TPINGSend.Checksum6(Value: AnsiString): Word;
|
|
const
|
|
IOC_OUT = $40000000;
|
|
IOC_IN = $80000000;
|
|
IOC_INOUT = (IOC_IN or IOC_OUT);
|
|
IOC_WS2 = $08000000;
|
|
SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT;
|
|
var
|
|
ICMP6Ptr: ^TICMP6Packet;
|
|
s: AnsiString;
|
|
b: integer;
|
|
ip6: TSockAddrIn6;
|
|
x: integer;
|
|
begin
|
|
Result := 0;
|
|
{$IFDEF MSWINDOWS}
|
|
s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
|
|
ICMP6Ptr := Pointer(s);
|
|
x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
|
|
@FSock.RemoteSin, SizeOf(FSock.RemoteSin),
|
|
@ip6, SizeOf(ip6), @b, nil, nil);
|
|
if x <> -1 then
|
|
ICMP6Ptr^.in_dest := ip6.sin6_addr
|
|
else
|
|
ICMP6Ptr^.in_dest := FSock.LocalSin.sin6_addr;
|
|
ICMP6Ptr^.in_source := FSock.RemoteSin.sin6_addr;
|
|
ICMP6Ptr^.Length := synsock.htonl(Length(Value));
|
|
ICMP6Ptr^.proto := IPPROTO_ICMPV6;
|
|
Result := Checksum(s);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TPINGSend.TranslateError;
|
|
begin
|
|
if fSock.IP6used then
|
|
begin
|
|
case FReplyType of
|
|
ICMP6_ECHOREPLY:
|
|
FReplyError := IE_NoError;
|
|
ICMP6_TIME_EXCEEDED:
|
|
FReplyError := IE_TTLExceed;
|
|
ICMP6_UNREACH:
|
|
case FReplyCode of
|
|
0:
|
|
FReplyError := IE_UnreachRoute;
|
|
3:
|
|
FReplyError := IE_UnreachAddr;
|
|
4:
|
|
FReplyError := IE_UnreachPort;
|
|
1:
|
|
FReplyError := IE_UnreachAdmin;
|
|
else
|
|
FReplyError := IE_UnreachOther;
|
|
end;
|
|
else
|
|
FReplyError := IE_Other;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case FReplyType of
|
|
ICMP_ECHOREPLY:
|
|
FReplyError := IE_NoError;
|
|
ICMP_TIME_EXCEEDED:
|
|
FReplyError := IE_TTLExceed;
|
|
ICMP_UNREACH:
|
|
case FReplyCode of
|
|
0:
|
|
FReplyError := IE_UnreachRoute;
|
|
1:
|
|
FReplyError := IE_UnreachAddr;
|
|
3:
|
|
FReplyError := IE_UnreachPort;
|
|
13:
|
|
FReplyError := IE_UnreachAdmin;
|
|
else
|
|
FReplyError := IE_UnreachOther;
|
|
end;
|
|
else
|
|
FReplyError := IE_Other;
|
|
end;
|
|
end;
|
|
GenErrorDesc;
|
|
end;
|
|
|
|
procedure TPINGSend.TranslateErrorIpHlp(value: integer);
|
|
begin
|
|
case value of
|
|
11000, 0:
|
|
FReplyError := IE_NoError;
|
|
11013:
|
|
FReplyError := IE_TTLExceed;
|
|
11002:
|
|
FReplyError := IE_UnreachRoute;
|
|
11003:
|
|
FReplyError := IE_UnreachAddr;
|
|
11005:
|
|
FReplyError := IE_UnreachPort;
|
|
11004:
|
|
FReplyError := IE_UnreachAdmin;
|
|
else
|
|
FReplyError := IE_Other;
|
|
end;
|
|
GenErrorDesc;
|
|
end;
|
|
|
|
function TPINGSend.InternalPingIpHlp(const Host: string): Boolean;
|
|
{$IFDEF MSWINDOWS}
|
|
var
|
|
PingIp6: boolean;
|
|
PingHandle: integer;
|
|
r: integer;
|
|
ipo: TIP_OPTION_INFORMATION;
|
|
RBuff: Ansistring;
|
|
ip4reply: PICMP_ECHO_REPLY;
|
|
ip6reply: PICMPV6_ECHO_REPLY;
|
|
ip6: TSockAddrIn6;
|
|
begin
|
|
Result := False;
|
|
PingIp6 := Fsin.sin_family = AF_INET6;
|
|
if pingIp6 then
|
|
PingHandle := Icmp6CreateFile
|
|
else
|
|
PingHandle := IcmpCreateFile;
|
|
if PingHandle <> -1 then
|
|
begin
|
|
try
|
|
ipo.TTL := FTTL;
|
|
ipo.TOS := 0;
|
|
ipo.Flags := 0;
|
|
ipo.OptionsSize := 0;
|
|
ipo.OptionsData := nil;
|
|
setlength(RBuff, 4096);
|
|
if pingIp6 then
|
|
begin
|
|
FillChar(ip6, sizeof(ip6), 0);
|
|
r := Icmp6SendEcho2(PingHandle, nil, nil, nil, @ip6, @Fsin,
|
|
PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
|
|
if r > 0 then
|
|
begin
|
|
RBuff := #0 + #0 + RBuff;
|
|
ip6reply := PICMPV6_ECHO_REPLY(pointer(RBuff));
|
|
FPingTime := ip6reply^.RoundTripTime;
|
|
ip6reply^.Address.sin6_family := AF_INET6;
|
|
FReplyFrom := GetSinIp(TVarSin(ip6reply^.Address));
|
|
TranslateErrorIpHlp(ip6reply^.Status);
|
|
Result := True;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
r := IcmpSendEcho2(PingHandle, nil, nil, nil, Fsin.sin_addr,
|
|
PAnsichar(FBuffer), length(FBuffer), @ipo, pAnsichar(RBuff), length(RBuff), FTimeout);
|
|
if r > 0 then
|
|
begin
|
|
ip4reply := PICMP_ECHO_REPLY(pointer(RBuff));
|
|
FPingTime := ip4reply^.RoundTripTime;
|
|
FReplyFrom := IpToStr(swapbytes(ip4reply^.Address.S_addr));
|
|
TranslateErrorIpHlp(ip4reply^.Status);
|
|
Result := True;
|
|
end;
|
|
end
|
|
finally
|
|
IcmpCloseHandle(PingHandle);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
begin
|
|
result := false;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{==============================================================================}
|
|
|
|
function PingHost(const Host: string): Integer;
|
|
begin
|
|
with TPINGSend.Create do
|
|
try
|
|
Result := -1;
|
|
if Ping(Host) then
|
|
if ReplyError = IE_NoError then
|
|
Result := PingTime;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function TraceRouteHost(const Host: string): string;
|
|
var
|
|
Ping: TPingSend;
|
|
ttl : byte;
|
|
begin
|
|
Result := '';
|
|
Ping := TPINGSend.Create;
|
|
try
|
|
ttl := 1;
|
|
repeat
|
|
ping.TTL := ttl;
|
|
inc(ttl);
|
|
if ttl > 30 then
|
|
Break;
|
|
if not ping.Ping(Host) then
|
|
begin
|
|
Result := Result + cAnyHost+ ' Timeout' + CRLF;
|
|
continue;
|
|
end;
|
|
if (ping.ReplyError <> IE_NoError)
|
|
and (ping.ReplyError <> IE_TTLExceed) then
|
|
begin
|
|
Result := Result + Ping.ReplyFrom + ' ' + Ping.ReplyErrorDesc + CRLF;
|
|
break;
|
|
end;
|
|
Result := Result + Ping.ReplyFrom + ' ' + IntToStr(Ping.PingTime) + CRLF;
|
|
until ping.ReplyError = IE_NoError;
|
|
finally
|
|
Ping.Free;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
initialization
|
|
begin
|
|
IcmpHelper4 := false;
|
|
IcmpHelper6 := false;
|
|
IcmpDllHandle := LoadLibrary(DLLIcmpName);
|
|
if IcmpDllHandle <> 0 then
|
|
begin
|
|
IcmpCreateFile := GetProcAddress(IcmpDLLHandle, 'IcmpCreateFile');
|
|
IcmpCloseHandle := GetProcAddress(IcmpDLLHandle, 'IcmpCloseHandle');
|
|
IcmpSendEcho2 := GetProcAddress(IcmpDLLHandle, 'IcmpSendEcho2');
|
|
Icmp6CreateFile := GetProcAddress(IcmpDLLHandle, 'Icmp6CreateFile');
|
|
Icmp6SendEcho2 := GetProcAddress(IcmpDLLHandle, 'Icmp6SendEcho2');
|
|
IcmpHelper4 := assigned(IcmpCreateFile)
|
|
and assigned(IcmpCloseHandle)
|
|
and assigned(IcmpSendEcho2);
|
|
IcmpHelper6 := assigned(Icmp6CreateFile)
|
|
and assigned(Icmp6SendEcho2);
|
|
end;
|
|
end;
|
|
|
|
finalization
|
|
begin
|
|
FreeLibrary(IcmpDllHandle);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
end.
|