////////////////////////////////////////////////////////////////////////////////
//
// ****************************************************************************
// * Unit Name : Unit1
// * Purpose : Демо получения ТСР статистики
// * Author : Александр (Rouse_) Багель
// * Version : 1.03
// ****************************************************************************
//
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Winsock;
// так как в примере используются недокументированные функции присутствующие
// только в ХР и выше - то часть кода сделал через директивы компилятора
// (лень было делать динамическую загрузку)
// Если они вам нужны раскоментируйте директиву USES_NATIVE_API
{.$DEFINE USES_NATIVE_API}
const
 TH32CS_SNAPPROCESS = $00000002;
 // Константы состояний порта
 MIB_TCP_STATE_CLOSED = 1;
 MIB_TCP_STATE_LISTEN = 2;
 MIB_TCP_STATE_SYN_SENT = 3;
 MIB_TCP_STATE_SYN_RCVD = 4;
 MIB_TCP_STATE_ESTAB = 5;
 MIB_TCP_STATE_FIN_WAIT1 = 6;
 MIB_TCP_STATE_FIN_WAIT2 = 7;
 MIB_TCP_STATE_CLOSE_WAIT = 8;
 MIB_TCP_STATE_CLOSING = 9;
 MIB_TCP_STATE_LAST_ACK = 10;
 MIB_TCP_STATE_TIME_WAIT = 11;
 MIB_TCP_STATE_DELETE_TCB = 12;
type
 TForm1 = class(TForm)
  Memo1: TMemo;
  Button1: TButton;
  Button2: TButton;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
  function PortStateToStr(const State: DWORD): String;
 end;
 // Стандартная структура для получения ТСР статистики
 PTMibTCPRow = ^TMibTCPRow;
 TMibTCPRow = packed record
  dwState: DWORD;
  dwLocalAddr: DWORD;
  dwLocalPort: DWORD;
  dwRemoteAddr: DWORD;
  dwRemotePort: DWORD;
 end;
 // В данную структуру будет передаваться результат GetTcpTable
 PTMibTCPTable = ^TMibTCPTable;
 TMibTCPTable = packed record
  dwNumEntries: DWORD;
  Table: array[0..0] of TMibTCPRow;
 end;
 // Стандартная структура для получения UDP статистики
 PTMibUdpRow = ^TMibUdpRow;
 TMibUdpRow = packed record
  dwLocalAddr: DWORD;
  dwLocalPort: DWORD;
 end;
 // В данную структуру будет передаваться результат GetUDPTable
 PTMibUdpTable = ^TMibUdpTable;
 TMibUdpTable = packed record
  dwNumEntries: DWORD;
  table: array [0..0] of TMibUdpRow;
 end;

 {$IFDEF USES_NATIVE_API}
  // Расширенные варианты данных структур
  PTMibTCPExRow = ^TMibTCPExRow;
  TMibTCPExRow = packed record
  dwState: DWORD;
  dwLocalAddr: DWORD;
  dwLocalPort: DWORD;
  dwRemoteAddr: DWORD;
  dwRemotePort: DWORD;
  dwProcessID: DWORD;
  end;
  PTMibTCPExTable = ^TMibTCPExTable;
  TMibTCPExTable = packed record
  dwNumEntries: DWORD;
  Table: array[0..0] of TMibTCPExRow;
  end;
  PTMibUdpExRow = ^TMibUdpExRow;
  TMibUdpExRow = packed record
  dwLocalAddr: DWORD;
  dwLocalPort: DWORD;
  dwProcessID: DWORD;
  end;
  PTMibUdpExTable = ^TMibUdpExTable;
  TMibUdpExTable = packed record
  dwNumEntries: DWORD;
  table: array [0..0] of TMibUdpExRow;
  end;
  // Структура для получения списка текущий процессов и их параметров
  TProcessEntry32 = packed record
  dwSize: DWORD;
  cntUsage: DWORD;
  th32ProcessID: DWORD;
  th32DefaultHeapID: DWORD;
  th32ModuleID: DWORD;
  cntThreads: DWORD;
  th32ParentProcessID: DWORD;
  pcPriClassBase: Longint;
  dwFlags: DWORD;
  szExeFile: array [0..MAX_PATH - 1] of WideChar;
  end;
 {$ENDIF}
 function GetTcpTable(pTCPTable: PTMibTCPTable; var pDWSize: DWORD;
  bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
 function GetUdpTable(pUDPTable: PTMibUDPTable; var pDWSize: DWORD;
  bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
 {$IFDEF USES_NATIVE_API}
  function AllocateAndGetTcpExTableFromStack(pTCPExTable: PTMibTCPExTable;
  bOrder: BOOL; heap: THandle; zero: DWORD; flags: DWORD): DWORD; stdcall;
  external 'IPHLPAPI.DLL';
  function AllocateAndGetUdpExTableFromStack(pUDPExTable: PTMibUDPExTable;
  bOrder: BOOL; heap: THandle; zero: DWORD; flags: DWORD): DWORD; stdcall;
  external 'IPHLPAPI.DLL';
  function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle;
  stdcall; external 'KERNEL32.DLL';
  function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
  stdcall; external 'KERNEL32.DLL' name 'Process32FirstW';
  function Process32(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;
  stdcall; external 'KERNEL32.DLL' name 'Process32W';
 {$ENDIF}
var
 Form1: TForm1;
implementation
{$R *.dfm}
// при помощи стандартных методов
procedure TForm1.Button1Click(Sender: TObject);
var
 Size: DWORD;
 TCPTable: PTMibTCPTable;
 UDPTable: PTMibUdpTable;
 I: DWORD;
begin
 // для успешного получения стстаистики первоначально необходимо определиться
 // сколько памяти потребует данная операция
 // для этого делаем так:
 // Вделяем память под TCP таблицу (под один элемент)
 GetMem(TCPTable, SizeOf(TMibTCPTable));
 try
  // Показываем что памяти у нас не выделено
  Size := 0;
  // Выполняем функцию и после этого переменная Size
  // будет содержать кол-во необходимой памяти
  if GetTcpTable(TCPTable, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
 finally
  // освобождаем память занятую под один элемент
  FreeMem(TCPTable);
 end;
 // Теперь выделяем уже требуемое кол-во памяти
 GetMem(TCPTable, Size);
 try
  // Выполняем функцию
  if GetTcpTable(TCPTable, Size, True) = NO_ERROR then
  begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Standart TCP Stats');
  Memo1.Lines.Add(Format('%15s: | %5s %-12s', ['Host', 'Port', 'State']));
  Memo1.Lines.Add('==================================================');
  // и насинаем выводить данные по ТСР
  for I := 0 to TCPTable^.dwNumEntries - 1 do
  Memo1.Lines.Add(Format('%15s: | %5d %s', [inet_ntoa(in_addr(TCPTable^.Table[I].dwLocalAddr)),
  htons(TCPTable^.Table[I].dwLocalPort), PortStateToStr(TCPTable^.Table[I].dwState)]));
  end;
 finally
  // Не забываем освободить память
  FreeMem(TCPTable);
 end;
 // По аналогии поступаем и с UDP статистикой
 GetMem(UDPTable, SizeOf(TMibUDPTable));
 try
  Size := 0;
  if GetUdpTable(UDPTable, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
 finally
  FreeMem(UDPTable);
 end;
 GetMem(UDPTable, Size);
 try
  if GetUdpTable(UDPTable, Size, True) = NO_ERROR then
  begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Standart UDP Stats');
  Memo1.Lines.Add(Format('%15s: | %5s', ['Host', 'Port']));
  Memo1.Lines.Add('======================================');
  for I := 0 to UDPTable^.dwNumEntries - 1 do
  Memo1.Lines.Add(Format('%15s: | %5d', [inet_ntoa(in_addr(UDPTable^.Table[I].dwLocalAddr)),
  htons(UDPTable^.Table[I].dwLocalPort)]));
  end;
 finally
  FreeMem(UDPTable);
 end;
end;
{$IFNDEF USES_NATIVE_API}
procedure TForm1.Button2Click(Sender: TObject);
begin
 Memo1.Lines.Add('');
 Memo1.Lines.Add('USES_NATIVE_API are disabled.');
end;
{$ELSE}
// при помощи недокументрированных методов
// Работает только на ХР или Win 2003
procedure TForm1.Button2Click(Sender: TObject);
 // данная функция ищет процесс с th32ProcessID совпадающий с ProcessId
 // и возвращает его имя
 function ProcessPIDToName(const hProcessSnap: THandle; ProcessId: DWORD): String;
 var
  processEntry: TProcessEntry32;
 begin
  // Подготовительные действия
  Result := '';
  FillChar(processEntry, SizeOf(TProcessEntry32), #0);
  processEntry.dwSize := SizeOf(TProcessEntry32);
  // Прыгаем на первый процесс в списке
  if not Process32First(hProcessSnap, processEntry) then Exit;
  repeat
  // Сравнение
  if processEntry.th32ProcessID = ProcessId then
  begin
  // Если нашли нужный процесс - выводим результат и выходим
  Result := String(processEntry.szExeFile);
  Exit;
  end;
  // ищем пока не кончатся процессы
  until not Process32(hProcessSnap, processEntry);
 end;
var
 TCPExTable: PTMibTCPExTable;
 UDPExTable: PTMibUdpExTable;
 I: DWORD;
 hProcessSnap: THandle;
begin
 // для определения каким процессом открыт тот или иной порт
 // получаем список процессов
 hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 if (hProcessSnap = INVALID_HANDLE_VALUE) then
 begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('CreateToolhelp32Snapshot failed');
  Exit;
 end;
 try
  // Выполняем вот такую вот функцию
  // она не документтрованна, но как видно из названия - она сама выделяет необходимую для работы
  // память и нам остается только прочитать результат по завершении ее выполнения
  if AllocateAndGetTcpExTableFromStack(@TCPExTable, False, GetProcessHeap, 2, 2) = NO_ERROR then
  try
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Extended TCP Stats');
  Memo1.Lines.Add(Format('%15s: | %5s | %-12s | %20s | (%s)', ['Host', 'Port', 'State', 'Process name', 'ID']));
  Memo1.Lines.Add('==========================================================================');
  // начинаем выводить информацию
  for I := 0 to TCPExTable^.dwNumEntries - 1 do
  Memo1.Lines.Add(Format('%15s: | %5d | %-12s | %20s | (%d)',
  [inet_ntoa(in_addr(TCPExTable^.Table[I].dwLocalAddr)),
  htons(TCPExTable^.Table[I].dwLocalPort),
  PortStateToStr(TCPExTable^.Table[I].dwState),
  // Вот здесь у нас происходит сопоставление процесса открытому порту
  ProcessPIDToName(hProcessSnap, TCPExTable^.Table[I].dwProcessID),
  TCPExTable^.Table[I].dwProcessID]));
  finally
  // Не забываем освободить память занятую функцией
  GlobalFreePtr(TCPExTable);
  end;
  // По аналогии поступаем и с UDP статистикой
  if AllocateAndGetUdpExTableFromStack(@UDPExTable, False, GetProcessHeap, 2, 2) = NO_ERROR then
  try
  Memo1.Lines.Add('');
  Memo1.Lines.Add('Extended UDP Stats');
  Memo1.Lines.Add(Format('%15s: | %5s | %20s | (%s)', ['Host', 'Port', 'Process name', 'ID']));
  Memo1.Lines.Add('==============================================================');
  // начинаем выводить информацию
  for I := 0 to UDPExTable^.dwNumEntries - 1 do
  Memo1.Lines.Add(Format('%15s: | %5d | %20s | (%d)',
  [inet_ntoa(in_addr(UDPExTable^.Table[I].dwLocalAddr)),
  htons(UDPExTable^.Table[I].dwLocalPort),
  ProcessPIDToName(hProcessSnap, UDPExTable^.Table[I].dwProcessID),
  UDPExTable^.Table[I].dwProcessID]));
  finally
  GlobalFreePtr(UDPExTable);
  end;
 finally
  // Закрываем хэндл полученый от CreateToolhelp32Snapshot
  CloseHandle(hProcessSnap);
 end;
end;
{$ENDIF}
// Функция преобразует состояние порта в строковый эквивалент
function TForm1.PortStateToStr(const State: DWORD): String;
begin
 case State of
  MIB_TCP_STATE_CLOSED: Result := 'CLOSED';
  MIB_TCP_STATE_LISTEN: Result := 'LISTEN';
  MIB_TCP_STATE_SYN_SENT: Result := 'SYN SENT';
  MIB_TCP_STATE_SYN_RCVD: Result := 'SYN RECEIVED';
  MIB_TCP_STATE_ESTAB: Result := 'ESTABLISHED';
  MIB_TCP_STATE_FIN_WAIT1: Result := 'FIN WAIT 1';
  MIB_TCP_STATE_FIN_WAIT2: Result := 'FIN WAIT 2';
  MIB_TCP_STATE_CLOSE_WAIT: Result := 'CLOSE WAIT';
  MIB_TCP_STATE_CLOSING: Result := 'CLOSING';
  MIB_TCP_STATE_LAST_ACK: Result := 'LAST ACK';
  MIB_TCP_STATE_TIME_WAIT: Result := 'TIME WAIT';
  MIB_TCP_STATE_DELETE_TCB: Result := 'DELETE TCB';
 else
  Result := 'UNKNOWN';
 end;
end;

end.