nmicmp.pas

DELPHI里面一些常用的控件

unit NMICMP;

interface

uses
  Windows, Messages, SysUtils, Classes, Forms, Winsock,NMConst;
{$IFDEF VER110}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER120}
{$OBJEXPORTALL On}
{$ENDIF}
{$IFDEF VER125}
{$OBJEXPORTALL On}
{$ENDIF}

const
  WM_LOOKUPADDRESS = WM_USER + 101; // Message when looking up host

  // ICMP Status Codes
  BASE = 11000;
  OPER_ABORT = -1;
  ICMP_SUCCESS = 0;
  BUFF_TOO_SMALL = BASE + 1;
  DEST_NET_UNREACHABLE = BASE + 2;
  DEST_HOST_UNREACHABLE = BASE + 3;
  DEST_PROT_UNREACHABLE = BASE + 4;
  DEST_PORT_UNREACHABLE = BASE + 5;
  NO_RESOURCES = BASE + 6;
  BAD_OPTIONS = BASE + 7;
  HW_ERROR = BASE + 8;
  PACKET_TOO_BIG = BASE + 9;
  REQ_TIMED_OUT = BASE + 10;
  BAD_REQUEST = BASE + 11;
  BAD_ROUTE = BASE + 12;
  TTL_EXP_TRANSIT = BASE + 13;
  TTL_EXP_REASSMBLE = BASE + 14;
  PARAM_PROBLEM = BASE + 15;
  SOURCE_QUENCH = BASE + 16;
  OPTIONS_TOO_BIG = BASE + 17;
  BAD_DEST = BASE + 18;
  ADDR_DELETED = BASE + 19;
  SPEC_MTU_CHANGE = BASE + 20;
  MTU_CHANGE = BASE + 21;
  UNLOAD = BASE + 22;
  GENERAL_FAILURE = BASE + 50;
  IP_STATUS = GENERAL_FAILURE;
  PENDING = BASE + 255;

  // String constants
  con_abort = 'Operation aborted';
  con_lookup_fail = 'Host lookup failed';
  con_cantload = 'Unable to load ICMP.DLL';
  con_winserror = 'Error starting Winsock';
  con_icmperr = 'Error initializing ICMP Handle';
  con_datachar = '#';
  con_icmpdll = 'ICMP.DLL';
  con_icmpcreatefile = 'IcmpCreateFile';
  con_icmpclosehandle = 'IcmpCloseHandle';
  con_icmpsendecho = 'IcmpSendEcho';
  con_localabort = 'Local Abort';
  con_badimports = 'Failure to import one or more routines from ICMP.DLL';
  con_hosttimedout = 'Host lookup timed out';

type
  THandle = Integer;

  // Record type for ICMP options
  PIPOptionInfo = ^TIPOptionInfo;
  TIPOptionInfo = packed record
    TTL: Byte; // time to live (for TraceRt)
    TOS: Byte; // Type of Service
    Flags: Byte; // IP Header Flags
    OptionSize: Byte; // Size of OptionData
    OptionData: Pointer; // pointer to option data
  end;

  // Record type for ICMP replies
  PIPEchoReply = ^TIPEchoReply;
  TIPEchoReply = packed record
    Address: u_long; // replying address
    Status: u_long; // Reply Status
    RTT: u_long; //Round tip time in milliseconds
    DataSize: word; // Size of data
    Reserved: word; // Reserved for sys use
    Data: Pointer; // Pointer to echoed data
    IPOptions: TIPOptionInfo; // Reply options
  end;

  //-------------Types for routines from ICMP.DLL
  TICMPCreateFile = function: THandle; stdcall;
  TICMPCloseHandle = function(ICMPHandle: THandle): Boolean; stdcall;
  TICMPSendEcho = function(ICMPHandle: THandle; // Handle gotten from ICMPCreateFile
    DestAddress: longint; // Target IP (in NBO)
    RequestData: Pointer; // Pointer to request data to send
    RequestSize: word; // Length of RequestData
    RequestOptions: PIPOptionInfo;
    ReplyBuffer: Pointer;
    ReplySize: dword; // Length of Reply
    Timeout: dword // Time in milliseconds before TimeOut
    ): dword; stdcall;

  //-------------Event types-------------//
  // When a ping comes back
  TPingEvent = procedure(Sender: TObject; Host: string; Size, Time: Integer) of object;
  // When a TraceRt packet "hops"
  THopEvent = procedure(Sender: TObject; Host: string; Time1, Time2, Time3: Integer; HopNo: Integer) of object;
  // Generic event when a host name might need to be known
  THostEvent = procedure(Sender: TObject; Host: string) of object;
  // Status Event
  TStatusEvent = procedure(Sender: TObject; Status: Integer; Host: string) of object;


  EICMPError = class(Exception);
  // Exception for ICMP Errors

  TNMICMP = class(TComponent)
  // NMICMP Class, base for NMPing and NMTraceRt
  private
    { Private declarations }
    DLLHandle: THandle; // Handle for ICMP.DLL
    ICMPHandle: THandle; // Handle for ICMP Functions
    WinHandle: HWND; // Window handle
    MyWSAData: TWSAData; // Winsock Data
    FHost: string; // Target host
    FTimeOut: Integer; // Timeout in milliseconds
    FPacketSize: Integer; // Size of data packets
    FAborted: Boolean; // If the current process has been aborted or not
//    FResolveIP: Boolean; // Resolve IPs to addresses
    FOnAbort: TNotifyEvent; // Called when the Abort method is used
    FOnInvalidHost: TNotifyEvent; // Called when the specified host is invalid
    FOnTimeOut: TNotifyEvent; // Called when an ICMP packet times out
    FHostUnreachable: THostEvent; // Destination host is unreachable
    FOnStatus: TStatusEvent; // For ICMP status messages
  protected
    { Protected declarations }
    // Functions from ICMP.DLL
    ICMPCreateFile: TICMPCreateFile;
    ICMPCloseHandle: TICMPCloseHandle;
    ICMPSendEcho: TICMPSendEcho;
    IPOptions: PIPOptionInfo; // Options for echo
    NetworkAddress: longint; // Network address of target host
    HostInfo: PHostEnt; // Winsock struct contains info on remote host
    AddressInfo: TSockAddr; // Contains address info for remote host
    Success: Boolean; // Simple Success flag
    HostLookup: Boolean; // Set when the remote host lookup returns
    procedure WndProc(var Msg: TMessage); virtual; // Handles messages
    procedure ResolveAddresses; // Resolves network address/IP Address
    function GetHostName(InetAddr: longint): string;

    // Events
    property OnTimeOut: TNotifyEvent read FOnTimeOut write FOnTimeOut;
  public
    { Public declarations }
//    HostName: String;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Abort; // Aborts current operation
  published
    { Published declarations }
    property Host: string read FHost write FHost;
    property PacketSize: Integer read FPacketSize write FPacketSize;
    property Timeout: Integer read FTimeOut write FTimeOut;
//    property ResolveIPs: Boolean read FResolveIP write FResolveIP;
    //Events
    property OnAbort: TNotifyEvent read FOnAbort write FOnAbort;
    property OnInvalidHost: TNotifyEvent read FOnInvalidHost write FOnInvalidHost;
    property OnHostUnreachable: THostEvent read FHostUnreachable write FHostUnreachable;
    property OnStatus: TStatusEvent read FOnStatus write FOnStatus;
  end;

  TNMPing = class(TNMICMP)
  // NMPing, for pinging remote hosts
  private
    FOnPing: TPingEvent;
    FPings: Integer;
  protected
  public
    constructor Create(AOwner: TComponent); override;
    procedure Ping;
  published
    property Pings: Integer read FPings write FPings;
    property OnPing: TPingEvent read FOnPing write FOnPing;
    property OnTimeOut; // From TNMICMP
  end;

  TNMTraceRt = class(TNMICMP)
  // NMTraceRt, for tracing the route to remote hosts
  private
    FHops: Integer; // Maximum number of hops (hosts to pass)
    FTraceComplete: TNotifyEvent;
    FOnHop: THopEvent; // Hop event
  protected
    TraceDone: Boolean; // Is the trace done?
  public
    constructor Create(AOwner: TComponent); override;
    procedure Trace;
  published
    // properties
    property MaxHops: Integer read FHops write FHops;
    // Events
    property OnHop: THopEvent read FOnHop write FOnHop;
    property OnTraceComplete: TNotifyEvent read FTraceComplete write FTraceComplete;
  end;

implementation

//--------------------------------------------------------------------------//
//------------TNMICMP (base class for TNMPing and TNMTraceRt----------------//
//--------------------------------------------------------------------------//
procedure TNMICMP.WndProc(var Msg: TMessage);
begin
  Success := false;
  if Msg.Msg = WM_LOOKUPADDRESS then
  begin
    if Msg.lparamhi = 0 then
      Success := true
    else
      Success := false;
    HostLookup := true;
  end;
end;

function TNMICMP.GetHostName(InetAddr: longint): string;
var
  HostRes: PHostEnt;
begin
  // Returns Host name from a network address
  GetMem(HostRes, MAXGETHOSTSTRUCT);
  try
    WSAAsyncGetHostByAddr(WinHandle, WM_LOOKUPADDRESS, PChar(InetAddr), 4, PF_INET, PChar(HostRes), MAXGETHOSTSTRUCT);
    repeat
      Application.ProcessMessages;
    until HostLookup or FAborted;
    if FAborted then
      raise EICMPError.Create(con_abort);
(******* Need to check this out, to see if the host resolution is working right. ****)
    Result := StrPas(HostRes^.h_name);
  finally
    FreeMem(HostRes, MAXGETHOSTSTRUCT);
  end;
end;

//---This procedure needs to set the Network Address for the target host.
procedure TNMICMP.ResolveAddresses;
var
  Buff: array[0..127] of Char;
begin
  // See if an IP Address was set as the host
  AddressInfo.sin_addr.s_addr := Inet_Addr(StrPCopy(Buff, FHost));
  if AddressInfo.sin_addr.s_addr = SOCKET_ERROR then
  begin // If not, resolve it a different way
    AddressInfo.sin_addr.s_addr := 0;
    HostLookup := false;
    WSAAsyncGetHostByName(WinHandle, WM_LOOKUPADDRESS, Buff, PChar(HostInfo), MAXGETHOSTSTRUCT);
    repeat
      Application.ProcessMessages;
    until HostLookup or FAborted;

    // If the host lookup was aborted
    if FAborted then
      raise EICMPError.Create(con_abort);

    // if the host lookup failed
    if (not HostLookup) or (not Success) then
    begin
      if Assigned(FOnInvalidHost) then
        FOnInvalidHost(Self);
      raise EICMPError.Create(con_lookup_fail);
    end
    else
    begin
      // Look up host name if resolve IP is true
      with AddressInfo.sin_addr.S_un_b do
      begin
        s_b1 := HostInfo.h_addr_list^[0];
        s_b2 := HostInfo.h_addr_list^[1];
        s_b3 := HostInfo.h_addr_list^[2];
        s_b4 := HostInfo.h_addr_list^[3];
      end;
    end;
  end;
  NetworkAddress := AddressInfo.sin_addr.s_addr;
//  If FResolveIP then
//    HostName := GetHostName(NetworkAddress);
end;

constructor TNMICMP.Create(AOwner: TComponent);
begin
 // Basic TComponent create
  inherited Create(AOwner);