得到当前系统的Tcp所有打开端口及IP地址

//GetTcpTable函数单元
unit untIPHLPAPI;

interface

uses
Windows, sysutils, WinSock;

type
EIpHlpError = class(Exception);
//----------------TCP结构------------------------------------------------
PTMibTCPRow = ^TMibTCPRow;
TMibTCPRow = packed record
  dwState   : DWORD;//状态
  dwLocalAddr : DWORD;//本地IP地址
  dwLocalPort : DWORD;//本地端口号
  dwRemoteAddr: DWORD;//远程IP地址
  dwRemotePort: DWORD;//远程端口号
end;
//
PTMibTCPTable = ^TMibTCPTable;
TMibTCPTable   = packed record
  dwNumEntries : DWORD; //Tcp打开的数量
  Table     : array[0..0] of TMibTCPRow;
end;

//------------------从IPHLPAPI.DLL输入的API函数----------------------------
function GetTcpTable(pTcpTable: PTMibTCPTable; var pdwSize: DWORD;
bOrder: BOOL): DWORD; stdcall;

//转换成IP地址形式
function IpAddressToString(Addr: DWORD): string;
//GetTcpTable的实现过程
procedure VVGetTcpTable(var pTcpTable: PTMibTCPTable; var dwSize: DWORD;
const bOrder: BOOL);
//转换成端口号
Function GetTcpPortNumber(aDWord: DWord): Longint;

implementation

resourcestring
sNotImplemented = 'Function %s is not implemented.';
sInvalidParameter = 'Function %s. Invalid parameter';
sNoData = 'Function %s. No adapter information exists for the local computer.';
sNotSupported = 'Function %s is not supported by the operating system.';
const
iphlpapilib = 'iphlpapi.dll';

function GetTcpTable; external iphlpapilib name 'GetTcpTable';


function IpAddressToString(Addr: DWORD): string;
var
InAddr: TInAddr;
begin
InAddr.S_addr := Addr;
Result := inet_ntoa(InAddr);
end;

procedure IpHlpError(const FunctionName: string; ErrorCode: DWORD);
begin
case ErrorCode of
  ERROR_INVALID_PARAMETER :
  raise EIpHlpError.CreateFmt(sInvalidParameter, [FunctionName]);
  ERROR_NO_DATA :
  raise EIpHlpError.CreateFmt(sNoData, [FunctionName]);
  ERROR_NOT_SUPPORTED :
  raise EIpHlpError.CreateFmt(sNotSupported, [FunctionName]);
else ;
  RaiseLastWin32Error;
end;
end;

procedure VVGetTcpTable(var pTcpTable: PTMibTCPTable; var dwSize: DWORD;
const bOrder: BOOL);
var
Res: DWORD;
begin
pTcpTable := Nil;
dwSize := 0;
if @GetTcpTable = Nil then
  raise EIpHlpError.CreateFmt(sNotImplemented, ['GetTcpTable']);
Res := GetTcpTable(pTcpTable, dwSize, bOrder);
if Res = ERROR_INSUFFICIENT_BUFFER then
begin
Getmem(pTcpTable, dwSize);
FillChar(pTcpTable^, dwSize, #0);
Res := GetTcpTable(pTcpTable, dwSize, bOrder);
end;
if Res <> NO_ERROR then
  IpHlpError('GetTcpTable', Res);
end;

Function GetTcpPortNumber(aDWord: DWord): Longint;
begin
Result := Trunc(aDWord / 256 + (aDWord Mod 256) * 256);
end;

end.



2003-10-7 16:08:00  
发表评语»»»  

2003-10-7 16:10:45   //演示例子：procedure TFmIpTest.BtGetTcpTableClick(Sender: TObject);
var
pTcpTable: PMibTcpTable;
dwSize: DWORD;
i: integer;
begin
Memo1.Lines.Add('GetTcpTable');
VVGetTcpTable(pTcpTable, dwSize, False);
if pTcpTable <> nil then
try
  Memo1.Lines.Add(' NumEntries: ' + IntToStr(pTcpTable^.dwNumEntries));
  Memo1.Lines.Add('   Local Address Port Remote Address Port State');
  for i := 0 to pTcpTable^.dwNumEntries do
  with pTcpTable^.table, Memo1.Lines do
  begin
    Add(Format(' %15s %5d %15s %5d %5d', [IpAddressToString(dwLocalAddr),
      GetTcpPortNumber(dwLocalPort), IpAddressToString(dwRemoteAddr),
      GetTcpPortNumber(dwRemotePort), dwState]));
  end;
finally
Freemem(pTcpTable);
end;
end;