[leon2009]

Здравствуйте! как зная PID вывести все соединение программы?

Код:

function RunCommandAndCaptureOutput(const CmdLine: string; OutputLines: TStrings): Boolean;
var
  Security: TSecurityAttributes;
  ReadPipe, WritePipe: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Buffer: array[0..255] of Byte;
  BytesRead: DWORD;
  S: string;
begin
  Result := False;
  Security.nLength := SizeOf(TSecurityAttributes);
  Security.bInheritHandle := True;
  Security.lpSecurityDescriptor := nil;

  if not CreatePipe(ReadPipe, WritePipe, @Security, 0) then Exit;

  try
    ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
    StartupInfo.cb := SizeOf(StartupInfo);
    StartupInfo.hStdOutput := WritePipe;
    StartupInfo.hStdError := WritePipe;
    StartupInfo.dwFlags := STARTF_USESTDHANDLES;

    if not CreateProcess(nil, PChar(CmdLine), nil, nil, True,
      CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
      Exit;

    CloseHandle(WritePipe);

    S := '';
    repeat
      BytesRead := 0;
      ZeroMemory(@Buffer, SizeOf(Buffer));
      if ReadFile(ReadPipe, Buffer, SizeOf(Buffer), BytesRead, nil) then
      begin
        if BytesRead > 0 then
        begin
          S := S + String(PAnsiChar(@Buffer[0]));
        end;
      end;
    until BytesRead = 0;

    WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);

    // Разделяем строки
    OutputLines.Text := S;
    Result := True;
  finally
    CloseHandle(ReadPipe);
  end;
end;

Код:

procedure GetIPsByPID(PID: DWORD; Memo: TMemo);
var
  OutputLines: TStringList;
  Line: string;
  SearchStr: string;
  P: Integer;
begin
  Memo.Clear;
  // Запускаем netstat
  OutputLines := TStringList.Create;
  try
    if not RunCommandAndCaptureOutput('netstat -ano', OutputLines) then
    begin
      Memo.Lines.Add('Ошибка запуска netstat');
      Exit;
    end;

    // Ищем строки с нужным PID
    for Line in OutputLines do
    begin
      SearchStr := ' ' + IntToStr(PID) + ' ';
      if Pos(SearchStr, Line) > 0 then
      begin
        // В строке ищем IP-адреса
        // Обычно строки вида: TCP    192.168.1.2:12345   93.184.216.34:80   ESTABLISHED
        // Разделяем по пробелам
        // Можно парсить вручную или искать IP-адреса
        Memo.Lines.Add(Line);
      end;
    end;
  finally
    OutputLines.Free;
  end;
end;

Код:

GetIPsByPID(12156, Memo1);

у меня ошибка KERNELLBASE

[lmikle]

В предыдущем вопросе (https://delphisources.ru/forum/showt...077#post159077) я оставил константу TCP_TABLE_OWNER_PID_ALL при вызове GetExtendedTcpTable. В этом случае в ответе будет также заполнено поле dwOwningPid - там как раз PID процесса, установившего соединение. Соответсвенно, получи PID и просто отфильтруй нужные соединения.

[leon2009]

добавил: PID :=1234;
if dwOwningPid = PID then

может что то упустил

Код:

procedure TConnectionListener.ListOpenTCPConnections;
var
  TcpTable: PMIB_TCPTABLE_OWNER_PID;
  TableSize,PID: DWORD;
  i: Integer;
begin

  PID :=1234;// strtoint(form1.edit1.text);

  TableSize := 0;
  // First call to get the required buffer size
  GetExtendedTcpTable(nil, TableSize, True, AF_INET, {TCP_TABLE_BASIC_CONNECTIONS} TCP_TABLE_OWNER_PID_ALL, 0);

  // Allocate memory for the table
 GetMem(TcpTable, TableSize);
  try
    // Retrieve the TCP table
    if GetExtendedTcpTable(TcpTable, TableSize, True, AF_INET, {TCP_TABLE_BASIC_CONNECTIONS} TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
    begin
      SetLength(FIpTable,TcpTable.dwNumEntries);
      for i := 0 to TcpTable.dwNumEntries - 1 do
      begin
        with TcpTable.Table[i] do
        begin

         if dwOwningPid = PID then
         begin

          FIpTable[i].LocalAddr := Format('%d.%d.%d.%d:%d', [
            dwLocalAddr and $FF,
            (dwLocalAddr shr 8) and $FF,
            (dwLocalAddr shr 16) and $FF,
            (dwLocalAddr shr 24) and $FF,
            ntohs(dwLocalPort)
          ]);

          FIpTable[i].RemoteAddr := Format('%d.%d.%d.%d:%d', [
            dwRemoteAddr and $FF,
            (dwRemoteAddr shr 8) and $FF,
            (dwRemoteAddr shr 16) and $FF,
            (dwRemoteAddr shr 24) and $FF,
            ntohs(dwRemotePort)
          ]);
        end;
      end;
      end;
    end
    else
      Begin
        SetLength(FIpTable,1);
        FIpTable[0].LocalAddr := 'Error';
        FIpTable[0].RemoteAddr := 'Error';
      End;
  finally
    FreeMem(TcpTable);
  end;
end;

[leon2009]

вот что выдает

PID: 832, Local: 0.0.0.0:135, Remote: 0.0.0.0:0

[lmikle]

1. Еще раз - фильтровать лучше на "клиентской" стороне, т.е. там, где ты выводишь.
2. надо посмотреть, может PID тоже надо конвертировать с помощью ntohs
3. Ну и что такого, открыт листенер на 135 порт, но никто туда не подключался еще, хотя конечно 0.0.0.0 смотрится странно.

[leon2009]

Код:

GetExtendedTcpTable(nil, TableSize, True, AF_INET, TCP_TABLE_BASIC_CONNECTIONS {TCP_TABLE_OWNER_PID_ALL}, 0); 
if GetExtendedTcpTable(TcpTable, TableSize, True, AF_INET, TCP_TABLE_BASIC_CONNECTIONS {TCP_TABLE_OWNER_PID_ALL}, 0) = NO_ERROR then

Код:

  FIpTable[i].LocalAddr := Format('%d.%d.%d.%d:%d:PID:%d', [
            dwLocalAddr and $FF,
            (dwLocalAddr shr 8) and $FF,
            (dwLocalAddr shr 16) and $FF,
            (dwLocalAddr shr 24) and $FF,
            ntohs(dwLocalPort), dwOwningPid
          ]);

          FIpTable[i].RemoteAddr := Format('%d.%d.%d.%d:%d:PID:%d', [
            dwRemoteAddr and $FF,
            (dwRemoteAddr shr 8) and $FF,
            (dwRemoteAddr shr 16) and $FF,
            (dwRemoteAddr shr 24) and $FF,
            ntohs(dwRemotePort) , dwOwningPid
          ]);

и вывод: UNIT1

Код:

begin
  IpTableLocker.Enter;
  Memo1.Lines.BeginUpdate;
  Try
    Memo1.Lines.Clear;
    for I := 0 to FThread.Count-1 do
      Memo1.Lines.Add(Format('%s <=> %s',[FThread.IpTable[i].LocalAddr,FThread.IpTable[i].RemoteAddr,FThread.IpTable[i].PidAddr]));
          Finally
    Memo1.Lines.EndUpdate;
    IpTableLocker.Leave;
  End;

проверка:

Код:

if FThread.IpTable[i].PidAddr=1111 then Memo1.Lines.Add(Format('%s <=> %s',[FThread.IpTable[i].LocalAddr,FThread.IpTable[i].RemoteAddr]));

[leon2009]

0.0.0.0 выводил потому что

Код:

TCP_TABLE_BASIC_CONNECTIONS {TCP_TABLE_OWNER_PID_ALL}

делал

Код:

{TCP_TABLE_BASIC_CONNECTIONS} TCP_TABLE_OWNER_PID_ALL