?? iphelper.pas
字號:
end;
//取得列表
GetMem( pBuf, TableSize );
ErrorCode := GetIpNetTable( PTMIBIPNetTable( pBuf ), @TableSize, false );
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMIBIPNetTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
inc( pBuf, SizeOf( DWORD ) );
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 ) );
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, false );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
// get required size of memory, 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 ) ),
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;
//TCP數據流量統計
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;
//取得UDP連接的列表
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;
//取得列表所需的內存大小
TableSize := 0;
ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, false );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
//分配內存
GetMem( pBuf, TableSize );
//取得列表
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 ) );
for i := 1 to NumEntries do
begin
UDPRow := PTMIBUDPRow( pBuf )^; //下一個記錄
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;
//獲得IP地址及其配置信息
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; ;
//取得列表所需內存大小
ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
GetMem( pBuf, TableSize );
//獲得列表
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 ) );
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;
//獲得列表所需的內存大小
ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ),
@TableSize, true);
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
//獲取列表
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;
//IP數據流量統計
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;
//UDP數據流量統計
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;
//ICMP數據流量統計
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
}
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -