(*
  Fnugry Netstat Components
  Version 1.00
  Copyright (C) 1998 Gleb Yourchenko

  Contact:
  Gleb Yourchenko
  E-Mail: eip__@hotmail.com
  Please specify "Netstat Components" in the subject string.
  
*)

unit fngnetstat;

interface

uses
   Windows,
   WInSock,
   Snmp,
   SysUtils,
   Classes;

const
   mibLen = $0A;

type


   TMibId = array[1..mibLen] of integer;

   TIpConnInfo = class
   private
      FRemoteIp :TInAddr;
      FRemotePort :integer;
      FState :DWORD;
      FLocalIp :TInAddr;
      FLocalPort :integer;
      FProto :ShortString;
      function GetLocalPort :Integer;
      function GetLocalIpString :String;
      function Ip2Str( const Ip :TInAddr ):String;
      function GetRemotePort :Integer;
      function GetRemoteIpString :String;
      function GetStateString :String;
   public
      constructor Create( const aProto :String );
      property IpProtoName :ShortString
         read FProto;
      property LocalIp :TInAddr
         read FLocalIp;
      property LocalPort :Integer
         read GetLocalPort;
      property LocalIpString :String
         read GetLocalIpString;
      property RemoteIpString :String
         read GetRemoteIpString;
      property RemoteIp :TInAddr
         read FRemoteIp;
      property RemotePort :Integer
         read GetRemotePort;
      property State :DWORD
         read FState;
      property StateString :String
         read GetStateString;
   end;


   EConnListError = class(Exception);
      EConnListLockError = class(EConnListError);
      EConnListUnlockError = class(EConnListError);
      EConnListRefreshError = class(EConnListError);

   TIpConnListStatus = ( connlist_ready, connlist_refreshing );

   TIpProtocol = (udp_ip, tcp_ip);
   TIpProtocols = set of TIpProtocol;

   TFnugryIpConnectionList = class(TComponent)
   private
      FConnections :TList;
      FWsInited :Bool;
      FSnmpLib :THandle;
      FSnmpQueryProc :Pointer;
      FSnmpInitProc :Pointer;
      FProtocols :TIpProtocols;
      FStatus :TIpConnListStatus;
      FOnStatusChange :TNotifyEvent;
      FAccessMutex :THandle;
      FPollForTrapEvent :THandle;
      FSupportedViewRoot :TAsnObjectIdentifier;
      function GetConnCount :Integer;
      function GetConnections( Index :Integer ):TIpConnInfo;
   protected
      procedure StatusChange; virtual;
      procedure SetStatus( Value :TIpConnListStatus ); virtual;
      procedure DoLock;
      procedure DoUnlock;
      procedure Clear;
   public
      constructor Create( aOwner :TComponent ); override;
      destructor Destroy; override;
      procedure Refresh;
      function Lock( Timeout :DWORD ):Bool;
      function Unlock :Bool;
      property Status :TIpConnListStatus
         read FStatus;
      property Connections[ Index :Integer ] :TIpConnInfo
         read GetConnections; default;
      property ConnCount :Integer
         read GetConnCount;
   published
      property Protocols :TIpProtocols
         read FProtocols write FProtocols;
      property OnStatusChange :TNotifyEvent
         read FOnStatusChange write FOnStatusChange;
   end;

   ENetstatError = class(Exception);

   TNetstatCounterObject = class
   private
      FName :String;
      FId   :TMibId;
      FDescription :String;
      FWsInited :Bool;
      FSnmpLib :THandle;
      FSnmpQueryProc :Pointer;
      FSnmpInitProc :Pointer;
      function GetValue :DWORD;
   public
      constructor Create( const aName, aDesc :String; const aId :TMibId );
      destructor Destroy; override;
      property Description :String
         read FDescription;
      property Name :String
         read FName;
      property Id :TMibId
         read FId;
      property Value :DWORD
         read GetValue;
   end;

   TCounterList = class(TComponent)
   private
      FCounters :TStringList;
      function GetCount :Integer;
      function GetCounters( Index :Integer ):TNetstatCounterObject;
   public
      constructor Create( aOwner :TComponent ); override;
      destructor Destroy; override;
      procedure Clear;
      procedure AddCounter( aCounter :TNetstatCounterObject );
      function IndexOf( const aName :String ):Integer;
      property Count :Integer
         read GetCount;
      property Counters[Index :Integer] :TNetstatCounterObject
         read GetCounters; default;
   end;


   TIpStats = class(TCounterList)
   public
      constructor Create( aOwner :TComponent ); override;
   end;


   TIcmpStats = class(TCounterList)
   public
      constructor Create( aOwner :TComponent ); override;
   end;

   TTCPStats = class(TCounterList)
   public
      constructor Create( aOwner :TComponent ); override;
   end;

   TUdpStats = class(TCounterList)
   public
      constructor Create( aOwner :TComponent ); override;
   end;

procedure Register;

implementation

procedure Register;
begin
   RegisterComponents('Fnugry Tools',
     [TFnugryIpConnectionList, TUdpStats,
     TTcpStats, TIpStats, TIcmpStats]);
end;

resourcestring
  m_err_lock       = 'Connection list lock failure';
  m_err_unlock     = 'Connection list unlock failure';
  m_err_alloc      = 'Error allocating required resources';
  m_err_inv_state  = 'Requested operation is not supported in the current state.';
  m_err_wsstartup  = 'Failed to initialize Windows Sockets library.';
  m_err_loadlib    = 'SNMP extension agent library is not available.';
  m_err_initlib    = 'Error initializing SNMP extension agent.';
  m_err_query      = 'SNMP query failed.';
  m_err_queryend   = 'Unexpected end of query results encountered.';
  m_err_invtype    = 'Unexpected result type';

const

  DEFAULT_LOCK_TIMEOUT  = 100;

  SNMP_LIB_NAME         = 'inetmib1.dll';

  SNMP_INITPROC_NAME    = 'SnmpExtensionInit';
  SNMP_QUERYPROC_NAME   = 'SnmpExtensionQuery';



  mib_tcpConnTable :TMibId =
     (1, 3, 6, 1, 2, 1, 6, 13, 1, 1);
  mib_udpTable : TMibId =
     (1, 3, 6, 1, 2, 1, 7, 5, 1, 1);

  mib_ipDefaultTTL : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 2, 1, 1);
  mib_ipInReceives : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 3, 1, 1);
  mib_ipInHdrErrors : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 4, 1, 1);
  mib_ipInAddrErrors : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 5, 1, 1);
  mib_ipForwDatagrams : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 6, 1, 1);
  mib_InUnknownProtos : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 7, 1, 1);
  mib_ipInDiscards : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 8, 1, 1);
  mib_ipInDelivers : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 9, 1, 1);
  mib_ipOutRequests : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 10, 1, 1);
  mib_ipOutDiscards : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 11, 1, 1);
  mib_ipOutNoRoutes : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 12, 1, 1);

  mib_ipReasmTimeout : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 13, 1, 1);
  mib_ipReasmReqds : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 14, 1, 1);
  mib_ipReasmOKs : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 15, 1, 1);
  mib_ipReasmFails : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 16, 1, 1);
  mib_ipFragOKs : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 17, 1, 1);
  mib_ipFragFails : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 18, 1, 1);
  mib_ipFragCreates : TMibId =
     (1, 3, 6, 1, 2, 1, 4, 19, 1, 1);

  mib_icmpInMsgs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 1, 1, 1);
  mib_icmpInErrors : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 2, 1, 1);
  mib_icmpInDestUnreachs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 3, 1, 1);
  mib_icmpInTimeExcds : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 4, 1, 1);
  mib_icmpInParmProbs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 5, 1, 1);
  mib_icmpInSrcQuenchs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 6, 1, 1);
  mib_icmpInRedirects : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 7, 1, 1);
  mib_icmpInEchos : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 8, 1, 1);
  mib_icmpInEchoReps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 9, 1, 1);
  mib_icmpInTimestamps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 10, 1, 1);
  mib_icmpInTimestampReps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 11, 1, 1);
  mib_icmpInAddrMasks : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 12, 1, 1);
  mib_icmpInAddrMaskReps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 13, 1, 1);

  mib_icmpOutMsgs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 14, 1, 1);
  mib_icmpOutErrors : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 15, 1, 1);
  mib_icmpOutDestUnreachs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 16, 1, 1);
  mib_icmpOutTimeExcds : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 17, 1, 1);
  mib_icmpOutParmProbs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 18, 1, 1);
  mib_icmpOutSrcQuenchs : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 19, 1, 1);
  mib_icmpOutRedirects : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 20, 1, 1);
  mib_icmpOutEchos : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 21, 1, 1);
  mib_icmpOutEchoReps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 22, 1, 1);
  mib_icmpOutTimestamps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 23, 1, 1);
  mib_icmpOutTimestampReps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 24, 1, 1);
  mib_icmpOutAddrMasks : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 25, 1, 1);
  mib_icmpOutAddrMaskReps : TMibId =
     (1, 3, 6, 1, 2, 1, 5, 26, 1, 1);

  mib_tcpRtoAlgorithm : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 1, 1, 1);
  mib_tcpRtoMin : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 2, 1, 1);
  mib_tcpRtoMax : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 3, 1, 1);
  mib_tcpMaxConn : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 4, 1, 1);
  mib_tcpActiveOpens : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 5, 1, 1);
  mib_tcpPassiveOpens : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 6, 1, 1);
  mib_tcpAttemptsFails : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 7, 1, 1);
  mib_tcpEstabResets : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 8, 1, 1);
  mib_tcpCurrEstab : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 9, 1, 1);
  mib_tcpInSegs : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 10, 1, 1);
  mib_tcpOutSegs : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 11, 1, 1);
  mib_tcpRetransSegs : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 12, 1, 1);
  mib_tcpInErrs : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 14, 1, 1);
  mib_tcpOutRsts : TMibId =
     (1, 3, 6, 1, 2, 1, 6, 15, 1, 1);

  mib_udpInDatagrams : TMibId =
     (1, 3, 6, 1, 2, 1, 7, 1, 1, 1);
  mib_udpNoPorts : TMibId =
     (1, 3, 6, 1, 2, 1, 7, 2, 1, 1);
  mib_udpInErrors : TMibId =
     (1, 3, 6, 1, 2, 1, 7, 3, 1, 1);
  mib_udpOutDatagrams : TMibId =
     (1, 3, 6, 1, 2, 1, 7, 4, 1, 1);


  // Socket Status constants

  CLOSED       = 1;
  LISTEN       = 2;
  SYN_SENT     = 3;
  SYN_RECEIVED = 4;
  ESTABLISHED  = 5;
  CLOSE_WAIT   = 6;
  FIN_WAIT_1   = 7;
  CLOSING      = 8;
  LAST_ACK     = 9;
  FIN_WAIT_2   = 10;
  TIME_WAIT    = 11;
  TCB_DISCARD  = 12;

type


  TSnmpInitProc = function(
     dwTimeZeroReference : DWORD;
     Var hPollForTrapEvent : THandle;
     Var SupportedView : TAsnObjectIdentifier) : BOOL; stdcall;

  TSnmpQueryProc = function(
     RequestType : Byte;
     Var VariableVindings : TRFC1157VarBindList;
     Var ErrorStatus : TAsnInteger;
     Var ErrorIndex : TAsnInteger) : BOOL; stdcall;

{ TIpStats }

constructor TIpStats.Create( aOwner :TComponent );
begin
   inherited;
   AddCounter( TNetstatCounterObject.Create( 'ipDefaultTTL', '', mib_ipDefaultTTL));
   AddCounter( TNetstatCounterObject.Create( 'ipInReceives', '', mib_ipInReceives));
   AddCounter( TNetstatCounterObject.Create( 'ipInHdrErrors', '', mib_ipInHdrErrors));
   AddCounter( TNetstatCounterObject.Create( 'ipInAddrErrors', '', mib_ipInAddrErrors));
   AddCounter( TNetstatCounterObject.Create( 'ipForwDatagrams', '', mib_ipForwDatagrams));
   AddCounter( TNetstatCounterObject.Create( 'ipInUnknownProtos', '', mib_InUnknownProtos));
   AddCounter( TNetstatCounterObject.Create( 'ipInDiscards', '', mib_ipInDiscards));
   AddCounter( TNetstatCounterObject.Create( 'ipInDelivers', '', mib_ipInDelivers));
   AddCounter( TNetstatCounterObject.Create( 'ipOutRequests', '', mib_ipOutRequests));
   AddCounter( TNetstatCounterObject.Create( 'ipOutDiscards', '', mib_ipOutDiscards));
   AddCounter( TNetstatCounterObject.Create( 'ipOutNoRoutes', '', mib_ipOutNoRoutes));

   AddCounter( TNetstatCounterObject.Create( 'ipReasmTimeout', '', mib_ipReasmTimeout));
   AddCounter( TNetstatCounterObject.Create( 'ipReasmReqds', '', mib_ipReasmReqds));
   AddCounter( TNetstatCounterObject.Create( 'ipReasmOKs', '', mib_ipReasmOKs));
   AddCounter( TNetstatCounterObject.Create( 'ipReasmFails', '', mib_ipReasmFails));
   AddCounter( TNetstatCounterObject.Create( 'ipFragOKs', '', mib_ipFragOKs));
   AddCounter( TNetstatCounterObject.Create( 'ipFragFails', '', mib_ipFragFails));
   AddCounter( TNetstatCounterObject.Create( 'ipFragCreates', '', mib_ipFragCreates));
end;

{ TIcmpStats }


constructor TIcmpStats.Create( aOwner :TComponent );
begin
   inherited;
   AddCounter( TNetstatCounterObject.Create( 'icmpInMsgs', '', mib_icmpInMsgs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInErrors', '', mib_icmpInErrors ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInDestUnreachs', '', mib_icmpInDestUnreachs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInTimeExcds', '', mib_icmpInTimeExcds ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInParmProbs', '', mib_icmpInParmProbs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInSrcQuenchs', '', mib_icmpInSrcQuenchs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInRedirects', '', mib_icmpInRedirects ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInEchos', '', mib_icmpInEchos ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInEchoReps', '', mib_icmpInEchoReps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInTimestamps', '', mib_icmpInTimestamps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInTimestampReps', '', mib_icmpInTimestampReps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInAddrMasks', '', mib_icmpInAddrMasks ));
   AddCounter( TNetstatCounterObject.Create( 'icmpInAddrMaskReps', '', mib_icmpInAddrMaskReps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutMsgs', '', mib_icmpOutMsgs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutErrors', '', mib_icmpOutErrors ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutDestUnreachs', '', mib_icmpOutDestUnreachs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutTimeExcds', '', mib_icmpOutTimeExcds ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutParmProbs', '', mib_icmpOutParmProbs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutSrcQuenchs', '', mib_icmpOutSrcQuenchs ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutRedirects', '', mib_icmpOutRedirects ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutEchos', '', mib_icmpOutEchos ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutEchoReps', '', mib_icmpOutEchoReps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutTimestamps', '', mib_icmpOutTimestamps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutTimestampReps', '', mib_icmpOutTimestampReps ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutAddrMasks', '', mib_icmpOutAddrMasks ));
   AddCounter( TNetstatCounterObject.Create( 'icmpOutAddrMaskReps', '', mib_icmpOutAddrMaskReps ));
end;


{ TCP Stats }


constructor TTcpStats.Create( aOwner :TComponent );
begin
   inherited;
  AddCounter( TNetstatCounterObject.Create( 'tcpRtoAlgorithm', '', mib_tcpRtoAlgorithm));
  AddCounter( TNetstatCounterObject.Create( 'tcpRtoMin', '', mib_tcpRtoMin));
  AddCounter( TNetstatCounterObject.Create( 'tcpRtoMax', '', mib_tcpRtoMax));
  AddCounter( TNetstatCounterObject.Create( 'tcpMaxConn', '', mib_tcpMaxConn));
  AddCounter( TNetstatCounterObject.Create( 'tcpActiveOpens', '', mib_tcpActiveOpens));
  AddCounter( TNetstatCounterObject.Create( 'tcpPassiveOpens', '', mib_tcpPassiveOpens));
  AddCounter( TNetstatCounterObject.Create( 'tcpAttemptsFails', '', mib_tcpAttemptsFails));
  AddCounter( TNetstatCounterObject.Create( 'tcpEstabResets', '', mib_tcpEstabResets));
  AddCounter( TNetstatCounterObject.Create( 'tcpCurrEstab', '', mib_tcpCurrEstab));
  AddCounter( TNetstatCounterObject.Create( 'tcpInSegs', '', mib_tcpInSegs));
  AddCounter( TNetstatCounterObject.Create( 'tcpOutSegs', '', mib_tcpOutSegs));
  AddCounter( TNetstatCounterObject.Create( 'tcpRetransSegs', '', mib_tcpRetransSegs));
  AddCounter( TNetstatCounterObject.Create( 'tcpInErrs', '', mib_tcpInErrs));
  AddCounter( TNetstatCounterObject.Create( 'tcpOutRsts', '', mib_tcpOutRsts));
end;

constructor TUdpStats.Create( aOwner :TComponent );
begin
   inherited;

  AddCounter( TNetstatCounterObject.Create( 'udpInDatagrams', '', mib_udpInDatagrams ));
  AddCounter( TNetstatCounterObject.Create( 'udpNoPorts', '', mib_udpNoPorts ));
  AddCounter( TNetstatCounterObject.Create( 'udpInErrors', '', mib_udpInErrors ));
  AddCounter( TNetstatCounterObject.Create( 'udpOutDatagrams', '', mib_udpOutDatagrams ));
end;

{ TNetstatCounterObject }



function TNetstatCounterObject.GetValue :DWORD;
var
   varBind     :TRFC1157VarBind;
   varBindList :TRFC1157VarBindList;
   errorStatus :TAsnInteger;
   errorIndex  :TAsnInteger;
begin
   varBindList.List := @varBind;
   varBindList.len := 1;
   fillchar(varBind, SizeOf(varBind), 0);
   varBind.Name.idLength := mibLen;
   varBind.Name.ids := @FId;
   if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
      varBindList, errorStatus, errorIndex) then
      raise ENetstatError.Create(m_err_query);
   if not (varBindList.list.value.asnType in
     [ASN_GAUGE32, ASN_INTEGER, ASN_INTEGER32, ASN_COUNTER32, ASN_UNSIGNED32]) then
      raise ENetstatError.Create(m_err_invtype);
   result := varBindList.list.value.Counter;
end;

constructor TNetstatCounterObject.Create(
  const aName, aDesc :String; const aId :TMibId );
var
   WSData :TWSAData;
   PollForTrapEvent :THandle;
   SupportedViewRoot :TAsnObjectIdentifier;
begin
   inherited Create;
   FWsInited := WsaStartup($0101, WSData ) = 0;
   if not FWsInited then
      raise EConnListError.Create(m_err_wsstartup);
   FSnmpLib := LoadLibrary(SNMP_LIB_NAME);
   if FSnmpLib = 0 then
      raise EConnListError.Create(m_err_loadlib);
   FSnmpInitProc := GetProcAddress(FSNmpLib, SNMP_INITPROC_NAME);
   FSnmpQueryProc := GetProcAddress(FSNmpLib, SNMP_QUERYPROC_NAME);
   if ( ( FSnmpQueryProc = Nil ) or ( FSnmpInitProc = Nil ) ) then
      raise EConnListError.Create(m_err_loadlib);
   if not TSnmpInitProc(FSnmpInitProc)(GetTickCount,
      PollForTrapEvent, SupportedViewRoot) then
      raise EConnListError.Create(m_err_initlib);
   FName := aname;
   FDescription := aDesc;
   FId := aid;
   dec(Fid[8]);
end;

destructor TNetstatCounterObject.Destroy;
begin
   if FSnmpLib <> 0 then FreeLibrary(FSnmpLib);
   if FWsInited then WSACleanup;
   inherited;
end;

{ TCounterList }

procedure TCounterList.AddCounter( aCounter :TNetstatCounterObject );
begin
   assert( assigned( aCounter ));
   FCounters.AddObject( aCounter.Name, aCounter );
end;

function TCounterList.GetCount :Integer;
begin
   assert( assigned( FCounters ));
   result := FCounters.Count;
end;

function TCounterList.GetCounters( Index :Integer ):TNetstatCounterObject;
begin
   assert( assigned( FCounters ));
   result := TNetstatCounterObject(FCounters.Objects[Index]);
end;

function TCounterList.IndexOf( const aName :String ):Integer;
begin
   result := FCounters.IndexOf( aName );
end;

constructor TCounterList.Create( aOwner :TComponent );
begin
   inherited;
   FCounters := TStringList.Create;
end;

destructor TCounterList.Destroy;
begin
   Clear;
   if assigned(FCounters) then FCounters.Free;
   inherited;
end;

procedure TCounterList.Clear;
var
   i :integer;
   c :TObject;
begin
   if assigned(FCounters) then
      for i := FCounters.Count-1 downto 0 do
         begin
            c := FCounters.Objects[i];
            FCounters.Delete(i);
            if assigned(c) then c.free;
         end;
end;


{ TIpConNInfo }

constructor TIpConNInfo.Create( const aProto :String );
begin
   inherited Create;
   FState := LISTEN;
   FProto := aProto;
end;

function TIpConNInfo.Ip2Str( const Ip :TInAddr ):String;
begin
   result := format('%d.%d.%d.%d',
     [Integer(ip.s_un_b.s_b1),
      Integer(ip.s_un_b.s_b2),
      Integer(ip.s_un_b.s_b3),
      Integer(ip.s_un_b.s_b4)]);
end;

function TIpConNInfo.GetLocalPort :Integer;
begin
   result := FLocalPort;
end;

function TIpConNInfo.GetLocalIpString :String;
begin
   result := Ip2Str(FLocalIp);
end;


function TIpConNInfo.GetRemotePort :Integer;
begin
   if State = LISTEN then
      result := 0
   else
      result := FRemotePort;
end;

function TIpConNInfo.GetRemoteIpString :String;
begin
   result := Ip2Str(FRemoteIp);
end;


function TIpConNInfo.GetStateString :String;
const
   state_name :array[CLOSED..TCB_DISCARD] of string[16] =
   ('CLOSED',
    'LISTEN',
    'SYN_SENT',
    'SYN_RECEIVED',
    'ESTABLISHED',
    'CLOSE_WAIT',
    'FIN_WAIT_1',
    'CLOSING',
    'LAST_ACK',
    'FIN_WAIT_2',
    'TIME_WAIT',
    'TCB_DISCARD'
   );
begin
   if State in [CLOSED..TCB_DISCARD] then
      result := state_name[state]
   else
      result := 'UNKNOWN';
end;



{ TFnugryIpConnectionList }

function TFnugryIpConnectionList.GetConnCount :Integer;
begin
   assert(assigned(FConnections));
   result := FConnections.Count;
end;

function TFnugryIpConnectionList.GetConnections( Index :Integer ):TIpConnInfo;
begin
   assert(assigned(FConnections));
   result := FConnections[Index];
end;

procedure TFnugryIpConnectionList.Clear;
var
   i :integer;
   p :TIpConnInfo;
begin
   if assigned(FConnections) then
      for i := FConnections.Count-1 downto 0 do
         begin
            p := FConnections[i];
            assert(assigned(p));
            FConnections.Delete(i);
            p.free;
         end;
end;

procedure TFnugryIpConnectionList.StatusChange;
begin
   if assigned(FOnStatusChange) then FOnStatusChange(Self);
end;

procedure TFnugryIpConnectionList.SetStatus( Value :TIpConnListStatus );
begin
   if FStatus <> Value then
      begin
        FStatus := Value;
        StatusChange;
      end;
end;

procedure TFnugryIpConnectionList.DoLock;
begin
   if not Lock(DEFAULT_LOCK_TIMEOUT) then
      raise ECOnnListLockError.Create(m_err_lock);
end;

procedure TFnugryIpConnectionList.DoUnlock;
begin
   if not UnLock then
      raise ECOnnListUnLockError.Create(m_err_unlock);
end;


constructor TFnugryIpConnectionList.Create( aOwner :TComponent );
var
   WSData :TWSAData;
begin
   inherited;
   FProtocols := [udp_ip, tcp_ip];
   FWsInited := WsaStartup($0101, WSData ) = 0;
   if not FWsInited then
      raise EConnListError.Create(m_err_wsstartup);
   FSnmpLib := LoadLibrary(SNMP_LIB_NAME);
   if FSnmpLib = 0 then
      raise EConnListError.Create(m_err_loadlib);
   FSnmpInitProc := GetProcAddress(FSNmpLib, SNMP_INITPROC_NAME);
   FSnmpQueryProc := GetProcAddress(FSNmpLib, SNMP_QUERYPROC_NAME);
   if ( ( FSnmpQueryProc = Nil ) or ( FSnmpInitProc = Nil ) ) then
      raise EConnListError.Create(m_err_loadlib);
   if not TSnmpInitProc(FSnmpInitProc)(GetTickCount,
      FPollForTrapEvent, FSupportedViewRoot) then
      raise EConnListError.Create(m_err_initlib);
   FAccessMutex := CreateMutex(nil, false, nil);
   if FAccessMutex = 0 then
      raise ECOnnListError.Create(m_err_alloc);
   FCOnnections := TList.Create;
   FStatus := connlist_ready;
end;

destructor TFnugryIpConnectionList.Destroy;
begin
   Clear;
   if assigned(FConnections) then FCOnnections.Free;
   if FAccessMutex <> 0 then CloseHandle(FAccessMutex);
   if FSnmpLib <> 0 then FreeLibrary(FSnmpLib);
   if FWsInited then WSACleanup;
   inherited;
end;

function TFnugryIpConnectionList.Lock( Timeout :DWORD ):Bool;
begin
   result := WaitForSingleObject(FAccessMutex, Timeout ) = WAIT_OBJECT_0;
end;

function TFnugryIpConnectionList.Unlock :Bool;
begin
  result := ReleaseMutex(FAccessMutex);
end;

procedure TFnugryIpConnectionList.Refresh;

   procedure ReadTcpTable;
   var
      varBind     :TRFC1157VarBind;
      varBindList :TRFC1157VarBindList;
      errorStatus :TAsnInteger;
      errorIndex  :TAsnInteger;
      ConnIndex   :Integer;
      Info        :TIpConnInfo;
      ListTail    :Integer;
   begin
      fillchar( varBindList, SizeOf(varBindList), 0);
      varBindList.List := @varBind;
      varBindList.len := 1;
      fillchar(varBind, SizeOf(varBind), 0);
      varBind.Name.idLength := mibLen;
      varBind.name.ids := @mib_tcpConnTable;
      ListTail    := FConnections.Count;


      if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
         varBindList, errorStatus, errorIndex) then
         raise EConnListRefreshError.Create(m_err_query);
      if varBindList.list.value.asnType = ASN_NULL then
         exit;

      { read connections }

      while (varBindList.list.value.asnType = ASN_INTEGER) do
      begin
         Info := TIpConnInfo.Create('TCP');
         Info.FState := varBindList.list.value.Counter;
         FCOnnections.Add(Info);
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
      end;
      if varBindList.list.value.asnType = ASN_NULL then
         raise EConnListRefreshError.Create(m_err_queryend);

      { read local ips }

      ConnIndex := ListTail;
      while (varBindList.list.value.asnType = ASN_RFC1155_IPADDRESS) do
      begin
         move(varBindList.list.value.address.stream^,
            Connections[ConnIndex].FLocalIP, sizeof(TInAddr));
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
         inc(ConnIndex);
      end;
      if varBindList.list.value.asnType = ASN_NULL then
         raise EConnListRefreshError.Create(m_err_queryend);

      { read local ports }

      ConnIndex := ListTail;
      while (varBindList.list.value.asnType = ASN_INTEGER) do
      begin
         Connections[ConnIndex].FLocalPort := varBindList.list.value.counter;
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
         inc(ConnIndex);
      end;
      if varBindList.list.value.asnType = ASN_NULL then
         raise EConnListRefreshError.Create(m_err_queryend);

      { read remote ips }

      ConnIndex := ListTail;
      while (varBindList.list.value.asnType = ASN_RFC1155_IPADDRESS) do
      begin
         move(varBindList.list.value.address.stream^,
            Connections[ConnIndex].FRemoteIP,
            sizeof(TInAddr));
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
         inc(ConnIndex);
      end;
      if varBindList.list.value.asnType = ASN_NULL then
         raise EConnListRefreshError.Create(m_err_queryend);

      { read remote ports }

      ConnIndex := ListTail;
      while (varBindList.list.value.asnType = ASN_INTEGER) do
      begin
         Connections[ConnIndex].FRemotePort := varBindList.list.value.counter;
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
         inc(ConnIndex);
      end;
  end;


  procedure ReadUdpTable;
   var
      varBind     :TRFC1157VarBind;
      varBindList :TRFC1157VarBindList;
      errorStatus :TAsnInteger;
      errorIndex  :TAsnInteger;
      ConnIndex   :Integer;
      Info        :TIpConnInfo;
      ListTail    :Integer;
   begin
      fillchar( varBindList, SizeOf(varBindList), 0);
      varBindList.List := @varBind;
      varBindList.len := 1;
      fillchar(varBind, SizeOf(varBind), 0);
      varBind.Name.idLength := mibLen;
      varBind.name.ids := @mib_udpTable;
      ListTail := FConnections.Count;

      if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
         varBindList, errorStatus, errorIndex) then
         raise EConnListRefreshError.Create(m_err_query);
      if varBindList.list.value.asnType = ASN_NULL then
         exit;

      { read local ips }

      while (varBindList.list.value.asnType = ASN_RFC1155_IPADDRESS) do
      begin
         Info := TIpConnInfo.Create('UDP');
         move(varBindList.list.value.address.stream^,
            Info.FLocalIP,
            sizeof(TInAddr));
         FConnections.Add(Info);
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
      end;
      if varBindList.list.value.asnType = ASN_NULL then
         raise EConnListRefreshError.Create(m_err_queryend);

      { read local ports }

      ConnIndex := ListTail;
      while (varBindList.list.value.asnType = ASN_INTEGER) do
      begin
         Connections[ConnIndex].FLocalPort := varBindList.list.value.counter;
         if not TSnmpQueryProc(FSnmpQueryProc)(ASN_RFC1157_GETNEXTREQUEST,
            varBindList, errorStatus, errorIndex) then
            raise EConnListRefreshError.Create(m_err_query);
         inc(ConnIndex);
      end;
  end;

begin
   DoLock;
   try
      if FStatus <> connlist_ready then
         raise EConnListError.Create(m_err_inv_state);
      SetStatus( connlist_refreshing );
      Clear;
      if tcp_ip in FProtocols then
         ReadTcpTable;
      if udp_ip in FProtocols then
         ReadUdpTable;
   finally
      DoUnlock;
      SetStatus(connlist_ready);
   end;
end;


end.
