关于Delphi通讯 ( 积分: 80 )

请问，Delphi如何检测本机上的空闲端口？？？

请问，Delphi如何检测本机上的空闲端口？？？

怎么没人回答我啊，自己顶一下!

这个问题要倒过来解决,看看本机有哪些端口被占用了,其余的就是没有占用的.

例如循环1~~10000的端口,依次启动监听,没有异常就是空闲端口.

有没有好点的方法啊？

IP助手函数，可以检查出所以已经打开的端口

能否讲详细些，谢谢

unit IPHelper;

(*
==========================
Delphi IPHelper functions
==========================
Requires : NT4/SP4 or higher, WIN98/WIN98se
Developed on: D4.03
Tested on : WIN-NT4/SP6, WIN98se, WIN95/OSR1

================================================================
This software is FREEWARE
-------------------------
If this software works, it was surely written by Dirk Claessens
<dirk.claessens16@yucom.be>
<dirk.claessens.dc@belgium.agfa.com>
(If it doesn't, I don't know anything about it.)
================================================================

Version: 1.3 2000-12-8

*)

interface

uses
Windows, Messages, SysUtils, Classes, Dialogs, IpHlpApi;

const
NULL_IP = ' 0. 0. 0. 0';

//------conversion of well-known port numbers to service names----------------

type
TWellKnownPort = record
Prt: DWORD;
Srv: string[20];
end;

PTTcpConnStatus = ^TTcpConnStatus;
TTcpConnStatus = record
LocalIP : string;
LocalPort : string;
RemoteIP : string;
RemotePort : string;
Status : string;
end;


const
// only most &quot;popular&quot; services...
WellKnownPorts: array[1..29] of TWellKnownPort
= (
( Prt: 0; Srv: 'LOOPBACK'),
( Prt: 7; Srv: 'ECHO' ), {Ping }
( Prt: 9; Srv: 'DISCRD' ), { Discard}
( Prt: 13; Srv: 'DAYTIM' ), {DayTime}
( Prt: 17; Srv: 'QOTD' ), {Quote Of The Day}
( Prt: 19; Srv: 'CHARGEN' ), {CharGen}
( Prt: 20; Srv: 'FTP ' ),
( Prt: 21; Srv: 'FTPC' ), { File Transfer Control Protocol}
( Prt: 23; Srv: 'TELNET' ), {TelNet}
( Prt: 25; Srv: 'SMTP' ), { Simple Mail Transfer Protocol}
( Prt: 37; Srv: 'TIME' ),
( Prt: 43; Srv: 'WHOIS'), { WHO IS service }
( Prt: 53; Srv: 'DNS ' ), { Domain Name Service }
( Prt: 67; Srv: 'BOOTPS' ), { BOOTP Server }
( Prt: 68; Srv: 'BOOTPC' ), { BOOTP Client }
( Prt: 69; Srv: 'TFTP' ), { Trivial FTP }
( Prt: 70; Srv: 'GOPHER' ), { Gopher }
( Prt: 79; Srv: 'FING' ), { Finger }
( Prt: 80; Srv: 'HTTP' ), { HTTP }
( Prt: 88; Srv: 'KERB' ), { Kerberos }
( Prt: 109; Srv: 'POP2' ), { Post Office Protocol Version 2 }
( Prt: 110; Srv: 'POP3' ), { Post Office Protocol Version 3 }
( Prt: 119; Srv: 'NNTP' ), { Network News Transfer Protocol }
( Prt: 123; Srv: 'NTP ' ), { Network Time protocol }
( Prt: 135; Srv: 'LOCSVC'), { Location Service }
( Prt: 137; Srv: 'NBNAME' ), { NETBIOS Name service }
( Prt: 138; Srv: 'NBDGRAM' ), { NETBIOS Datagram Service }
( Prt: 139; Srv: 'NBSESS' ), { NETBIOS Session Service }
( Prt: 161; Srv: 'SNMP' ) { Simple Netw. Management Protocol }
);


//-----------conversion of ICMP error codes to strings--------------------------
{taken from www.sockets.com/ms_icmp.c }

const
ICMP_ERROR_BASE = 11000;
IcmpErr : array[1..22] of string =
(
'IP_BUFFER_TOO_SMALL','IP_DEST_NET_UNREACHABLE', 'IP_DEST_HOST_UNREACHABLE',
'IP_PROTOCOL_UNREACHABLE', 'IP_DEST_PORT_UNREACHABLE', 'IP_NO_RESOURCES',
'IP_BAD_OPTION','IP_HARDWARE_ERROR', 'IP_PACKET_TOO_BIG', 'IP_REQUEST_TIMED_OUT',
'IP_BAD_REQUEST','IP_BAD_ROUTE', 'IP_TTL_EXPIRED_TRANSIT',
'IP_TTL_EXPIRED_REASSEM','IP_PARAMETER_PROBLEM', 'IP_SOURCE_QUENCH',
'IP_OPTION_TOO_BIG', 'IP_BAD_DESTINATION','IP_ADDRESS_DELETED',
'IP_SPEC_MTU_CHANGE', 'IP_MTU_CHANGE', 'IP_UNLOAD'
);


//----------conversion of diverse enumerated values to strings------------------

ARPEntryType : array[1..4] of string = ( 'Other', 'Invalid',
'Dynamic', 'Static'
);
TCPConnState :
array[1..12] of string =
( 'closed', 'listening', 'syn_sent',
'syn_rcvd', 'established', 'fin_wait1',
'fin_wait2', 'close_wait', 'closing',
'last_ack', 'time_wait', 'delete_tcb'
);

TCPToAlgo : array[1..4] of string =
( 'Const.Timeout', 'MIL-STD-1778',
'Van Jacobson', 'Other' );

IPForwTypes : array[1..4] of string =
( 'other', 'invalid', 'local', 'remote' );

IPForwProtos : array[1..18] of string =
( 'OTHER', 'LOCAL', 'NETMGMT', 'ICMP', 'EGP',
'GGP', 'HELO', 'RIP', 'IS_IS', 'ES_IS',
'CISCO', 'BBN', 'OSPF', 'BGP', 'BOOTP',
'AUTO_STAT', 'STATIC', 'NOT_DOD' );


//---------------exported stuff-----------------------------------------------

procedure Get_AdaptersInfo( List: TStrings );
procedure Get_NetworkParams( List: TStrings );
procedure Get_ARPTable( List: TStrings );
procedure Get_TCPTable( List: TStrings );
procedure Get_TCPStatistics( List: TStrings );
procedure Get_UDPTable( List: TStrings );
procedure Get_UDPStatistics( List: TStrings );
procedure Get_IPAddrTable( List: TStrings );
procedure Get_IPForwardTable( List: TStrings );
procedure Get_IPStatistics( List: TStrings );
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint;
var RTT: longint; var HopCount: longint ): integer;
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
procedure Get_IfTable( List: TStrings );
procedure Get_RecentDestIPs( List: TStrings );

// added functions
procedure Get_OpenConnections( List: TList );



// conversion utils
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
function IpAddr2Str( IPAddr: DWORD ): string;
function Str2IpAddr( IPStr: string ): DWORD;
function Port2Str( nwoPort: DWORD ): string;
function Port2Wrd( nwoPort: DWORD ): DWORD;
function Port2Svc( Port: DWORD ): string;
function ICMPErr2Str( ICMPErrCode: DWORD) : string;

implementation

var
RecentIPs : TStringList;

//--------------General utilities-----------------------------------------------

{ extracts next &quot;token&quot; from string, then eats string }
function NextToken( var s: string; Separator: char ): string;
var
Sep_Pos : byte;
begin
Result := '';
if length( s ) > 0 then begin
Sep_Pos := pos( Separator, s );
if Sep_Pos > 0 then begin
Result := copy( s, 1, Pred( Sep_Pos ) );
Delete( s, 1, Sep_Pos );
end
else begin
Result := s;
s := '';
end;
end;
end;

//------------------------------------------------------------------------------
{ concerts numerical MAC-address to ww-xx-yy-zz string }
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
var
i : integer;
begin
if Size = 0 then
begin
Result := '00-00-00-00-00-00';
EXIT;
end
else Result := '';
//
for i := 1 to Size do
Result := Result + IntToHex( MacAddr, 2 ) + '-';
Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts IP-address in network byte order DWORD to dotted decimal string}
function IpAddr2Str( IPAddr: DWORD ): string;
var
i : integer;
begin
Result := '';
for i := 1 to 4 do
begin
Result := Result + Format( '%3d.', [IPAddr and $FF] );
IPAddr := IPAddr shr 8;
end;
Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts dotted decimal IP-address to network byte order DWORD}
function Str2IpAddr( IPStr: string ): DWORD;
var
i : integer;
Num : DWORD;
begin
Result := 0;
for i := 1 to 4 do
try
Num := ( StrToInt( NextToken( IPStr, '.' ) ) ) shl 24;
Result := ( Result shr 8 ) or Num;
except
Result := 0;
end;

end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to DWORD }
function Port2Wrd( nwoPort: DWORD ): DWORD;
begin
Result := Swap( WORD( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to string }
function Port2Str( nwoPort: DWORD ): string;
begin
Result := IntToStr( Port2Wrd( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts well-known port numbers to service ID }
function Port2Svc( Port: DWORD ): string;
var
i : integer;
begin
Result := Format( '%4d', [Port] ); // in case port not found
for i := Low( WellKnownPorts ) to High( WellKnownPorts ) do
if Port = WellKnownPorts.Prt then
begin
Result := WellKnownPorts.Srv;
BREAK;
end;
end;

//-----------------------------------------------------------------------------
{ general, fixed network parameters }
procedure Get_NetworkParams( List: TStrings );
var
InfoSize : Longint;
ErrorCode : DWORD;
pBuf : PChar;
begin
if not Assigned( List ) then EXIT;
List.Clear;
InfoSize := 0;
ErrorCode := GetNetworkParams( PTFixedInfo(pBuf), @InfoSize );
GetMem( pBuf, InfoSize );
ErrorCode := GetNetworkParams( PTFixedInfo(pBuf), @InfoSize );
if ErrorCode = ERROR_SUCCESS then
with PTFixedinfo(pBuf)^ do
begin
List.Add( 'HOSTNAME : ' + string( HostName ) );
List.Add( 'DOMAIN : ' + string( DomainName ) );
List.Add( 'SCOPE : ' + string( ScopeID ) );
List.Add( 'NETBIOS NODE TYPE : ' + NETBIOSTypes[NodeType] );
List.Add( 'ROUTING ENABLED :' + IntToStr( EnableRouting ) );
List.Add( 'PROXY ENABLED :' + IntToStr( EnableProxy ) );
List.Add( 'DNS ENABLED :' + IntToHex( EnableDNS,8 ) );
end
else
List.Add( SysErrorMessage( ErrorCode ) );
FreeMem(pBuf);
end;

//------------------------------------------------------------------------------
function ICMPErr2Str( ICMPErrCode: DWORD) : string;
var
i : integer;
begin
Result := 'UnknownError : ' + IntToStr( ICMPErrCode );
dec( ICMPErrCode, ICMP_ERROR_BASE );
if ICMPErrCode in [Low(ICMpErr)..High(ICMPErr)] then
Result := ICMPErr[ ICMPErrCode];
end;




//------------------------------------------------------------------------------
procedure Get_IfTable( List: TStrings );
var
IfRow : TMibIfRow;
i,
Error,
TableSize : integer;
pBuf : PChar;
NumEntries : DWORD;
sDescr,
Temp : string;
begin
if not Assigned( List ) then EXIT;
List.Clear;
TableSize := 0;
// first call: get memsize needed
Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
if Error <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
GetMem( pBuf, TableSize );

// get table pointer
Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
if Error = NO_ERROR then
begin
NumEntries := PTMibIfTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( NumEntries ) );
for i := 1 to NumEntries do
begin
IfRow := PTMibIfRow( pBuf )^;
with IfRow do
begin
SetLength( sDescr, dwDescrLen );
move( bDescr, sDescr[1], Length( sDescr ) );
sDescr := trim( sDescr );
List.Add( Format( '%0.8x| %3d| %16s| %8d| %12d| %2d| %2d| %-s',
[dwIndex, dwType,
MacAddr2Str( TMacAddress( bPhysAddr ), dwPhysAddrLen )
, dwMTU, dwSpeed, dwAdminStatus,
dwOPerStatus, sDescr] )
);
end;
inc( pBuf, SizeOf( IfRow ) );
end;
end
else
List.Add( 'no entries.' );
end
else
List.Add( SysErrorMessage( GetLastError ) );
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IfRow ) );
FreeMem( pBuf );
end;



//-----------------------------------------------------------------------------
{ Info on installed adapters }
procedure Get_AdaptersInfo( List: TStrings );
var
Error,
BufLen : DWORD;
AdapterInfo : PTIP_ADAPTER_INFO;
Descr,
LocalIP,
GatewayIP,
DHCPIP : string;
begin
if not Assigned( List ) then EXIT;
List.Clear;
BufLen := SizeOf( AdapterInfo^ );
New( AdapterInfo );
Error := GetAdaptersInfo( AdapterInfo, @BufLen );
if Error = NO_ERROR then
begin
while ( AdapterInfo <> nil ) do
with AdapterInfo^ do
begin
SetLength( Descr, SizeOf( Description ) );
Descr := Trim( string( Description ) );
//
LocalIP := NULL_IP;
if IPAddressList.IpAddress[1] <> #0 then
LocalIP := IPAddressList.IpAddress
else
LocalIP := NULL_IP;
//
if GateWayList.IPAddress[1] <> #0 then
GateWayIP := GatewayList.IPAddress
else
GateWayIP := NULL_IP;
//
if DHCPServer.IPAddress[1] <> #0 then
DHCPIP := DHCPServer.IPAddress
else
DHCPIP := NULL_IP;

List.Add( Descr );
List.Add( Format(
'%8.8x|%6s|%16s|%2d|%16s|%16s|%16s',
[Index, AdaptTypes[aType],
MacAddr2Str( TMacAddress( Address ), AddressLength ),
DHCPEnabled, LocalIP, GatewayIP, DHCPIP] )
);
List.Add( ' ' );
AdapterInfo := Next;
end
end
else
List.Add( SysErrorMessage( Error ) );
Dispose( AdapterInfo );
end;

//-----------------------------------------------------------------------------
{ get round trip time and hopcount to indicated IP }
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint; var RTT: Longint;
var HopCount: Longint ): integer;
begin
if not GetRTTAndHopCount( IPAddr, @HopCount, MaxHops, @RTT ) then
begin
Result := GetLastError;
RTT := -1; // Destination unreachable, BAD_HOST_NAME,etc...
HopCount := -1;
end
else
Result := NO_ERROR;
end;

//-----------------------------------------------------------------------------
{ ARP-table lists relations between remote IP and remote MAC-address.
NOTE: these are cached entries ;when there is no more network traffic to a
node, entry is deleted after a few minutes.
}
procedure Get_ARPTable( List: TStrings );
var
IPNetRow : TMibIPNetRow;
TableSize : DWORD;
NumEntries : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
begin
if not Assigned( List ) then EXIT;
List.Clear;
// first call: get table length
TableSize := 0;
ErrorCode := GetIPNetTable( PTMIBIpNetTable( pBuf ), @TableSize, false );
//
if ErrorCode = ERROR_NO_DATA then
begin
List.Add( ' ARP-cache empty.' );
EXIT;
end;
// get table
GetMem( pBuf, TableSize );
ErrorCode := GetIpNetTable( PTMIBIPNetTable( pBuf ), @TableSize, false );
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMIBIPNetTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then // paranoia striking, but you never know...
begin
inc( pBuf, SizeOf( DWORD ) ); // get past table size
for i := 1 to NumEntries do
begin
IPNetRow := PTMIBIPNetRow( PBuf )^;
with IPNetRow do
List.Add( Format( '%8x | %12s | %16s| %10s',
[dwIndex, MacAddr2Str( bPhysAddr, dwPhysAddrLen ),
IPAddr2Str( dwAddr ), ARPEntryType[dwType]
]));
inc( pBuf, SizeOf( IPNetRow ) );
end;
end
else
List.Add( ' ARP-cache empty.' );
end
else
List.Add( SysErrorMessage( ErrorCode ) );

// we _must_ restore pointer!
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPNetRow ) );
FreeMem( pBuf );

end;


//------------------------------------------------------------------------------
procedure Get_TCPTable( List: TStrings );
var
TCPRow : TMIBTCPRow;
i,
NumEntries : integer;
TableSize : DWORD;
ErrorCode : DWORD;
DestIP : string;
pBuf : PChar;
begin
if not Assigned( List ) then EXIT;
List.Clear;
RecentIPs.Clear;
// first call : get size of table
TableSize := 0;
ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;

// get required size of memory, call again
GetMem( pBuf, TableSize );
// get table
ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
if ErrorCode = NO_ERROR then
begin

NumEntries := PTMIBTCPTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( DWORD ) ); // get past table size
for i := 1 to NumEntries do
begin
TCPRow := PTMIBTCPRow( pBuf )^; // get next record
with TCPRow do
begin
if dwRemoteAddr = 0 then
dwRemotePort := 0;
DestIP := IPAddr2Str( dwRemoteAddr );
List.Add(
Format( '%15s : %-7s|%15s : %-7s| %-16s',
[IpAddr2Str( dwLocalAddr ),
Port2Svc( Port2Wrd( dwLocalPort ) ),
DestIP,
Port2Svc( Port2Wrd( dwRemotePort ) ),
TCPConnState[dwState]
] ) );
//
if (not ( dwRemoteAddr = 0 ))
and ( RecentIps.IndexOf(DestIP) = -1 ) then
RecentIPs.Add( DestIP );
end;
inc( pBuf, SizeOf( TMIBTCPRow ) );
end;
end;
end
else
List.Add( SyserrorMessage( ErrorCode ) );
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibTCPRow ) );
FreeMem( pBuf );
end;


//------------------------------------------------------------------------------
procedure Get_OpenConnections( List: TList );
var
TCPRow : TMIBTCPRow;
i,NumEntries : integer;
TableSize : DWORD;
ErrorCode : DWORD;
DestIP : string;
pBuf : PChar;
CStat : PTTcpConnStatus;
begin
if not Assigned( List ) then EXIT;
List.Clear;
//首先取得TCP连接的列表的大小
TableSize := 0;
ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;

//分配内存
GetMem( pBuf, TableSize );
//取得TCP连接的列表
ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMIBTCPTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( DWORD ) );
for i := 1 to NumEntries do
begin
TCPRow := PTMIBTCPRow( pBuf )^;//下一个记录
with TCPRow do
if dwState in [2,5] then//只取两种状态的连接
begin
New( CStat );
CStat^.LocalIP := IPAddr2Str( dwLocalAddr );
CStat^.LocalPort := Port2Svc( Port2Wrd( dwLocalPort ));
if dwRemoteAddr <> 0 then
begin
CStat^.RemoteIP := IPAddr2Str( dwRemoteAddr );
CStat^.RemotePort :=
Port2Svc( Port2Wrd( dwRemotePort ));
end
else
begin
CStat^.RemoteIP := '...';
CStat^.RemotePort := '...';
end;
CStat^.Status := TCPConnState[dwState];
List.Add( CStat );
end;
inc( pBuf, SizeOf( TMIBTCPRow ) );
end;
end;
end;
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibTCPRow ) );
FreeMem( pBuf );
end;



//------------------------------------------------------------------------------
procedure Get_TCPStatistics( List: TStrings );
var
TCPStats : TMibTCPStats;
ErrorCode : DWORD;
begin
if not Assigned( List ) then EXIT;
List.Clear;
ErrorCode := GetTCPStatistics( @TCPStats );
if ErrorCode = NO_ERROR then
with TCPStats do
begin
List.Add( 'Retransmission algorithm :' + TCPToAlgo[dwRTOAlgorithm] );
List.Add( 'Minimum Time-Out :' + IntToStr( dwRTOMin ) + ' ms' );
List.Add( 'Maximum Time-Out :' + IntToStr( dwRTOMax ) + ' ms' );
List.Add( 'Maximum Pend.Connections :' + IntToStr( dwRTOAlgorithm ) );
List.Add( 'Active Opens :' + IntToStr( dwActiveOpens ) );
List.Add( 'Passive Opens :' + IntToStr( dwPassiveOpens ) );
List.Add( 'Failed Open Attempts :' + IntToStr( dwAttemptFails ) );
List.Add( 'Established conn. Reset :' + IntToStr( dwEstabResets ) );
List.Add( 'Current Established Conn.:' + IntToStr( dwCurrEstab ) );
List.Add( 'Segments Received :' + IntToStr( dwInSegs ) );
List.Add( 'Segments Sent :' + IntToStr( dwOutSegs ) );
List.Add( 'Segments Retransmitted :' + IntToStr( dwReTransSegs ) );
List.Add( 'Incoming Errors :' + IntToStr( dwInErrs ) );
List.Add( 'Outgoing Resets :' + IntToStr( dwOutRsts ) );
List.Add( 'Cumulative Connections :' + IntToStr( dwNumConns ) );
end
else
List.Add( SyserrorMessage( ErrorCode ) );

end;

//------------------------------------------------------------------------------
procedure Get_UDPTable( List: TStrings );
var
UDPRow : TMIBUDPRow;
i,
NumEntries : integer;
TableSize : DWORD;
ErrorCode : DWORD;
pBuf : PChar;
begin
if not Assigned( List ) then EXIT;
List.Clear;

// first call : get size of table
TableSize := 0;
ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, true );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;

// get required size of memory, call again
GetMem( pBuf, TableSize );

// get table
ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, true );
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMIBUDPTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( DWORD ) ); // get past table size
for i := 1 to NumEntries do
begin
UDPRow := PTMIBUDPRow( pBuf )^; // get next record
with UDPRow do
List.Add( Format( '%15s : %-6s',
[IpAddr2Str( dwLocalAddr ),
Port2Svc( Port2Wrd( dwLocalPort ) )
] ) );
inc( pBuf, SizeOf( TMIBUDPRow ) );
end;
end
else
List.Add( 'no entries.' );
end
else
List.Add( SyserrorMessage( ErrorCode ) );
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibUDPRow ) );
FreeMem( pBuf );
end;

//------------------------------------------------------------------------------
procedure Get_IPAddrTable( List: TStrings );
var
IPAddrRow : TMibIPAddrRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
NumEntries : DWORD;
begin
if not Assigned( List ) then EXIT;
List.Clear;
TableSize := 0; ;
// first call: get table length
ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;

GetMem( pBuf, TableSize );
// get table
ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMibIPAddrTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( DWORD ) );
for i := 1 to NumEntries do
begin
IPAddrRow := PTMIBIPAddrRow( pBuf )^;
with IPAddrRow do
List.Add( Format( '%8.8x|%15s|%15s|%15s|%8.8d',
[dwIndex,
IPAddr2Str( dwAddr ),
IPAddr2Str( dwMask ),
IPAddr2Str( dwBCastAddr ),
dwReasmSize
] ) );
inc( pBuf, SizeOf( TMIBIPAddrRow ) );
end;
end
else
List.Add( 'no entries.' );
end
else
List.Add( SysErrorMessage( ErrorCode ) );

// we must restore pointer!
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
FreeMem( pBuf );
end;


//-----------------------------------------------------------------------------
{ gets entries in routing table; equivalent to &quot;Route Print&quot; }
procedure Get_IPForwardTable( List: TStrings );
var
IPForwRow : TMibIPForwardRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
NumEntries : DWORD;
begin
if not Assigned( List ) then EXIT;
List.Clear;
TableSize := 0;

// first call: get table length
ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ), @TableSize, true
);
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;

// get table
GetMem( pBuf, TableSize );
ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ), @TableSize, true
);
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMibIPForwardTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( DWORD ) );
for i := 1 to NumEntries do
begin
IPForwRow := PTMibIPForwardRow( pBuf )^;
with IPForwRow do
List.Add( Format(
'%15s|%15s|%15s|%8.8x|%7s| %5.5d| %7s| %2.2d',
[IPAddr2Str( dwForwardDest ),
IPAddr2Str( dwForwardMask ),
IPAddr2Str( dwForwardNextHop ),
dwForwardIFIndex,
IPForwTypes[dwForwardType],
dwForwardNextHopAS,
IPForwProtos[dwForwardProto],
dwForwardMetric1
] ) );
inc( pBuf, SizeOf( TMibIPForwardRow ) );
end;
end
else
List.Add( 'no entries.' );
end
else
List.Add( SysErrorMessage( ErrorCode ) );
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibIPForwardRow ) );
FreeMem( pBuf );
end;

//------------------------------------------------------------------------------
procedure Get_IPStatistics( List: TStrings );
var
IPStats : TMibIPStats;
ErrorCode : integer;
begin
if not Assigned( List ) then EXIT;
ErrorCode := GetIPStatistics( @IPStats );
if ErrorCode = NO_ERROR then
begin
List.Clear;
with IPStats do
begin
if dwForwarding = 1 then
List.add( 'Forwarding Enabled : ' + 'Yes' )
else
List.add( 'Forwarding Enabled : ' + 'No' );
List.add( 'Default TTL : ' + inttostr( dwDefaultTTL ) );
List.add( 'Datagrams Received : ' + inttostr( dwInReceives ) );
List.add( 'Header Errors (In) : ' + inttostr( dwInHdrErrors ) );
List.add( 'Address Errors (In) : ' + inttostr( dwInAddrErrors ) );
List.add( 'Unknown Protocols (In) : ' + inttostr( dwInUnknownProtos ) );
List.add( 'Datagrams Discarded : ' + inttostr( dwInDiscards ) );
List.add( 'Datagrams Delivered : ' + inttostr( dwInDelivers ) );
List.add( 'Requests Out : ' + inttostr( dwOutRequests ) );
List.add( 'Routings Discarded : ' + inttostr( dwRoutingDiscards ) );
List.add( 'No Routes (Out): ' + inttostr( dwOutNoRoutes ) );
List.add( 'Reassemble TimeOuts : ' + inttostr( dwReasmTimeOut ) );
List.add( 'Reassemble Requests : ' + inttostr( dwReasmReqds ) );
List.add( 'Succesfull Reassemblies : ' + inttostr( dwReasmOKs ) );
List.add( 'Failed Reassemblies : ' + inttostr( dwReasmFails ) );
List.add( 'Succesful Fragmentations: ' + inttostr( dwFragOKs ) );
List.add( 'Failed Fragmentations : ' + inttostr( dwFragFails ) );
List.add( 'Datagrams Fragmented : ' + inttostr( dwFRagCreates ) );
List.add( 'Number of Interfaces : ' + inttostr( dwNumIf ) );
List.add( 'Number of IP-addresses : ' + inttostr( dwNumAddr ) );
List.add( 'Routes in RoutingTable : ' + inttostr( dwNumRoutes ) );
end;
end
else
List.Add( SysErrorMessage( ErrorCode ) );
end;

//------------------------------------------------------------------------------
procedure Get_UdpStatistics( List: TStrings );
var
UdpStats : TMibUDPStats;
ErrorCode : integer;
begin
if not Assigned( List ) then EXIT;
ErrorCode := GetUDPStatistics( @UdpStats );
if ErrorCode = NO_ERROR then
begin
List.Clear;
with UDPStats do
begin
List.add( 'Datagrams (In) : ' + inttostr( dwInDatagrams ) );
List.add( 'Datagrams (Out) : ' + inttostr( dwOutDatagrams ) );
List.add( 'No Ports : ' + inttostr( dwNoPorts ) );
List.add( 'Errors (In) : ' + inttostr( dwInErrors ) );
List.add( 'UDP Listen Ports : ' + inttostr( dwNumAddrs ) );
end;
end
else
List.Add( SysErrorMessage( ErrorCode ) );
end;

//------------------------------------------------------------------------------
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
var
ErrorCode : DWORD;
ICMPStats : PTMibICMPInfo;
begin
if ( ICMPIn = nil ) or ( ICMPOut = nil ) then EXIT;
ICMPIn.Clear;
ICMPOut.Clear;
New( ICMPStats );
ErrorCode := GetICMPStatistics( ICMPStats );
if ErrorCode = NO_ERROR then
begin
with ICMPStats.InStats do
begin
ICMPIn.Add( 'Messages received : ' + IntToStr( dwMsgs ) );
ICMPIn.Add( 'Errors : ' + IntToStr( dwErrors ) );
ICMPIn.Add( 'Dest. Unreachable : ' + IntToStr( dwDestUnreachs ) );
ICMPIn.Add( 'Time Exceeded : ' + IntToStr( dwTimeEcxcds ) );
ICMPIn.Add( 'Param. Problems : ' + IntToStr( dwParmProbs ) );
ICMPIn.Add( 'Source Quench : ' + IntToStr( dwSrcQuenchs ) );
ICMPIn.Add( 'Redirects : ' + IntToStr( dwRedirects ) );
ICMPIn.Add( 'Echo Requests : ' + IntToStr( dwEchos ) );
ICMPIn.Add( 'Echo Replies : ' + IntToStr( dwEchoReps ) );
ICMPIn.Add( 'Timestamp Requests : ' + IntToStr( dwTimeStamps ) );
ICMPIn.Add( 'Timestamp Replies : ' + IntToStr( dwTimeStampReps ) );

ICMPIn.Add( 'Addr. Masks Requests : ' + IntToStr( dwAddrMasks ) );
ICMPIn.Add( 'Addr. Mask Replies : ' + IntToStr( dwAddrReps ) );
end;
//
with ICMPStats^.OutStats do
begin
ICMPOut.Add( 'Messages sent : ' + IntToStr( dwMsgs ) );
ICMPOut.Add( 'Errors : ' + IntToStr( dwErrors ) );
ICMPOut.Add( 'Dest. Unreachable : ' + IntToStr( dwDestUnreachs ) );
ICMPOut.Add( 'Time Exceeded : ' + IntToStr( dwTimeEcxcds ) );
ICMPOut.Add( 'Param. Problems : ' + IntToStr( dwParmProbs ) );
ICMPOut.Add( 'Source Quench : ' + IntToStr( dwSrcQuenchs ) );
ICMPOut.Add( 'Redirects : ' + IntToStr( dwRedirects ) );
ICMPOut.Add( 'Echo Requests : ' + IntToStr( dwEchos ) );
ICMPOut.Add( 'Echo Replies : ' + IntToStr( dwEchoReps ) );
ICMPOut.Add( 'Timestamp Requests : ' + IntToStr( dwTimeStamps ) );
ICMPOut.Add( 'Timestamp Replies : ' + IntToStr( dwTimeStampReps ) );
ICMPOut.Add( 'Addr. Masks Requests : ' + IntToStr( dwAddrMasks ) );
ICMPOut.Add( 'Addr. Mask Replies : ' + IntToStr( dwAddrReps ) );
end;
end
else
IcmpIn.Add( SysErrorMessage( ErrorCode ) );
Dispose( ICMPStats );
end;

//------------------------------------------------------------------------------
procedure Get_RecentDestIPs( List: TStrings );
begin
if Assigned( List ) then
List.Assign( RecentIPs )
end;

initialization

RecentIPs := TStringList.Create;

finalization

RecentIPs.Free;

end.

{ List of Fixes &amp; Additions

v1.1
-----
Fix : wrong errorcode reported in GetNetworkParams()
Fix : RTTI MaxHops 20 > 128
Add : ICMP -statistics
Add : Well-Known port numbers
Add : RecentIP list
Add : Timer update

v1.2
----
Fix : Recent IP's correct update
ADD : ICMP-error codes translated

}

unit IPHLPAPI;

//------------------------------------------------------------------------------
// Partial translation of IPHLPAPI.DLL ( IP-Helper API )
// D. Claessens <dirk.claessens16@yucom.be>
//------------------------------------------------------------------------------

interface
uses
Windows, winsock;
const

VERSION = '1.2';

//------------- headers from Microsoft IPTYPES.H--------------------------------

const
ANY_SIZE = 1;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128; // arb.
MAX_ADAPTER_NAME_LENGTH = 256; // arb.
MAX_ADAPTER_ADDRESS_LENGTH = 8; // arb.
DEFAULT_MINIMUM_ENTITIES = 32; // arb.
MAX_HOSTNAME_LEN = 128; // arb.
MAX_DOMAIN_NAME_LEN = 128; // arb.
MAX_SCOPE_ID_LEN = 256; // arb.

// Node Types ( NETBIOS)
BROADCAST_NODETYPE = 1;
PEER_TO_PEER_NODETYPE = 2;
MIXED_NODETYPE = 4;
HYBRID_NODETYPE = 8;

NETBIOSTypes : array[0..8] of string[20] =
( 'UNKNOWN', 'BROADCAST', 'PEER_TO_PEER', '', 'MIXED', '', '', '', 'HYBRID'
);

// Adapter Types
IF_OTHER_ADAPTERTYPE = 0;
IF_ETHERNET_ADAPTERTYPE = 1;
IF_TOKEN_RING_ADAPTERTYPE = 2;
IF_FDDI_ADAPTERTYPE = 3;
IF_PPP_ADAPTERTYPE = 4;
IF_LOOPBACK_ADAPTERTYPE = 5;
IF_SLIP_ADAPTERTYPE = 6;
//
AdaptTypes : array[0..6] of string[10] =
( 'other', 'ethernet', 'tokenring', 'FDDI', 'PPP', 'loopback', 'SLIP' );

//-------------from other MS header files---------------------------------------

MAX_INTERFACE_NAME_LEN = 256; { mrapi.h }
MAXLEN_PHYSADDR = 8; { iprtrmib.h }
MAXLEN_IFDESCR = 256; { --&quot;--- }

//------------------------------------------------------------------------------

type
TMacAddress = array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;

//------IP address structures---------------------------------------------------

PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
TIP_ADDRESS_STRING = array[0..15] of char; // IP as string
//
PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
TIP_ADDR_STRING = packed record // for use in linked lists
Next: PTIP_ADDR_STRING;
IpAddress: TIP_ADDRESS_STRING;
IpMask: TIP_ADDRESS_STRING;
Context: DWORD;
end;

//----------Fixed Info STRUCTURES---------------------------------------------

PTFixedInfo = ^TFixedInfo;
TFixedInfo = packed record
HostName: array[0..MAX_HOSTNAME_LEN + 4] of char;
DomainName: array[0..MAX_DOMAIN_NAME_LEN + 4] of char;
CurrentDNSServer: PTIP_ADDR_STRING;
DNSServerList: TIP_ADDR_STRING;
NodeType: UINT;
ScopeID: array[0..MAX_SCOPE_ID_LEN + 4] of char;
EnableRouting: UINT;
EnableProxy: UINT;
EnableDNS: UINT;
end;

//----------INTERFACE STRUCTURES-------------------------------------------------

PTMibIfRow = ^TMibIfRow;
TMibIfRow = packed record
wszName: array[1..MAX_INTERFACE_NAME_LEN] of WCHAR;
dwIndex: DWORD;
dwType: DWORD;
dwMTU: DWORD;
dwSpeed: DWORD;
dwPhysAddrLen: DWORD;
bPhysAddr: array[1..MAXLEN_PHYSADDR] of byte;
dwAdminStatus: DWORD;
dwOperStatus: DWORD;
dwLastChange: DWORD;
dwInOctets: DWORD;
dwInUcastPkts: DWORD;
dwInNUCastPkts: DWORD;
dwInDiscards: DWORD;
dwInErrors: DWORD;
dwInUnknownProtos: DWORD;
dwOutOctets: DWORD;
dwOutUCastPkts: DWORD;
dwOutNUCastPkts: DWORD;
dwOutDiscards: DWORD;
dwOutErrors: DWORD;
dwOutQLen: DWORD;
dwDescrLen: DWORD;
bDescr: array[1..MAXLEN_IFDESCR] of char; //byte;
end;

//
PTMibIfTable = ^TMIBIfTable;
TMibIfTable = packed record
dwNumEntries: DWORD;
Table: array[0..ANY_SIZE - 1] of TMibIfRow;
end;

//------ADAPTER INFO STRUCTURES-------------------------------------------------

TTIME_T = array[1..325] of byte; // hack! MS time.h missing!

PTIP_ADAPTER_INFO = ^TIP_ADAPTER_INFO;
TIP_ADAPTER_INFO = packed record
Next: PTIP_ADAPTER_INFO;
ComboIndex: DWORD;
AdapterName: array[1..MAX_ADAPTER_NAME_LENGTH + 4] of char;
Description: array[1..MAX_ADAPTER_DESCRIPTION_LENGTH + 4] of char;
AddressLength: UINT;
Address: array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;
Index: DWORD;
aType: UINT;
DHCPEnabled: UINT;
CurrentIPAddress: PTIP_ADDR_STRING;
IPAddressList: TIP_ADDR_STRING;
GatewayList: TIP_ADDR_STRING;
DHCPServer: TIP_ADDR_STRING;
HaveWINS: BOOL;
PrimaryWINSServer: TIP_ADDR_STRING;
SecondaryWINSServer: TIP_ADDR_STRING;
LeaseObtained: TTIME_T; //??
LeaseExpires: TTIME_T; //??
end;

//----------------TCP STRUCTURES------------------------------------------------

PTMibTCPRow = ^TMibTCPRow;
TMibTCPRow = packed record
dwState: DWORD;
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
dwRemoteAddr: DWORD;
dwRemotePort: DWORD;
end;
//
PTMibTCPTable = ^TMibTCPTable;
TMibTCPTable = packed record
dwNumEntries: DWORD;
Table: array[0..0] of TMibTCPRow;
end;
//
PTMibTCPStats = ^TMibTCPStats;
TMibTCPStats = packed record
dwRTOAlgorithm: DWORD;
dwRTOMin: DWORD;
dwRTOMax: DWORD;
dwMaxConn: DWORD;
dwActiveOpens: DWORD;
dwPassiveOpens: DWORD;
dwAttemptFails: DWORD;
dwEstabResets: DWORD;
dwCurrEstab: DWORD;
dwInSegs: DWORD;
dwOutSegs: DWORD;
dwRetransSegs: DWORD;
dwInErrs: DWORD;
dwOutRsts: DWORD;
dwNumConns: DWORD;
end;

//---------UDP STRUCTURES-------------------------------------------------------

PTMibUDPRow = ^TMibUDPRow;
TMibUDPRow = packed record
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
end;
//
PTMibUDPTable = ^TMIBUDPTable;
TMIBUDPTable = packed record
dwNumEntries: DWORD;
UDPTable: array[0..ANY_SIZE - 1] of TMibUDPRow;
end;
//
PTMibUdpStats = ^TMIBUdpStats;
TMIBUdpStats = packed record
dwInDatagrams: DWORD;
dwNoPorts: DWORD;
dwInErrors: DWORD;
dwOutDatagrams: DWORD;
dwNumAddrs: DWORD;
end;

//-----------IP STRUCTURES------------------------------------------------------

//
PTMibIPNetRow = ^TMibIPNetRow;
TMibIPNetRow = packed record
dwIndex: DWord;
dwPhysAddrLen: DWord;
bPhysAddr: TMACAddress;
dwAddr: DWord;
dwType: DWord;
end;
//
PTMibIPNetTable = ^TMibIPNetTable;
TMibIPNetTable = packed record
dwNumEntries: DWORD;
Table: array[0..ANY_SIZE - 1] of TMibIPNetRow;
end;
//
PTMibIPStats = ^TMibIPStats;
TMibIPStats = packed record
dwForwarding: DWORD;
dwDefaultTTL: DWORD;
dwInReceives: DWORD;
dwInHdrErrors: DWORD;
dwInAddrErrors: DWORD;
dwForwDatagrams: DWORD;
dwInUnknownProtos: DWORD;
dwInDiscards: DWORD;
dwInDelivers: DWORD;
dwOutRequests: DWORD;
dwRoutingDiscards: DWORD;
dwOutDiscards: DWORD;
dwOutNoRoutes: DWORD;
dwReasmTimeOut: DWORD;
dwReasmReqds: DWORD;
dwReasmOKs: DWORD;
dwReasmFails: DWORD;
dwFragOKs: DWORD;
dwFragFails: DWORD;
dwFragCreates: DWORD;
dwNumIf: DWORD;
dwNumAddr: DWORD;
dwNumRoutes: DWORD;
end;
//
PTMibIPAddrRow = ^TMibIPAddrRow;
TMibIPAddrRow = packed record
dwAddr: DWORD;
dwIndex: DWORD;
dwMask: DWORD;
dwBCastAddr: DWORD;
dwReasmSize: DWORD;
Unused1,
Unused2: WORD;
end;
//
PTMibIPAddrTable = ^TMibIPAddrTable;
TMibIPAddrTable = packed record
dwNumEntries: DWORD;
Table: array[0..ANY_SIZE - 1] of TMibIPAddrRow;
end;

//
PTMibIPForwardRow = ^TMibIPForwardRow;
TMibIPForwardRow = packed record
dwForwardDest: DWORD;
dwForwardMask: DWORD;
dwForwardPolicy: DWORD;
dwForwardNextHop: DWORD;
dwForwardIFIndex: DWORD;
dwForwardType: DWORD;
dwForwardProto: DWORD;
dwForwardAge: DWORD;
dwForwardNextHopAS: DWORD;
dwForwardMetric1: DWORD;
dwForwardMetric2: DWORD;
dwForwardMetric3: DWORD;
dwForwardMetric4: DWORD;
dwForwardMetric5: DWORD;
end;
//
PTMibIPForwardTable = ^TMibIPForwardTable;
TMibIPForwardTable = packed record
dwNumEntries: DWORD;
Table: array[0..ANY_SIZE - 1] of TMibIPForwardRow;
end;

//--------ICMP-STRUCTURES------------------------------------------------------

PTMibICMPStats = ^TMibICMPStats;
TMibICMPStats = packed record
dwMsgs: DWORD;
dwErrors: DWORD;
dwDestUnreachs: DWORD;
dwTimeEcxcds: DWORD;
dwParmProbs: DWORD;
dwSrcQuenchs: DWORD;
dwRedirects: DWORD;
dwEchos: DWORD;
dwEchoReps: DWORD;
dwTimeStamps: DWORD;
dwTimeStampReps: DWORD;
dwAddrMasks: DWORD;
dwAddrReps: DWORD;
end;

PTMibICMPInfo = ^TMibICMPInfo;
TMibICMPInfo = packed record
InStats: TMibICMPStats;
OutStats: TMibICMPStats;
end;

//------------------imports from IPHLPAPI.DLL-----------------------------------

function GetAdaptersInfo( pAdapterInfo: PTIP_ADAPTER_INFO;
pOutBufLen: PULONG ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetNetworkParams( FixedInfo: PTFixedInfo; pOutPutLen: PULONG ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetTcpTable( pTCPTable: PTMibTCPTable; pDWSize: PDWORD;
bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetTcpStatistics( pStats: PTMibTCPStats ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetUdpTable( pUdpTable: PTMibUDPTable; pDWSize: PDWORD;
bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetUdpStatistics( pStats: PTMibUdpStats ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpStatistics( pStats: PTMibIPStats ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpNetTable( pIpNetTable: PTMibIPNetTable;
pdwSize: PULONG;
bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpAddrTable( pIpAddrTable: PTMibIPAddrTable;
pdwSize: PULONG;
bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpForwardTable( pIPForwardTable: PTMibIPForwardTable;
pdwSize: PULONG;
bOrder: BOOL ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

function GetIcmpStatistics( pStats: PTMibICMPInfo ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

function GetRTTAndHopCount( DestIPAddress: DWORD; HopCount: PULONG;
MaxHops: ULONG; RTT: PULONG ): BOOL;
stdCall; external 'IPHLPAPI.DLL';

function GetIfTable( pIfTable: PTMibIfTable; pdwSize: PULONG;
bOrder: boolean ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

function GetIfEntry( pIfRow: PTMibIfRow ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

implementation

end.

自己慢慢看吧,这也是别人申明好的单元,呵呵,我也只是贴出来而已

辛苦了