Search code examples
delphinetwork-programmingdelphi-xe3ports

How to find out which port uses a process?


I would like to know how I can find out which ports a program / process uses. I want to know the used ports from one process and write then in a label.

Is there a unit or function that is available?


Solution

  • You can use the GetExtendedTcpTable function passing the TCP_TABLE_OWNER_PID_ALL TableClass value , this will return a MIB_TCPTABLE_OWNER_PID structure which is an array to the MIB_TCPROW_OWNER_PID record , this structure contains the port number (dwLocalPort) and the PID (dwOwningPid) of the process, you can resolve the name of the PID using the CreateToolhelp32Snapshot function.

    Sample

    {$APPTYPE CONSOLE}
    
    uses
      WinSock,
      TlHelp32,
      Classes,
      Windows,
      SysUtils;
    
    const
       ANY_SIZE = 1;
       iphlpapi = 'iphlpapi.dll';
       TCP_TABLE_OWNER_PID_ALL = 5;
    
    type
      TCP_TABLE_CLASS = Integer;
    
      PMibTcpRowOwnerPid = ^TMibTcpRowOwnerPid;
      TMibTcpRowOwnerPid  = packed record
        dwState     : DWORD;
        dwLocalAddr : DWORD;
        dwLocalPort : DWORD;
        dwRemoteAddr: DWORD;
        dwRemotePort: DWORD;
        dwOwningPid : DWORD;
        end;
    
      PMIB_TCPTABLE_OWNER_PID  = ^MIB_TCPTABLE_OWNER_PID;
      MIB_TCPTABLE_OWNER_PID = packed record
       dwNumEntries: DWORD;
       table: Array [0..ANY_SIZE - 1] of TMibTcpRowOwnerPid;
      end;
    
    var
       GetExtendedTcpTable:function  (pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL; lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWord; stdcall;
    
    
    function GetPIDName(hSnapShot: THandle; PID: DWORD): string;
    var
      ProcInfo: TProcessEntry32;
    begin
      ProcInfo.dwSize := SizeOf(ProcInfo);
      if not Process32First(hSnapShot, ProcInfo) then
         Result := 'Unknow'
      else
      repeat
        if ProcInfo.th32ProcessID = PID then
           Result := ProcInfo.szExeFile;
      until not Process32Next(hSnapShot, ProcInfo);
    end;
    
    procedure ShowTCPPortsUsed(const AppName : string);
    var
       Error      : DWORD;
       TableSize  : DWORD;
       i          : integer;
       pTcpTable  : PMIB_TCPTABLE_OWNER_PID;
       SnapShot   : THandle;
       LAppName   : string;
       LPorts     : TStrings;
    begin
      LPorts:=TStringList.Create;
      try
        TableSize := 0;
        //Get the size o the tcp table
        Error := GetExtendedTcpTable(nil, @TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0);
        if Error <> ERROR_INSUFFICIENT_BUFFER then exit;
    
        GetMem(pTcpTable, TableSize);
        try
         SnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
         try
           //get the tcp table data
           if GetExtendedTcpTable(pTcpTable, @TableSize, TRUE, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
              for i := 0 to pTcpTable.dwNumEntries - 1 do
              begin
                 LAppName:=GetPIDName(SnapShot, pTcpTable.Table[i].dwOwningPid);
                 if SameText(LAppName, AppName) and (LPorts.IndexOf(IntToStr(pTcpTable.Table[i].dwLocalPort))=-1) then
                   LPorts.Add(IntToStr(pTcpTable.Table[i].dwLocalPort));
              end;
         finally
           CloseHandle(SnapShot);
         end;
        finally
           FreeMem(pTcpTable);
        end;
    
        Writeln(LPorts.Text);
    
      finally
        LPorts.Free;
      end;
    
    end;
    
    var
       hModule : THandle;
    begin
      try
        hModule := LoadLibrary(iphlpapi);
        try
          GetExtendedTcpTable := GetProcAddress(hModule, 'GetExtendedTcpTable');
          ShowTCPPortsUsed('Skype.exe');
        finally
          FreeLibrary(hModule);
        end;
      except
        on E: Exception do
          Writeln(E.ClassName, ': ', E.Message);
      end;
      Readln;
    end.