Delphi xe10.3 获取 所有连接 信息

unit tcpudpfun;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ExtCtrls, StrUtils, PsAPI, tlhelp32, WinSock;

const
ANY_SIZE = 1;
iphlpapi = 'iphlpapi.dll';
TCP_TABLE_OWNER_PID_ALL = 5;
MIB_TCP_STATE: array[1..12] of string = ('CLOSED', 'LISTEN', 'SYN-SENT ',
'SYN-RECEIVED', 'ESTABLISHED', 'FIN-WAIT-1', 'FIN-WAIT-2', 'CLOSE-WAIT',
'CLOSING', 'LAST-ACK', 'TIME-WAIT', 'delete TCB');
MIB_TCP_STATE1: array[1..12] of string = ('关闭', '监听', '同步发送 ',
'同步接收', '已建立', '等待完成1', '等待完成2', '等待关闭',
'正在关闭', '最后确认', '等待时间', '删除');

type
TCP_TABLE_CLASS = Integer;

PMibTcpRowOwnerPid = ^TMibTcpRowOwnerPid;

TMibTcpRowOwnerPid = packed record
dwState: DWORD;
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
dwRemoteAddr: DWORD;
dwRemotePort: DWORD;
dwOwningPid: DWORD;
end;

PMIB_TCPTABLE_OWNER_PID = ^MIB_TCPTABLE_OWNER_PID;

OnTcpGetEvent = reference to procedure (TcpInfo: TMibTcpRowOwnerPid);

MIB_TCPTABLE_OWNER_PID = packed record
dwNumEntries: DWord;
table: array[0..ANY_SIZE - 1] of TMibTcpRowOwnerPid;
end;

function AdjustProcessPrivilege(ProcessHandle: Cardinal; Token_Name: Pchar): boolean;
procedure GetTcpAll(OnEvent: OnTcpGetEvent);

var
GetExtendedTcpTable: function(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWord; stdcall;
libHandle: THandle;

implementation

function AdjustProcessPrivilege(ProcessHandle: Cardinal; Token_Name: Pchar): boolean;
var
Token: THandle;
TokenPri: _TOKEN_PRIVILEGES;
ProcessDest: int64;
l: DWORD;
begin
Result := False;
if OpenProcessToken(ProcessHandle, TOKEN_Adjust_Privileges, Token) then
begin
if LookupPrivilegeValue(nil, Token_Name, ProcessDest) then
begin
TokenPri.PrivilegeCount := 1;
TokenPri.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPri.Privileges[0].Luid := ProcessDest;
l := 0;
//更新进程令牌，成功返回TRUE
if AdjustTokenPrivileges(Token, False, TokenPri, sizeof(TokenPri), nil, l) then
Result := True;
end;
end;
end;

procedure GetTcpAll(OnEvent: OnTcpGetEvent);
var
Error: DWORD;
TableSize: DWORD;
i, row: integer;
IpAddress: in_addr;
RemoteIp: string;
LocalIp: string;
FExtendedTcpTable: PMIB_TCPTABLE_OWNER_PID;
begin
TableSize := 0;
Error := GetExtendedTcpTable(nil, @TableSize, False, AF_INET,
TCP_TABLE_OWNER_PID_ALL, 0);
if Error <> ERROR_INSUFFICIENT_BUFFER then
Exit;

GetMem(FExtendedTcpTable, TableSize);
try
if GetExtendedTcpTable(FExtendedTcpTable, @TableSize, TRUE, AF_INET,
TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
begin
row := 1;
for i := 0 to FExtendedTcpTable.dwNumEntries - 1 do
begin
if Assigned(OnEvent) then
OnEvent(FExtendedTcpTable.table[i]);
end;

end;

finally
FreeMem(FExtendedTcpTable);
end;

end;

procedure InitIPhlapi;
begin
libHandle := LoadLibrary(iphlpapi);
GetExtendedTcpTable := GetProcAddress(libHandle, 'GetExtendedTcpTable');
end;

initialization
InitIPhlapi;

finalization
if libHandle > 0 then
FreeLibrary(libHandle);

end.

界面

unit Unit2;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Winapi.WinSock, Winapi.TlHelp32, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, Vcl.Grids, tcpudpfun;

type
TForm2 = class(TForm)
grid1: TStringGrid;
btn1: TButton;
procedure FormCreate(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.btn1Click(Sender: TObject);
var
row: Integer;
begin
row := 1;
GetTcpAll(
procedure(tcpInfo: TMibTcpRowOwnerPid)
begin
if row >= grid1.RowCount then
grid1.RowCount := row + 3;
grid1.Cells[0, row] := 'TCP';
grid1.Cells[1, row] := inet_ntoa(TInAddr(tcpInfo.dwLocalAddr)) + ':' +
IntToStr(ntohs(tcpInfo.dwLocalPort));
grid1.Cells[2, row] := inet_ntoa(TInAddr(tcpInfo.dwRemoteAddr)) + ':' +
IntToStr(ntohs(tcpInfo.dwRemotePort));

grid1.Cells[3, row] := MIB_TCP_STATE1[tcpInfo.dwState];
grid1.Cells[4, row] := IntToStr(tcpInfo.dwOwningPid);
inc(row)

end);

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
//提权
AdjustProcessPrivilege(GetCurrentProcess, 'SeDebugPrivilege');
grid1.ColCount := 5;
grid1.Cells[0, 0] := '协议';
grid1.ColWidths[0] := 60;
grid1.Cells[1, 0] := '本地IP地址';
grid1.ColWidths[1] := 120;
grid1.Cells[2, 0] := '远程IP地址';
grid1.ColWidths[2] := 120;
grid1.Cells[3, 0] := '连接状态';
grid1.ColWidths[3] := 80;
grid1.Cells[4, 0] := '进程ID';
end;

end.