想做熊猫烧香啊 ................. 下面是流光里的一部分源码，看着有用的话给点分吧 PING实际上是用ICMP.dll中的一组函数实现的。我这儿有一个能在Delphi里面用的类，比较长，你粘走用就是了。unit icmp;interface{$IFDEF VER80} // This source file is *NOT* compatible with Delphi 1 because it uses // Win 32 features. {$ENDIF}uses Windows, SysUtils, Classes, WinSock;const IcmpVersion = 102; IcmpDLL = 'icmp.dll'; // IP status codes returned to transports and user IOCTLs. IP_SUCCESS = 0; IP_STATUS_BASE = 11000; IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1); IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2); IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3); IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4); IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5); IP_NO_RESOURCES = (IP_STATUS_BASE + 6); IP_BAD_OPTION = (IP_STATUS_BASE + 7); IP_HW_ERROR = (IP_STATUS_BASE + 8); IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9); IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10); IP_BAD_REQ = (IP_STATUS_BASE + 11); IP_BAD_ROUTE = (IP_STATUS_BASE + 12); IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13); IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14); IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15); IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16); IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17); IP_BAD_DESTINATION = (IP_STATUS_BASE + 18); // status codes passed up on status indications. IP_ADDR_DELETED = (IP_STATUS_BASE + 19); IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20); IP_MTU_CHANGE = (IP_STATUS_BASE + 21); IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50); MAX_IP_STATUS = IP_GENERAL_FAILURE; IP_PENDING = (IP_STATUS_BASE + 255); // IP header flags IP_FLAG_DF = $02; // Don't fragment this packet. // IP Option Types IP_OPT_EOL = $00; // End of list option IP_OPT_NOP = $01; // No operation IP_OPT_SECURITY = $82; // Security option. IP_OPT_LSRR = $83; // Loose source route. IP_OPT_SSRR = $89; // Strict source route. IP_OPT_RR = $07; // Record route. IP_OPT_TS = $44; // Timestamp. IP_OPT_SID = $88; // Stream ID (obsolete) MAX_OPT_SIZE = $40;type // IP types TIPAddr = DWORD; // An IP address. TIPMask = DWORD; // An IP subnet mask. TIPStatus = DWORD; // Status code returned from IP APIs. PIPOptionInformation = ^TIPOptionInformation; TIPOptionInformation = packed record TTL: Byte; // Time To Live (used for traceroute) TOS: Byte; // Type Of Service (usually 0) Flags: Byte; // IP header flags (usually 0) OptionsSize: Byte; // Size of options data (usually 0, max 40) OptionsData: PChar; // Options data buffer end; PIcmpEchoReply = ^TIcmpEchoReply; TIcmpEchoReply = packed record Address: TIPAddr; // Replying address Status: DWord; // IP status value RTT: DWord; // Round Trip Time in milliseconds DataSize: Word; // Reply data size Reserved: Word; // Reserved Data: Pointer; // Pointer to reply data buffer Options: TIPOptionInformation; // Reply options end; // IcmpCreateFile: // Opens a handle on which ICMP Echo Requests can be issued. // Arguments: // None. // Return Value: // An open file handle or INVALID_HANDLE_VALUE. Extended error information // is available by calling GetLastError(). TIcmpCreateFile = function: THandle; stdcall; // IcmpCloseHandle: // Closes a handle opened by ICMPOpenFile. // Arguments: // IcmpHandle - The handle to close. // Return Value: // TRUE if the handle was closed successfully, otherwise FALSE. Extended // error information is available by calling GetLastError(). TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
// IcmpSendEcho: // Sends an ICMP Echo request and returns one or more replies. The // call returns when the timeout has expired or the reply buffer // is filled. // Arguments: // IcmpHandle - An open handle returned by ICMPCreateFile. // DestinationAddress - The destination of the echo request. // RequestData - A buffer containing the data to send in the // request. // RequestSize - The number of bytes in the request data buffer. // RequestOptions - Pointer to the IP header options for the request. // May be NULL. // ReplyBuffer - A buffer to hold any replies to the request. // On return, the buffer will contain an array of // ICMP_ECHO_REPLY structures followed by options // and data. The buffer should be large enough to // hold at least one ICMP_ECHO_REPLY structure // and 8 bytes of data - this is the size of // an ICMP error message. // ReplySize - The size in bytes of the reply buffer. // Timeout - The time in milliseconds to wait for replies. // Return Value: // Returns the number of replies received and stored in ReplyBuffer. If // the return value is zero, extended error information is available // via GetLastError(). TIcmpSendEcho = function(IcmpHandle: THandle; DestinationAddress: TIPAddr; RequestData: Pointer; RequestSize: Word; RequestOptions: PIPOptionInformation; ReplyBuffer: Pointer; ReplySize: DWord; Timeout: DWord ): DWord; stdcall; // Event handler type declaration for TICMP.OnDisplay event. TICMPDisplay = procedure(Sender: TObject; Msg : String) of object; TICMPReply = procedure(Sender: TObject; Error : Integer) of object; // The object wich encapsulate the ICMP.DLL TICMP = class(TObject) private hICMPdll : HModule; // Handle for ICMP.DLL IcmpCreateFile : TIcmpCreateFile; IcmpCloseHandle : TIcmpCloseHandle; IcmpSendEcho : TIcmpSendEcho; hICMP : THandle; // Handle for the ICMP Calls FReply : TIcmpEchoReply; // ICMP Echo reply buffer FAddress : String; // Address given FHostName : String; // Dotted IP of host (output) FHostIP : String; // Name of host (Output) FIPAddress : TIPAddr; // Address of host to contact FSize : Integer; // Packet size (default to 56) FTimeOut : Integer; // Timeout (default to 4000mS) FTTL : Integer; // Time To Live (for send) FOnDisplay : TICMPDisplay; // Event handler to display FOnEchoRequest : TNotifyEvent; FOnEchoReply : TICMPReply; FLastError : DWORD; // After sending ICMP packet FAddrResolved : Boolean; procedure ResolveAddr; public constructor Create; virtual; destructor Destroy; override; function Ping : Integer; procedure SetAddress(Value : String); function GetErrorString : String; property Address : String read FAddress write SetAddress; property Size : Integer read FSize write FSize; property Timeout : Integer read FTimeout write FTimeout; property Reply : TIcmpEchoReply read FReply; property TTL : Integer read FTTL write FTTL; property ErrorCode : Integer read FLastError; property ErrorString : String read GetErrorString; property HostName : String read FHostName; property HostIP : String read FHostIP; property OnDisplay : TICMPDisplay read FOnDisplay write FOnDisplay; property OnEchoRequest : TNotifyEvent read FOnEchoRequest write FOnEchoRequest; property OnEchoReply : TICMPReply read FOnEchoReply write FOnEchoReply; end; TICMPException = class(Exception);implementation{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} constructor TICMP.Create; var WSAData: TWSAData; begin hICMP := INVALID_HANDLE_VALUE; FSize := 56; FTTL := 64; FTimeOut := 4000; // initialise winsock if WSAStartup($101, WSAData) <> 0 then raise TICMPException.Create('Error initialising Winsock'); // register the icmp.dll stuff hICMPdll := LoadLibrary(icmpDLL); if hICMPdll = 0 then raise TICMPException.Create('Unable to register ' + icmpDLL); @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile'); @IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle'); @IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho'); if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then raise TICMPException.Create('Error loading dll functions'); hICMP := IcmpCreateFile; if hICMP = INVALID_HANDLE_VALUE then raise TICMPException.Create('Unable to get ping handle'); end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} destructor TICMP.Destroy; begin if hICMP <> INVALID_HANDLE_VALUE then IcmpCloseHandle(hICMP); if hICMPdll <> 0 then FreeLibrary(hICMPdll); WSACleanup; inherited Destroy; end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} function MinInteger(X, Y: Integer): Integer; begin if X >= Y then Result := Y else Result := X; end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TICMP.ResolveAddr; var Phe : PHostEnt; // HostEntry buffer for name lookup begin // Convert host address to IP address FIPAddress := inet_addr(PChar(FAddress)); if FIPAddress <> INADDR_NONE then // Was a numeric dotted address let it in this format FHostName := FAddress else begin // Not a numeric dotted address, try to resolve by name Phe := GetHostByName(PChar(FAddress)); if Phe = nil then begin FLastError := GetLastError; if Assigned(FOnDisplay) then FOnDisplay(Self, 'Unable to resolve ' + FAddress); Exit; end; FIPAddress := longint(plongint(Phe^.h_addr_list^)^); FHostName := Phe^.h_name; end; FHostIP := StrPas(inet_ntoa(TInAddr(FIPAddress))); FAddrResolved := TRUE; end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} procedure TICMP.SetAddress(Value : String); begin // Only change if needed (could take a long time) if FAddress = Value then Exit; FAddress := Value; FAddrResolved := FALSE; // ResolveAddr; end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} function TICMP.GetErrorString : String; begin case FLastError of IP_SUCCESS: Result := 'No error'; IP_BUF_TOO_SMALL: Result := 'Buffer too small'; IP_DEST_NET_UNREACHABLE: Result := 'Destination network unreachable'; IP_DEST_HOST_UNREACHABLE: Result := 'Destination host unreachable'; IP_DEST_PROT_UNREACHABLE: Result := 'Destination protocol unreachable'; IP_DEST_PORT_UNREACHABLE: Result := 'Destination port unreachable'; IP_NO_RESOURCES: Result := 'No resources'; IP_BAD_OPTION: Result := 'Bad option'; IP_HW_ERROR: Result := 'Hardware error'; IP_PACKET_TOO_BIG: Result := 'Packet too big'; IP_REQ_TIMED_OUT: Result := 'Request timed out'; IP_BAD_REQ: Result := 'Bad request'; IP_BAD_ROUTE: Result := 'Bad route'; IP_TTL_EXPIRED_TRANSIT: Result := 'TTL expired in transit'; IP_TTL_EXPIRED_REASSEM: Result := 'TTL expired in reassembly'; IP_PARAM_PROBLEM: Result := 'Parameter problem'; IP_SOURCE_QUENCH: Result := 'Source quench'; IP_OPTION_TOO_BIG: Result := 'Option too big'; IP_BAD_DESTINATION: Result := 'Bad Destination'; IP_ADDR_DELETED: Result := 'Address deleted'; IP_SPEC_MTU_CHANGE: Result := 'Spec MTU change'; IP_MTU_CHANGE: Result := 'MTU change'; IP_GENERAL_FAILURE: Result := 'General failure'; IP_PENDING: Result := 'Pending'; else Result := 'ICMP error #' + IntToStr(FLastError); end; end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} function TICMP.Ping : Integer; var BufferSize: Integer; pReqData, pData: Pointer; pIPE: PIcmpEchoReply; // ICMP Echo reply buffer IPOpt: TIPOptionInformation; // IP Options for packet to send Msg: String; begin Result := 0; FLastError := 0; if not FAddrResolved then ResolveAddr; if FIPAddress = INADDR_NONE then begin FLastError := IP_BAD_DESTINATION; if Assigned(FOnDisplay) then FOnDisplay(Self, 'Invalid host address'); Exit; end; // Allocate space for data buffer space BufferSize := SizeOf(TICMPEchoReply) + FSize; GetMem(pReqData, FSize); GetMem(pData, FSize); GetMem(pIPE, BufferSize); try // Fill data buffer with some data bytes FillChar(pReqData^, FSize, $20); Msg := 'Pinging from Delphi code written by F. Piette'; Move(Msg[1], pReqData^, MinInteger(FSize, Length(Msg))); pIPE^.Data := pData; FillChar(pIPE^, SizeOf(pIPE^), 0); if Assigned(FOnEchoRequest) then FOnEchoRequest(Self); FillChar(IPOpt, SizeOf(IPOpt), 0); IPOpt.TTL := FTTL; Result := IcmpSendEcho(hICMP, FIPAddress, pReqData, FSize, @IPOpt, pIPE, BufferSize, FTimeOut); FLastError := GetLastError; FReply := pIPE^; if Assigned(FOnEchoReply) then FOnEchoReply(Self, Result); finally // Free those buffers FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData); end; end;
.................
下面是流光里的一部分源码，看着有用的话给点分吧
PING实际上是用ICMP.dll中的一组函数实现的。我这儿有一个能在Delphi里面用的类，比较长，你粘走用就是了。unit icmp;interface{$IFDEF VER80}
// This source file is *NOT* compatible with Delphi 1 because it uses
// Win 32 features.
{$ENDIF}uses
Windows, SysUtils, Classes, WinSock;const
IcmpVersion = 102;
IcmpDLL = 'icmp.dll'; // IP status codes returned to transports and user IOCTLs.
IP_SUCCESS = 0;
IP_STATUS_BASE = 11000;
IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1);
IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2);
IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3);
IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4);
IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5);
IP_NO_RESOURCES = (IP_STATUS_BASE + 6);
IP_BAD_OPTION = (IP_STATUS_BASE + 7);
IP_HW_ERROR = (IP_STATUS_BASE + 8);
IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9);
IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10);
IP_BAD_REQ = (IP_STATUS_BASE + 11);
IP_BAD_ROUTE = (IP_STATUS_BASE + 12);
IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13);
IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14);
IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15);
IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16);
IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17);
IP_BAD_DESTINATION = (IP_STATUS_BASE + 18); // status codes passed up on status indications.
IP_ADDR_DELETED = (IP_STATUS_BASE + 19);
IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20);
IP_MTU_CHANGE = (IP_STATUS_BASE + 21); IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50); MAX_IP_STATUS = IP_GENERAL_FAILURE; IP_PENDING = (IP_STATUS_BASE + 255); // IP header flags
IP_FLAG_DF = $02; // Don't fragment this packet. // IP Option Types
IP_OPT_EOL = $00; // End of list option
IP_OPT_NOP = $01; // No operation
IP_OPT_SECURITY = $82; // Security option.
IP_OPT_LSRR = $83; // Loose source route.
IP_OPT_SSRR = $89; // Strict source route.
IP_OPT_RR = $07; // Record route.
IP_OPT_TS = $44; // Timestamp.
IP_OPT_SID = $88; // Stream ID (obsolete)
MAX_OPT_SIZE = $40;type
// IP types
TIPAddr = DWORD; // An IP address.
TIPMask = DWORD; // An IP subnet mask.
TIPStatus = DWORD; // Status code returned from IP APIs. PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte; // Time To Live (used for traceroute)
TOS: Byte; // Type Of Service (usually 0)
Flags: Byte; // IP header flags (usually 0)
OptionsSize: Byte; // Size of options data (usually 0, max 40)
OptionsData: PChar; // Options data buffer
end; PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: TIPAddr; // Replying address
Status: DWord; // IP status value
RTT: DWord; // Round Trip Time in milliseconds
DataSize: Word; // Reply data size
Reserved: Word; // Reserved
Data: Pointer; // Pointer to reply data buffer
Options: TIPOptionInformation; // Reply options
end; // IcmpCreateFile:
// Opens a handle on which ICMP Echo Requests can be issued.
// Arguments:
// None.
// Return Value:
// An open file handle or INVALID_HANDLE_VALUE. Extended error information
// is available by calling GetLastError().
TIcmpCreateFile = function: THandle; stdcall; // IcmpCloseHandle:
// Closes a handle opened by ICMPOpenFile.
// Arguments:
// IcmpHandle - The handle to close.
// Return Value:
// TRUE if the handle was closed successfully, otherwise FALSE. Extended
// error information is available by calling GetLastError().
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
// Sends an ICMP Echo request and returns one or more replies. The
// call returns when the timeout has expired or the reply buffer
// is filled.
// Arguments:
// IcmpHandle - An open handle returned by ICMPCreateFile.
// DestinationAddress - The destination of the echo request.
// RequestData - A buffer containing the data to send in the
// request.
// RequestSize - The number of bytes in the request data buffer.
// RequestOptions - Pointer to the IP header options for the request.
// May be NULL.
// ReplyBuffer - A buffer to hold any replies to the request.
// On return, the buffer will contain an array of
// ICMP_ECHO_REPLY structures followed by options
// and data. The buffer should be large enough to
// hold at least one ICMP_ECHO_REPLY structure
// and 8 bytes of data - this is the size of
// an ICMP error message.
// ReplySize - The size in bytes of the reply buffer.
// Timeout - The time in milliseconds to wait for replies.
// Return Value:
// Returns the number of replies received and stored in ReplyBuffer. If
// the return value is zero, extended error information is available
// via GetLastError().
TIcmpSendEcho = function(IcmpHandle: THandle;
DestinationAddress: TIPAddr;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall; // Event handler type declaration for TICMP.OnDisplay event.
TICMPDisplay = procedure(Sender: TObject; Msg : String) of object;
TICMPReply = procedure(Sender: TObject; Error : Integer) of object; // The object wich encapsulate the ICMP.DLL
TICMP = class(TObject)
private
hICMPdll : HModule; // Handle for ICMP.DLL
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;
hICMP : THandle; // Handle for the ICMP Calls
FReply : TIcmpEchoReply; // ICMP Echo reply buffer
FAddress : String; // Address given
FHostName : String; // Dotted IP of host (output)
FHostIP : String; // Name of host (Output)
FIPAddress : TIPAddr; // Address of host to contact
FSize : Integer; // Packet size (default to 56)
FTimeOut : Integer; // Timeout (default to 4000mS)
FTTL : Integer; // Time To Live (for send)
FOnDisplay : TICMPDisplay; // Event handler to display
FOnEchoRequest : TNotifyEvent;
FOnEchoReply : TICMPReply;
FLastError : DWORD; // After sending ICMP packet
FAddrResolved : Boolean;
procedure ResolveAddr;
public
constructor Create; virtual;
destructor Destroy; override;
function Ping : Integer;
procedure SetAddress(Value : String);
function GetErrorString : String; property Address : String read FAddress write SetAddress;
property Size : Integer read FSize write FSize;
property Timeout : Integer read FTimeout write FTimeout;
property Reply : TIcmpEchoReply read FReply;
property TTL : Integer read FTTL write FTTL;
property ErrorCode : Integer read FLastError;
property ErrorString : String read GetErrorString;
property HostName : String read FHostName;
property HostIP : String read FHostIP;
property OnDisplay : TICMPDisplay read FOnDisplay write FOnDisplay;
property OnEchoRequest : TNotifyEvent read FOnEchoRequest
write FOnEchoRequest;
property OnEchoReply : TICMPReply read FOnEchoReply
write FOnEchoReply;
end; TICMPException = class(Exception);implementation{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TICMP.Create;
var
WSAData: TWSAData;
begin
hICMP := INVALID_HANDLE_VALUE;
FSize := 56;
FTTL := 64;
FTimeOut := 4000; // initialise winsock
if WSAStartup($101, WSAData) <> 0 then
raise TICMPException.Create('Error initialising Winsock'); // register the icmp.dll stuff
hICMPdll := LoadLibrary(icmpDLL);
if hICMPdll = 0 then
raise TICMPException.Create('Unable to register ' + icmpDLL); @ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho'); if (@ICMPCreateFile = Nil) or
(@IcmpCloseHandle = Nil) or
(@IcmpSendEcho = Nil) then
raise TICMPException.Create('Error loading dll functions'); hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then
raise TICMPException.Create('Unable to get ping handle');
end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TICMP.Destroy;
begin
if hICMP <> INVALID_HANDLE_VALUE then
IcmpCloseHandle(hICMP);
if hICMPdll <> 0 then
FreeLibrary(hICMPdll);
WSACleanup;
inherited Destroy;
end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function MinInteger(X, Y: Integer): Integer;
begin
if X >= Y then
Result := Y
else
Result := X;
end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TICMP.ResolveAddr;
var
Phe : PHostEnt; // HostEntry buffer for name lookup
begin
// Convert host address to IP address
FIPAddress := inet_addr(PChar(FAddress));
if FIPAddress <> INADDR_NONE then
// Was a numeric dotted address let it in this format
FHostName := FAddress
else begin
// Not a numeric dotted address, try to resolve by name
Phe := GetHostByName(PChar(FAddress));
if Phe = nil then begin
FLastError := GetLastError;
if Assigned(FOnDisplay) then
FOnDisplay(Self, 'Unable to resolve ' + FAddress);
Exit;
end; FIPAddress := longint(plongint(Phe^.h_addr_list^)^);
FHostName := Phe^.h_name;
end; FHostIP := StrPas(inet_ntoa(TInAddr(FIPAddress)));
FAddrResolved := TRUE;
end;
procedure TICMP.SetAddress(Value : String);
begin
// Only change if needed (could take a long time)
if FAddress = Value then
Exit;
FAddress := Value;
FAddrResolved := FALSE;
// ResolveAddr;
end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TICMP.GetErrorString : String;
begin
case FLastError of
IP_SUCCESS: Result := 'No error';
IP_BUF_TOO_SMALL: Result := 'Buffer too small';
IP_DEST_NET_UNREACHABLE: Result := 'Destination network unreachable';
IP_DEST_HOST_UNREACHABLE: Result := 'Destination host unreachable';
IP_DEST_PROT_UNREACHABLE: Result := 'Destination protocol unreachable';
IP_DEST_PORT_UNREACHABLE: Result := 'Destination port unreachable';
IP_NO_RESOURCES: Result := 'No resources';
IP_BAD_OPTION: Result := 'Bad option';
IP_HW_ERROR: Result := 'Hardware error';
IP_PACKET_TOO_BIG: Result := 'Packet too big';
IP_REQ_TIMED_OUT: Result := 'Request timed out';
IP_BAD_REQ: Result := 'Bad request';
IP_BAD_ROUTE: Result := 'Bad route';
IP_TTL_EXPIRED_TRANSIT: Result := 'TTL expired in transit';
IP_TTL_EXPIRED_REASSEM: Result := 'TTL expired in reassembly';
IP_PARAM_PROBLEM: Result := 'Parameter problem';
IP_SOURCE_QUENCH: Result := 'Source quench';
IP_OPTION_TOO_BIG: Result := 'Option too big';
IP_BAD_DESTINATION: Result := 'Bad Destination';
IP_ADDR_DELETED: Result := 'Address deleted';
IP_SPEC_MTU_CHANGE: Result := 'Spec MTU change';
IP_MTU_CHANGE: Result := 'MTU change';
IP_GENERAL_FAILURE: Result := 'General failure';
IP_PENDING: Result := 'Pending';
else
Result := 'ICMP error #' + IntToStr(FLastError);
end;
end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TICMP.Ping : Integer;
var
BufferSize: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
IPOpt: TIPOptionInformation; // IP Options for packet to send
Msg: String;
begin
Result := 0;
FLastError := 0; if not FAddrResolved then
ResolveAddr; if FIPAddress = INADDR_NONE then begin
FLastError := IP_BAD_DESTINATION;
if Assigned(FOnDisplay) then
FOnDisplay(Self, 'Invalid host address');
Exit;
end; // Allocate space for data buffer space
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pReqData, FSize);
GetMem(pData, FSize);
GetMem(pIPE, BufferSize); try
// Fill data buffer with some data bytes
FillChar(pReqData^, FSize, $20);
Msg := 'Pinging from Delphi code written by F. Piette';
Move(Msg[1], pReqData^, MinInteger(FSize, Length(Msg))); pIPE^.Data := pData;
FillChar(pIPE^, SizeOf(pIPE^), 0); if Assigned(FOnEchoRequest) then
FOnEchoRequest(Self); FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := FTTL;
Result := IcmpSendEcho(hICMP, FIPAddress, pReqData, FSize,
@IPOpt, pIPE, BufferSize, FTimeOut);
FLastError := GetLastError;
FReply := pIPE^; if Assigned(FOnEchoReply) then
FOnEchoReply(Self, Result);
finally
// Free those buffers
FreeMem(pIPE);
FreeMem(pData);
FreeMem(pReqData);
end;
end;
可以用Indy现成的控件实现。