iphelper.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

unit IPHelper;



//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
//                      Delphi IPHelper functions                            //
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
//     PLEASE NOTE:   REQUIRES  NT4/SP4 or higher, WIN98 or higher           //
//     Tested on   :  Delphi 4.03, Delphi 6.0 Enterprise,                    //
//               WIN2K, WIN-NT4/SP6, WIN98se                                 //
//                                                                           //
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
//                    This software is FREEWARE                              //
//                    -------------------------                              //
//  If this software works, it was surely written by Dirk Claessens          //
//                   <[e-mail]>                                       //
//  (If it doesn't, I don't know anything about it.)                         //
//  Version: 1.5 2001-12-29                                                  //
//                                                                           //
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//


interface

uses
  Windows, Messages, SysUtils, Classes, Dialogs, IpHlpApi;

const
  NULL_IP       = '  0.  0.  0.  0';

//------conversion of well-known port numbers to service names----------------

type
  TWellKnownPort = record
    Prt: DWORD;
    Srv: string[20];
  end;

  PTTcpConnStatus = ^TTcpConnStatus;
  TTcpConnStatus = record
    LocalIP      : string;
    LocalPort    : string;
    RemoteIP     : string;
    RemotePort   : string;
    Status       : string;
  end;


const
    // only most "popular" services...
  WellKnownPorts: array[1..29] of TWellKnownPort
  = (
    ( Prt: 0; Srv: 'LOOPBACK'),
    ( Prt: 7; Srv: 'ECHO' ),      {Ping    }
    ( Prt: 9; Srv: 'DISCRD' ),    { Discard}
    ( Prt: 13; Srv: 'DAYTIM' ),   {DayTime}
    ( Prt: 17; Srv: 'QOTD' ),     {Quote Of The Day}
    ( Prt: 19; Srv: 'CHARGEN' ),  {CharGen}
    ( Prt: 20; Srv: 'FTP ' ),     { File Transfer Protocol}
    ( Prt: 21; Srv: 'FTPC' ),     { File Transfer Control Protocol}
    ( Prt: 23; Srv: 'TELNET' ),   {TelNet}
    ( Prt: 25; Srv: 'SMTP' ),     { Simple Mail Transfer Protocol}
    ( Prt: 37; Srv: 'TIME' ),     { Time Protocol }
    ( Prt: 43; Srv: 'WHOIS'),     { WHO IS service  }
    ( Prt: 53; Srv: 'DNS ' ),     { Domain Name Service }
    ( Prt: 67; Srv: 'BOOTPS' ),   { BOOTP Server }
    ( Prt: 68; Srv: 'BOOTPC' ),   { BOOTP Client }
    ( Prt: 69; Srv: 'TFTP' ),     { Trivial FTP  }
    ( Prt: 70; Srv: 'GOPHER' ),   { Gopher       }
    ( Prt: 79; Srv: 'FING' ),     { Finger       }
    ( Prt: 80; Srv: 'HTTP' ),     { HTTP         }
    ( Prt: 88; Srv: 'KERB' ),     { Kerberos     }
    ( Prt: 109; Srv: 'POP2' ),    { Post Office Protocol Version 2 }
    ( Prt: 110; Srv: 'POP3' ),    { Post Office Protocol Version 3 }
    ( Prt: 119; Srv: 'NNTP' ),    { Network News Transfer Protocol }
    ( Prt: 123; Srv: 'NTP ' ),    { Network Time protocol          }
    ( Prt: 135; Srv: 'LOCSVC'),   { Location Service              }
    ( Prt: 137; Srv: 'NBNAME' ),  { NETBIOS Name service          }
    ( Prt: 138; Srv: 'NBDGRAM' ), { NETBIOS Datagram Service     }
    ( Prt: 139; Srv: 'NBSESS' ),  { NETBIOS Session Service        }
    ( Prt: 161; Srv: 'SNMP' )     { Simple Netw. Management Protocol }
    );


//-----------conversion of ICMP error codes to strings--------------------------
             {taken from www.sockets.com/ms_icmp.c }

const
  ICMP_ERROR_BASE = 11000;
  IcmpErr : array[1..22] of string =
  (
   'IP_BUFFER_TOO_SMALL','IP_DEST_NET_UNREACHABLE', 'IP_DEST_HOST_UNREACHABLE',
   'IP_PROTOCOL_UNREACHABLE', 'IP_DEST_PORT_UNREACHABLE', 'IP_NO_RESOURCES',
   'IP_BAD_OPTION','IP_HARDWARE_ERROR', 'IP_PACKET_TOO_BIG', 'IP_REQUEST_TIMED_OUT',
   'IP_BAD_REQUEST','IP_BAD_ROUTE', 'IP_TTL_EXPIRED_TRANSIT',
   'IP_TTL_EXPIRED_REASSEM','IP_PARAMETER_PROBLEM', 'IP_SOURCE_QUENCH',
   'IP_OPTION_TOO_BIG', 'IP_BAD_DESTINATION','IP_ADDRESS_DELETED',
   'IP_SPEC_MTU_CHANGE', 'IP_MTU_CHANGE', 'IP_UNLOAD'
  );


//----------conversion of various enumerated values to strings----------------//

  ARPEntryType  : array[1..4] of string = ( 'Other', 'Invalid',
    'Dynamic', 'Static'
    );

  TCPConnState  :      // TCP connection states
    array[1..12] of string =
    ( 'closed', 'listening', 'syn_sent',
    'syn_rcvd', 'established', 'fin_wait1',
    'fin_wait2', 'close_wait', 'closing',
    'last_ack', 'time_wait', 'delete_tcb'
    );

  TCPToAlgo     : array[1..4] of string =  // TCP time out algorithms
    ( 'Const.Timeout', 'MIL-STD-1778',
    'Van Jacobson', 'Other' );

  IPForwTypes   : array[1..4] of string =   // IP forwarding methods
    ( 'other', 'invalid', 'local', 'remote' );

  IPForwProtos  : array[1..18] of string =  // IP forwarding protocols
    ( 'OTHER', 'LOCAL', 'NETMGMT', 'ICMP', 'EGP',
    'GGP', 'HELO', 'RIP', 'IS_IS', 'ES_IS',
    'CISCO', 'BBN', 'OSPF', 'BGP', 'BOOTP',
    'AUTO_STAT', 'STATIC', 'NOT_DOD' );


//---------------exported stuff-----------------------------------------------

// data output to Tstrings for display purposes
procedure Get_AdaptersInfo( List: TStrings );
procedure Get_NetworkParams( List: TStrings );
procedure Get_ARPTable( List: TStrings );
procedure Get_TCPTable( List: TStrings );
procedure Get_TCPStatistics( List: TStrings );
procedure Get_UDPTable( List: TStrings );
procedure Get_UDPStatistics( List: TStrings );
procedure Get_IPAddrTable( List: TStrings );
procedure Get_IPForwardTable( List: TStrings );
procedure Get_IPStatistics( List: TStrings );
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint;
  var RTT: longint; var HopCount: longint ): integer;
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
procedure Get_IfTable( NameList, ItemList: TStrings );

// output as structured array
procedure Get_IfTableMIB( var MIBIfArray: TMIBIfArray );
procedure Get_IPAddrTableMIB( var IPAddrTable:TMibIPAddrArray  );


procedure Get_RecentDestIPs( List: TStrings );

// added functions
procedure Get_OpenConnections( List: TList );



// conversion utils
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
function IpAddr2Str( IPAddr: DWORD ): string;
function Str2IpAddr( IPStr: string ): DWORD;
function Port2Str( nwoPort: DWORD ): string;
function Port2Wrd( nwoPort: DWORD ): DWORD;
function Port2Svc( Port: DWORD ): string;
function ICMPErr2Str( ICMPErrCode: DWORD) : string;

implementation

var
  RecentIPs     : TStringList;

//--------------General utilities-----------------------------------------------

{ extracts next "token" from string, then eats string }
function NextToken( var s: string; Separator: char ): string;
var
  Sep_Pos       : byte;
begin
  Result := '';
  if length( s ) > 0 then begin
    Sep_Pos := pos( Separator, s );
    if Sep_Pos > 0 then begin
      Result := copy( s, 1, Pred( Sep_Pos ) );
      Delete( s, 1, Sep_Pos );
    end
    else begin
      Result := s;
      s := '';
    end;
  end;
end;

//------------------------------------------------------------------------------
{ converts numerical MAC-address to ww-xx-yy-zz string }
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
var
    i   : integer;
begin
    if Size = 0 then
    begin
        Result := '00-00-00-00-00-00';
        EXIT;
    end
    else Result := '';
    for i := 1 to Size do
    Result := Result + IntToHex( MacAddr[i], 2 ) + '-';
    Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts IP-address in network byte order DWORD to dotted decimal string}
function IpAddr2Str( IPAddr: DWORD ): string;
var
    i: integer;
begin
    Result := '';
    for i := 1 to 4 do
    begin
        Result := Result + Format( '%3d.', [IPAddr and $FF] );
        IPAddr := IPAddr shr 8;
    end;
    Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts dotted decimal IP-address to network byte order DWORD}
function Str2IpAddr( IPStr: string ): DWORD;
var
  i             : integer;
  Num           : DWORD;
begin
  Result := 0;
  for i := 1 to 4 do
  try
    Num := ( StrToInt( NextToken( IPStr, '.' ) ) ) shl 24;
    Result := ( Result shr 8 ) or Num;
  except
    Result := 0;
  end;

end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to DWORD }
function Port2Wrd( nwoPort: DWORD ): DWORD;
begin
  Result := Swap( WORD( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to string }
function Port2Str( nwoPort: DWORD ): string;
begin
  Result := IntToStr( Port2Wrd( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts well-known port numbers to service ID }
function Port2Svc( Port: DWORD ): string;
var
  i             : integer;
begin
  Result := Format( '%4d', [Port] ); // in case port not found
  for i := Low( WellKnownPorts ) to High( WellKnownPorts ) do
    if Port = WellKnownPorts[i].Prt then
    begin
      Result := WellKnownPorts[i].Srv;
      BREAK;
    end;
end;

//-----------------------------------------------------------------------------
{ general,  fixed network parameters }
procedure Get_NetworkParams( List: TStrings );
var
  InfoSize      : Longint;
  ErrorCode     : DWORD;
  pBuf          : PChar;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  InfoSize := 0;
  ErrorCode := GetNetworkParams( PTFixedInfo(pBuf), @InfoSize );
  GetMem( pBuf, InfoSize );
  ErrorCode := GetNetworkParams( PTFixedInfo(pBuf), @InfoSize );
  if ErrorCode = ERROR_SUCCESS then
    with PTFixedinfo(pBuf)^ do
    begin
      List.Add( 'HOSTNAME          : ' + string( HostName ) );
      List.Add( 'DOMAIN            : ' + string( DomainName ) );
      List.Add( 'SCOPE             : ' + string( ScopeID ) );
      List.Add( 'NETBIOS NODE TYPE : ' + NETBIOSTypes[NodeType] );
      List.Add( 'ROUTING ENABLED   :' + IntToStr( EnableRouting ) );
      List.Add( 'PROXY   ENABLED   :' + IntToStr( EnableProxy ) );
      List.Add( 'DNS     ENABLED   :' + IntToHex( EnableDNS,8 ) );
    end
  else
    List.Add( SysErrorMessage( ErrorCode ) );
  FreeMem(pBuf);
end;

//------------------------------------------------------------------------------
function ICMPErr2Str( ICMPErrCode: DWORD) : string;
var
 i : integer;
begin
   Result := 'UnknownError : ' + IntToStr( ICMPErrCode );
   dec( ICMPErrCode, ICMP_ERROR_BASE );
   if ICMPErrCode in [Low(ICMpErr)..High(ICMPErr)] then
     Result := ICMPErr[ ICMPErrCode];
end;




//------------------------------------------------------------------------------
procedure Get_IfTable( NameList, ItemList: TStrings );
var
  IfRow         : TMibIfRow;
  i,
    Error,
    TableSize   : integer;
  pBuf          : PChar;
  NumEntries    : DWORD;
  sDescr,
    Temp        : string;
begin
  if (not Assigned( NameList ))
  or (not Assigned( ItemList ))  then EXIT;
  NameList.Clear;
  ItemList.Clear;
  TableSize := 0;
   // first call: get memsize needed
  Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
  if Error <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;
  GetMem( pBuf, TableSize );

   // get table pointer
  Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
  if Error = NO_ERROR then
  begin
    NumEntries := PTMibIfTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( NumEntries ) );
      for i := 1 to NumEntries do
      begin
        IfRow := PTMibIfRow( pBuf )^;
        with IfRow do
        begin
          SetLength( sDescr, dwDescrLen );
          move( bDescr, sDescr[1], Length( sDescr ) );