Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Имя процесса по порту [D6, D7, WinXP]


Sniron ©   (2004-10-14 19:21:00) 

Как узнать имя процесса который использует заданный порт?


Sniron   (2004-10-15 14:29:00) [1]

Пасибо, это лучше чем нечего!


Rouse_   (2004-10-15 09:31:00) [2]

Зы, код только для ХР и 2003 сервера, другие OS не поддерживаются...


Rouse_   (2004-10-15 09:29:00) [3]

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : Unit1
//  * Purpose   : Демо получения ТСР статистики
//  * Author    : Александр (Rouse_) Багель
//  * Version   : 1.01
//  ****************************************************************************
//

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Winsock;

const
 TH32CS_SNAPPROCESS  = $00000002;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 end;

 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;

 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;

 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;

 function GetTcpTable(pTCPTable: PTMibTCPTable; var pDWSize: DWORD;
   bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';

 function AllocateAndGetTcpExTableFromStack(pTCPExTable: PTMibTCPExTable;
   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';

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 Size: DWORD;
 TCPTable: PTMibTCPTable;
 I: DWORD;
begin
 GetMem(TCPTable, SizeOf(TMibTCPTable));
 try
   Size := 0;
   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
   for I := 0 to TCPTable^.dwNumEntries - 1 do
     Memo1.Lines.Add(Format('%15s: port %5d', [inet_ntoa(in_addr(TCPTable^.Table[I].dwLocalAddr)),
       TCPTable^.Table[I].dwLocalPort]));
 finally
   FreeMem(TCPTable);
 end;
end;

procedure TForm1.Button2Click(Sender: TObject);

 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;
 I: DWORD;
 hProcessSnap: THandle;
begin
 if AllocateAndGetTcpExTableFromStack(@TCPExTable, False, GetProcessHeap, 2, 2) = NO_ERROR then
 begin
   hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   if (hProcessSnap = INVALID_HANDLE_VALUE) then Exit;
   Memo1.Lines.Add(Format('%15s:| %5s | %20s | (%s)', ['Host', 'Port', 'Process name', 'ID']));
   Memo1.Lines.Add('==============================================================');
   for I := 0 to TCPExTable^.dwNumEntries - 1 do
     Memo1.Lines.Add(Format('%15s:| %5d | %20s | (%d)',
       [inet_ntoa(in_addr(TCPExTable^.Table[I].dwLocalAddr)),
       TCPExTable^.Table[I].dwLocalPort,
       ProcessPIDToName(hProcessSnap, TCPExTable^.Table[I].dwProcessID),
       TCPExTable^.Table[I].dwProcessID]));
 end;
end;

end.


Наверх

Титульная страница Поиск, карта сайта Написать письмо