unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function GetTcpConnections: string;
const
TCP_TABLE_BASIC_ALL = 4;
type
TCP_TABLE_BASIC_ALL = record
dwNumEntries: DWORD;
table: array [0..0] of MIB_TCPROW_OWNER_PID;
end;
var
tcpTable: TCP_TABLE_BASIC_ALL;
dwSize: DWORD;
i: Integer;
begin
Result := '';
dwSize := 0;
if GetExtendedTcpTable(nil, @dwSize, False, AF_INET, TCP_TABLE_BASIC_ALL, 0) = ERROR_INSUFFICIENT_BUFFER then
begin
SetLength(Result, dwSize);
if GetExtendedTcpTable(@tcpTable, @dwSize, False, AF_INET, TCP_TABLE_BASIC_ALL, 0) = NO_ERROR then
begin
for i := 0 to tcpTable.dwNumEntries - 1 do
begin
Result := Result + Format('LocalAddr: %s, LocalPort: %d, RemoteAddr: %s, RemotePort: %d, PID: %d',
[IntToIP(tcpTable.table[i].dwLocalAddr), ntohs(tcpTable.table[i].dwLocalPort),
IntToIP(tcpTable.table[i].dwRemoteAddr), ntohs(tcpTable.table[i].dwRemotePort),
tcpTable.table[i].dwOwningPid]) + sLineBreak;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Text := GetTcpConnections;
end;
end.