Показать сообщение отдельно
  #2  
Старый 29.06.2025, 01:52
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,096
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

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

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.

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