About me| Chi sono?| BLOG
Chiara| Paola| Valentina| Francesca
Home| Download| Poesie | Poems| Immagini | Pictures| Articoli | Papers| Winamp Plugins
English
› Home » Download › Poems › Pictures › Technical Papers › Winamp Plugins
Italiano
› Principale » Download › Poesie › Immagini › Articoli IoProgrammo › Plugins per Winamp

NetStat32 Delphi Source

Back to the Download Page
Torna alla Sezione Download



program Netstat32; // Advanced Netstat Delphi Source Code (GUI version) - (C) 2003-2005 Salvatore Meschini

(*

If you like this program or you are looking for a custom version please write me at salvatoremeschini@tiscali.it ! Thank you!
Se vuoi dare un contributo allo sviluppo di questo programma scrivi a salvatoremeschini@tiscali.it ! Grazie!

Salvatore Meschini
http://salvatoremeschini.cjb.net

*)



program Netstat32; // Netstat Delphi Source Code - (C) 2003-2005 Salvatore Meschini

uses
   WinTypes, WinProcs, Messages, TlHelp32, Winsock;

{$R WINDRES.RES}
{$R WINXP.RES} // Thanks to TMSSOFTWARE - http://www.tmssoftware.com

{

History:
  1.0 - First release
  1.1 - Automatic delay management using a command line parameter
        Example (update the table every "number of connections" * 250ms) --> NETSTAT32 250
        Default value is 100 milliseconds
        Added some ports and other minor changes
        Windows XP styles support
  1.2 - Anti-flicker code
      - Executable is even smaller!
  1.3 - Now NetStat32 remembers current selection
      - Connection close command (pressing the DEL key). It only works with Established TCP connections!

Todo:
      - Resolves address will become an option
      - Manual selection of (update) delay
      - User interface improvements
      - Log to file (useful to trace worms...)
      - Shows only Established Connections
      - Solve "Known Issues"
      - Rewrite the program as a .NET application? Now it's cool but hard to manage

Known issues:
      - Memory leaks: I don't call HeapFree neither FreeMem in order to free resources
}

const
   AppName = 'Netstat32';
   AppTitle = 'Netstat32 1.3 - Salvatore Meschini';
   CM_ABOUT = 100;
   ANY_SIZE = 1; // Take a look to data structures
   UPDATETABLE = 666; // Timer event param
   IpDLLName = 'iphlpapi.dll'; // Useful functions mine :-)

   // Constants used by Listview functions (Windows standard)
   WC_LISTVIEW = 'SysListView32';
   LVS_REPORT = $0001;
   LVS_SINGLESEL = $0004;
   LVS_SHOWSELALWAYS = $0008;
   LVCF_FMT = $0001;
   LVCF_WIDTH = $0002;
   LVCF_TEXT = $0004;
   LVCF_SUBITEM = $0008;
   LVCF_IMAGE = $0010;
   LVCF_ORDER = $0020;
   LVM_FIRST = $1000;
   LVM_GETITEMCOUNT = LVM_FIRST + 4;
   LVM_INSERTITEM = LVM_FIRST + 7;
   LVM_DELETEITEM = LVM_FIRST + 8;
   LVM_DELETEALLITEMS = LVM_FIRST + 9;
   LVM_GETNEXTITEM = LVM_FIRST + 12;
   LVM_INSERTCOLUMN = LVM_FIRST + 27;
   LVM_SETITEMSTATE = LVM_FIRST + 43;
   LVM_GETITEMTEXT = LVM_FIRST + 45;
   LVM_SETITEMTEXT = LVM_FIRST + 46;
   LVM_SETEXTENDEDLISTVIEWSTYLE = LVM_FIRST + 54;
   LVS_EX_FULLROWSELECT = $00000020;
   LVIF_TEXT = $0001;
   LVIF_STATE = $0008;
   LVNI_SELECTED = $0002;

type
   // DATA STRUCTURES (Advanced)
   PTMibTCPRowEx = ^TMibTCPRowEx;
   TMibTCPRowEx = packed record
      dwState: DWORD;
      dwLocalAddr: DWORD;
      dwLocalPort: DWORD;
      dwRemoteAddr: DWORD;
      dwRemotePort: DWORD;
      dwProcessId: DWORD;
   end;

   PTMibTCPTableEx = ^TMibTCPTableEx;
   TMibTCPTableEx = packed record
      dwNumEntries: DWORD;
      Table: array[0..ANY_SIZE - 1] of TMibTCPRowEx;
   end;

   PTMibUDPRowEx = ^TMibUDPRowEx;
   TMibUDPRowEx = packed record
      dwLocalAddr: DWORD;
      dwLocalPort: DWORD;
      dwProcessId: DWORD;
   end;

   PTMibUDPTableEx = ^TMIBUDPTableEx;
   TMIBUDPTableEx = packed record
      dwNumEntries: DWORD;
      UDPTable: array[0..ANY_SIZE - 1] of TMibUDPRowEx;
   end;

   // DATA STRUCTURES (basic)
   PTMibTCPRow = ^TMibTCPRow;
   TMibTCPRow = packed record
      dwState: DWORD;
      dwLocalAddr: DWORD;
      dwLocalPort: DWORD;
      dwRemoteAddr: DWORD;
      dwRemotePort: DWORD;
   end;
   //
   PTMibTCPTable = ^TMibTCPTable;
   TMibTCPTable = packed record
      dwNumEntries: DWORD;
      Table: array[0..0] of TMibTCPRow;
   end;

   PTMibUDPRow = ^TMibUDPRow;
   TMibUDPRow = packed record
      dwLocalAddr: DWORD;
      dwLocalPort: DWORD;
   end;
   //
   PTMibUDPTable = ^TMIBUDPTable;
   TMIBUDPTable = packed record
      dwNumEntries: DWORD;
      UDPTable: array[0..ANY_SIZE - 1] of TMibUDPRow;
   end;

   TLVColumn = packed record // Listview column type
      mask: UINT;
      fmt: Integer;
      cx: Integer;
      pText: PAnsiChar;
      cchTextMax: Integer;
      iSubItem: Integer;
      iImage: Integer;
      iOrder: Integer;
   end;

   TLVITEM = packed record // Listview row (item) type
      mask: UINT;
      iItem: Integer;
      iSubItem: Integer;
      state: UINT;
      stateMask: UINT;
      pszText: PAnsiChar;
      cchTextMax: Integer;
      iImage: Integer;
      lParam: LPARAM;
      iIndent: Integer;
   end;

var
   AdvancedAPI: Boolean; // Windows XP and higher => AdvancedAPI
   ConnList: HWND; // Listview handle
   TcPTableEx: PTMibTCPTableEx; // Our TcpTableEx
   UdpTableEx: PTMibUDPTableEx; // Our UdpTableEx
   TcpTable: PTMibTCPTable;
   UdpTable: PTMibUDPTable;
   AMessage: TMsg; // Message
   IpDll: THandle; // DLL Handle (IPHLPAPI.DLL)
   Window: HWnd; // Window handle
   Column: TLVColumn; // Generic listview column
   TableRow: TLVItem; // Generic listview row
   Connections, UpdateMsDelay, CurrentRow: Integer; // Some important variables

   TCPConnState: // Connection state type
   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'
      );
   ColTitles: // Column header
   array[1..5] of string = ('Process:PID', 'Local Address:Port', 'Remote Address:Port', 'Protocol', 'Status');

   // Undocumented IpHLPApi Windows API functions:
   AllocateAndGetTcpExTableFromStack: function(Table: PTMibTCPTableEx; bOrder: BOOL; H: THANDLE; zero, flags: DWORD): DWORD; stdcall;
   AllocateAndGetUdpExTableFromStack: function(Table: PTMibTCPTableEx; bOrder: BOOL; H: THANDLE; zero, flags: DWORD): DWORD; stdcall;
   // Standard IpHelper (IPHLPAPI) functions:
   GetTcpTable: function(Table: PTMibTCPTable; dwSize: PDWORD; bOrder: BOOL): DWORD; stdcall;
   GetUdpTable: function(Table: PTMibUDPTable; dwSize: PDWORD; bOrder: BOOL): DWORD; stdcall;
   // I need the following function to close (kill) a connection:
   SetTcpEntry: function(const Row: TMibTCPRow): DWORD; stdcall;

   // Error messages
   const SelectConnection = 'Please select a connection!';
         ThisIsUdp = 'UDP protocol is connection-less';
         WrongStatus = 'I can only close Established connections!';
         DllNotFound = 'Iphlpapi.dll not found!';
         RegisterFailed = 'Register failed';
         CreateFailed = 'Create failed';

   // Add a column to Listview control

function InsertColumn(hwnd: HWND; iCol: Integer; const pcol: TLVColumn): Integer;
begin
   Result := SendMessage(hWnd, LVM_INSERTCOLUMN, iCol, Longint(@pcol));
end;

// Add a new row to Listview control

function InsertItem(hWnd: HWND; const pItem: TLVItem): Integer;
begin
   Result := Integer(SendMessage(hWnd, LVM_INSERTITEM, 0, Longint(@pItem)));
end;

// Set text

function SetItemText(hwndLV: HWND; i, iSubItem: Integer; pText: PChar): Bool;
var
   Item: TLVItem; // Generic listview row (table item)
begin
   Item.iSubItem := iSubItem;
   Item.pszText := pText;
   Result := Bool(SendMessage(hwndLV, LVM_SETITEMTEXT, i, Longint(@Item)));
end;

// Get Text of item i - ToDo: Optimize this function

function GetItemText(hwndLV: HWND; i, iSubItem: Integer): string;
var
   Item: TLVItem;
   pText: pchar;
begin
   GetMem(pText, 256);
   try
      Item.iSubItem := iSubItem; // SubItem to read
      Item.cchTextMax := 256;
      Item.pszText := pText;
      if SendMessage(hwndLV, LVM_GETITEMTEXT, i, Longint(@Item)) > 0 then
         Result := string(pText)
      else
         Result := '';
   finally
      FreeMem(pText);
   end;
end;

function SetItemState(hwndLV: HWND; i: Integer; data, mask: UINT): Bool;
var
   Item: TLVItem;
begin
   Item.stateMask := mask;
   Item.state := data;
   Result := Bool(SendMessage(hwndLV, LVM_SETITEMSTATE, i, Longint(@Item)));
end;

// Clear ALL the items of Listview

function DeleteAllItems(hWnd: HWND): Bool;
begin
   Result := Bool(SendMessage(hWnd, LVM_DELETEALLITEMS, 0, 0));
end;

function ShowError(Number: Integer): string;
var
   Size: Integer;
   Buffer: PChar;
begin
   GetMem(Buffer, 4000);
   try
      Size := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, Number, 0, Buffer, 4000, nil);
      SetString(Result, Buffer, Size);
   finally
      FreeMem(Buffer);
   end;
end;

function IntToStr(Value: Integer): string; // FROM KOL (Kladov Vladimir)
asm
        XOR       ECX, ECX
        PUSH      ECX
        ADD       ESP, -0Ch

        PUSH      EBX
        LEA       EBX, [ESP + 15 + 4]
        PUSH      EDX
        CMP       EAX, ECX
        PUSHFD
        JGE       @@1
        NEG       EAX
@@1:
        MOV       CL, 10

@@2:
        DEC       EBX
        XOR       EDX, EDX
        DIV       ECX
        ADD       DL, 30h
        MOV       [EBX], DL
        TEST      EAX, EAX
        JNZ       @@2

        POPFD
        JGE       @@3

        DEC       EBX
        MOV       byte ptr [EBX], '-'
@@3:
        POP       EAX
        MOV       EDX, EBX
        CALL      System.@LStrFromPChar

        POP       EBX
        ADD       ESP, 10h
end;

procedure UpdateConnectionsTable; // Update connections table (once a second)
var
   I, Base: Integer; // Counters
   Error, TableSize: DWORD; // All went ok?
   Snapshot: THandle; // Process snapshot

   function PortDescription(Port: DWORD): string; // Obtain port service
   var
      i: integer;
   type
      TWKP = record // Well Known Ports structure
         Port: DWORD; // Port Number
         Service: string[50]; // Description
      end;

   const
      WellKnownPorts: array[1..60] of TWKP // Some well known ports
      = ((Port: 1; Service: 'TCP Port Service Multiplexer'),
         (Port: 7; Service: 'ECHO'),
         (Port: 9; Service: 'Discard'),
         (Port: 13; Service: 'DayTime'),
         (Port: 17; Service: 'QOTD - Quote Of The Day'),
         (Port: 18; Service: 'MSP - Message Send Protocol'),
         (Port: 19; Service: 'CharGen - Character Generator'),
         (Port: 20; Service: 'FTPDATA - File Transfer Protocol'),
         (Port: 21; Service: 'FTP - File Transfer Control Protocol'),
         (Port: 22; Service: 'SSH Remote Login Protocol'),
         (Port: 23; Service: 'TELNET'),
         (Port: 25; Service: 'SMTP - Simple Mail Transfer Protocol '),
         (Port: 37; Service: 'TIME'),
         (Port: 38; Service: 'RAP - Route Access Protocol'),
         (Port: 39; Service: 'RLP - Resource Location Protocol'),
         (Port: 42; Service: 'NAMESERVER - Host Name Server'),
         (Port: 53; Service: 'DNS - Domain Name Server'),
         (Port: 66; Service: 'Oracle SQL*NET'),
         (Port: 67; Service: 'BOOTP Server'),
         (Port: 68; Service: 'BOOTP Client'),
         (Port: 69; Service: 'Trivial FTP'),
         (Port: 70; Service: 'GOPHER'),
         (Port: 79; Service: 'FINGER'),
         (Port: 80; Service: 'HTTP - Hyper Text Transfer Protocol'),
         (Port: 88; Service: 'KERBEROS'),
         (Port: 101; Service: 'NIC Host Name Server'),
         (Port: 109; Service: 'POP2 - Post Office Protocol 2'),
         (Port: 110; Service: 'POP3 - Post Office Protocol 3'),
         (Port: 113; Service: 'IDENT - Authentication Service'),
         (Port: 115; Service: 'SFTP - Simple File Transfer Protocol'),
         (Port: 119; Service: 'Network News Transfer Protocol (NNTP)'),
         (Port: 123; Service: 'Network Time Protocol (NTP)'),
         (Port: 135; Service: 'Location Service (RPC) - EPMAP'),
         (Port: 137; Service: 'NETBIOS Name Service'),
         (Port: 138; Service: 'NETBIOS Datagram Service'),
         (Port: 139; Service: 'NETBIOS Session Service'),
         (Port: 161; Service: 'SNMP - Simple Network Management Protocol'),
         (Port: 194; Service: 'IRC - Internet Relay Chat Protocol'),
         (Port: 213; Service: 'IPX'),
         (Port: 443; Service: 'HTTPS - Hyper Text Transfer Protocol Secure'),
         (Port: 445; Service: 'Microsoft-DS'),
         (Port: 500; Service: 'Isakmp'),
         (Port: 523; Service: 'IBM-DB2'),
         (Port: 524; Service: 'NCP'),
         (Port: 525; Service: 'Timeserver'),
         (Port: 1433; Service: 'Microsoft SQL Server'),
         (Port: 1434; Service: 'Microsoft SQL Monitor'),
         (Port: 1512; Service: 'WINS - Windows Internet Name Service'),
         (Port: 1801; Service: 'Microsoft Message Queue'),
         (Port: 1863; Service: 'MSNP'),
         (Port: 2234; Service: 'Directplay'),
         (Port: 3389; Service: 'Microsoft Term Server'),
         (Port: 5000; Service: 'Universal Plug & Play'),
         (Port: 42424; Service: '.NET State Server'),
         (Port: 8787; Service: 'Back Orifice 2000'), // And now some trojans
         (Port: 31337; Service: 'Back Orifice 2000 Russian'),
         (Port: 31338; Service: 'Back Orifice'),
         (Port: 54283; Service: 'Back Orifice 2000'),
         (Port: 54320; Service: 'Back Orifice 2000'),
         (Port: 54321; Service: 'Back Orifice 2000')
         );
   begin
      Result := IntToStr(Port); // If the port isn't "well known"! :-)
      for i := Low(WellKnownPorts) to High(WellKnownPorts) do // Iterate through well ports
         if WellKnownPorts[i].Port = Port then
         begin
            Result := WellKnownPorts[i].Service;
            Break;
         end;
   end;

   function GetName(Addr, Port: DWORD; Local: Boolean): string; // Get address name
   var
      MyAddress: in_addr;
      ServEnt: PServEnt;
      HostEnt: PHostEnt;

      function GetLocalHost: string; // Get localhost
      var
         Size: DWORD;

         function StrLen(const Str: PChar): Cardinal; assembler; // String length
         asm
          MOV     EDX,EDI
          MOV     EDI,EAX
          MOV     ECX,0FFFFFFFFH
          XOR     AL,AL
          REPNE   SCASB
          MOV     EAX,0FFFFFFFEH
          SUB     EAX,ECX
          MOV     EDI,EDX
         end;

         function LowerCase(const S: string): string; // Put a string lowercase
         var
            Ch: Char;
            L: Integer;
            Source, Dest: PChar;
         begin
            L := Length(S);
            SetLength(Result, L);
            Source := Pointer(S);
            Dest := Pointer(Result);
            while L <> 0 do
            begin
               Ch := Source^;
               if (Ch >= 'A') and (Ch <= 'Z') then
                  Inc(Ch, 32);
               Dest^ := Ch;
               Inc(Source);
               Inc(Dest);
               Dec(L);
            end;
         end;

      begin
         Size := 1024;
         SetLength(Result, Size);
         GetComputerName(PChar(Result), Size);
         SetLength(Result, StrLen(PChar(Result)));
         Result := LowerCase(Result);
      end;

   begin
      MyAddress.s_addr := Addr;
      Result := inet_ntoa(MyAddress); // Set default result
      if Local or (Addr = 0) then // Local address
      begin
         ServEnt := GetServByPort(Port, nil);
         if ServEnt <> nil then
            Result := GetLocalHost + ':' + ServEnt^.s_name + '(' + ServEnt^.s_proto + ')'
         else
            Result := GetLocalHost + ':' + PortDescription(htons(Port));
      end
      else // Remote address
      begin
         HostEnt := GetHostByAddr(PChar(@Addr), SizeOf(DWORD), AF_INET);
         if HostEnt <> nil then
            Result := HostEnt^.h_name + ':' + IntToStr(htons(Port))
         else
            Result := Result + ':' + PortDescription(htons(word(Port)));
      end;
   end;

   // Convert PID to ProcessName
   function ProcessName(CurrentSnapShot: Thandle; PID: DWORD): string;
   var
      Entry: TProcessEntry32;
   begin
      if not Process32First(CurrentSnapShot, Entry) then
         Result := '?'
      else
         repeat
            if Entry.th32ProcessID = PID then
               Result := Entry.szExeFile;
         until not Process32Next(CurrentSnapShot, Entry);
   end;

begin
   LockWindowUpdate(Window); // Locks updates
   CurrentRow := SendMessage(ConnList, LVM_GETNEXTITEM, -1, LVNI_SELECTED); // Save current selection
   DeleteAllItems(ConnList); // Clear the list
   Connections := 0; // Zero connections
   TableRow.mask := LVIF_TEXT or LVIF_STATE; // Set properties
   if AdvancedAPI then // Windows XP and higher
   begin
      try
         Error := AllocateAndGetTcpExTableFromStack(@TcpTableEx, TRUE, GetProcessHeap(), 2, 2); // Get TCPTABLE
         SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); // Get process snapshot
         if Error = 0 then // If we have a correct TcpTable then we can process it
            for i := 0 to TcpTableEx.dwNumEntries - 1 do
            begin
               if TcpTableEx.Table[i].dwRemoteAddr = 0 then
                  TcpTableEx.Table[i].dwRemotePort := 0;
               TableRow.iItem := i; // Set item counter
               InsertItem(ConnList, TableRow); // Add a new row. Following lines of code process TcpTable and send output to Listview
               SetItemText(ConnList, i, 0, pchar(ProcessName(Snapshot, TcpTableEx.Table[i].dwProcessId) + ':' + inttostr(TcpTableEx.Table[i].dwProcessId)));
               SetItemText(ConnList, i, 1, pchar(GetName(TcpTableEx.Table[i].dwLocalAddr, TcpTableEx.Table[i].dwLocalPort, TRUE)));
               SetItemText(ConnList, i, 2, pchar(GetName(TcpTableEx.Table[i].dwRemoteAddr, TcpTableEx.Table[i].dwRemotePort, FALSE)));
               SetItemText(ConnList, i, 3, 'TCP');
               SetItemText(ConnList, i, 4, pchar(TCPConnState[TcpTableEx.Table[i].dwState]));
            end;
         Base := TcpTableEx.dwNumEntries; // Keep counting from BASE
         Error := AllocateAndGetUdpExTableFromStack(@UdpTableEx, TRUE, GetProcessHeap(), 2, 2); // Get UdpTable
         if Error = 0 then // Is it ok?
            for i := 0 to UdpTableEx.dwNumEntries - 1 do
            begin
               TableRow.iItem := i + Base; // It's the same old soup
               InsertItem(ConnList, TableRow);
               SetItemText(ConnList, i + Base, 0, pchar(ProcessName(Snapshot, UdpTableEx.UDPTable[i].dwProcessId) + ':' + inttostr(UdpTableEx.UDPTable[i].dwProcessId)));
               SetItemText(ConnList, i + Base, 1, pchar(GetName(UdpTableEx.UDPTable[i].dwLocalAddr, UdpTableEx.UDPTable[i].dwLocalPort, TRUE)));
               SetItemText(ConnList, i + Base, 2, '*:*');
               SetItemText(ConnList, i + Base, 3, 'UDP');
               SetItemText(ConnList, i + Base, 4, '-');
            end;
      finally
         LockWindowUpdate(0);
         Connections := UdpTableEx.dwNumEntries + TcpTableEx.dwNumEntries;
         // HeapFree(GetProcessHeap, 0, TcpTableEx); // Free precious resources
         // HeapFree(GetProcessHeap, 0, UdpTableEx); // Free precious resources
      end;
   end
   else // Standard API
   begin
      TableSize := 0;
      Error := GetTCPTable(nil, @TableSize, False);
      if Error <> ERROR_INSUFFICIENT_BUFFER then
         Exit;
      try
         GetMem(TcpTable, TableSize);
         if GetTCPTable(TcpTable, @TableSize, TRUE) = NO_ERROR then
            for i := 0 to TcpTable.dwNumEntries - 1 do
            begin
               if TcpTable.Table[i].dwRemoteAddr = 0 then
                  TcpTable.Table[i].dwRemotePort := 0;
               TableRow.iItem := i; // Set item counter
               InsertItem(ConnList, TableRow); // Add a new row. Following lines of code process TcpTable and send output to Listview
               SetItemText(ConnList, i, 0, 'Not supported');
               SetItemText(ConnList, i, 1, pchar(GetName(TcpTable.Table[i].dwLocalAddr, TcpTable.Table[i].dwLocalPort, TRUE)));
               SetItemText(ConnList, i, 2, pchar(GetName(TcpTable.Table[i].dwRemoteAddr, TcpTable.Table[i].dwRemotePort, FALSE)));
               SetItemText(ConnList, i, 3, 'TCP');
               SetItemText(ConnList, i, 4, pchar(TCPConnState[TcpTable.Table[i].dwState]));
            end;
         Base := TcpTable.dwNumEntries;
         TableSize := 0;
         Error := GetUDPTable(nil, @TableSize, False);
         if Error <> ERROR_INSUFFICIENT_BUFFER then
            Exit;
         GetMem(UdpTable, TableSize);
         if GetUDPTable(UdpTable, @TableSize, TRUE) = NO_ERROR then
            for i := 0 to UdpTable.dwNumEntries - 1 do
            begin
               TableRow.iItem := i + Base; // It's the same old soup
               InsertItem(ConnList, TableRow);
               SetItemText(ConnList, i + Base, 0, 'Not supported');
               SetItemText(ConnList, i + Base, 1, pchar(GetName(UdpTable.UDPTable[i].dwLocalAddr, UdpTable.UDPTable[i].dwLocalPort, TRUE)));
               SetItemText(ConnList, i + Base, 2, '*:*');
               SetItemText(ConnList, i + Base, 3, 'UDP');
               SetItemText(ConnList, i + Base, 4, '-');
            end;
      finally
         LockWindowUpdate(0);
         Connections := UdpTable.dwNumEntries + TcpTable.dwNumEntries;
         //FreeMem(TcpTable);
         //FreeMem(UdpTable);
      end;
   end;
   // Restore selection if number of items is greater or equal to the previous value:
   if SendMessage(ConnList, LVM_GETITEMCOUNT, 0, 0) >= CurrentRow then
      SetItemState(ConnList, CurrentRow, LVNI_SELECTED, LVNI_SELECTED);
   SetTimer(Window, UPDATETABLE, UpdateMsDelay * Connections, nil); // Set new delay
end;

// About box - (C) 2003-2005 Salvatore Meschini

function About(Dialog: HWnd; AMessage, WParam: UINT;
   LParam: LPARAM): Bool; stdcall;
begin
   Result := True;
   case AMessage of
      WM_INITDIALOG: Exit;

      WM_COMMAND:
         if (WParam = idOk) or (WParam = idCancel) then
         begin
            EndDialog(Dialog, 1);
            Exit;
         end;
   end;
   Result := False;
end;

// After several checks (see below) we can call this function

function CloseConnection(Row: Integer): integer;
var
   kRow: TMibTCPRow;
   kRowEx: TMibTCPRowEx; // Microsoft use it for undocumented function SetTcpEntryToStack?
begin
   if AdvancedApi then
   begin
      kRowEx := TcpTableEx.Table[Row];
      // Now "convert" it to standard kRow:
      kRow.dwLocalPort := kRowEx.dwLocalPort;
      kRow.dwLocalAddr := kRowEx.dwLocalAddr;
      kRow.dwRemotePort := kRowEx.dwRemotePort;
      kRow.dwRemoteAddr := kRowEx.dwRemoteAddr;
   end
   else
      kRow := TcpTable.Table[Row];
   kRow.dwState := 12; // MIB_TCP_STATE_DELETE_TCB = 12
   Result := SetTcpEntry(kRow); // Close it!
end;

// This routing calls CloseConnection with R=selected row

procedure CloseSelectedConnection;
var
   Res: Integer;
begin
   CurrentRow := SendMessage(ConnList, LVM_GETNEXTITEM, -1, LVNI_SELECTED); // Which row?
   if CurrentRow = -1 then
      MessageBox(0, SelectConnection, 'Error', MB_OK or MB_ICONERROR) // Please select a row!
   else
   begin
      if AdvancedApi then
        begin
         if Cardinal(CurrentRow) > TcpTableEx.dwNumEntries then // Windows XP
            Messagebox(0, ThisIsUdp, 'Error', MB_OK or MB_ICONERROR)
        end
         else
          begin
            if Cardinal(CurrentRow) > TcpTable.dwNumEntries then // Windows NT/2000
               Messagebox(0, ThisIsUdp, 'Error', MB_OK or MB_ICONERROR)
          end;
               if GetItemText(ConnList, CurrentRow, 4) <> 'Established' then // Is it established?
                  Messagebox(0, WrongStatus, 'Error', MB_OK or MB_ICONERROR)
               else
               begin // We can try to close it!
                  Res := CloseConnection(CurrentRow);
                  if Res <> NO_ERROR then // Something bad happened
                     MessageBox(0, pchar(ShowError(Res)), 'Error', MB_OK or MB_ICONERROR)
                  else
                     Sendmessage(ConnList, LVM_DELETEITEM, CurrentRow, 0); // Delete the row
               end;
   end;
end;

function WindowProc(Window: HWnd; AMessage, WParam: UINT;
   LParam: LPARAM): Longint; stdcall;
var
   AboutProc: TFarProc;
   R: TRect;
   I: Integer;

begin
   Result := 0;

   case AMessage of

      WM_COMMAND:
         if WParam = CM_ABOUT then
         begin // User requested information about Netstat32
            AboutProc := MakeProcInstance(@About, HInstance);
            DialogBox(HInstance, 'About', Window, AboutProc);
            FreeProcInstance(AboutProc);
            Exit;
         end;

      WM_DESTROY: // Destroy the window and remove the timer
         begin
            KillTimer(Window, UPDATETABLE);
            PostQuitMessage(0);
            Exit;
         end;

      WM_TIMER: // Timer event
         UpdateConnectionsTable; // Do the (dirty) job!

      WM_SIZE: // Size event
         begin
            GetClientRect(Window, R);
            MoveWindow(ConnList, 0, 0, R.right, R.bottom, True);
         end;

      WM_CREATE:
         begin
            // Try to import functions:
            AllocateAndGetTcpExTableFromStack := GetProcAddress(IpDll, 'AllocateAndGetTcpExTableFromStack');
            AllocateAndGetUdpExTableFromStack := GetProcAddress(IpDll, 'AllocateAndGetUdpExTableFromStack');
            GetTcpTable := GetProcAddress(IpDll, 'GetTcpTable');
            GetUdpTable := GetProcAddress(IpDll, 'GetUdpTable');
            SetTcpEntry := GetProcAddress(IpDll, 'SetTcpEntry');

            // It should work only with Windows XP
            if (Assigned(AllocateAndGetTcpExTableFromStack) and (Assigned(AllocateAndGetUdpExTableFromStack))) then
               AdvancedAPI := True
            else
               AdvancedAPI := False;

            // Create Listview
            ConnList := CreateWindowEx(WS_EX_STATICEDGE, WC_LISTVIEW, '', LVS_SHOWSELALWAYS or WS_VISIBLE or WS_CHILD or LVS_REPORT or LVS_SINGLESEL, 0, 0, 1, 1, Window, 0, hInstance, nil);
            // Create Columns automatically
            for I := 1 to 5 do
               with Column do
               begin
                  Mask := LVCF_TEXT or LVCF_SUBITEM or LVCF_WIDTH or LVCF_FMT;
                  iSubItem := I;
                  Cx := GetSystemMetrics(SM_CXSCREEN) div 5; // Fit columns
                  Fmt := 0; // LVCFMT_LEFT
                  pText := Pchar(ColTitles[I]); // Set title
                  InsertColumn(ConnList, I, Column); // Add the i-th column
               end;
            // Set properties
            SendMessage(ConnList, LVM_SETEXTENDEDLISTVIEWSTYLE, LVS_EX_FULLROWSELECT, LVS_EX_FULLROWSELECT); // LVM_SETEXTENDEDLISTVIEWSTYLE
            UpdateConnectionsTable; // First job
         end;
   end;

   Result := DefWindowProc(Window, AMessage, WParam, LParam);
end;

{ Register the Window Class }

function DoRegister: Boolean;
var
   WindowClass: TWndClass;
begin
   WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
   WindowClass.lpfnWndProc := @WindowProc;
   WindowClass.cbClsExtra := 0;
   WindowClass.cbWndExtra := 0;
   WindowClass.hInstance := HInstance;
   WindowClass.hIcon := LoadIcon(HInstance, 'WindowIcon');
   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
   WindowClass.hbrBackground := GetStockObject(White_Brush);
   WindowClass.lpszMenuName := 'WindowMenu';
   WindowClass.lpszClassName := AppName;

   Result := RegisterClass(WindowClass) <> 0;
end;

procedure InitCommonControls; external 'comctl32.dll' name 'InitCommonControls';

{ Create the Window Class }

function Create: HWnd;
begin
{$WARNINGS OFF}
   InitCommonControls;
   Result := CreateWindow(AppName,
      AppTitle,
      WS_OVERLAPPEDWINDOW,
      CW_USEDEFAULT,
      CW_USEDEFAULT,
      CW_USEDEFAULT,
      CW_USEDEFAULT,
      0,
      0,
      HInstance,
      nil);
{$WARNINGS ON}
end;

procedure SetUpdateDelay; // You can set an arbitrary delay, many connections require a "longer" delay
var
   Dummy: Integer;
begin
   UpdateMsDelay := 100; // Default value = 100ms - Global variable
   if paramcount = 1 then // You can specify a new value for UpdateMsDelay. Example: netstat32 250
   begin
      Val(paramstr(1), UpdateMsDelay, Dummy); // Try to set a new delay
      if Dummy <> 0 then
         UpdateMsDelay := 100; // Invalid Update Delay parameter
   end;
end;

begin
   SetUpdateDelay;
   IpDll := LoadLibrary(IpDLLName); // Check IPhlpAPI.DLL
   if IpDll = 0 then // DLL NOT FOUND!
      MessageBox(0, DllNotFound, 'Fatal error', MB_OK or MB_ICONERROR)
   else // DLL FOUND!
   begin
      if not DoRegister then
      begin
         MessageBox(0, RegisterFailed, nil, mb_Ok);
         Exit;
      end;
      Window := Create;
      if Window = 0 then
      begin
         MessageBox(0, CreateFailed, nil, mb_Ok);
         Exit;
      end;

      SetTimer(Window, UPDATETABLE, 1000, nil); // Initial delay = ONE second
      ShowWindow(Window, SW_MAXIMIZE);
      UpdateWindow(Window);

      while GetMessage(AMessage, 0, 0, 0) do
      begin
         if AMessage.Message = WM_KEYUP then // Close the selected connection if user press DEL
            if AMessage.WParam = VK_DELETE then
               CloseSelectedConnection;
         TranslateMessage(AMessage);
         DispatchMessage(AMessage);
      end;

      Halt(AMessage.wParam);
   end; // DLL not found
end.