netstat.dpr

IPHlpAPI delphi源码

begin
  if GetIcmpStatistics(Icmp) = NO_ERROR then
  begin
    WriteLn('Incoming ICMP message statistics');
    WriteLn;
    DisplayStats(Icmp.stats.icmpInStats);
    WriteLn;
    WriteLn('Outgoing ICMP message statistics');
    WriteLn;
    DisplayStats(Icmp.stats.icmpOutStats);
    WriteLn;
  end;
end;

//------------------------------------------------------------------------------

// Displays statistics for the UDP protocol

procedure DisplayUdpStatistics;
var
  UdpStats: TMibUdpStats;
begin
  if GetUdpStatistics(UdpStats) = NO_ERROR then
  begin
    WriteLn('UDP Statistics');
    WriteLn;
    WriteLn('  Received datagrams. . . . . . . . . . . : ' + IntToStr(UdpStats.dwInDatagrams));
    WriteLn('  Discarded due to invalid port . . . . . : ' + IntToStr(UdpStats.dwNoPorts));
    WriteLn('  Erroneous datagrams . . . . . . . . . . : ' + IntToStr(UdpStats.dwInErrors));
    WriteLn('  Transmitted datagrams . . . . . . . . . : ' + IntToStr(UdpStats.dwOutDatagrams));
    WriteLn('  Number of entries in UDP listened table : ' + IntToStr(UdpStats.dwNumAddrs));
  end;
  WriteLn;
end;

//------------------------------------------------------------------------------

// Displays statistics for all ethernet adapter type interfaces registered with
// the system

procedure DisplayInterfaceStatistics;
var
  Size: ULONG;
  IntfTable: PMibIfTable;
  I: Integer;
  MibRow: TMibIfRow;
begin
  WriteLn('Interface Statistics');
  WriteLn;
  Size := 0;
  // Thanks to Eran Kampf for pointing out that the line below should check agains
  // ERROR_INSUFFICIENT_BUFFER and not ERROR_BUFFER_OVERFLOW !
  if GetIfTable(nil, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
  IntfTable := AllocMem(Size);
  try
    if GetIfTable(IntfTable, Size, True) = NO_ERROR then
    begin
      for I := 0 to IntfTable^.dwNumEntries - 1 do
      begin
        {$R-}MibRow := IntfTable.Table[I];{$R+}
        // Ignore everything except ethernet cards
        if MibRow.dwType <> MIB_IF_TYPE_ETHERNET then Continue;
        WriteLn(PChar(@MibRow.bDescr[0]));
        WriteLn(       '                     Received         Send');
        WriteLn;
        WriteLn(Format('Bytes                %10d %10d', [MibRow.dwInOctets, MibRow.dwOutOctets]));
        WriteLn(Format('Unicast packets      %10d %10d', [MibRow.dwInUcastPkts, MibRow.dwOutUcastPkts]));
        WriteLn(Format('Non-unicast packets  %10d %10d', [MibRow.dwInNUcastPkts, MibRow.dwOutNUcastPkts]));
        WriteLn(Format('Discards             %10d %10d', [MibRow.dwInDiscards, MibRow.dwOutDiscards]));
        WriteLn(Format('Errors               %10d %10d', [MibRow.dwInErrors, MibRow.dwOutErrors]));
        WriteLn(Format('Unknown protocols    %10d %10d', [MibRow.dwInUnknownProtos, 0]));
        WriteLn;
      end;
    end;
  finally
    FreeMem(IntfTable);
  end;
end;

//------------------------------------------------------------------------------

// Displays statistics for the specified protocol. Protocol can be TCP, IP, UDP
// of ICMP. If Protocol is an empty string, statistics for all protocols is
// displayed

procedure DisplayProtocolStatistics(const Protocol: string);
begin
  if Protocol = '' then
  begin
    DisplayTcpStatistics;
    DisplayIpStatistics;
    DisplayIcmpStatistics;
    DisplayUdpStatistics;
  end
  else if Protocol = 'TCP' then
    DisplayTcpStatistics
  else if Protocol = 'IP' then
    DisplayIpStatistics
  else if Protocol = 'ICMP' then
    DisplayIcmpStatistics
  else if Protocol = 'UDP' then
    DisplayUdpStatistics;
end;

//------------------------------------------------------------------------------

// Displays the IP forwarding table (routing table)

procedure DisplayRoutingTable;
var
  ForwardTable: PMibIpForwardTable;
  ForwardRow: TMibIpForwardRow;
  Size: ULONG;
  I: Integer;
begin
  Size := 0;
  if GetIpForwardTable(nil, Size, True) <> ERROR_BUFFER_OVERFLOW then Exit;
  ForwardTable := AllocMem(Size);
  try
    if GetIpForwardTable(ForwardTable, Size, True) = ERROR_SUCCESS then
    begin
      WriteLn('Route Table');
      WriteLn('');
      for I := 0 to ForwardTable^.dwNumEntries - 1 do
      begin
        {$R-}ForwardRow := ForwardTable^.Table[I];{$R+}
        WriteLn('Destination IP. . . : ' + IpAddrToString(ForwardRow.dwForwardDest));
        WriteLn('Destination Subnet. : ' + IpAddrToString(ForwardRow.dwForwardMask));
        WriteLn('Forward: Policy . . : ' + IntToStr(ForwardRow.dwForwardPolicy));
        WriteLn('Next hop. . . . . . : ' + IpAddrToString(ForwardRow.dwForwardNextHop));
        WriteLn('Interface index . . : ' + IntToStr(ForwardRow.dwForwardIfIndex));
        case ForwardRow.dwForwardType of
          MIB_IPROUTE_TYPE_OTHER: WriteLn('Route type. . . . . : Other');
          MIB_IPROUTE_TYPE_INVALID: WriteLn('Route type. . . . . : Invalid');
          MIB_IPROUTE_TYPE_DIRECT: WriteLn('Route type. . . . . : Direct (local route, next hop is final destination)');
          MIB_IPROUTE_TYPE_INDIRECT: WriteLn('Route type. . . . . : Indirect (remote route, next hop isn''t final destination)');
        end;
        case ForwardRow.dwForwardProto of
          MIB_IPPROTO_OTHER        : WriteLn('Protocol Type . . . : Unknown');
          MIB_IPPROTO_LOCAL        : WriteLn('Protocol Type . . . : Local generated by the stack');
          MIB_IPPROTO_NETMGMT      : WriteLn('Protocol Type . . . : SNMP');
          MIB_IPPROTO_ICMP         : WriteLn('Protocol Type . . . : ICMP');
          MIB_IPPROTO_EGP          : WriteLn('Protocol Type . . . : EGP');
          MIB_IPPROTO_GGP          : WriteLn('Protocol Type . . . : Gateway Gateway Protocol');
          MIB_IPPROTO_HELLO        : WriteLn('Protocol Type . . . : HELLO');
          MIB_IPPROTO_RIP          : WriteLn('Protocol Type . . . : Routing Information Protocol (RIP)');
          MIB_IPPROTO_IS_IS        : WriteLn('Protocol Type . . . : IP Intermediate System to Intermediate System Protocol');
          MIB_IPPROTO_ES_IS        : WriteLn('Protocol Type . . . : IP End System to Intermediate System Protocol');
          MIB_IPPROTO_CISCO        : WriteLn('Protocol Type . . . : IP Cisco Protocol');
          MIB_IPPROTO_BBN          : WriteLn('Protocol Type . . . : BBN Protocol');
          MIB_IPPROTO_OSPF         : WriteLn('Protocol Type . . . : Open Shortest Path First routing Protocol');
          MIB_IPPROTO_BGP          : WriteLn('Protocol Type . . . : Border Gateway Protocol');
          MIB_IPPROTO_NT_AUTOSTATIC: WriteLn('Protocol Type . . . : Routes originally added by the routing protocol, but not static');
          MIB_IPPROTO_NT_STATIC    : WriteLn('Protocol Type . . . : Routes added by the user or via the Routemon.exe');
        else
          WriteLn('Protocol Type . . . : Unknown');
        end;
        WriteLn('Route age (sec) . . : ' + IntToStr(ForwardRow.dwForwardAge));
        WriteLn('Next hop AS . . . . : ' + IntToStr(ForwardRow.dwForwardNextHopAS));
        WriteLn;
      end;
    end;
  finally
    FreeMem(ForwardTable);
  end;
end;

//------------------------------------------------------------------------------

// How is this program to be used by the end user?

procedure Usage;
begin
  WriteLn('Displays protocol statistics and current TCP/IP connections.');
  WriteLn;
  WriteLn('NETSTAT [-a] [-e] [-n] [-s] [-p proto] [-r] [interval]');
  WriteLn;
  WriteLn('  -a        Displays all connections and listening ports');
  WriteLn('  -e        Displays all ethernet statistics. This may be combined with the -s option');
  WriteLn('  -n        Displays addresses and port numbers in numerical form, must be the first switch');
  WriteLn('  -p proto  Shows connections for the protocol specified by proto; proto may be');
  WriteLn('            TCP or UDP. If used with the -s option to display per-protocol');
  WriteLn('            statistics, proto may be TCP, UDP or IP');
  WriteLn('  -r        Displays the routing table');
  WriteLn('  -s        Displays per protocol statistics. By default, statistics are shown for TCP,');
  WriteLn('            UDP and IP; the -p option may be used to specify a subset of the default');
  WriteLn('  interval  Redisplays selected statistics, pausing interval seconds between each');
  WriteLn('            display. Press CTRL+C to stop redisplaying statistics. If omitted,');
  WriteLn('            netstat will print the current configuration information once. The');
  WriteLn('            interval switch must be the last switch on the command line');
end;

//------------------------------------------------------------------------------

// Extract the repetition interval from the command line. Assumes it's specified
// last and that no other command line switches are numerical

function GetInterval: Integer;
begin
  try
    Result := StrToInt(ParamStr(ParamCount));
  except
    on Exception do Result := 0;
  end;
end;

//------------------------------------------------------------------------------

var
  WsData: TWsaData;          // Must provide this in call to WsaStartup but unused
  WsaInitialized: Boolean;   // Was Winsock properly initialized?
  ParamIndexOffset: Integer; // Used to offset access to ParamStr in case -n is used
  Interval: Integer;         // Interval in seconds to repeat information

//------------------------------------------------------------------------------

// Executed if user specified a repetition interval and presses CTRL+C to break
// out of the loop.

function CtrlHandler(fdwCtrlType: DWORD): BOOL; stdcall;
begin
  Result := False;
  if (fdwCtrlType in [CTRL_C_EVENT, CTRL_BREAK_EVENT]) and WsaInitialized then
  begin
    WsaCleanup;
    WsaInitialized := False;
  end;
end;

//------------------------------------------------------------------------------

begin

  WriteLn('');
  WriteLn('Windows 2000 NetStat');
  WriteLn('Copyright (C) 2000 Marcel van Brakel');
  WriteLn('');

  if FindCmdLineSwitch('?', ['/', '-'], True) then
  begin
    Usage;
    Exit;
  end;

  // Does user want IP address to hostname mapping turned off?

  ParamIndexOffset := 0;
  if FindCmdLineSwitch('n', ['/', '-'], True) then
  begin
    ResolveNames := False;
    ParamIndexOffset := 1;
  end;

  // If so, we need to intialize Winsock because we use GetHostByAddr to do so

  WsaInitialized := False;
  if ResolveNames then
  begin
    // Ask for a low version of Winsock, we don't need new features so this
    // minimizes the chance initialization will fail
    WsaInitialized := WsaStartup($0101, WsData) = 0;
    if not WsaInitialized then
    begin
      WriteLn('Failed to initialize Winsock. IP to name resolution disabled.');
      WriteLn;
      ResolveNames := False;
    end;
  end;

  // Get the repetition interval, if any

  Interval := GetInterval;

  // If non-zero repetition then the loop below runs until CTRL+C or CTRL+BREAK
  // is pressed. In that case the WsaUninitialize is never executed. Therefore
  // we install a control handler routine which calls WsaUninitialize instead.
  // Of course if this happens we are already on our way out and we could live
  // without the WsaUninitialize but I thought this was a nice opportunity to
  // demo it's usage (thanks to Vladimir Vassiliev for pointing out that the
  // call to WsaUninitialize after the loop wouldn't execute without it).

  if Interval <> 0 then
    SetConsoleCtrlHandler(@CtrlHandler, True);

  // Assume the user specified a repetition interval and loop forever

  while True do
  begin

    // The following looks complex but it's really just a case statement in
    // disguise. Don't spend too much time trying to understand it (I'm not even
    // sure I do myself) just trust that it dispatches control to the appropriate
    // subroutine based on the specified command line switches. Note though that
    // even with this complexity, command line checking is minimal...

    if FindCmdLineSwitch('a', ['/', '-'], True) then
      DisplayConnections('')
    else if FindCmdLineSwitch('r', ['/', '-'], True) then
      DisplayRoutingTable
    else
    begin
      if FindCmdLineSwitch('e', ['/', '-'], True) then
      begin
        DisplayInterfaceStatistics;
        if FindCmdLineSwitch('s', ['/', '-'], True) then
        begin
          if FindCmdLineSwitch('p', ['/', '-'], True) then
          begin
            DisplayProtocolStatistics(ParamStr(4 + ParamIndexOffset));
            DisplayConnections(ParamStr(4 + ParamIndexOffset));
          end
          else
            DisplayProtocolStatistics('');
        end
        else if FindCmdLineSwitch('p', ['/', '-'], True) then
          DisplayConnections(ParamStr(3 + ParamIndexOffset));
      end
      else if FindCmdLineSwitch('s', ['/', '-'], True) then
      begin
        if ParamCount = 1 then
          DisplayProtocolStatistics('')
        else if FindCmdLineSwitch('p', ['/', '-'], True) then
        begin
          DisplayProtocolStatistics(ParamStr(3 + ParamIndexOffset));
          DisplayConnections(ParamStr(3 + ParamIndexOffset));
        end
        else
          Usage;
      end
      else if FindCmdLineSwitch('p', ['/', '-'], True) then
        DisplayConnections(ParamStr(2 + ParamIndexOffset))
      else
        Usage;
    end;

    // Either sleep <interval> seconds and display again or break out of the loop

    if Interval = 0 then
      Break
    else
    begin
      WriteLn;
      WriteLn('Press CTRL+C to quit');
      WriteLn;
      Sleep(1000 * Interval); // Sleep() takes milliseconds
    end;

  end; { while True do }

  // If we initialised it, we must clean up as well (see comment above about the
  // control handler)

  if WsaInitialized then
  begin
    WsaCleanup;
    WsaInitialized := False;
  end;

end.