iphelper.pas

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

unit IPHelper;

(*
  ==========================
  Delphi IPHelper functions
  ==========================
  Requires : NT4/SP4 or higher, WIN98/WIN98se
  Developed on: D4.03
  Tested on   :  WIN-NT4/SP6, WIN98se, WIN95/OSR1

  ================================================================
                    This software is FREEWARE
                    -------------------------
  If this software works, it was surely written by Dirk Claessens
                   <[e-mail]>
               <[e-mail]>
  (If it doesn't, I don't know anything about it.)
  ================================================================

  Version: 1.3 2000-12-8

*)

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 ' ),
    ( 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' ),
    ( 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 diverse enumerated values to strings------------------

  ARPEntryType  : array[1..4] of string = ( 'Other', 'Invalid',
    'Dynamic', 'Static'
    );
  TCPConnState  :
    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 =
    ( 'Const.Timeout', 'MIL-STD-1778',
    'Van Jacobson', 'Other' );

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

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


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

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( List: TStrings );
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;

//------------------------------------------------------------------------------
{ concerts 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( List: TStrings );
var
  IfRow         : TMibIfRow;
  i,
    Error,
    TableSize   : integer;
  pBuf          : PChar;
  NumEntries    : DWORD;
  sDescr,
    Temp        : string;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;