unit IPHelper;
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
// Delphi IPHelper functions //
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
// PLEASE NOTE: REQUIRES NT4/SP4 or higher, WIN98 or higher //
// Tested on : Delphi 4.03, Delphi 6.0 Enterprise, //
// WIN2K, WIN-NT4/SP6, WIN98se //
// //
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
// This software is FREEWARE //
// ------------------------- //
// If this software works, it was surely written by Dirk Claessens //
// <dirkCL@pandora.be> //
// (If it doesn't, I don't know anything about it.) //
// Version: 1.5 2002-08-21 //
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs, IpHlpApi,IpExport,IpIfConst,IpRtrMib,IPTypes;
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 "popular" 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 ' ), { File Transfer Protocol}
( 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' ), { Time Protocol }
( 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 various enumerated values to strings----------------//
ARPEntryType : array[1..4] of string = ( 'Other', 'Invalid',
'Dynamic', 'Static'
);
TCPConnState : // TCP connection states
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 = // TCP time out algorithms
( 'Const.Timeout', 'MIL-STD-1778',
'Van Jacobson', 'Other' );
IPForwTypes : array[1..4] of string = // IP forwarding methods
( 'other', 'invalid', 'local', 'remote' );
IPForwProtos : array[1..18] of string = // IP forwarding protocols
( 'OTHER', 'LOCAL', 'NETMGMT', 'ICMP', 'EGP',
'GGP', 'HELO', 'RIP', 'IS_IS', 'ES_IS',
'CISCO', 'BBN', 'OSPF', 'BGP', 'BOOTP',
'AUTO_STAT', 'STATIC', 'NOT_DOD' );
//---------------exported stuff-----------------------------------------------
// data output to Tstrings for display purposes
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( NameList, ItemList: TStrings );
procedure Get_IfTableMIB( var MIBIfArray: TMIBIfArray );
procedure Get_IPAddrTableMIB( var IPAddrTable:TMibIPAddrArray );
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 "token" 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;
//------------------------------------------------------------------------------
{ converts 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( NameList, ItemList: TStrings );
var
IfRow : TMibIfRow;
i,
Error,
TableSize : integer;
pBuf : PChar;
NumEntries : DWORD;
sDescr,
Temp : string;
begin
if (not Assigned( NameList ))
or (not Assigned( ItemList )) then EXIT;
NameList.Clear;
ItemList.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 );
NameList.Add( sDescr );
ItemList.Add( Format( '%0.8x|%2d| %16s| %4d| %8d| %8d| %8d',
[dwIndex, dwType,
MacAddr2Str( TMacAddress( bPhysAddr ), dwPhysAddrLen )
, dwMTU, dwSpeed,
dwInOctets, dwOutOctets,
dwOPerStatus] )
);
end;
inc( pBuf, SizeOf( IfRow ) );
end;
end
else begin
NameList.Add( 'no entries');
ItemList.Add( 'no data' );
end;
end
else begin
NameList.Add( 'Oops');
ItemList.Add( SysErrorMessage( GetLastError ) );
end;
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IfRow ) );
FreeMem( pBuf );
end;
//------------------------------------------------------------------------------
procedure Get_IfTableMIB( var MIBIfArray: TMIBIfArray );
var
i,
Error,
TableSize : integer;
pBuf : PChar;
NumEntries : DWORD;
sDescr,
Temp : string;
begin
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
SetLength( MIBIfArray, NumEntries );
inc( pBuf, SizeOf( NumEntries ) );
for i := 0 to pred(NumEntries) do
begin
MIBIfArray := PTMibIfRow( pBuf )^;
inc( pBuf, SizeOf( TMIBIfRow ) );
end;
end
end;
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMIBIfRow ) );
FreeMem( pBuf );
end;
//------------------------------------------------------------------------------
procedure Get_IPAddrTableMIB( var IPAddrTable:TMibIPAddrArray );
var
IPAddrRow : TMibIPAddrRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
NumEntries : DWORD;
begin
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
SetLength( IPAddrTable, NumEntries);
inc( pBuf, SizeOf( DWORD ) );
for i := 1 to NumEntries do
begin
IPAddrTable[ i-1 ] := PTMIBIPAddrRow( pBuf )^;
inc( pBuf, SizeOf( TMIBIPAddrRow ) );
end;
end;
end;
// we must restore pointer!
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
FreeMem( pBuf );
end;
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
procedure Get_AdaptersInfo( List: TStrings );
var
Error,
BufLen : DWORD;
P : Pointer;
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 );
P := AdapterInfo;
if Error = NO_ERROR then
begin
while P <> nil do
with TIP_ADAPTER_INFO(P^) do
begin
SetLength( Descr, SizeOf( Description ) );
Descr := Trim( string( Description ) );
//
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( ' ' );
P := Next; // TIP_ADAPTER_INFO(P^).Next points to next entry
end // with
end // while
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 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;
// 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
if dwState in [2,5] then // only listening, established
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;
(*
//------------------------------------------------------------------------------
procedure Get_IPAddrTableMIB( var IPAddrTable:TMibIPAddrArray );
var
IPAddrRow : TMibIPAddrRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
NumEntries : DWORD;
begin
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
SetLength( IPAddrTable, NumEntries);
inc( pBuf, SizeOf( DWORD ) );
for i := 1 to NumEntries do
begin
IPAddrTable[ i-1 ] := PTMIBIPAddrRow( pBuf )^;
inc( pBuf, SizeOf( TMIBIPAddrRow ) );
end;
end;
end;
// we must restore pointer!
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
FreeMem( pBuf );
end;
*)
//-----------------------------------------------------------------------------
{ gets entries in routing table; equivalent of "route print" }
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 & 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
v1.3
----
chg : left out adapter "admin status" and "oper. status"
add : adapter bytes in/out
v1.4
----
Fix : GetadaptersInfo()
Last iteration nills pointer => memory leak on Dispose()!
(reported by David Sarasinni)
}
