Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.01.02;
Скачать: CL | DM;

Вниз

Имя процесса по порту   Найти похожие ветки 

 
Sniron   (2004-10-14 19:21) [0]

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


 
Rouse_ ©   (2004-10-15 09:29) [1]

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


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

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


 
Sniron ©   (2004-10-15 14:29) [3]

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



Страницы: 1 вся ветка

Текущий архив: 2005.01.02;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.05 c
1-1103273196
hooch
2004-12-17 11:46
2005.01.02
Форма в качестве фрейма


14-1102802617
by
2004-12-12 01:03
2005.01.02
Что-то затронуло ...


3-1101976169
Sholoma
2004-12-02 11:29
2005.01.02
MySQL


14-1102662547
Cosinus
2004-12-10 10:09
2005.01.02
Как разметить диск под FAT32, если он сейчас NTFS? Под ДОС.


14-1103029609
Кудесник
2004-12-14 16:06
2005.01.02
Ошибка 500...