Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Получение TCP/UDP статистики

01.01.2007
////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * 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.

 
 

Проект также доступен по адресу: http://rouse.front.ru/tcpstat.zip

Взято из https://forum.sources.ru

Автор: Rouse_