initial commit from lost SVN repo
This commit is contained in:
fatalerrors
720
common/synapse/pingsend.pas
Normal file
720
common/synapse/pingsend.pas
Normal file
@@ -0,0 +1,720 @@
|
||||
{==============================================================================|
|
||||
| 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.
|
||||
Reference in New Issue
Block a user