Ага, то, что выдает ИИ просто так не работает, надо допиливать напильником. При этом ИИ выдает код для единичного снапшота, а соединения имеют особенность не только открываться, но и закрываться.
Вот пример реализации постоянного обновления списка соединений:
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.
Для синхронизации используется критическая секция (иначе в какой-то момент можно "вылететь" за размеры массива).
Ну и хранение таблицы сделал по простому. Если надо что-то фильтровать, сам допиши так, как тебе надо.