iphelper.pas

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

unit IPHelper;

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;


const
    // only most "popular" services...
  WellKnownPorts: array[1..27] of TWellKnownPort
  = ( ( 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: 53; Srv: 'DNS ' ),
    ( 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 );

// 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
    FixedInfo     : PTFixedInfo;
    InfoSize      : integer;
    ErrorCode     : DWORD;
    I             : Integer;
    DNS           : PTIP_ADDR_STRING;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    InfoSize := 1024;
    GetMem(FixedInfo,infosize);
    ErrorCode := GetNetworkParams( FixedInfo, InfoSize );
    if ErrorCode = ERROR_SUCCESS then
    begin
        with FixedInfo^ 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   :' + IntToStr( EnableDNS ) );
        end;
        //获取域名解析服务器地址
        DNS := @FixedInfo^.DNSServerList;
        Repeat
            List.Add('DNS '+IntToStr(I)+': '+DNS^.IpAddress);
            Inc(I);
            DNS := DNS^.Next;
        Until (DNS = nil);
    end
    else
    List.Add( SysErrorMessage( ErrorCode ) );
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;
  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 ) );
          sDescr := trim( sDescr );
          List.Add( Format( '%0.8x| %3d| %16s| %8d| %12d| %2d| %2d| %-s',
            [dwIndex, dwType,
            MacAddr2Str( TMacAddress( bPhysAddr ), dwPhysAddrLen )
              , dwMTU, dwSpeed, dwAdminStatus,
              dwOPerStatus, sDescr] )
              );
        end;
        inc( pBuf, SizeOf( IfRow ) );
      end;
    end
    else
      List.Add( 'no entries.' );
  end
  else
    List.Add( SysErrorMessage( GetLastError ) );
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IfRow ) );
  FreeMem( pBuf );
end;



//网卡配置信息
procedure Get_AdaptersInfo( List: TStrings );
var
    Error,
    BufLen      : DWORD;
    AdapterInfo : PTIP_ADAPTER_INFO;
    Descr,
    LocalIP,
    GatewayIP,
    DHCPIP      : string;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    BufLen := SizeOf( AdapterInfo^ );
    New( AdapterInfo );
    Error := GetAdaptersInfo( AdapterInfo, @BufLen );
    if Error = NO_ERROR then
    begin
        while ( AdapterInfo <> nil ) do
        with AdapterInfo^ do
        begin
            SetLength( Descr, SizeOf( Description ) );
            Descr := Trim( string( Description ) );
            LocalIP := NULL_IP;
            if IPAddressList.IpAddress[1] <> #0 then
                LocalIP := IPAddressList.IpAddress
            else
                LocalIP := NULL_IP;
            if GateWayList.IPAddress[1] <> #0 then
                GateWayIP := GatewayList.IPAddress
            else
                GateWayIP := NULL_IP;
            if DHCPServer.IPAddress[1] <> #0 then
                DHCPIP := DHCPServer.IPAddress
            else
                DHCPIP := NULL_IP;

            List.Add( Descr );
            List.Add( Format(
                '%8.8x|%6s|%16s|%2d|%16s|%16s|%16s',
                [Index, AdaptTypes[aType],
                MacAddr2Str( TMacAddress( Address ), AddressLength ),
                DHCPEnabled, LocalIP, GatewayIP, DHCPIP] ));
            List.Add( '  ' );
            AdapterInfo := Next;
        end
    end
    else
        List.Add( SysErrorMessage( Error ) );
    Dispose( AdapterInfo );
end;

//获取数据到达指定主机的中转次数与时间
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint; var RTT: Longint;
  var HopCount: Longint ): integer;
begin
    if not GetRTTAndHopCount( IPAddr, @HopCount, MaxHops, @RTT ) then
    begin
        Result := GetLastError;
        RTT := -1; //无法到达指定主机
        HopCount := -1;
    end
    else
    Result := NO_ERROR;
end;

//-----------------------------------------------------------------------------
{ARP列表中保存远程主机的IP地址与实际物理地址（MAC）之间的映射。
}
procedure Get_ARPTable( List: TStrings );
var
    IPNetRow      : TMibIPNetRow;
    TableSize     : DWORD;
    NumEntries    : DWORD;
    ErrorCode     : DWORD;
    i             : integer;
    pBuf          : PChar;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    //首先取得列表所需内存的大小
    TableSize := 0;
    ErrorCode := GetIPNetTable( PTMIBIpNetTable( pBuf ), @TableSize, false );
    if ErrorCode = ERROR_NO_DATA then
    begin
        List.Add( ' ARP-cache empty.' );
        EXIT;