Hello, I'm an academic student from Brazil, and I have a project of
updating and porting to Linux an application called YANA(Yet Another
Network Analyzer). You can find it on the following link:
http://sourceforge.net/projects/yana/.
The latest version was written using Lazarus 0.9.22 and seemingly Free
Pascal 2.0.4(I'm not entirely sure of it), which was back in 2007. Since
then, much has changed in these two tools, and many things need to be
reworked on YANA.
But the first problem is that I can't even compile the code provided by the
author, because it uses Kylix compatibility-only units for Linux, libc and
kernelioctl, and it relies on a specific dll of Windows, IP Helper DLL.
Therefore, this fact locks the software to Windows and Linux running on a
i386 platform.
I successfully compiled and ran all the utility modules that composes it as
separate programs, but when they are put together with a particular unit,
which I will send as an attachment to this e-mail, the whole process broke
down in others platforms.
My intent is to remove this dependency and make the software more
cross-platform possible, but I actually have no clue about how to do it, so
please: can any of you help me by telling the first steps which I must
take, the beginning is hard, but once the flow is established, the outcome
will be a natural consequence of it.
Thank you in advance for any help.
{TODO : remove Windows dll dependency - currently it may work only under Win32 }
{TODO : redo string grid lines append - scrolls to top on timer}
{TODO : Datagrams Discarded (Out) }
{TODO : Forward Policy }
{TODO : Age (sec) }
{TODO : Adapters info tab; Description }
{TODO : change adapters inormation: +Descriptionę +Ip Addressę +WINS +Secondary WINS Server.}
{TODO : Change interface informationas as follows:
Index of Interface - Shows the index that identifies the interface.
Type of Interface - Shows the type of interface.
Max Transmission Unit - Shows the Maximum Transmission Unit (MTU).
Speed of Interface - Shows the speed of the interface in bits
per second.
Physical Address of Adapter - Shows the length of the physical address.
Administrative Status - Shows whether the interface is administratively
enabled or disabled.
Operational Status - Shows the operational status of the interface.
The following values are available:
NON_OPERATIONAL, UNREACHABLE, DISCONNECTED,
CONNECTING, CONNECTED, OPERATIONAL.
Bytes Received - Shows the number of octets of data received
through this interface.
+Unicast Packets Received - Shows the number of unicast packets received
through this interface.
+Non Unicast Packets Received- Shows the number of non-unicast packets
received through this interface. Broadcast
and multicast packets are included.
+Received packets discarded - Shows the number of incoming packets that
were discarded even though they did not
have errors.
+Erroneous packets received - Shows the number of incoming packets that were
discarded because of errors.
+Unknown Protocol packets received - Shows the number of incoming packets
that were discarded because the protocol
was unknown.
Bytes Sent - - Shows the number of octets of data sent
through this interface.
+Unicast Packets sent - Shows the number of unicast packets sent
through this interface.
+Non Unicast Packets sent - Shows the number of non-unicast packets
sent through this interface. Broadcast and
multicast packets are included.
+Outgoing packets discarded - Shows the number of outgoing packets that
were discarded even though they did not
have errors.
+Erroneous packets sent - Shows the number of outgoing packets that were
discarded because of errors.
+Output Queue Length - Shows the output queue length.
}
(*
==========================
Delphi IPHelper functions
==========================
Required OS : NT4/SP4 or higher, WIN98/WIN98se
Developed on: D6 Ent. & Prof.
Tested on : WIN-NT4/SP6, WIN98se, WIN95/OSR1
: WIN98, W2K-SP2, 3, 4
: W2K, W2K prof, W2K server
Warning - currently only supports Delphi 5 and later unless int64 is removed
(Int64 is only used to force Format to show unsigned 32-bit numbers)
================================================================
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.)
================================================================
List of Fixes & Additions
v1.1 dirkcl
-----
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 dirkcl
----
Fix : Recent IP's correct update
ADD : ICMP-error codes translated
v1.3 - 18th September 2001
----
Angus Robertson, Magenta Systems Ltd, England
delphi@@magsys.co.uk, http://www.magsys.co.uk/delphi/
Slowly converting procs into functions that can be used by other programs,
ie Get_ becomes IpHlp
Primary improvements are that current DNS server is now shown, also
in/out bytes for each interface (aka adaptor)
All functions are dynamically loaded so program can be used on W95/NT4
Tested with Delphi 6 on Windows 2000 and XP
v1.4 - 28th February 2002 - Angus
----
Fixed major memory leak in IpHlpIfTable (except instead of finally)
Fixed major memory leak in Get_AdaptersInfo (incremented buffer pointer)
Created IpHlpAdaptersInfo which returns TAdaptorRows
Note: IpHlpNetworkParams returns dynamic DNS address (and other stuff)
Note: IpHlpIfEntry returns bytes in/out for a network adaptor
v1.5 - 5th October 2003
----
Jean-Pierre Turchi "From South of France" <jpturchi@@mageos.com>
Cosmetic (more readable) and add-in's from iana.org in "WellKnownPorts"
v1.6 - 1st April 2007
----
Sergei Kostigoff <sergei@@kostigoff.net>
Minor cosmetics
Output results to string grids
v1.7 - 12th May 2007
----
Sergei Kostigoff <sergei@@kostigoff.net>
Proto type strings moved to RFC1213ip unit
IPForwTypes strings moved to RFC1213ip unit (and renamed to sIpRouteTypeString)
ARPEntryType strings moved to RFC1213ip unit (and renamed to...
*)
{ @abstract(@bold(uIpHelper); no forms. IP helper functions) @br
Original source has been written by Dirk Claessens <dirkcl@@pandora.be>. @br
Original license message is as follows:
@preformatted(
==========================
Delphi IPHelper functions
==========================
Required OS : NT4/SP4 or higher, WIN98/WIN98se
Developed on: D6 Ent. & Prof.
Tested on : WIN-NT4/SP6, WIN98se, WIN95/OSR1
: WIN98, W2K-SP2, 3, 4
: W2K, W2K prof, W2K server
Warning - currently only supports Delphi 5 and later unless int64 is removed
(Int64 is only used to force Format to show unsigned 32-bit numbers)
================================================================
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.)
================================================================
)
Miscellaneous IP functions collection.
}
unit uIpHelper;
{$H+}
{$IFDEF FPC}
{$mode Delphi}
{$ENDIF}
interface
uses
{$IFDEF LINUX}
Libc, Types, KernelIoctl,
{$ELSE}
Windows, Classes,
{$ENDIF}
SysUtils,
Grids,
rfc1213const,
rfc1213if,
rfc1213ip,
rfc1213tcp,
uYanaUtil,
uIpHlpApi; // replace or remove on beta stage!!!
var
{ List of recent IP addresses}
RecentIPs : TStringList;
//------conversion of well-known port numbers to service names----------------
type
{ well known port record structure }
TWellKnownPort = record
Prt: DWORD;
Srv: string[15];
end;
const
// Only most "popular" services. Names and descriptions given
// as per http://www.iana.org/assignments/port-numbers
WellKnownPorts: array[1..37] of TWellKnownPort
= (
// ( Prt: 0; Srv: 'RESRVED' ), { Reserved }
( Prt: 7; Srv: 'echo' ), { Ping }
( Prt: 9; Srv: 'discard' ), { Discard }
( Prt: 11; Srv: 'systat' ), { Active Users }
( Prt: 13; Srv: 'daytime' ), { Daytime (RFC 867) }
( Prt: 17; Srv: 'qotd' ), { Quote of the Day }
( Prt: 19; Srv: 'chargen' ), { Character Generator }
( Prt: 20; Srv: 'ftp-data' ), { File Transfer [Default Data] }
( Prt: 21; Srv: 'ftp' ), { File Transfer [Control] }
( Prt: 22; Srv: 'ssh' ), { SSH Remote Login Protocol }
( Prt: 23; Srv: 'telnet' ), { Telnet }
( Prt: 25; Srv: 'smtp' ), { Simple Mail Transfer }
( Prt: 37; Srv: 'time' ), { Time }
( Prt: 43; Srv: 'nicname' ), { Who Is }
( Prt: 53; Srv: 'domain' ), { Domain Name Server }
( Prt: 67; Srv: 'bootps' ), { Bootstrap Protocol Server }
( Prt: 68; Srv: 'bootpc' ), { Bootstrap Protocol Client }
( Prt: 69; Srv: 'tftp' ), { Trivial File Transfer }
( Prt: 70; Srv: 'gopher' ), { Gopher }
( Prt: 79; Srv: 'finger' ), { Finger }
( Prt: 80; Srv: 'http' ), { World Wide Web HTTP }
( Prt: 88; Srv: 'kerberos' ), { Kerberos }
( Prt: 109; Srv: 'pop2' ), { Post Office Protocol - Version 2 }
( Prt: 110; Srv: 'pop3' ), { Post Office Protocol - Version 3 }
( Prt: 111; Srv: 'sunrpc' ), { SUN Remote Procedure Call }
( Prt: 119; Srv: 'nntp' ), { Network News Transfer Protocol }
( Prt: 123; Srv: 'ntp' ), { Network Time protocol }
( Prt: 135; Srv: 'epmap' ), { DCE endpoint resolution; NETBIOS RPC }
( Prt: 137; Srv: 'netbios-ns' ), { NETBIOS Name Service }
( Prt: 138; Srv: 'netbios-dgm' ), { NETBIOS Datagram Service }
( Prt: 139; Srv: 'netbios-ssn' ), { NETBIOS Session Service }
( Prt: 143; Srv: 'imap' ), { Internet Message Access Protocol }
( Prt: 161; Srv: 'snmp' ), { SNMP }
( Prt: 169; Srv: 'send' ), { SEND }
( Prt: 179; Srv: 'bgp' ), { Border Gateway Protocol }
( Prt: 515; Srv: 'printer' ), { spooler }
( Prt: 4000; Srv: 'terabase' ), { Terabase; also used by ICQ}
( Prt: 8080; Srv: 'http-alt' ) { HTTP Alternate (see port 80) }
);
//-----------conversion of ICMP error codes to strings--------------------------
{taken from www.sockets.com/ms_icmp.c }
const
{ offset of ICMP error (@link(IcmpErr))}
ICMP_ERROR_BASE = 11000;
{ ICMP error strings array }
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'
);
type
// for IpHlpNetworkParams
TNetworkParams = record
HostName: string ;
DomainName: string ;
CurrentDnsServer: string ;
DnsServerTot: integer ;
DnsServerNames: array [0..9] of string ;
NodeType: UINT;
ScopeID: string ;
EnableRouting: UINT;
EnableProxy: UINT;
EnableDNS: UINT;
end;
// dynamic array of rows
TIfRows = array of TMibIfRow ;
// for IpHlpAdaptersInfo
TAdaptorInfo = record
AdapterName: string ;
Description: string ;
MacAddress: string ;
Index: DWORD;
aType: UINT;
DHCPEnabled: UINT;
CurrIPAddress: string ;
CurrIPMask: string ;
IPAddressTot: integer ;
IPAddressList: array of string ;
IPMaskList: array of string ;
GatewayTot: integer ;
GatewayList: array of string ;
DHCPTot: integer ;
DHCPServer: array of string ;
HaveWINS: BOOL;
PrimWINSTot: integer ;
PrimWINSServer: array of string ;
SecWINSTot: integer ;
SecWINSServer: array of string ;
LeaseObtained: LongInt ; // UNIX time, seconds since 1970
LeaseExpires: LongInt; // UNIX time, seconds since 1970
end ;
// dynamic array of records
TAdaptorRows = array of TAdaptorInfo ;
//---------------exported stuff-----------------------------------------------
{ Info on installed adapters }
function IpHlpAdaptersInfo(var AdpTot: integer;var AdpRows: TAdaptorRows): integer ;
{}
procedure Get_AdaptersInfo( List: TStrings );
{}
function IpHlpNetworkParams (var NetworkParams: TNetworkParams): integer ;
{}
procedure Get_NetworkParams( List: TStrings );
{}
procedure Get_ARPTable( List: TStrings );
{}
procedure Get_TCPTable( List: TStrings );
{}
procedure Get_TCPStatistics( List: TStrings );
{}
function IpHlpTCPStatistics (var TCPStats: TMibTCPStats): integer ;
{}
procedure Get_UDPTable( List: TStrings );
{}
procedure Get_UDPStatistics( List: TStrings );
{}
function IpHlpUdpStatistics (UdpStats: TMibUDPStats): integer ;
{}
procedure Get_IPAddrTable( List: TStrings );
{}
procedure Get_IPForwardTable( List: TStrings );
{}
procedure Get_IPStatistics( List: TStrings );
{}
function IpHlpIPStatistics (var IPStats: TMibIPStats): integer ;
{}
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint;
var RTT: longint; var HopCount: longint ): integer;
{}
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
{ include bytes in/out for each adaptor }
function IpHlpIfTable(var IfTot: integer; var IfRows: TIfRows): integer ;
{ get interface table to TStrings }
procedure Get_IfTable( List: TStrings );
{}
function IpHlpIfEntry(Index: integer; var IfRow: TMibIfRow): integer ;
{}
procedure Get_RecentDestIPs( List: TStrings );
// string grid interface
{}
procedure DoNetworkParams(sg : TStringGrid);
{}
procedure DoArpTable(sg : TStringGrid);
{}
procedure DoTcpTable(sg: TStringGrid);
{}
procedure DoUdpTable(sg : TStringGrid);
{}
procedure DoTCPStatistics(sg : TStringGrid);
{}
procedure DoICMPInputStatistics( sg : TStringGrid );
{}
procedure DoIcmpOutputStatistics(sg : TStringGrid);
{}
procedure DoUdpStatistics(sg : TStringGrid);
{}
procedure DoIpStatistics(sg : TStringGrid);
{}
procedure DoIPAddrTable(sg : TStringGrid);
{ fill ip forward string grid }
procedure DoIPForwardTable(sg : TStringGrid);
{ fill adapaters info string grid }
procedure DoAdaptersInfo(sg: TStringGrid);
{ fill interfaces table string grid }
procedure DoIfTable(sg: TStringGrid);
// conversion utils
{ converts numerical MAC-address to ww-xx-yy-zz string }
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
{ converts IP-address in network byte order DWORD to dotted decimal string}
function IpAddr2Str( IPAddr: DWORD ): string;
{ converts dotted decimal IP-address to network byte order DWORD}
function Str2IpAddr( IPStr: string ): DWORD;
{ converts port number in network byte order to string }
function Port2Str( nwoPort: DWORD ): string;
{ converts port number in network byte order to DWORD }
function Port2Wrd( nwoPort: DWORD ): DWORD;
{ converts well-known port numbers to service ID }
function Port2Svc( Port: DWORD ): string;
{ conversion of ICMP error codes to strings }
function ICMPErr2Str( ICMPErrCode: DWORD) : string;
implementation
//--------------General utilities-----------------------------------------------
{ extracts next "token" from string, then eats string }
function NextToken( var s: string; Separator: char ): string;
var
Sep_Pos: integer;
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[i], 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( '%d.', [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
Result := IntToStr(Port); // svk
for i := Low( WellKnownPorts ) to High( WellKnownPorts ) do
if Port = WellKnownPorts[i].Prt then begin { svk }
Result := Result +': ' + WellKnownPorts[i].Srv;
BREAK;
end;
end;
//-----------------------------------------------------------------------------
{ general, fixed network parameters }
procedure Get_NetworkParams( List: TStrings );
var
NetworkParams: TNetworkParams ;
I, ErrorCode: integer ;
begin
if not Assigned( List ) then EXIT;
List.Clear;
ErrorCode := IpHlpNetworkParams (NetworkParams) ;
if ErrorCode <> 0 then begin
List.Add (SysErrorMessage (ErrorCode));
exit;
end;
with NetworkParams do begin
List.Add( 'HOSTNAME : ' + HostName );
List.Add( 'DOMAIN : ' + DomainName );
List.Add( 'NETBIOS NODE TYPE : ' + NETBIOSTypes[NodeType] );
List.Add( 'DHCP SCOPE : ' + ScopeID );
List.Add( 'ROUTING ENABLED : ' + IntToStr( EnableRouting ) );
List.Add( 'PROXY ENABLED : ' + IntToStr( EnableProxy ) );
List.Add( 'DNS ENABLED : ' + IntToStr( EnableDNS ) );
if DnsServerTot <> 0 then begin
for I := 0 to Pred (DnsServerTot) do
List.Add( 'DNS SERVER ADDR : ' + DnsServerNames [I] ) ;
end; // if
end; // with
end ;
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
function IpHlpNetworkParams (var NetworkParams: TNetworkParams): integer ;
var
FixedInfo : PTFixedInfo; // Angus
InfoSize : Longint;
PDnsServer : PTIP_ADDR_STRING ; // Angus
begin
InfoSize := 0 ; // Angus
result := ERROR_NOT_SUPPORTED ;
if NOT LoadIpHlp then
exit ;
result := GetNetworkParams( Nil, @InfoSize ); // Angus
if result <> ERROR_BUFFER_OVERFLOW then
exit ; // Angus
GetMem (FixedInfo, InfoSize) ; // Angus
try
result := GetNetworkParams( FixedInfo, @InfoSize ); // Angus
if result <> ERROR_SUCCESS then
exit ;
NetworkParams.DnsServerTot := 0 ;
with FixedInfo^ do begin
NetworkParams.HostName := trim (HostName) ;
NetworkParams.DomainName := trim (DomainName) ;
NetworkParams.ScopeId := trim (ScopeID) ;
NetworkParams.NodeType := NodeType ;
NetworkParams.EnableRouting := EnableRouting ;
NetworkParams.EnableProxy := EnableProxy ;
NetworkParams.EnableDNS := EnableDNS ;
NetworkParams.DnsServerNames [0] := DNSServerList.IPAddress ; // Angus
if NetworkParams.DnsServerNames [0] <> '' then
NetworkParams.DnsServerTot := 1 ;
PDnsServer := DnsServerList.Next;
while PDnsServer <> Nil do begin
NetworkParams.DnsServerNames [NetworkParams.DnsServerTot] :=
PDnsServer^.IPAddress ; // Angus
inc (NetworkParams.DnsServerTot) ;
if NetworkParams.DnsServerTot >=
Length (NetworkParams.DnsServerNames) then
exit ;
PDnsServer := PDnsServer.Next ;
end;
end ;
finally
FreeMem (FixedInfo) ; // Angus
end ;
end;
//------------------------------------------------------------------------------
function ICMPErr2Str( ICMPErrCode: DWORD) : string;
begin
Result := 'Unknown Error : ' + IntToStr( ICMPErrCode );
dec( ICMPErrCode, ICMP_ERROR_BASE );
if ICMPErrCode in [Low(ICMpErr)..High(ICMPErr)] then
Result := ICMPErr[ ICMPErrCode];
end;
//------------------------------------------------------------------------------
// include bytes in/out for each adaptor
function IpHlpIfTable(var IfTot: integer; var IfRows: TIfRows): integer ;
var
I,
TableSize : integer;
pBuf, pNext : PChar;
begin
result := ERROR_NOT_SUPPORTED ;
if NOT LoadIpHlp then exit ;
SetLength (IfRows, 0) ;
IfTot := 0 ; // Angus
TableSize := 0;
// first call: get memsize needed
result := GetIfTable (Nil, @TableSize, false) ; // Angus
if result <> ERROR_INSUFFICIENT_BUFFER then exit ;
GetMem( pBuf, TableSize );
try
FillChar (pBuf^, TableSize, #0); // clear buffer, since W98 does not
// get table pointer
result := GetIfTable (PTMibIfTable (pBuf), @TableSize, false) ;
if result <> NO_ERROR then exit ;
IfTot := PTMibIfTable (pBuf)^.dwNumEntries ;
if IfTot = 0 then exit ;
SetLength (IfRows, IfTot) ;
pNext := pBuf + SizeOf(IfTot) ;
for i := 0 to Pred (IfTot) do
begin
IfRows [i] := PTMibIfRow (pNext )^ ;
inc (pNext, SizeOf (TMibIfRow)) ;
end;
finally
FreeMem (pBuf) ;
end ;
end;
procedure Get_IfTable( List: TStrings );
var
IfRows : TIfRows ;
Error, I : integer;
NumEntries : integer;
sDescr, sIfName: string ;
begin
if not Assigned( List ) then EXIT;
List.Clear;
SetLength (IfRows, 0) ;
Error := IpHlpIfTable (NumEntries, IfRows) ;
if (Error <> 0) then
List.Add( SysErrorMessage( GetLastError ) )
else if NumEntries = 0 then
List.Add( 'no entries.' )
else
begin
for I := 0 to Pred (NumEntries) do
begin
with IfRows [I] do
begin
if wszName [1] = #0 then
sIfName := ''
else
sIfName := WideCharToString (@wszName) ; // convert Unicode to string
sIfName := trim (sIfName) ;
sDescr := bDescr ;
sDescr := trim (sDescr);
List.Add (Format (
'%0.8x |%3d | %16s |%8d |%12d |%2d |%2d |%10d |%10d | %-s| %-s',
[dwIndex, dwType, MacAddr2Str( TMacAddress( bPhysAddr ),
dwPhysAddrLen ), dwMTU, dwSpeed, dwAdminStatus,
dwOPerStatus, Int64 (dwInOctets), Int64 (dwOutOctets), // counters are 32-bit
sIfName, sDescr] ) // Angus, added in/out
);
end;
end ;
end ;
SetLength (IfRows, 0) ; // free memory
end ;
function IpHlpIfEntry(Index: integer; var IfRow: TMibIfRow): integer ;
begin
result := ERROR_NOT_SUPPORTED ;
if NOT LoadIpHlp then exit ;
FillChar (IfRow, SizeOf (TMibIfRow), #0); // clear buffer, since W98 does not
IfRow.dwIndex := Index ;
result := GetIfEntry (@IfRow) ;
end ;
//-----------------------------------------------------------------------------
{ Info on installed adapters }
function IpHlpAdaptersInfo(var AdpTot: integer; var AdpRows: TAdaptorRows): integer ;
var
BufLen : DWORD;
AdapterInfo : PTIP_ADAPTER_INFO;
PIpAddr : PTIP_ADDR_STRING;
PBuf : PCHAR ;
I : integer ;
begin
SetLength (AdpRows, 4) ;
AdpTot := 0 ;
BufLen := 0 ;
result := GetAdaptersInfo( Nil, @BufLen );
if (result <> ERROR_INSUFFICIENT_BUFFER) and (result = NO_ERROR) then exit ;
GetMem( pBuf, BufLen );
try
FillChar (pBuf^, BufLen, #0); // clear buffer
result := GetAdaptersInfo( PTIP_ADAPTER_INFO (PBuf), @BufLen );
if result = NO_ERROR then
begin
AdapterInfo := PTIP_ADAPTER_INFO (PBuf) ;
while ( AdapterInfo <> nil ) do
begin
AdpRows [AdpTot].IPAddressTot := 0 ;
SetLength (AdpRows [AdpTot].IPAddressList, 2) ;
SetLength (AdpRows [AdpTot].IPMaskList, 2) ;
AdpRows [AdpTot].GatewayTot := 0 ;
SetLength (AdpRows [AdpTot].GatewayList, 2) ;
AdpRows [AdpTot].DHCPTot := 0 ;
SetLength (AdpRows [AdpTot].DHCPServer, 2) ;
AdpRows [AdpTot].PrimWINSTot := 0 ;
SetLength (AdpRows [AdpTot].PrimWINSServer, 2) ;
AdpRows [AdpTot].SecWINSTot := 0 ;
SetLength (AdpRows [AdpTot].SecWINSServer, 2) ;
AdpRows [AdpTot].CurrIPAddress := NULL_IP;
AdpRows [AdpTot].CurrIPMask := NULL_IP;
AdpRows [AdpTot].AdapterName := Trim( string( AdapterInfo^.AdapterName ) );
AdpRows [AdpTot].Description := Trim( string( AdapterInfo^.Description ) );
AdpRows [AdpTot].MacAddress := MacAddr2Str( TMacAddress(
AdapterInfo^.Address ), AdapterInfo^.AddressLength ) ;
AdpRows [AdpTot].Index := AdapterInfo^.Index ;
AdpRows [AdpTot].aType := AdapterInfo^.aType ;
AdpRows [AdpTot].DHCPEnabled := AdapterInfo^.DHCPEnabled ;
if AdapterInfo^.CurrentIPAddress <> Nil then
begin
AdpRows [AdpTot].CurrIPAddress := AdapterInfo^.CurrentIPAddress.IpAddress ;
AdpRows [AdpTot].CurrIPMask := AdapterInfo^.CurrentIPAddress.IpMask ;
end ;
// get list of IP addresses and masks for IPAddressList
I := 0 ;
PIpAddr := @AdapterInfo^.IPAddressList ;
while (PIpAddr <> Nil) do
begin
AdpRows [AdpTot].IPAddressList [I] := PIpAddr.IpAddress ;
AdpRows [AdpTot].IPMaskList [I] := PIpAddr.IpMask ;
PIpAddr := PIpAddr.Next ;
inc (I) ;
if Length (AdpRows [AdpTot].IPAddressList) <= I then
begin
SetLength (AdpRows [AdpTot].IPAddressList, I * 2) ;
SetLength (AdpRows [AdpTot].IPMaskList, I * 2) ;
end ;
end ;
AdpRows [AdpTot].IPAddressTot := I ;
// get list of IP addresses for GatewayList
I := 0 ;
PIpAddr := @AdapterInfo^.GatewayList ;
while (PIpAddr <> Nil) do
begin
AdpRows [AdpTot].GatewayList [I] := PIpAddr.IpAddress ;
PIpAddr := PIpAddr.Next ;
inc (I) ;
if Length (AdpRows [AdpTot].GatewayList) <= I then
SetLength (AdpRows [AdpTot].GatewayList, I * 2) ;
end ;
AdpRows [AdpTot].GatewayTot := I ;
// get list of IP addresses for GatewayList
I := 0 ;
PIpAddr := @AdapterInfo^.DHCPServer ;
while (PIpAddr <> Nil) do
begin
AdpRows [AdpTot].DHCPServer [I] := PIpAddr.IpAddress ;
PIpAddr := PIpAddr.Next ;
inc (I) ;
if Length (AdpRows [AdpTot].DHCPServer) <= I then
SetLength (AdpRows [AdpTot].DHCPServer, I * 2) ;
end ;
AdpRows [AdpTot].DHCPTot := I ;
// get list of IP addresses for PrimaryWINSServer
I := 0 ;
PIpAddr := @AdapterInfo^.PrimaryWINSServer ;
while (PIpAddr <> Nil) do
begin
AdpRows [AdpTot].PrimWINSServer [I] := PIpAddr.IpAddress ;
PIpAddr := PIpAddr.Next ;
inc (I) ;
if Length (AdpRows [AdpTot].PrimWINSServer) <= I then
SetLength (AdpRows [AdpTot].PrimWINSServer, I * 2) ;
end ;
AdpRows [AdpTot].PrimWINSTot := I ;
// get list of IP addresses for SecondaryWINSServer
I := 0 ;
PIpAddr := @AdapterInfo^.SecondaryWINSServer ;
while (PIpAddr <> Nil) do
begin
AdpRows [AdpTot].SecWINSServer [I] := PIpAddr.IpAddress ;
PIpAddr := PIpAddr.Next ;
inc (I) ;
if Length (AdpRows [AdpTot].SecWINSServer) <= I then
SetLength (AdpRows [AdpTot].SecWINSServer, I * 2) ;
end ;
AdpRows [AdpTot].SecWINSTot := I ;
AdpRows [AdpTot].LeaseObtained := AdapterInfo^.LeaseObtained ;
AdpRows [AdpTot].LeaseExpires := AdapterInfo^.LeaseExpires ;
inc (AdpTot) ;
if Length (AdpRows) <= AdpTot then
SetLength (AdpRows, AdpTot * 2) ; // more memory
AdapterInfo := AdapterInfo^.Next;
end ;
SetLength (AdpRows, AdpTot) ;
end ;
finally
FreeMem( pBuf );
end ;
end ;
procedure Get_AdaptersInfo( List: TStrings );
var
AdpTot: integer;
AdpRows: TAdaptorRows ;
Error: DWORD ;
I: integer ;
//J: integer ; jpt - see below
//S: string ; id.
begin
if not Assigned( List ) then EXIT;
List.Clear;
SetLength (AdpRows, 0) ;
AdpTot := 0 ;
Error := IpHlpAdaptersInfo(AdpTot, AdpRows) ;
if (Error <> 0) then
List.Add( SysErrorMessage( GetLastError ) )
else if AdpTot = 0 then
List.Add( 'no entries.' )
else
begin
for I := 0 to Pred (AdpTot) do
begin
with AdpRows [I] do
begin
//List.Add(AdapterName + '|' + Description ); // jpt : not useful
List.Add( Format('%8.8x | %6s | %16s | %2d | %16s | %16s | %16s',
[Index, ifTypeStr[aType], MacAddress, DHCPEnabled,
GatewayList [0], DHCPServer [0], PrimWINSServer [0]] ) );
{if IPAddressTot <> 0 then // jpt : not useful
begin
S := '' ;
for J := 0 to Pred (IPAddressTot) do
S := S + IPAddressList [J] + '/' + IPMaskList [J] + ' | ' ;
List.Add(IntToStr (IPAddressTot) + ' IP Addresse(s): ' + S);
end ;
List.Add( ' ' ); }
end ;
end ;
end ;
SetLength (AdpRows, 0) ;
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( Nil, @TableSize, false ); // Angus
//
if ErrorCode = ERROR_NO_DATA then
begin
List.Add( ' ARP-cache empty.' );
EXIT;
end;
// get table
GetMem( pBuf, TableSize );
NumEntries := 0 ;
try
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 ), sipNetToMediaTypeString[dwType]
]));
inc( pBuf, SizeOf( IPNetRow ) );
end;
end
else
List.Add( ' ARP-cache empty.' );
end
else
List.Add( SysErrorMessage( ErrorCode ) );
// we _must_ restore pointer!
finally
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPNetRow ) );
FreeMem( pBuf );
end ;
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;
NumEntries := 0 ;
ErrorCode := GetTCPTable(Nil, @TableSize, false ); // Angus
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
// get required memory size, call again
GetMem( pBuf, TableSize );
// get table
ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, false );
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 ) ),
stcpConnStateString[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_TCPStatistics( List: TStrings );
var
TCPStats : TMibTCPStats;
ErrorCode : DWORD;
begin
if not Assigned( List ) then EXIT;
List.Clear;
if NOT LoadIpHlp then exit ;
ErrorCode := GetTCPStatistics( @TCPStats );
if ErrorCode = NO_ERROR then
with TCPStats do
begin
List.Add( 'Retransmission algorithm : ' + sTcpRtoAlgorithmString[dwRTOAlgorithm] );
List.Add( 'Minimum Timeout : ' + IntToStr( dwRTOMin ) + ' ms' );
List.Add( 'Maximum Timeout : ' + 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;
function IpHlpTCPStatistics (var TCPStats: TMibTCPStats): integer ;
begin
result := ERROR_NOT_SUPPORTED ;
if NOT LoadIpHlp then exit ;
result := GetTCPStatistics( @TCPStats );
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;
NumEntries := 0 ;
ErrorCode := GetUDPTable(Nil, @TableSize, false );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
// get required size of memory, call again
GetMem( pBuf, TableSize );
// get table
ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, false );
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; ;
NumEntries := 0 ;
// first call: get table length
ErrorCode := GetIpAddrTable(Nil, @TableSize, true ); // Angus
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 "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
NumEntries := 0 ;
ErrorCode := GetIpForwardTable(Nil, @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
begin
if (dwForwardType < 1)
or (dwForwardType > 4) then
dwForwardType := 1 ; // Angus, allow for bad value
List.Add( Format(
'%15s | %15s | %15s | %8.8x | %7s | %5.5d | %7s | %2.2d',
[IPAddr2Str( dwForwardDest ),
IPAddr2Str( dwForwardMask ),
IPAddr2Str( dwForwardNextHop ),
dwForwardIFIndex,
sIpRouteTypeString[dwForwardType],
dwForwardNextHopAS,
sIpRouteProtoString[dwForwardProto],
dwForwardMetric1
] ) );
end ;
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;
if NOT LoadIpHlp 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( 'Datagrams Forwarded : ' + inttostr( dwForwDatagrams ) ); // Angus
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;
function IpHlpIPStatistics (var IPStats: TMibIPStats): integer ; // Angus
begin
result := ERROR_NOT_SUPPORTED ;
if NOT LoadIpHlp then exit ;
result := GetIPStatistics( @IPStats );
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;
//* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *//
function IpHlpUdpStatistics (UdpStats: TMibUDPStats): integer ; // Angus
begin
result := ERROR_NOT_SUPPORTED ;
if NOT LoadIpHlp then exit ;
result := GetUDPStatistics (@UdpStats) ;
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;
//--------------------------------
procedure DoNetworkParams(sg : TStringGrid);
var
NetworkParams : TNetworkParams;
i, ErrorCode : integer;
//*******************************
procedure AppendRow(const Parameter, Value : string);
var
RowIdx: integer;
begin
with sg do begin
RowIdx := RowCount-1;
Cells[0,RowIdx] := Parameter;
Cells[1,RowIdx] := Value;
RowCount := RowCount + 1;
end;
end;
//*******************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
ErrorCode := IpHlpNetworkParams (NetworkParams) ;
if ErrorCode <> 0 then begin
AppendRow('Error', SysErrorMessage (ErrorCode));
exit;
end ;
with NetworkParams do begin
AppendRow('Host name',HostName);
AppendRow('Domain name',DomainName);
AppendRow('NETBIOS node type', NETBIOSTypes[NodeType]);
AppendRow('DHCP scope', ScopeID);
AppendRow('Routing enabled', IntToStr(EnableRouting));
AppendRow('Proxy enabled', IntToStr(EnableProxy));
AppendRow('DNS enabled', IntToStr(EnableDNS));
if DnsServerTot <> 0 then begin
for i:= 0 to Pred (DnsServerTot) do begin
AppendRow('DNS server address', DnsServerNames[I]);
end;
end; // if DnsServerTot <> 0
end;
end;
//-----------------
procedure DoArpTable(sg : TStringGrid);
var
IPNetRow : TMibIPNetRow;
TableSize : DWORD;
NumEntries : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
//*************************************
procedure AppendRow(AdapterIndex, RemoteMAC, RemoteIp, ArpType : string);
var
RowIdx: integer;
begin
with sg do begin
RowIdx := RowCount-1;
Cells[0,RowIdx] := AdapterIndex;
Cells[1,RowIdx] := RemoteMAC;
Cells[2,RowIdx] := RemoteIp;
Cells[3,RowIdx] := ArpType;
RowCount := RowCount + 1;
end;
end;
//*************************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
// first call: get table length
TableSize := 0;
ErrorCode := GetIPNetTable( Nil, @TableSize, false ); // Angus
//
if ErrorCode = ERROR_NO_DATA then begin
AppendRow('ARP-cache empty.','','','' );
exit;
end;
// get table
GetMem( pBuf, TableSize );
NumEntries := 0 ;
try
ErrorCode := GetIpNetTable( PTMIBIPNetTable( pBuf ), @TableSize, false );
if ErrorCode = NO_ERROR then begin
NumEntries := PTMIBIPNetTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then begin // paranoia striking, but you never know...
inc( pBuf, SizeOf( DWORD ) ); // get past table size
for i := 1 to NumEntries do begin
IPNetRow := PTMIBIPNetRow( PBuf )^;
with IPNetRow do
AppendRow(HexLS(dwIndex),
MacAddr2Str( bPhysAddr, dwPhysAddrLen ),
IPAddr2Str( dwAddr ),
sipNetToMediaTypeString[dwType]);
inc( pBuf, SizeOf( IPNetRow ) );
end; // for
end else // if NumEntries > 0
AppendRow('ARP-cache empty.','','','' );
end else // if ErrorCode = NO_ERROR
AppendRow('Error', SysErrorMessage( ErrorCode ), '','');
// we _must_ restore pointer!
finally
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPNetRow ) );
FreeMem( pBuf );
end ;
end;
//------------------------
procedure DoTcpTable(sg: TStringGrid);
var
TCPRow : TMIBTCPRow;
i,NumEntries : integer;
TableSize : DWORD;
ErrorCode : DWORD;
DestIP : string;
pBuf : PChar;
//************************************************
procedure AppendRow(LocalIP, LocalPort, RemoteIP, RemotePort, State : string);
begin
sg.Cells[0,sg.RowCount-1] := LocalIp;
sg.Cells[1,sg.RowCount-1] := LocalPort;
sg.Cells[2,sg.RowCount-1] := RemoteIp;
sg.Cells[3,sg.RowCount-1] := RemotePort;
sg.Cells[4,sg.RowCount-1] := State;
sg.RowCount := sg.RowCount + 1;
end;
//************************************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
RecentIPs.Clear;
// first call : get size of table
TableSize := 0;
NumEntries := 0 ;
ErrorCode := GetTCPTable(Nil, @TableSize, false ); // Angus
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
exit;
// get required memory size, call again
GetMem( pBuf, TableSize );
// get table
ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, false );
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 );
AppendRow( IpAddr2Str( dwLocalAddr ),
Port2Svc( Port2Wrd( dwLocalPort ) ),
DestIP,
Port2Svc( Port2Wrd( dwRemotePort ) ),
stcpConnStateString[dwState] );
//
if (not ( dwRemoteAddr = 0 ))
and ( RecentIps.IndexOf(DestIP) = -1 ) then
RecentIPs.Add( DestIP );
end; // with TCPRow
inc( pBuf, SizeOf( TMIBTCPRow ) );
end;
end;
end
else
AppendRow('Error', SyserrorMessage( ErrorCode ), '','','' );
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibTCPRow ) );
FreeMem( pBuf );
end;
//----------------------------
procedure DoUdpTable(sg : TStringGrid);
var
UDPRow : TMIBUDPRow;
i,NumEntries : integer;
TableSize : DWORD;
ErrorCode : DWORD;
pBuf : PChar;
//************************************************
procedure AppendRow(LocalIp, Port : string);
begin
sg.Cells[0,sg.RowCount-1] := LocalIp;
sg.Cells[1,sg.RowCount-1] := Port;
sg.RowCount := sg.RowCount + 1;
end;
//************************************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
// first call : get size of table
TableSize := 0;
NumEntries := 0 ;
ErrorCode := GetUDPTable(Nil, @TableSize, false );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
exit;
// get required size of memory, call again
GetMem( pBuf, TableSize );
// get table
ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, false );
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
AppendRow(IpAddr2Str( dwLocalAddr ), Port2Svc( Port2Wrd( dwLocalPort ) ));
inc( pBuf, SizeOf( TMIBUDPRow ) );
end;
end
else
AppendRow('no entries.', '' );
end else
AppendRow('Error', SyserrorMessage( ErrorCode ));
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibUDPRow ) );
FreeMem( pBuf );
end;
//-------------------------------------
procedure DoTCPStatistics(sg : TStringGrid);
var
TCPStats : TMibTCPStats;
ErrorCode : DWORD;
//=================
procedure AppendRow(Parameter, Value: string);
begin
sg.Cells[0,sg.RowCount-1] := Parameter;
sg.Cells[1,sg.RowCount-1] := Value;
sg.RowCount := sg.RowCount + 1;
end;
//=================
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
if NOT LoadIpHlp then
exit;
ErrorCode := GetTCPStatistics( @TCPStats );
if ErrorCode = NO_ERROR then with TCPStats do begin
AppendRow('Retransmission algorithm', sTcpRtoAlgorithmString[dwRTOAlgorithm] );
AppendRow('Minimum Timeout', IntToStr( dwRTOMin ) + ' ms' );
AppendRow('Maximum Timeout', IntToStr( dwRTOMax ) + ' ms' );
AppendRow('Maximum Pending Connections', IntToStr( dwRTOAlgorithm ) );
AppendRow('Active Opens', IntToStr( dwActiveOpens ) );
AppendRow('Passive Opens', IntToStr( dwPassiveOpens ) );
AppendRow('Failed Open Attempts', IntToStr( dwAttemptFails ) );
AppendRow('Established connections Reset', IntToStr( dwEstabResets ) );
AppendRow('Current Established Connections', IntToStr( dwCurrEstab ) );
AppendRow('Segments Received', IntToStr( dwInSegs ) );
AppendRow('Segments Sent', IntToStr( dwOutSegs ) );
AppendRow('Segments Retransmitted', IntToStr( dwReTransSegs ) );
AppendRow('Incoming Errors', IntToStr( dwInErrs ) );
AppendRow('Outgoing Resets', IntToStr( dwOutRsts ) );
AppendRow('Cumulative Connections', IntToStr( dwNumConns ) );
end else
AppendRow('Error', SyserrorMessage( ErrorCode ));
end;
//---------------------------------------
procedure DoICMPInputStatistics( sg : TStringGrid );
var
ErrorCode : DWORD;
ICMPStats : PTMibICMPInfo;
//=================
procedure AppendRow(Parameter, Value: string);
begin
sg.Cells[0,sg.RowCount-1] := Parameter;
sg.Cells[1,sg.RowCount-1] := Value;
sg.RowCount := sg.RowCount + 1;
end;
//=================
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
New( ICMPStats );
ErrorCode := GetICMPStatistics( ICMPStats );
if ErrorCode = NO_ERROR then begin
with ICMPStats.InStats do begin
AppendRow('Messages received', IntToStr( dwMsgs ) );
AppendRow('Errors', IntToStr( dwErrors ) );
AppendRow('Destination Unreachable', IntToStr( dwDestUnreachs ) );
AppendRow('Time Exceeded', IntToStr( dwTimeEcxcds ) );
AppendRow('Parameter Problems', IntToStr( dwParmProbs ) );
AppendRow('Source Quench', IntToStr( dwSrcQuenchs ) );
AppendRow('Redirects', IntToStr( dwRedirects ) );
AppendRow('Echo Requests', IntToStr( dwEchos ) );
AppendRow('Echo Replies', IntToStr( dwEchoReps ) );
AppendRow('Timestamp Requests', IntToStr( dwTimeStamps ) );
AppendRow('Timestamp Replies', IntToStr( dwTimeStampReps ) );
AppendRow('Address Masks Requests', IntToStr( dwAddrMasks ) );
AppendRow('Address Mask Replies', IntToStr( dwAddrReps ) );
end;
end else
AppendRow('Error', SysErrorMessage( ErrorCode ));
Dispose( ICMPStats );
end;
//-------------------------------------------------
procedure DoIcmpOutputStatistics(sg : TStringGrid);
var
ErrorCode : DWORD;
ICMPStats : PTMibICMPInfo;
//=================
procedure AppendRow(Parameter, Value: string);
begin
sg.Cells[0,sg.RowCount-1] := Parameter;
sg.Cells[1,sg.RowCount-1] := Value;
sg.RowCount := sg.RowCount + 1;
end;
//=================
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
New( ICMPStats );
ErrorCode := GetICMPStatistics( ICMPStats );
if ErrorCode = NO_ERROR then begin
with ICMPStats.OutStats do begin
AppendRow('Messages sent', IntToStr( dwMsgs ) );
AppendRow('Errors', IntToStr( dwErrors ) );
AppendRow('Destination Unreachable', IntToStr( dwDestUnreachs ) );
AppendRow('Time Exceeded', IntToStr( dwTimeEcxcds ) );
AppendRow('Parameter Problems', IntToStr( dwParmProbs ) );
AppendRow('Source Quench', IntToStr( dwSrcQuenchs ) );
AppendRow('Redirects', IntToStr( dwRedirects ) );
AppendRow('Echo Requests', IntToStr( dwEchos ) );
AppendRow('Echo Replies', IntToStr( dwEchoReps ) );
AppendRow('Timestamp Requests', IntToStr( dwTimeStamps ) );
AppendRow('Timestamp Replies', IntToStr( dwTimeStampReps ) );
AppendRow('Address Masks Requests', IntToStr( dwAddrMasks ) );
AppendRow('Address Mask Replies', IntToStr( dwAddrReps ) );
end;
end else
AppendRow('Error', SysErrorMessage( ErrorCode ));
Dispose( ICMPStats );
end; {-- procedure DoIcmpOutput}
//------------------------------------------------------------------------------
procedure DoUdpStatistics(sg : TStringGrid);
var
UdpStats : TMibUDPStats;
ErrorCode : integer;
//=================
procedure AppendRow(Parameter, Value : string);
begin
sg.Cells[0,sg.RowCount-1] := Parameter;
sg.Cells[1,sg.RowCount-1] := Value;
sg.RowCount := sg.RowCount + 1;
end;
//=================
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
ErrorCode := GetUDPStatistics( @UdpStats );
if ErrorCode = NO_ERROR then begin
with UDPStats do begin
AppendRow('Datagrams (In)', inttostr( dwInDatagrams ) );
AppendRow('Datagrams (Out)', inttostr( dwOutDatagrams ) );
AppendRow('No Ports', inttostr( dwNoPorts ) );
AppendRow('Errors (In)', inttostr( dwInErrors ) );
AppendRow('UDP Listen Ports', inttostr( dwNumAddrs ) );
end;
end else
AppendRow('Error', SysErrorMessage( ErrorCode ));
end;
//---------------------------------------------------
procedure DoIpStatistics(sg : TStringGrid);
var
IPStats : TMibIPStats;
ErrorCode : integer;
//=================
procedure AppendRow(Parameter, Value : string);
begin
sg.Cells[0,sg.RowCount-1] := Parameter;
sg.Cells[1,sg.RowCount-1] := Value;
sg.RowCount := sg.RowCount + 1;
end;
//=================
begin
if not Assigned(sg) then
exit;
if NOT LoadIpHlp then
exit;
sg.RowCount := 2;
ErrorCode := GetIPStatistics( @IPStats );
if ErrorCode = NO_ERROR then begin
with IPStats do begin
if dwForwarding = 1 then
AppendRow('Forwarding Enabled', 'Yes' )
else
AppendRow('Forwarding Enabled', 'No' );
AppendRow('Default TTL', inttostr( dwDefaultTTL ) );
AppendRow('Datagrams Received', inttostr( dwInReceives ) );
AppendRow('Header Errors (In)', inttostr( dwInHdrErrors ) );
AppendRow('Address Errors (In)', inttostr( dwInAddrErrors ) );
AppendRow('Datagrams Forwarded', inttostr( dwForwDatagrams ) ); // Angus
AppendRow('Unknown Protocols (In)', inttostr( dwInUnknownProtos ) );
AppendRow('Datagrams Discarded', inttostr( dwInDiscards ) );
AppendRow('Datagrams Delivered', inttostr( dwInDelivers ) );
AppendRow('Requests Out', inttostr( dwOutRequests ) );
AppendRow('Routings Discarded', inttostr( dwRoutingDiscards ) );
AppendRow('No Routes (Out)', inttostr( dwOutNoRoutes ) );
AppendRow('Reassemble TimeOuts', inttostr( dwReasmTimeOut ) );
AppendRow('Reassemble Requests', inttostr( dwReasmReqds ) );
AppendRow('Successfull Reassemblies', inttostr( dwReasmOKs ) );
AppendRow('Failed Reassemblies', inttostr( dwReasmFails ) );
AppendRow('Successful Fragmentations', inttostr( dwFragOKs ) );
AppendRow('Failed Fragmentations', inttostr( dwFragFails ) );
AppendRow('Datagrams Fragmented', inttostr( dwFRagCreates ) );
AppendRow('Number of Interfaces', inttostr( dwNumIf ) );
AppendRow('Number of IP-addresses', inttostr( dwNumAddr ) );
AppendRow('Routes in Routing Table', inttostr( dwNumRoutes ) );
end;
end else
AppendRow('Error', SysErrorMessage( ErrorCode ));
end;
//------------------------------------------------------------------------------
procedure DoIPAddrTable(sg : TStringGrid);
var
IPAddrRow : TMibIPAddrRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
NumEntries : DWORD;
//***********************************
procedure AppendRow(const index,ip,subnet,broadcast,reasm: string);
begin
sg.Cells[0,sg.RowCount-1] := index;
sg.Cells[1,sg.RowCount-1] := ip;
sg.Cells[2,sg.RowCount-1] := subnet;
sg.Cells[3,sg.RowCount-1] := broadcast;
sg.Cells[4,sg.RowCount-1] := reasm;
sg.RowCount := sg.RowCount + 1;
end;
//***********************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
TableSize := 0; ;
NumEntries := 0 ;
// first call: get table length
ErrorCode := GetIpAddrTable(Nil, @TableSize, true ); // Angus
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
AppendRow( HexLS(dwIndex),
IPAddr2Str( dwAddr ),
IPAddr2Str( dwMask ),
IPAddr2Str( dwBCastAddr ),
IntToStr(dwReasmSize));
inc( pBuf, SizeOf( TMIBIPAddrRow ) );
end;
end else
AppendRow('no entries.','','','','' );
end else
AppendRow('Error', SysErrorMessage( ErrorCode ),'','','');
// we must restore pointer!
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
FreeMem( pBuf );
end;
//-----------------------------------------------------------------------------
{ gets entries in routing table; equivalent to "Route Print" }
procedure DoIPForwardTable(sg : TStringGrid);
var
IPForwRow : TMibIPForwardRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
pBuf : PChar;
NumEntries : DWORD;
//***********************************
procedure AppendRow(const fw_dest_ip,fw_mask,ip_next_hop,if_index,
fw_type,next_as_nr,fw_proto,fw_metric : string);
begin
sg.Cells[0,sg.RowCount-1] := fw_dest_ip;
sg.Cells[1,sg.RowCount-1] := fw_mask;
sg.Cells[2,sg.RowCount-1] := ip_next_hop;
sg.Cells[3,sg.RowCount-1] := if_index;
sg.Cells[4,sg.RowCount-1] := fw_type;
sg.Cells[5,sg.RowCount-1] := next_as_nr;
sg.Cells[6,sg.RowCount-1] := fw_proto;
sg.Cells[7,sg.RowCount-1] := fw_metric;
sg.RowCount := sg.RowCount + 1;
end;
//***********************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
TableSize := 0;
// first call: get table length
NumEntries := 0 ;
ErrorCode := GetIpForwardTable(Nil, @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 begin
if (dwForwardType < 1)
or (dwForwardType > 4) then
dwForwardType := 1 ; // Angus, allow for bad value
AppendRow( IPAddr2Str( dwForwardDest ),
IPAddr2Str( dwForwardMask ),
IPAddr2Str( dwForwardNextHop ),
HexLS(dwForwardIFIndex),
sIpRouteTypeString[dwForwardType],
IntToStr(dwForwardNextHopAS),
sIpRouteProtoString[dwForwardProto],
IntToStr(dwForwardMetric1) );
end ;
inc( pBuf, SizeOf( TMibIPForwardRow ) );
end;
end
else
AppendRow('no entries.','','','','','','','' );
end
else
AppendRow('Error', SysErrorMessage( ErrorCode ),'','','','','','');
dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibIPForwardRow ) );
FreeMem( pBuf );
end;
//------------------------------------------------
procedure DoAdaptersInfo(sg: TStringGrid);
var
AdpTot: integer;
AdpRows: TAdaptorRows ;
Error: DWORD ;
I: integer ;
//J: integer ; jpt - see below
//S: string ; id.
//****************************************
procedure AppendRow(const adaptIdx,Typ,MAC,DHCP,DefGateway,DHCPsrv,PrimaryWinsSrv:string);
begin
with sg do begin
Cells[0,RowCount-1] := adaptIdx;
Cells[1,RowCount-1] := Typ;
Cells[2,RowCount-1] := MAC;
Cells[3,RowCount-1] := DHCP;
Cells[4,RowCount-1] := DefGateway;
Cells[5,RowCount-1] := DHCPsrv;
Cells[6,RowCount-1] := PrimaryWinsSrv;
RowCount := RowCount + 1;
end;
end;
//****************************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
SetLength (AdpRows, 0) ;
AdpTot := 0 ;
Error := IpHlpAdaptersInfo(AdpTot, AdpRows) ;
if (Error <> 0) then
AppendRow('Error', SysErrorMessage( GetLastError ),'','','','','' )
else
if AdpTot = 0 then
AppendRow('no entries.','','','','','','' )
else begin
for i := 0 to Pred (AdpTot) do begin
with AdpRows [i] do begin
AppendRow( HexLS(Index),
ifTypeStr[aType],
MacAddress,
IntToStr(DHCPEnabled),
GatewayList [0],
DHCPServer [0],
PrimWINSServer [0]);
end ; // with
end ; // for
end ; // if else
SetLength (AdpRows, 0) ;
end ;
//---------------------------------------
procedure DoIfTable(sg: TStringGrid);
var
IfRows : TIfRows ;
Error, I : integer;
NumEntries : integer;
sDescr, sIfName: string;
//***************************************
procedure AppendRow(const index,typ,MAC,MTU,speed,adminstatus,operstatus,inp,outp,name,descr:string);
var
RowIdx: integer;
begin
with sg do begin
RowIdx := RowCount-1;
Cells[0,RowIdx] := index;
Cells[1,RowIdx] := typ;
Cells[2,RowIdx] := MAC;
Cells[3,RowIdx] := MTU;
Cells[4,RowIdx] := speed;
Cells[5,RowIdx] := AdminStatus;
Cells[6,RowIdx] := OperStatus;
Cells[7,RowIdx] := inp;
Cells[8,RowIdx] := outp;
Cells[9,RowIdx] := name;
Cells[10,RowIdx] := descr;
RowCount := RowCount +1;
end;
end;
//***************************************
begin
if not Assigned(sg) then
exit;
sg.RowCount := 2;
SetLength (IfRows, 0) ;
Error := IpHlpIfTable(NumEntries, IfRows);
if (Error <> 0) then
AppendRow('Error', SysErrorMessage(GetLastError),'','','','','','','','','')
else
if NumEntries = 0 then
AppendRow('no entries.','','','','','','','','','','' )
else begin
for I := 0 to Pred (NumEntries) do begin
with IfRows [I] do begin
if wszName [1] = #0 then
sIfName := ''
else
sIfName := WideCharToString (@wszName) ; // convert Unicode to string
sIfName := trim (sIfName) ;
sDescr := bDescr ;
sDescr := trim (sDescr);
AppendRow(
HexLS(dwIndex),
HexLS(dwType),
MacAddr2Str( TMacAddress( bPhysAddr ), dwPhysAddrLen ),
IntToStr(dwMTU),
IntToStr(dwSpeed),
IntToStr(dwAdminStatus),
IntToStr(dwOPerStatus),
IntToStr(Int64 (dwInOctets)),
IntToStr(Int64 (dwOutOctets)), // counters are 32-bit
sIfName,
sDescr ); // Angus, added in/out
end;
end ;
end ;
SetLength (IfRows, 0) ; // free memory
end ;
initialization
RecentIPs := TStringList.Create;
finalization
RecentIPs.Free;
end.
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
