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.