////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * 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 Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;

      stdcall; external 'KERNEL32.DLL' name 'Process32NextW';

 

  {$ENDIF}

 

var

  Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

// Получение TCP/UDP статистики при помощи стандартных методов

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}

 

// Получение TCP/UDP статистики при помощи недокументрированных методов

// Работает только на ХР или 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 Process32Next(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.