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

Previous  Top  Next

    
 

 

Code:

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

//

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

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

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

Автор: Rouse_

©Drkb::03358