iphelper.pas

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

    end;
    //取得列表
    GetMem( pBuf, TableSize );
    ErrorCode := GetIpNetTable( PTMIBIPNetTable( pBuf ), @TableSize, false );
    if ErrorCode = NO_ERROR then
    begin
        NumEntries := PTMIBIPNetTable( pBuf )^.dwNumEntries;
        if NumEntries > 0 then
        begin
            inc( pBuf, SizeOf( DWORD ) );
            for i := 1 to NumEntries do
            begin
                IPNetRow := PTMIBIPNetRow( PBuf )^;
                with IPNetRow do
                List.Add( Format( '%8x | %12s | %16s| %10s',
                    [dwIndex, MacAddr2Str( bPhysAddr, dwPhysAddrLen ),
                    IPAddr2Str( dwAddr ), ARPEntryType[dwType]]));
                inc( pBuf, SizeOf( IPNetRow ) );
            end;
        end
        else
            List.Add( ' ARP-cache empty.' );
    end
    else
        List.Add( SysErrorMessage( ErrorCode ) );
    dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPNetRow ) );
    FreeMem( pBuf );
end;


//------------------------------------------------------------------------------
procedure Get_TCPTable( List: TStrings );
var
  TCPRow        : TMIBTCPRow;
  i,
    NumEntries  : integer;
  TableSize     : DWORD;
  ErrorCode     : DWORD;
  DestIP        : string;
  pBuf          : PChar;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  RecentIPs.Clear;
  // first call : get size of table
  TableSize := 0;
  ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, false );
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;

  // get required size of memory, call again
  GetMem( pBuf, TableSize );
  // get table
  ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, false );
  if ErrorCode = NO_ERROR then
  begin

    NumEntries := PTMIBTCPTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( DWORD ) ); // get past table size
      for i := 1 to NumEntries do
      begin
        TCPRow := PTMIBTCPRow( pBuf )^; // get next record
        with TCPRow do
        begin
          if dwRemoteAddr = 0 then
            dwRemotePort := 0;
          DestIP := IPAddr2Str( dwRemoteAddr );
          List.Add(
            Format( '%15s : %-7s|%15s : %-7s| %-16s',
            [IpAddr2Str( dwLocalAddr ),
            Port2Svc( Port2Wrd( dwLocalPort ) ),
              DestIP,
              Port2Svc( Port2Wrd( dwRemotePort ) ),
              TCPConnState[dwState]
              ] ) );
         //
            if (not ( dwRemoteAddr = 0 ))
            and ( RecentIps.IndexOf(DestIP) = -1 ) then
               RecentIPs.Add( DestIP );
        end;
        inc( pBuf, SizeOf( TMIBTCPRow ) );
      end;
    end;
  end
  else
    List.Add( SyserrorMessage( ErrorCode ) );
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibTCPRow ) );
  FreeMem( pBuf );
end;

//TCP数据流量统计
procedure Get_TCPStatistics( List: TStrings );
var
    TCPStats      : TMibTCPStats;
    ErrorCode     : DWORD;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    ErrorCode := GetTCPStatistics( @TCPStats );
    if ErrorCode = NO_ERROR then
    with TCPStats do
    begin
        List.Add( 'Retransmission algorithm :' + TCPToAlgo[dwRTOAlgorithm] );
        List.Add( 'Minimum Time-Out         :' + IntToStr( dwRTOMin ) + ' ms' );
        List.Add( 'Maximum Time-Out         :' + IntToStr( dwRTOMax ) + ' ms' );
        List.Add( 'Maximum Pend.Connections :' + IntToStr( dwRTOAlgorithm ) );
        List.Add( 'Active Opens             :' + IntToStr( dwActiveOpens ) );
        List.Add( 'Passive Opens            :' + IntToStr( dwPassiveOpens ) );
        List.Add( 'Failed Open Attempts     :' + IntToStr( dwAttemptFails ) );
        List.Add( 'Established conn. Reset  :' + IntToStr( dwEstabResets ) );
        List.Add( 'Current Established Conn.:' + IntToStr( dwCurrEstab ) );
        List.Add( 'Segments Received        :' + IntToStr( dwInSegs ) );
        List.Add( 'Segments Sent            :' + IntToStr( dwOutSegs ) );
        List.Add( 'Segments Retransmitted   :' + IntToStr( dwReTransSegs ) );
        List.Add( 'Incoming Errors          :' + IntToStr( dwInErrs ) );
        List.Add( 'Outgoing Resets          :' + IntToStr( dwOutRsts ) );
        List.Add( 'Cumulative Connections   :' + IntToStr( dwNumConns ) );
    end
    else
        List.Add( SyserrorMessage( ErrorCode ) );
end;

//取得UDP连接的列表
procedure Get_UDPTable( List: TStrings );
var
    UDPRow        : TMIBUDPRow;
    i,NumEntries  : integer;
    TableSize     : DWORD;
    ErrorCode     : DWORD;
    pBuf          : PChar;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;

    //取得列表所需的内存大小
    TableSize := 0;
    ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, false );
    if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
        EXIT;

    //分配内存
    GetMem( pBuf, TableSize );

    //取得列表
    ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, false );
    if ErrorCode = NO_ERROR then
    begin
        NumEntries := PTMIBUDPTable( pBuf )^.dwNumEntries;
        if NumEntries > 0 then
        begin
            inc( pBuf, SizeOf( DWORD ) );
            for i := 1 to NumEntries do
            begin
                UDPRow := PTMIBUDPRow( pBuf )^; //下一个记录
                with UDPRow do
                List.Add( Format( '%15s : %-6s',
                [IpAddr2Str( dwLocalAddr ),
                Port2Svc( Port2Wrd( dwLocalPort ) )] ) );
                inc( pBuf, SizeOf( TMIBUDPRow ) );
            end;
        end
        else
            List.Add( 'no entries.' );
        end
    else
        List.Add( SyserrorMessage( ErrorCode ) );
    dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibUDPRow ) );
    FreeMem( pBuf );
end;

//获得IP地址及其配置信息
procedure Get_IPAddrTable( List: TStrings );
var
    IPAddrRow     : TMibIPAddrRow;
    TableSize     : DWORD;
    ErrorCode     : DWORD;
    i             : integer;
    pBuf          : PChar;
    NumEntries    : DWORD;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    TableSize := 0; ;
    //取得列表所需内存大小
    ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
    if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
        EXIT;

    GetMem( pBuf, TableSize );
    //获得列表
    ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
    if ErrorCode = NO_ERROR then
    begin
        NumEntries := PTMibIPAddrTable( pBuf )^.dwNumEntries;
        if NumEntries > 0 then
        begin
        inc( pBuf, SizeOf( DWORD ) );
        for i := 1 to NumEntries do
        begin
            IPAddrRow := PTMIBIPAddrRow( pBuf )^;
            with IPAddrRow do
            List.Add( Format( '%8.8x|%15s|%15s|%15s|%8.8d',
                [dwIndex,IPAddr2Str( dwAddr ),IPAddr2Str( dwMask ),
              IPAddr2Str( dwBCastAddr ),dwReasmSize] ) );
            inc( pBuf, SizeOf( TMIBIPAddrRow ) );
        end;
        end
        else
            List.Add( 'no entries.' );
    end
    else
        List.Add( SysErrorMessage( ErrorCode ) );
    dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
    FreeMem( pBuf );
end;

//-----------------------------------------------------------------------------
{ gets entries in routing table; equivalent to "Route Print" }
procedure Get_IPForwardTable( List: TStrings );
var
    IPForwRow     : TMibIPForwardRow;
    TableSize     : DWORD;
    ErrorCode     : DWORD;
    i             : integer;
    pBuf          : PChar;
    NumEntries    : DWORD;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    TableSize := 0;
    //获得列表所需的内存大小
    ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ),
    @TableSize, true);
    if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
        EXIT;
    //获取列表
    GetMem( pBuf, TableSize );
    ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ),
    @TableSize, true);
    if ErrorCode = NO_ERROR then
    begin
        NumEntries := PTMibIPForwardTable( pBuf )^.dwNumEntries;
        if NumEntries > 0 then
        begin
            inc( pBuf, SizeOf( DWORD ) );
            for i := 1 to NumEntries do
            begin
            IPForwRow := PTMibIPForwardRow( pBuf )^;
            with IPForwRow do
                List.Add( Format(
                '%15s|%15s|%15s|%8.8x|%7s|   %5.5d|    %7s|        %2.2d',
                [IPAddr2Str( dwForwardDest ),
                IPAddr2Str( dwForwardMask ),
                IPAddr2Str( dwForwardNextHop ),
                dwForwardIFIndex,
                IPForwTypes[dwForwardType],
                dwForwardNextHopAS,
                IPForwProtos[dwForwardProto],
                dwForwardMetric1] ) );
                inc( pBuf, SizeOf( TMibIPForwardRow ) );
            end;
        end
        else
            List.Add( 'no entries.' );
    end
    else
        List.Add( SysErrorMessage( ErrorCode ) );
    dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibIPForwardRow ) );
    FreeMem( pBuf );
end;

//IP数据流量统计
procedure Get_IPStatistics( List: TStrings );
var
    IPStats       : TMibIPStats;
    ErrorCode     : integer;
begin
    if not Assigned( List ) then EXIT;
    ErrorCode := GetIPStatistics( @IPStats );
    if ErrorCode = NO_ERROR then
    begin
        List.Clear;
        with IPStats do
        begin
        if dwForwarding = 1 then
            List.add( 'Forwarding Enabled      : ' + 'Yes' )
        else
            List.add( 'Forwarding Enabled      : ' + 'No' );
            List.add( 'Default TTL             : ' + inttostr( dwDefaultTTL ) );
            List.add( 'Datagrams Received      : ' + inttostr( dwInReceives ) );
            List.add( 'Header Errors     (In)  : ' + inttostr( dwInHdrErrors ) );
            List.add( 'Address Errors    (In)  : ' + inttostr( dwInAddrErrors ) );
            List.add( 'Unknown Protocols (In)  : ' + inttostr( dwInUnknownProtos ) );
            List.add( 'Datagrams Discarded     : ' + inttostr( dwInDiscards ) );
            List.add( 'Datagrams Delivered     : ' + inttostr( dwInDelivers ) );
            List.add( 'Requests Out            : ' + inttostr( dwOutRequests ) );
            List.add( 'Routings Discarded      : ' + inttostr( dwRoutingDiscards ) );
            List.add( 'No Routes          (Out): ' + inttostr( dwOutNoRoutes ) );
            List.add( 'Reassemble TimeOuts     : ' + inttostr( dwReasmTimeOut ) );
            List.add( 'Reassemble Requests     : ' + inttostr( dwReasmReqds ) );
            List.add( 'Succesfull Reassemblies : ' + inttostr( dwReasmOKs ) );
            List.add( 'Failed Reassemblies     : ' + inttostr( dwReasmFails ) );
            List.add( 'Succesful Fragmentations: ' + inttostr( dwFragOKs ) );
            List.add( 'Failed Fragmentations   : ' + inttostr( dwFragFails ) );
            List.add( 'Datagrams Fragmented    : ' + inttostr( dwFRagCreates ) );
            List.add( 'Number of Interfaces    : ' + inttostr( dwNumIf ) );
            List.add( 'Number of IP-addresses  : ' + inttostr( dwNumAddr ) );
            List.add( 'Routes in RoutingTable  : ' + inttostr( dwNumRoutes ) );
        end;
    end
    else
        List.Add( SysErrorMessage( ErrorCode ) );
end;

//UDP数据流量统计
procedure Get_UdpStatistics( List: TStrings );
var
    UdpStats      : TMibUDPStats;
    ErrorCode     : integer;
begin
    if not Assigned( List ) then EXIT;
    ErrorCode := GetUDPStatistics( @UdpStats );
    if ErrorCode = NO_ERROR then
    begin
        List.Clear;
        with UDPStats do
        begin
        List.add( 'Datagrams (In)    : ' + inttostr( dwInDatagrams ) );
        List.add( 'Datagrams (Out)   : ' + inttostr( dwOutDatagrams ) );
        List.add( 'No Ports          : ' + inttostr( dwNoPorts ) );
        List.add( 'Errors    (In)    : ' + inttostr( dwInErrors ) );
        List.add( 'UDP Listen Ports  : ' + inttostr( dwNumAddrs ) );
        end;
    end
    else
        List.Add( SysErrorMessage( ErrorCode ) );
end;

//ICMP数据流量统计
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
var
    ErrorCode     : DWORD;
    ICMPStats     : PTMibICMPInfo;
begin
    if ( ICMPIn = nil ) or ( ICMPOut = nil ) then EXIT;
    ICMPIn.Clear;
    ICMPOut.Clear;
    New( ICMPStats );
    ErrorCode := GetICMPStatistics( ICMPStats );
    if ErrorCode = NO_ERROR then
    begin
        with ICMPStats.InStats do
        begin
        ICMPIn.Add( 'Messages received    : ' + IntToStr( dwMsgs ) );
        ICMPIn.Add( 'Errors               : ' + IntToStr( dwErrors ) );
        ICMPIn.Add( 'Dest. Unreachable    : ' + IntToStr( dwDestUnreachs ) );
        ICMPIn.Add( 'Time Exceeded        : ' + IntToStr( dwTimeEcxcds ) );
        ICMPIn.Add( 'Param. Problems      : ' + IntToStr( dwParmProbs ) );
        ICMPIn.Add( 'Source Quench        : ' + IntToStr( dwSrcQuenchs ) );
        ICMPIn.Add( 'Redirects            : ' + IntToStr( dwRedirects ) );
        ICMPIn.Add( 'Echo Requests        : ' + IntToStr( dwEchos ) );
        ICMPIn.Add( 'Echo Replies         : ' + IntToStr( dwEchoReps ) );
        ICMPIn.Add( 'Timestamp Requests   : ' + IntToStr( dwTimeStamps ) );
        ICMPIn.Add( 'Timestamp Replies    : ' + IntToStr( dwTimeStampReps ) );
        ICMPIn.Add( 'Addr. Masks Requests : ' + IntToStr( dwAddrMasks ) );
        ICMPIn.Add( 'Addr. Mask Replies   : ' + IntToStr( dwAddrReps ) );
        end;
        with ICMPStats^.OutStats do
        begin
        ICMPOut.Add( 'Messages sent        : ' + IntToStr( dwMsgs ) );
        ICMPOut.Add( 'Errors               : ' + IntToStr( dwErrors ) );
        ICMPOut.Add( 'Dest. Unreachable    : ' + IntToStr( dwDestUnreachs ) );
        ICMPOut.Add( 'Time Exceeded        : ' + IntToStr( dwTimeEcxcds ) );
        ICMPOut.Add( 'Param. Problems      : ' + IntToStr( dwParmProbs ) );
        ICMPOut.Add( 'Source Quench        : ' + IntToStr( dwSrcQuenchs ) );
        ICMPOut.Add( 'Redirects            : ' + IntToStr( dwRedirects ) );
        ICMPOut.Add( 'Echo Requests        : ' + IntToStr( dwEchos ) );
        ICMPOut.Add( 'Echo Replies         : ' + IntToStr( dwEchoReps ) );
        ICMPOut.Add( 'Timestamp Requests   : ' + IntToStr( dwTimeStamps ) );
        ICMPOut.Add( 'Timestamp Replies    : ' + IntToStr( dwTimeStampReps ) );
        ICMPOut.Add( 'Addr. Masks Requests : ' + IntToStr( dwAddrMasks ) );
        ICMPOut.Add( 'Addr. Mask Replies   : ' + IntToStr( dwAddrReps ) );
        end;
    end
    else
        IcmpIn.Add( SysErrorMessage( ErrorCode ) );
    Dispose( ICMPStats );
end;

//------------------------------------------------------------------------------
procedure Get_RecentDestIPs( List: TStrings );
begin
  if Assigned( List ) then
    List.Assign( RecentIPs )
end;

initialization

  RecentIPs := TStringList.Create;

finalization

  RecentIPs.Free;

end.

{ List of Fixes & Additions

v1.1
-----
Fix :  wrong errorcode reported in GetNetworkParams()
Fix :  RTTI MaxHops 20 > 128
Add :  ICMP -statistics
Add :  Well-Known port numbers
Add :  RecentIP list
Add :  Timer update

v1.2
----
Fix :  Recent IP's correct update
ADD :  ICMP-error codes translated

}