[leon2009]

Здравствуйте! Может кто подсказать как вывести список интернет соединений? пр: открываю сайт https://delphisources.ru = он мне в memo1 его ip адрес или отправил в чат сообщение или мне отправили, то memo ip адрес ии выдает = но я не могу разобраться .

Код:

procedure ListTCPConnections;
var
  TCPTable: PMIB_TCPTABLE_OWNER_PID;
  TableSize, i: DWORD;
  ConnInfo: PMIB_TCPROW_OWNER_PID;
begin
  TableSize := 0;
  // Получаем размер таблицы
  GetExtendedTcpTable(nil, TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0);
  GetMem(TCPTable, TableSize);
  try
    if GetExtendedTcpTable(TCPTable, TableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
    begin
      for i := 0 to TCPTable.dwNumEntries - 1 do
      begin
        ConnInfo := @TCPTable.Table[i];
        Writeln(Format('Local: %s:%d, Remote: %s:%d, State: %d, PID: %d',
          [inet_ntoa(ConnInfo.dwLocalAddr), ntohs(ConnInfo.dwLocalPort),
           inet_ntoa(ConnInfo.dwRemoteAddr), ntohs(ConnInfo.dwRemotePort),
           ConnInfo.dwState, ConnInfo.dwOwningPid]));
      end;
    end;
  finally
    FreeMem(TCPTable);
  end;
end;

Спасибо!

[lmikle]

Ага, то, что выдает ИИ просто так не работает, надо допиливать напильником. При этом ИИ выдает код для единичного снапшота, а соединения имеют особенность не только открываться, но и закрываться.
Вот пример реализации постоянного обновления списка соединений:

1. Поток, который раз 0.5 секунды (можно поменяит в Sleep) получает данные о соединениях:

Код:

unit Unit2;

interface

uses
  Windows, System.Classes, System.SyncObjs;

type
  TIpTableItem = record
    LocalAddr : String;
    RemoteAddr : String;
  end;

  TConnectionListener = class(TThread)
  private
    { Private declarations }
    FIpTable : Array Of TIpTableItem;
    function GetItem(Index: Integer): TIpTableItem;
    function GetCount: Integer;
    procedure ListOpenTCPConnections;
  protected
    procedure Execute; override;
  public
    property Count : Integer read GetCount;
    property IpTable[Index : Integer] : TIpTableItem read GetItem;
  end;

var
  IpTableLocker : TCriticalSection;

implementation

uses
  IpHlpApi, TlHelp32, WinSock, SysUtils;

const
  TCP_TABLE_BASIC_CONNECTIONS = 1; // Table class for basic TCP connections
  TCP_TABLE_OWNER_PID_ALL = 5; // Table class for all TCP connections with PIDs
  AF_INET = 2; // IPv4
  AF_INET6 = 23; // IPv6

type
  MIB_TCPROW_OWNER_PID = 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 = record
    dwNumEntries: DWORD;
    table: array[0..0] of MIB_TCPROW_OWNER_PID;
  end;

function GetExtendedTcpTable(pTcpTable: Pointer; var pdwSize: DWORD; bOrder: BOOL;
  ulAf: ULONG; TableClass: DWORD; Reserved: ULONG): DWORD; stdcall;
  external 'iphlpapi.dll';

{ TConnectionListener }

procedure TConnectionListener.Execute;
begin
  While Not Terminated Do
    Begin
      IpTableLocker.Enter;
      Try
        ListOpenTCPConnections;
      Finally
        IpTableLocker.Leave;
      End;
      Sleep(500);
    End;
end;

procedure TConnectionListener.ListOpenTCPConnections;
var
  TcpTable: PMIB_TCPTABLE_OWNER_PID;
  TableSize: DWORD;
  i: Integer;
begin
  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
          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
    else
      Begin
        SetLength(FIpTable,1);
        FIpTable[0].LocalAddr := 'Error';
        FIpTable[0].RemoteAddr := 'Error';
      End;
  finally
    FreeMem(TcpTable);
  end;
end;

function TConnectionListener.GetCount: Integer;
begin
  Result := Length(FIpTable);
end;

function TConnectionListener.GetItem(Index: Integer): TIpTableItem;
begin
  Result := FIpTable[Index];
end;

initialization
  IpTableLocker := TCriticalSection.Create;

finalization
  IpTableLocker.Free;

end.

2. А это основная программа, которая и выводит соединения в Memo:

Код:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Unit2, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FThread : TConnectionListener;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FThread := TConnectionListener.Create(True);
  FThread.FreeOnTerminate := False;
  FThread.Start;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FThread.Terminate;
  FThread.WaitFor;
  FThread.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  I : Integer;
begin
  Timer1.Enabled := False;
  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]));
  Finally
    Memo1.Lines.EndUpdate;
    IpTableLocker.Leave;
    Timer1.Enabled := True;
  End;
end;

end.

Для синхронизации используется критическая секция (иначе в какой-то момент можно "вылететь" за размеры массива).
Ну и хранение таблицы сделал по простому. Если надо что-то фильтровать, сам допиши так, как тебе надо.

[leon2009]

у меня ошибки: за пределы я уже понял как выходить:

Код:

 with TcpTable.Table[i] do

но может это проблема в windows
127.0.0.1 <=>127.0.0.1 и все все остальное пустое

Local: 127.0.0.1:49684 | Remote: 127.0.0.1:50327

а может и где ни будь я потерялся

Код:

procedure TForm1.ShowExternalAddresses;
var
  i: Integer;
  Item: TIpTableItem;
begin
  Memo1.Lines.Clear;
  for i := 0 to FThread.Count - 1 do
  begin
    Item := FThread.IpTable[i];
    Memo1.Lines.Add('Local: ' + Item.LocalAddr + ' | Remote: ' + Item.RemoteAddr);
  end;
end;



procedure TForm1.ConnectionsMemo;
var
  i: Integer;
begin
  Memo1.Lines.Clear;
  for i := 0 to FThread.Count - 1 do
  begin
    if (FThread.IpTable[i].LocalAddr <> '') and
       (FThread.IpTable[i].RemoteAddr <> '') then
      Memo1.Lines.Add('Local: ' + FThread.IpTable[i].LocalAddr +  ' | Remote: ' + FThread.IpTable[i].RemoteAddr);
  end;
end;

и

Код:

procedure TConnectionListener.ListOpenTCPConnections;
var
  TcpTable: PMIB_TCPTABLE_OWNER_PID;
  TableSize: DWORD;
  Res: DWORD;
  i: Integer;
begin
  TcpTable := nil;
  TableSize := 0;

  Res := GetExtendedTcpTable(nil, TableSize, True, AF_INET, TCP_TABLE_BASIC_CONNECTIONS, 0);
  if Res <> ERROR_INSUFFICIENT_BUFFER then
  begin
    SetLength(FIpTable, 1);
    FIpTable[0].LocalAddr := 'Error';
    FIpTable[0].RemoteAddr := 'Error';
    Exit;
  end;

  GetMem(TcpTable, TableSize);
  try
    Res := GetExtendedTcpTable(TcpTable, TableSize, True, AF_INET, TCP_TABLE_BASIC_CONNECTIONS, 0);
    if Res = NO_ERROR then
    begin
      SetLength(FIpTable, TcpTable.dwNumEntries);
      for i := 0 to TcpTable.dwNumEntries - 1 do
      begin
        with TcpTable.Table[i] do
        begin
          // Фильтр: пропускаем соединения с локальным IP 127.0.0.1 или 0.0.0.0
          if (dwRemoteAddr <> 0) and
             (dwRemoteAddr <> (127 shl 24 + 1)) then // 127.0.0.1
          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
          else
          begin
            // Помечаем как "скрыто" или пропускаем
            FIpTable[i].LocalAddr := '';
            FIpTable[i].RemoteAddr := '';
          end;
        end;
      end;
    end
    else
    begin
      SetLength(FIpTable, 1);
      FIpTable[0].LocalAddr := 'Error';
      FIpTable[0].RemoteAddr := 'Error';
    end;
  finally
    FreeMem(TcpTable);
  end;
end;

[leon2009]

[lmikle]

Это ты где-то накосячил.
Про выход за пределы массива - я ж не зря использовал критическую секцию и в потоке, и в основном коде.

По поводу фильтрации.
Я бы фильтровал в основной программе, а код листенера оставил бы как есть, пусть выгребает все, а уж что отображать можно решить в основной программе. Например так:

Код:

procedure TForm1.ConnectionsMemo;
var
  i: Integer;
begin
  Memo1.Lines.Clear;
  for i := 0 to FThread.Count - 1 do
  begin
    if (Pos('127.0.0',FThread.IpTable[i].LocalAddr) <> 0) And
       (Pos('127.0.0',FThread.IpTable[i].RemoteAddr) <> 0) then
      Memo1.Lines.Add('Local: ' + FThread.IpTable[i].LocalAddr +  ' | Remote: ' + FThread.IpTable[i].RemoteAddr);
  end;
end;

В принципе, можно в потоке в массив сохранять не сроку, а "разобранный" адрес и тогда сравнивать уже целые значения.