icmpdll.pas

IP地址查询,可以在互联网上搜索不同的IP地址为网络编程提供个接例程

unit ICMPDLL;

{ Microsoft doesn't support the standard way ICMP is implemented using
  sockets (using SOCK_RAW socket type). So this unit uses their
  ICMP.DLL, although MS discourages it's use - once they have a better solution
  this properitary implementation will vanish. So beware!
  I realise that there is an implentation around employing winsock and SOCK_RAW
  (by Andreas H鰎stemeier) but frankly it's scary! I stuck with just ICMP..}

interface

uses Windows,Classes,SysUtils,Winsock,IPExtra;

// The API declarations, etc. for the ICMP.DLL

{Documentation taken from :   http://www.sockets.com/ms_icmp.htm
                              Andreas H鰎stemeier
                              Francois Piette
                              Stuart Richmond
                              MSDN
 Many Thanks to All!!

 Translated into this unit - Duncan Parsons, based largely on Andreas H鰎stemeier's freeware model}

const
//ip status values
ipStatusBase          = 11000;
ipSuccess             = 0;
ipBuffTooSmall        = ipStatusBase +  1;
ipDestNetUnreachable  = ipStatusBase +  2;
ipDestHostUnreachable = ipStatusBase +  3;
ipDestProtUnreachable = ipStatusBase +  4;
ipDestPortUnreachable = ipStatusBase +  5;
ipNoResources         = ipStatusBase +  6;
ipBadOptions          = ipStatusBase +  7;
ipHWError             = ipStatusBase +  8;
ipPacketTooBig        = ipStatusBase +  9;
ipReqTimedOut         = ipStatusBase + 10;
ipBadReq              = ipStatusBase + 11;
ipBadRoute            = ipStatusBase + 12;
ipTTLExpiredTransmit  = ipStatusBase + 13;
ipTTLExpiredReassem   = ipStatusBase + 14;
ipParamProblem        = ipStatusBase + 15;
ipSourceQuench        = ipStatusBase + 16;
ipOptionTooBig        = ipStatusBase + 17;
ipBadDestination      = ipStatusBase + 18;
ipAddrDeleted         = ipStatusBase + 19;
ipSepcMtuChange       = ipStatusBase + 20;
ipMtuChange           = ipStatusBase + 21;
ipUnload              = ipStatusBase + 22;
ipGeneralFailure      = ipStatusBase + 50;
Max_IPStatus          = ipGeneralFailure;
ipPending             = ipStatusBase +255;

type
//TIPOptions
pIPOptions=^TIPOptions;
TIPOptions=packed record
  TTL: byte;             {time to live}
  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: pointer;  {options data buffer}
end;

//TICMPEchoReply
pICMPEchoReply=^TICMPEchoReply;
TICMPEchoReply=packed record
  address: u_long;           //source address
  status: u_long;            //IP status
  rttime: u_long;            //round trip time in milliseconds
  datasize: word;            //reply data size
  reserved: word;
  data: pointer;             //reply data buffer
  ip_options:TIPOptions;     //reply options
end;

//The Functions
var
  ICMPCreateFile:function:THandle; stdcall;
  ICMPCloseHandle:function(ICMPHandle:THandle):Boolean; stdcall;
  ICMPSendEcho:function(ICMPHandle: THandle;      //handle returned from ICMPCreateFile
                        DestAddress:longint;      //destination IP address (network order)
                        RequestData:pointer;      //pointer to buffer to send
                        RequestSize:word;         //length of data in buffer
                        RequestOptns: pIPOptions;
                        ReplyBuffer:pointer;      //see note
                        ReplySize:dword;          //length of reply, minimum 1 reply
                        Timeout: DWord            //time in milliseconds to wait for reply
                        ):DWORD; stdcall;


{The reply buffer will have an array of ICMP_ECHO_REPLY structures, followed
   by options and the data in ICMP echo reply datagram received. You must
   have root for at least one ICMP echo reply structure, plus 8 bytes for
   an ICMP header}

type
  TICMPCall=(ICMP_dll,ICMP_winsock,no_ICMP);
var
  ICMP_state:TICMPCall;

type
  TPingEvent = procedure (Sender:TObject; status: integer; ip:longint; RoundTime:longint; BadEcho:boolean) of object;
  TRouteEvent = procedure (Sender:TObject; hop: byte; ip:longint; RoundTime:longint; BadEcho:boolean) of object;
  EICMPError=class(Exception);

//Base Class
TICMPBase=class(TComponent)
private
  ICMPHandle: THandle;
protected
  fBlockSize: byte;
  fReplysize: dword;
  fTimeout: cardinal;
  fTTL: byte;
  fAddress: longint;
  fHostname: string;
  fTerminated: boolean;
public
  constructor Create(Aowner:TComponent); override;
  procedure Terminate;
  procedure Go; virtual;
  destructor Destroy; override;
end;

//TPing.. does what it says
TPing=class(TICMPBase)
private
  fNoOfPacketsRec: integer;
  fNoOfPackets: integer;
  fRoundTimeMax: longint;
  fRoundTimeMin: longint;
  fRoundTimeMed: extended;
  fOnPing: TPingEvent;
  function GetRoundTimeMin:longint;
public
  property MinimumRoundtTime: longint read GetRoundTimeMin;
  property MaximumRoundtTime: longint read fRoundTimeMax;
  property MeanRoundTime: extended read fRoundTimeMed;
  property ReceivedPackets: integer read fNoOfPacketsRec;
  constructor Create(Aowner:TComponent); override;
  procedure Go; override;
published
  property Timeout:cardinal read fTimeout write fTimeout;
  property BlockSize: byte read fBlockSize write fBlockSize default 64;
  property TimeToLive: byte read fTTL write fTTL default 255;
  property NumberOfPackets: integer read fNoOfPackets write fNoOfPackets default 5;
  property Hostname:string read fHostname write fHostname;
  property OnPing: TPingEvent read fOnPing write fOnPing;
end;

//TTraceRoute.. does what it says (as well!)
TTraceRoute=class(TICMPBase)
private
  fOnRoute: TRouteEvent;
public
  constructor Create(Aowner:TComponent); override;
  procedure Go; override;
published
  property Timeout:cardinal read fTimeout write fTimeout;
  property BlockSize: byte read fBlockSize write fBlockSize default 64;
  property TimeToLive: byte read fTTL write fTTL default 255;
  property Hostname:string read fHostname write fHostname;
  property OnRoute: TRouteEvent read fOnRoute write fOnRoute;
end;

implementation

var hDll: THandle; //Holds the Handle if the loaded ICMP dll

//------------------------------------------
//TICMPBase - a base class for the TPing and TTraceRoute classes
constructor TICMPBase.Create(Aowner:TComponent);
begin
     inherited create(AOwner);
     fTimeout:=5000;  //5 seconds
     fBlockSize:=64;
     fTTL:=255;       //Maximun Routers that a Packet can pass
     ICMPHandle:=Invalid_Handle_Value;
end;

destructor TICMPBase.Destroy;
begin
     case ICMP_state of
          ICMP_dll: if ICMPHandle<>Invalid_Handle_Value then
                       ICMPCloseHandle(ICMPHandle);
     end;
     inherited destroy;
end;

procedure TICMPBase.Go;
begin
     fTerminated:=false;
     fReplysize:=16+SizeOf(TICMPEchoReply)+fBlockSize;
     fAddress:=Lookup_Hostname(fHostname);
     case ICMP_state of
          ICMP_dll: if ICMPHandle=Invalid_Handle_Value then
                       ICMPHandle:=ICMPCreateFile;
     else
          raise EICMPError.Create('No ICMP.DLL found');
     end;
end;

procedure TICMPBase.Terminate;
begin
     fTerminated:=true;
end;

//------------------------------------------
//TPing
constructor TPing.Create(Aowner:TComponent);
begin
     inherited create(AOwner);
     fNoOfPackets:=5;
     fBlockSize:=64;
end;

procedure TPing.Go;
var RequestData,ReplyBuffer: pointer;
    pReply: pICMPEchoReply;