1166 lines
41 KiB
Plaintext
1166 lines
41 KiB
Plaintext
unit MagentaPackhdrs;
|
|
|
|
{ Magenta Systems Internet Packet Monitoring Components
|
|
|
|
Magenta Systems raw socket packet headers and helpers.
|
|
Updated by Angus Robertson, Magenta Systems Ltd, England, v1.3 9th August 2010
|
|
delphi@magsys.co.uk, http://www.magsys.co.uk/delphi/
|
|
Copyright Magenta Systems Ltd
|
|
|
|
Some of the TCP/IP headers are taken from 'Hands-On TCP/IP Programming' by Alfred
|
|
Mirzagotov in The Delphi Magazine January 2004.
|
|
|
|
8 Aug 2008 - 1.2 - updated to support ICS V6 and V7, and Delphi 2009
|
|
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, Classes, SysUtils, Winsock,
|
|
Magsubs1, MagClasses,
|
|
OverbyteIcsWSocket ;
|
|
|
|
const
|
|
sTrafficMask = '%-20s %-50s %-12s %5s %7s %5s %7s %8s %8s' ;
|
|
// pc09.magenta ermintrude.digitalspy.co.uk www-http 1.51K [10] 6.94K [10] 19:54:17 19:54:27
|
|
sTrafficHdr = 'Local IP Remote IP Service Sent [packet] Recv [packet] First Last' ;
|
|
sServiceMask = '%-12s %5s %7s %5s %7s %5s' ;
|
|
// www-http 1.51K [10] 6.94K [10] 22
|
|
sServiceHdr = 'Service Sent [packet] Recv [packet] Hosts' ;
|
|
MaxDnsLookupAttempts = 6 ; // total for both addresses
|
|
InitialTrafficSize = 100 ;
|
|
|
|
type
|
|
|
|
TMacAddr = array [0..5] of byte ; // a MAC address
|
|
|
|
// record used to return packet to application for both raw sockets and winpcap
|
|
|
|
TPacketInfo = record
|
|
PacketLen: integer ; // total length of packet including network interface layer
|
|
EtherProto: word ; // ethernet protocol
|
|
EtherSrc: TMacAddr ; // ethernet MAC addresses
|
|
EtherDest: TMacAddr ;
|
|
AddrSrc: TInAddr ; // IP addresses are 32-bit binary (we may not need ASCII)
|
|
AddrDest: TInAddr ;
|
|
PortSrc: integer ; // transport layer ports
|
|
PortDest: integer ;
|
|
ProtoType: byte ; // transport layer protocol
|
|
TcpFlags: word ; // TCP/IP packet type flags
|
|
SendFlag: boolean ; // true if packet being sent from local IP
|
|
IcmpType: byte ; // ICMP packet type
|
|
DataLen: integer ; // length of data (less headers)
|
|
DataBuf: AnsiString ; // packet data (may be blank even if datalen<>0)
|
|
PacketDT: TDateTime ; // when packet was captured
|
|
end ;
|
|
|
|
TPacketEvent = procedure (Sender: TObject; PacketInfo: TPacketInfo) of object;
|
|
|
|
// record used for maintaining traffic statistics
|
|
|
|
TTrafficInfo = packed record // first four elements are used for sorting, keep together and packed
|
|
AddrLoc: TInAddr ; // IP addresses are 32-bit binary
|
|
AddrRem: TInAddr ;
|
|
ServPort: word ; // service port
|
|
PackType: word ; // protocol or packet type, TCP, UDP, ARP, ICMP, etc - 12 bytes to here
|
|
HostLoc: string ; // host domains for IP addresses, if available
|
|
HostRem: string ;
|
|
ServName: string ; // looked up
|
|
BytesSent: int64 ; // traffic
|
|
BytesRecv: int64 ;
|
|
PacksSent: integer ;
|
|
PacksRecv: integer ;
|
|
LookupAttempts: integer ; // how many host name lookup attempts
|
|
FirstDT: TDateTime ; // when this traffic started
|
|
LastDT: TDateTime ; // last traffic update
|
|
end ;
|
|
PTrafficInfo = ^TTrafficInfo ;
|
|
|
|
TServiceInfo = packed record // first two elements are used for sorting, keep together and packed
|
|
ServPort: word ; // service port
|
|
PackType: word ; // protocol or packet type, TCP, UDP, ARP, ICMP, etc - 4 bytes to here
|
|
ServName: string ; // looked up
|
|
TotalHosts: integer; // how many different hosts for this service
|
|
BytesSent: int64 ; // traffic
|
|
BytesRecv: int64 ;
|
|
PacksSent: integer ;
|
|
PacksRecv: integer ;
|
|
end ;
|
|
PServiceInfo = ^TServiceInfo ;
|
|
|
|
const
|
|
TrafficIPCompLen = 12 ;
|
|
ServiceCompLen = 4 ;
|
|
|
|
type
|
|
THdrEthernet = packed record // Ethernet frame header - Network Interface Layer
|
|
dmac: TMacAddr;
|
|
smac: TMacAddr;
|
|
protocol: WORD;
|
|
end;
|
|
PHdrEthernet = ^THdrEthernet ;
|
|
|
|
const //rfc1340 ethernet protocols
|
|
PROTO_PUP = $0200;
|
|
PROTO_XNS = $0600;
|
|
PROTO_IP = $0800;
|
|
PROTO_ARP = $0806;
|
|
PROTO_REVARP = $0835;
|
|
PROTO_SCA = $6007;
|
|
PROTO_ATALK = $809B;
|
|
PROTO_AARP = $80F3;
|
|
PROTO_IPX = $8137;
|
|
PROTO_NOVELL = $8138;
|
|
PROTO_SNMP = $814C;
|
|
PROTO_IPV6 = $86DD;
|
|
PROTO_XIMETA = $88AD;
|
|
PROTO_LOOP = $900D;
|
|
|
|
OFFSET_IP = 14; // length of ethernet frame header
|
|
|
|
TCP_FLAG_FIN = $01; // TCP flags
|
|
TCP_FLAG_SYN = $02;
|
|
TCP_FLAG_RST = $04;
|
|
TCP_FLAG_PSH = $08;
|
|
TCP_FLAG_ACK = $10;
|
|
TCP_FLAG_URG = $20;
|
|
TCP_FLAG_ECH = $40;
|
|
TCP_FLAG_CWR = $80;
|
|
|
|
type
|
|
|
|
THdrIP = packed record // IP header (RFC 791) - Internet Layer
|
|
ihl_ver : BYTE; // Combined field:
|
|
// ihl:4 - IP header length divided by 4
|
|
// version:4 - IP version
|
|
tos : BYTE; // IP type-of-service field
|
|
tot_len : WORD; // total length
|
|
id : WORD; // unique ID
|
|
frag_off: WORD; // Fragment Offset + fragmentation flags (3 bits)
|
|
ttl : BYTE; // time to live
|
|
protocol: BYTE; // protocol type
|
|
check : WORD; // IP header checksum
|
|
saddr : TInAddr; // source IP
|
|
daddr : TInAddr; // destination IP
|
|
{The options start here...}
|
|
end;
|
|
PHdrIP = ^THdrIP;
|
|
|
|
(* Most of IP header is self-explanatory, but here are some
|
|
extra details for the curious (more in RFC 791):
|
|
|
|
-ih.ihl is header length in bytes divided by 4
|
|
Internet Header Length is the length of the internet
|
|
header in 32 bit words, and thus points to the beginning
|
|
of the data. Note that the minimum value for a correct
|
|
header is 5.
|
|
|
|
-ih.tos - IP type-of-service field provides an indication of the
|
|
quality of service desired. Several networks offer service precedence,
|
|
which somehow treats high precedence traffic as more important than
|
|
other traffic (generally by accepting only traffic above a certain
|
|
precedence at time of high load).
|
|
|
|
-ih.id - An identifying value assigned by the sender to aid in
|
|
assembling the fragments of a datagram.
|
|
|
|
-ih.frag_off contains 3 bit fragmentation flags and fragment offset.
|
|
These are used to keep track of the pieces when a datagram has to
|
|
be split up. This can happen when datagrams are forwarded through
|
|
a network for which they are too big. See RFC815 about reassembly.
|
|
Bit 0: reserved, must be zero
|
|
Bit 1: (DF) 0 = May Fragment, 1 = Don't Fragment.
|
|
Bit 2: (MF) 0 = Last Fragment, 1 = More Fragments.
|
|
Bits?: indicates where in the datagram this fragment belongs
|
|
|
|
-ih.protocol tells IP at the other end to send the datagram
|
|
to TCP. Although most IP traffic uses TCP, there are other
|
|
protocols that can use IP, so you have to tell IP which
|
|
protocol to send the datagram to.
|
|
|
|
-ih.check[sum] allows IP at the other end to verify that the header
|
|
wasn't damaged in transit. Note that TCP and IP have separate
|
|
checksums. IP only needs to be able to verify that the header
|
|
didn't get damaged in transit, or it could send a message to
|
|
the wrong place.
|
|
*)
|
|
|
|
THdrTCP = packed record // TCP header (RFC 793) - Transport Layer
|
|
source : WORD; // source port
|
|
dest : WORD; // destination port
|
|
seq : DWORD; // sequence number
|
|
ack_seq: DWORD; // next sequence number
|
|
flags : WORD; // Combined field:
|
|
// res1:4 - reserved, must be 0
|
|
// doff:4 - TCP header length divided by 4
|
|
// fin:1 - FIN
|
|
// syn:1 - SYN
|
|
// rst:1 - Reset
|
|
// psh:1 - Push
|
|
// ack:1 - ACK
|
|
// urg:1 - Urgent
|
|
// res2:2 - reserved, must be 0
|
|
window : WORD; // window size
|
|
check : WORD; // checksum, computed later
|
|
urg_ptr: WORD; // used for async messaging?
|
|
end;
|
|
PHdrTCP = ^THdrTCP;
|
|
(* Details of TCP header can be found in RFC 793
|
|
|
|
-th.seq - the sequence number of the first data octet in this segment
|
|
(except when SYN is present). If SYN is present the sequence number
|
|
is the initial sequence number (ISN) and the first data octet is ISN+1.
|
|
|
|
-th.doff - data offset - the number of 32 bit words in the TCP Header.
|
|
This indicates where the data begins. The TCP header (even one
|
|
including options) is an integral number of 32 bits long.
|
|
|
|
-th.ack_seq is used when ACK flag is set. If ACK is set this field
|
|
contains the value of the next sequence number the sender of the
|
|
segment is expecting to receive. Once a connection is established
|
|
this is always sent. This simply means that receiver got all the
|
|
octets up to the specific sequence number.
|
|
For example, sending a packet with an acknowledgement of 1500
|
|
indicates that you have received all the data up to octet
|
|
number 1500. If the sender doesn't get an acknowledgement
|
|
within a reasonable amount of time, it sends the data again.
|
|
|
|
-th.window is used to control how much data can be in transit
|
|
at any one time. It is not practical to wait for each datagram
|
|
to be acknowledged before sending the next one. That would slow
|
|
things down too much. On the other hand, you can't just keep
|
|
sending, or a fast computer might overrun the capacity of a slow
|
|
one to absorb data. Thus each end indicates how much new data
|
|
it is currently prepared to absorb by putting the number of
|
|
octets in its "window" field. As the computer receives data,
|
|
the amount of space left in its window decreases. When it goes
|
|
to zero, the sender has to stop. As the receiver processes
|
|
the data, it increases its window, indicating that it is ready
|
|
to accept more data.
|
|
[ See RFC813 for details and "silly-window-syndrome" ]
|
|
Often the same datagram can be used to acknowledge receipt of
|
|
a set of data and to give permission for additional new data
|
|
(by an updated window).
|
|
|
|
-th.urgent field allows one end to tell the other to skip ahead
|
|
in its processing to a particular octet. This is often useful
|
|
for handling asynchronous events, for example when you type
|
|
a control character or other command that interrupts output.
|
|
*)
|
|
|
|
THdrUDP = packed record // UDP header (RFC 768) - Transport Layer
|
|
src_port: WORD; // source port
|
|
dst_port: WORD; // destination port
|
|
length : WORD; // length, including this header
|
|
checksum: WORD; // UDP checksum
|
|
end;
|
|
PHdrUDP = ^THdrUDP;
|
|
|
|
type
|
|
TTcpFlagType = (ftFIN, ftSYN, ftRST, ftPSH, ftACK, ftURG);
|
|
|
|
|
|
// class used for maintaining traffic statistics
|
|
type
|
|
|
|
TTrafficClass = class(TComponent)
|
|
protected
|
|
{ Protected declarations }
|
|
FTrafficInfo: array of TTrafficInfo ;
|
|
FServiceInfo: array of TServiceInfo ;
|
|
FTrafficList: TFindList ;
|
|
FServiceList: TFindList ;
|
|
FTotTraffic: integer ;
|
|
FTotService: integer ;
|
|
FLookupLoc: integer ;
|
|
FLookupRem: integer ;
|
|
FLookupBusy: boolean ;
|
|
FWSocket: TWSocket ;
|
|
procedure DoneLookup (Sender: TObject; Error: Word);
|
|
procedure NextLookup ;
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Clear ;
|
|
procedure Add (PacketInfo: TPacketInfo) ;
|
|
procedure LookupHosts ;
|
|
procedure UpdateService ;
|
|
function GetServNameEx (PackType, ServPort: word): string ;
|
|
function GetUnSortTraf (item: integer): PTrafficInfo ;
|
|
function GetSortedTraf (item: integer): PTrafficInfo ;
|
|
function GetFmtTrafStr (item: integer): string ;
|
|
function GetSortedServ (item: integer): PServiceInfo ;
|
|
function GetFmtServStr (item: integer): string ;
|
|
function GetTotals: TServiceInfo ;
|
|
published
|
|
property TotTraffic: integer read FTotTraffic ;
|
|
property TotService: integer read FTotService ;
|
|
end;
|
|
|
|
var
|
|
PortNameArray: array of string ; // dynamic array for TCP and UDP port names, indexed by number
|
|
TotalPortNames: integer = -1 ;
|
|
ProtoNameArray: array of string ; // dynamic array for IP protocol names, indexed by number
|
|
TotalProtoNames: integer = -1 ;
|
|
PortListFileName: string = 'ports.txt' ;
|
|
ProtocolListFileName: string = 'protocols.txt' ;
|
|
|
|
// get name given a number
|
|
function GetEtherProtoName (protocol: word): string ;
|
|
function GetIPProtoName(protocol: integer): string ;
|
|
function GetServiceName(s_port, d_port: Integer): string;
|
|
function GetServName (port: integer): string ;
|
|
function GetServiceNameEx(s_port, d_port: Integer): string;
|
|
function GetICMPType (x: word): string ;
|
|
function GetFlags(flags: word): string ;
|
|
procedure LoadPortNameList ;
|
|
|
|
// these routines manipulate combined fields (set/get nibbles or bits)
|
|
procedure SetTHdoff(VAR th: THdrTCP; value: Byte);
|
|
function GetTHdoff(th: THdrTCP): Word;
|
|
procedure SetTHflag(VAR th: THdrTCP; flag: TTcpFlagType; on: Boolean);
|
|
function GetTHflag(th: THdrTCP; flag: TTcpFlagType): Boolean;
|
|
procedure SetIHver(VAR ih: THdrIP; value: Byte);
|
|
function GetIHver(ih: THdrIP): Byte;
|
|
procedure SetIHlen(VAR ih: THdrIP; value: Byte);
|
|
function GetIHlen(ih: THdrIP): Word;
|
|
|
|
function IPToStr (IPAddr: TInAddr): string ;
|
|
function StrToIP (strIP: string): TInAddr ;
|
|
function IsIPStr (strIP: string): boolean ;
|
|
function IsFmtIPStr (var strIP: string): boolean ;
|
|
function Str2IP (strIP: string; var IPAddr: TInAddr): boolean ;
|
|
function AscToInt (value: string): Integer;
|
|
function MacToStr (MacAddr: TMacAddr): string ;
|
|
|
|
implementation
|
|
|
|
type
|
|
|
|
TEtherProto = record
|
|
iType: integer ;
|
|
iName: string ;
|
|
end ;
|
|
|
|
TIPProto = record
|
|
iType: integer ;
|
|
iName: string ;
|
|
end ;
|
|
|
|
TWellKnownSvc = record
|
|
port: integer ;
|
|
svc: string ;
|
|
end ;
|
|
|
|
var
|
|
// Ethernet Protocol types
|
|
EtherProto: array[1..14] Of TEtherProto = (
|
|
(iType: PROTO_PUP; iName: 'PUP'),
|
|
(iType: PROTO_XNS; iName: 'XNS'),
|
|
(iType: PROTO_IP; iName: 'IP'),
|
|
(iType: PROTO_ARP; iName: 'ARP'),
|
|
(iType: PROTO_REVARP; iName: 'RARP'),
|
|
(iType: PROTO_SCA; iName: 'SCA'),
|
|
(iType: PROTO_ATALK; iName: 'ATLK'),
|
|
(iType: PROTO_AARP; iName: 'AARP'),
|
|
(iType: PROTO_IPX; iName: 'IPX'),
|
|
(iType: PROTO_NOVELL; iName: 'NOVL'),
|
|
(iType: PROTO_SNMP; iName: 'SNMP'),
|
|
(iType: PROTO_IPV6; iName: 'IPV6'),
|
|
(iType: PROTO_XIMETA; iName: 'XIMT'),
|
|
(iType: PROTO_LOOP; iName: 'LOOP')
|
|
);
|
|
|
|
// IP Protocol types
|
|
IpProto: array[1..6] Of TIPProto = (
|
|
(iType: IPPROTO_IP; iName: 'IP'), // dummy
|
|
(iType: IPPROTO_ICMP; iName: 'ICMP'),
|
|
(iType: IPPROTO_IGMP; iName: 'IGMP'),
|
|
(iType: IPPROTO_TCP; iName: 'TCP'),
|
|
(iType: IPPROTO_UDP; iName: 'UDP'),
|
|
(iType: $80; iName: 'ISO-IP')
|
|
);
|
|
|
|
// Well known service ports
|
|
WellKnownSvcs: array[1..46] of TWellKnownSvc = (
|
|
( port: 0; svc: 'LOOPBACK'),
|
|
( port: 1; svc: 'TCPMUX'), { TCP Port Service Multiplexer }
|
|
( port: 7; svc: 'ECHO' ), { Echo }
|
|
( port: 9; svc: 'DISCARD' ), { Discard }
|
|
( port: 13; svc: 'DAYTIME' ), { DayTime }
|
|
( port: 17; svc: 'QOTD' ), { Quote Of The Day }
|
|
( port: 19; svc: 'CHARGEN' ), { Character Generator }
|
|
( port: 20; svc: 'FTP_DATA' ), { Ftp }
|
|
( port: 21; svc: 'FTP_CTL' ), { File Transfer Control Protocol}
|
|
( port: 22; svc: 'SSH' ), { SSH Remote Login Protocol }
|
|
( port: 23; svc: 'TELNET' ), { TelNet }
|
|
( port: 25; svc: 'SMTP' ), { Simple Mail Transfer Protocol }
|
|
( port: 37; svc: 'TIME' ),
|
|
( port: 42; svc: 'NAME' ), { Host Name Server }
|
|
( port: 43; svc: 'WHOIS' ), { WHO IS service }
|
|
( port: 53; svc: 'DNS' ), { Domain Name Service }
|
|
( port: 66; svc: 'SQL*NET' ), { Oracle SQL*NET }
|
|
( port: 67; svc: 'BOOTPS' ), { BOOTP Server }
|
|
( port: 68; svc: 'BOOTPC' ), { BOOTP Client }
|
|
( port: 69; svc: 'TFTP' ), { Trivial FTP }
|
|
( port: 70; svc: 'GOPHER' ), { Gopher }
|
|
( port: 79; svc: 'FINGER' ), { Finger }
|
|
( port: 80; svc: 'HTTP' ), { HTTP }
|
|
( port: 88; svc: 'KERBEROS' ), { Kerberos }
|
|
( port: 92; svc: 'NPP' ), { Network Printing Protocol }
|
|
( port: 93; svc: 'DCP' ), { Device Control Protocol }
|
|
( port: 109; svc: 'POP2' ), { Post Office Protocol Version 2}
|
|
( port: 110; svc: 'POP3' ), { Post Office Protocol Version 3}
|
|
( port: 111; svc: 'SUNRPC' ), { SUN Remote Procedure Call }
|
|
( port: 119; svc: 'NNTP' ), { Network News Transfer Protocol}
|
|
( port: 123; svc: 'NTP' ), { Network Time protocol }
|
|
( port: 135; svc: 'LOCSVC' ), { Location Service }
|
|
( port: 137; svc: 'NETBIOS-NAME' ), { NETBIOS Name service }
|
|
( port: 138; svc: 'NETBIOS-DATA' ), { NETBIOS Datagram Service }
|
|
( port: 139; svc: 'NETBIOS-SESS' ), { NETBIOS Session Service }
|
|
( port: 161; svc: 'SNMP' ), { Simple Netw. Mgmt Protocol }
|
|
( port: 162; svc: 'SNMPTRAP' ), { SNMP TRAP }
|
|
( port: 220; svc: 'IMAP3' ), { Interactive Mail Access Protocol v3 }
|
|
( port: 443; svc: 'HTTPS' ), { HTTPS }
|
|
( port: 445; svc: 'MS-DS-SMB'), { Microsoft Directory Services - SAMBA }
|
|
( port: 514; svc: 'SYSLOG' ), { UDP Syslog }
|
|
( port: 520; svc: 'ROUTER' ), { UDP Router }
|
|
( port:1433; svc: 'MSSQLSRV' ), { MS SQL Server }
|
|
( port:1434; svc: 'MSSQLMON' ), { MS SQL Monitor }
|
|
( port:3306; svc: 'MYSQL' ), { MySQL }
|
|
( port:5900; svc: 'VNC' ) { VNC - similar to PC Anywhere }
|
|
);
|
|
|
|
function GetEtherProtoName (protocol: word): string ;
|
|
var
|
|
I: integer;
|
|
begin
|
|
result := IntToHex (protocol, 4) ;
|
|
for I := 1 To SizeOf (EtherProto) div SizeOf (TEtherProto) do
|
|
begin
|
|
if protocol = EtherProto [I].itype then result := EtherProto [I].iName ;
|
|
end ;
|
|
end;
|
|
|
|
function GetIPProtoName (protocol: integer): string ;
|
|
var
|
|
I: integer;
|
|
begin
|
|
result := IntToStr (protocol) ;
|
|
for I := 1 To SizeOf (IPPROTO) div SizeOf (TIPProto) do
|
|
begin
|
|
if protocol = IPPROTO [I].itype then result := IPPROTO [I].iName ;
|
|
end ;
|
|
end;
|
|
|
|
function GetServiceName (s_port, d_port: integer): string ;
|
|
var
|
|
I: integer;
|
|
begin
|
|
result := '';
|
|
for I := 1 to SizeOf (WellKnownSvcs) div SizeOf (TWellKnownSvc) do
|
|
begin
|
|
if (s_port = WellKnownSvcs [I].port) OR (d_port = WellKnownSvcs [I].port) then
|
|
begin
|
|
result := WellKnownSvcs[I].svc;
|
|
exit ;
|
|
end;
|
|
end ;
|
|
if (result = '') and (s_port < 1024) then result := '<' + IntToStr (s_port) + '>' ;
|
|
if (result = '') and (d_port < 1024) then result := '<' + IntToStr (d_port) + '>' ;
|
|
end ;
|
|
|
|
function GetICMPType(x: word): string ;
|
|
begin
|
|
result := 'UNKNOWN';
|
|
case x of
|
|
0: Result := 'ECHO_REPLY'; // Echo Reply
|
|
3: Result := 'DEST-UNREA'; // Destination Unreachable
|
|
4: Result := 'SRC_Q'; // Source Quench
|
|
5: Result := 'REDIR'; // Redirect
|
|
8: Result := 'ECHO'; // Echo
|
|
11: Result := 'TTLX'; // Time Exceeded
|
|
12: Result := 'BADPAR'; // Parameter Problem
|
|
13: Result := 'TIME'; // Timestamp
|
|
14: Result := 'TIME_REPLY'; // Timestamp Reply
|
|
15: Result := 'INFO'; // Information Request
|
|
16: Result := 'INFO_REPLY'; // Information Reply
|
|
end ;
|
|
end ;
|
|
|
|
// load well know port list from file ports.txt, which is copied from RFC 1700 with
|
|
// superflous lines removed or prefixed with #
|
|
// Note: currently using UDP port where TCP is different, should really have two arrays
|
|
|
|
procedure LoadPortNameList ;
|
|
var
|
|
PortInfo: TStringList ;
|
|
line, port: string ;
|
|
I, J, K, L, M: integer ;
|
|
begin
|
|
TotalPortNames := 0 ;
|
|
if FileExists (PortListFileName) then
|
|
begin
|
|
TotalPortNames := 10000 ;
|
|
SetLength (PortNameArray, TotalPortNames) ;
|
|
PortInfo := TStringList.Create ;
|
|
try
|
|
try
|
|
PortInfo.LoadFromFile (PortListFileName) ;
|
|
I := PortInfo.Count ;
|
|
except
|
|
I := 0 ;
|
|
end ;
|
|
if I <> 0 then
|
|
begin
|
|
for J := 0 to Pred (I) do
|
|
begin
|
|
// sample line - ignore / onwards
|
|
// echo 7/tcp Echo
|
|
line := PortInfo [J] ;
|
|
if Length (line) < 5 then continue ;
|
|
if line [1] = '#' then continue ;
|
|
K := Pos (' ', line) ;
|
|
M := Pos ('/', line) ;
|
|
if (K < 2) or (M < K) then continue ;
|
|
port := Copy (line, K, M - K) ;
|
|
L := AscToInt (Trim (port)) ;
|
|
if (L = 0) then continue ;
|
|
if L >= TotalPortNames then continue ; // ignore high ports
|
|
//if PortNameArray [L] = '' then
|
|
PortNameArray [L] := Copy (line, 1, Pred (K)) ;
|
|
end ;
|
|
end
|
|
else
|
|
TotalPortNames := 0 ;
|
|
finally
|
|
PortInfo.Destroy ;
|
|
end ;
|
|
end ;
|
|
end ;
|
|
|
|
function GetServName (port: integer): string ;
|
|
var
|
|
I: integer;
|
|
begin
|
|
result := '' ;
|
|
if TotalPortNames < 0 then LoadPortNameList ; // try and load list
|
|
if (port > 0) and (port < TotalPortNames) then result := PortNameArray [port] ;
|
|
if result = '' then // nothing in list, try hard coded ports
|
|
begin
|
|
for I := 1 to SizeOf (WellKnownSvcs) div SizeOf (TWellKnownSvc) do
|
|
begin
|
|
if (port = WellKnownSvcs [I].port) then
|
|
begin
|
|
result := WellKnownSvcs[I].svc;
|
|
exit ;
|
|
end;
|
|
end ;
|
|
end ;
|
|
if (result = '') then result := '<' + IntToStr (port) + '>' ;
|
|
end ;
|
|
|
|
function GetServiceNameEx (s_port, d_port: integer): string ;
|
|
var
|
|
I: integer;
|
|
s_name, d_name: string ;
|
|
begin
|
|
result := '';
|
|
s_name := '' ;
|
|
d_name := '';
|
|
if TotalPortNames < 0 then LoadPortNameList ; // try and load list
|
|
if (s_port > 0) and (s_port < TotalPortNames) then s_name := PortNameArray [s_port] ;
|
|
if (d_port > 0) and (d_port < TotalPortNames) then d_name := PortNameArray [d_port] ;
|
|
if d_name <> '' then
|
|
result := d_name
|
|
else
|
|
result := s_name ;
|
|
if result = '' then // nothing in list, try hard coded ports
|
|
begin
|
|
for I := 1 to SizeOf (WellKnownSvcs) div SizeOf (TWellKnownSvc) do
|
|
begin
|
|
if (s_port = WellKnownSvcs [I].port) OR (d_port = WellKnownSvcs [I].port) then
|
|
begin
|
|
result := WellKnownSvcs[I].svc;
|
|
exit ;
|
|
end;
|
|
end ;
|
|
end ;
|
|
if (result = '') and (s_port < 1024) then result := '<' + IntToStr (s_port) + '>' ;
|
|
if (result = '') then result := '<' + IntToStr (d_port) + '>' ;
|
|
end ;
|
|
|
|
(* IP header record contains "ihl_ver" which is used
|
|
to store two parameters: IP header length and IP version.
|
|
IP version is stored in the high nibble of "ihl_ver"
|
|
(it occupies 4 bits). IP header length is stored in the
|
|
low nibble of "ihl_ver" (also uses 4 bits).
|
|
IP header length is expressed in 32 bit words
|
|
(4 8-bit bytes), therefore we divide or multiply
|
|
the low nibble by 4 depending on the function.
|
|
*)
|
|
|
|
function GetIHlen(ih: THdrIP): Word; // IP header length
|
|
begin
|
|
// multiply the low nibble by 4
|
|
// and return the length in bytes
|
|
Result := (ih.ihl_ver AND $0F) SHL 2
|
|
end;
|
|
|
|
procedure SetIHlen(VAR ih: THdrIP; value: Byte);
|
|
begin
|
|
// divide the value by 4 and store it in low nibble
|
|
value := value SHR 2;
|
|
ih.ihl_ver := value OR (ih.ihl_ver AND $F0)
|
|
end;
|
|
|
|
function GetIHver(ih: THdrIP): Byte; // IP version
|
|
begin
|
|
// get the high nibble
|
|
Result := ih.ihl_ver SHR 4
|
|
end;
|
|
|
|
procedure SetIHver(VAR ih: THdrIP; value: Byte);
|
|
begin
|
|
// set the high nibble
|
|
ih.ihl_ver := (value SHL 4) OR (ih.ihl_ver AND $0F)
|
|
end;
|
|
|
|
(* TCP header record contains "flags" which is used
|
|
to store several parameters:
|
|
Least Significant Bit
|
|
res1:4 - reserved, must be 0
|
|
doff:4 - TCP header length divided by 4
|
|
fin:1 - FIN
|
|
syn:1 - SYN
|
|
rst:1 - Reset
|
|
psh:1 - Push
|
|
ack:1 - ACK
|
|
urg:1 - Urgent
|
|
res2:2 - reserved, must be 0
|
|
MSB
|
|
*)
|
|
|
|
CONST flagMask: Array[ftFIN..ftURG] of Integer = ($100, $200, $400, $800, $1000, $2000);
|
|
|
|
function GetTHflag(th: THdrTCP; flag: TTcpFlagType): Boolean;
|
|
begin
|
|
Result := Boolean(th.flags AND flagMask[flag])
|
|
end;
|
|
|
|
procedure SetTHflag(VAR th: THdrTCP; flag: TTcpFlagType; on: Boolean);
|
|
begin
|
|
if on then
|
|
th.flags := th.flags OR flagMask[flag]
|
|
else
|
|
th.flags := th.flags AND NOT flagMask[flag]
|
|
end;
|
|
|
|
function GetTHdoff(th: THdrTCP): Word;
|
|
begin
|
|
// doff (data offset) stored in 32 bit words,
|
|
// multiply the value by 4 to get byte offset
|
|
Result := (($00F0 AND th.flags) SHR 4) SHL 2;
|
|
end;
|
|
|
|
procedure SetTHdoff(VAR th: THdrTCP; value: Byte);
|
|
VAR x: Integer;
|
|
begin
|
|
x := value SHR 2; // divide the value by 4
|
|
th.flags := (x SHL 4) OR (th.flags AND $FF0F)
|
|
end;
|
|
|
|
function GetFlags(flags: word): string ;
|
|
begin
|
|
result := '' ;
|
|
if (flags AND TCP_FLAG_FIN) = TCP_FLAG_FIN then result := result + 'FIN ' ;
|
|
if (flags AND TCP_FLAG_SYN) = TCP_FLAG_SYN then result := result + 'SYN ' ;
|
|
if (flags AND TCP_FLAG_RST) = TCP_FLAG_RST then result := result + 'RST ' ;
|
|
if (flags AND TCP_FLAG_PSH) = TCP_FLAG_PSH then result := result + 'PSH ' ;
|
|
if (flags AND TCP_FLAG_ACK) = TCP_FLAG_ACK then result := result + 'ACK ' ;
|
|
if (flags AND TCP_FLAG_URG) = TCP_FLAG_URG then result := result + 'URG ' ;
|
|
if (flags AND TCP_FLAG_ECH) = TCP_FLAG_ECH then result := result + 'ECH ' ;
|
|
if (flags AND TCP_FLAG_CWR) = TCP_FLAG_CWR then result := result + 'CWR ' ;
|
|
result := trim (result) ;
|
|
end ;
|
|
|
|
// Convert a 32-bit IP address into a string representation
|
|
|
|
function IPToStr (IPAddr: TInAddr): string ;
|
|
begin
|
|
with IPAddr.S_un_b do
|
|
Result := Format('%d.%d.%d.%d', [Ord (s_b1), Ord (s_b2), Ord (s_b3), Ord (s_b4)]) ;
|
|
end;
|
|
|
|
function StrToIP (strIP: string): TInAddr ;
|
|
begin
|
|
Str2IP (strIP, result) ;
|
|
end ;
|
|
|
|
function IsIPStr (strIP: string): boolean ;
|
|
var
|
|
IPAddr: TInAddr ;
|
|
begin
|
|
result := Str2IP (strIP, IPAddr) ;
|
|
end ;
|
|
|
|
function IsFmtIPStr (var strIP: string): boolean ;
|
|
var
|
|
IPAddr: TInAddr ;
|
|
begin
|
|
result := Str2IP (strIP, IPAddr) ;
|
|
if result then strIP := IPToStr (IPAddr) ; // formats less space, zeros, etc.
|
|
end ;
|
|
|
|
function AscToInt (value: string): Integer; // simple version of StrToInt
|
|
var
|
|
E: Integer;
|
|
begin
|
|
Val (value, result, E) ;
|
|
end;
|
|
|
|
function Str2IP (strIP: string; var IPAddr: TInAddr): boolean ;
|
|
var
|
|
I, len, value, startpos, dotpos: Integer;
|
|
MyIPAddr: TInAddr ;
|
|
nonzeroflag: boolean ;
|
|
begin
|
|
result := false ;
|
|
IPAddr.S_addr := 0 ;
|
|
len := Length (strIP) ;
|
|
if len < 7 then exit ; // 0.0.0.0 bare IP address
|
|
|
|
// read each dotted number
|
|
nonzeroflag := false ;
|
|
startpos := 1 ;
|
|
for I := 1 to 4 do
|
|
begin
|
|
if len <= 0 then exit ;
|
|
if I < 4 then
|
|
dotpos := Pos ('.', Copy (strIP, startpos, len))
|
|
else
|
|
dotpos := len + 1 ;
|
|
if dotpos <= 0 then exit ; // not enough dots
|
|
if dotpos > 1 then
|
|
value := AscToInt (Copy (strIP, startpos, Pred (dotpos)))
|
|
else
|
|
value := 0 ; // allow for blank
|
|
if value > 255 then exit ; // number invalid for conversion
|
|
if value > 0 then nonzeroflag := true ;
|
|
case I of
|
|
1: MyIPAddr.S_un_b.s_b1 := u_char (value) ;
|
|
2: MyIPAddr.S_un_b.s_b2 := u_char (value) ;
|
|
3: MyIPAddr.S_un_b.s_b3 := u_char (value) ;
|
|
4: MyIPAddr.S_un_b.s_b4 := u_char (value) ;
|
|
end ;
|
|
startpos := startpos + dotpos ;
|
|
len := len - dotpos ;
|
|
end ;
|
|
|
|
// check valid IP address, only allowed all zeroes
|
|
if (MyIPAddr.S_un_b.s_b1 = u_char (0)) and nonzeroflag then exit ;
|
|
|
|
// found a valid IP address
|
|
IPAddr := MyIPAddr ;
|
|
result := true ;
|
|
end ;
|
|
|
|
function MacToStr (MacAddr: TMacAddr): string ;
|
|
begin
|
|
result := Format ('%.2x-%.2x-%.2x-%.2x-%.2x-%.2x',
|
|
[MacAddr [0], MacAddr [1], MacAddr [2],
|
|
MacAddr [3], MacAddr [4], MacAddr [5]]) ;
|
|
end ;
|
|
|
|
// called by TFindList for sort and find comparison of traffic records
|
|
// sort is by source IP, then dest IP, then ServPort, then PackType
|
|
|
|
function CompareIPTraffic (Item1, Item2: Pointer): Integer;
|
|
// Compare returns < 0 if Item1 is less than Item2, 0 if they are equal
|
|
// and > 0 if Item1 is greater than Item2.
|
|
begin
|
|
result := CompareGTMem (Item1, Item2, TrafficIPCompLen) ; // warning record must be packed
|
|
end ;
|
|
|
|
function CompareServTraffic (Item1, Item2: Pointer): Integer;
|
|
// Compare returns < 0 if Item1 is less than Item2, 0 if they are equal
|
|
// and > 0 if Item1 is greater than Item2.
|
|
begin
|
|
result := CompareGTMem (Item1, Item2, ServiceCompLen) ; // warning record must be packed
|
|
end ;
|
|
|
|
constructor TTrafficClass.Create(AOwner: TComponent);
|
|
begin
|
|
SetLength (FTrafficInfo, InitialTrafficSize) ;
|
|
FTrafficList := TFindList.Create ;
|
|
FTrafficList.Sorted := true ;
|
|
FTrafficList.Capacity := InitialTrafficSize ;
|
|
FTotTraffic := 0 ;
|
|
SetLength (FServiceInfo, 0) ;
|
|
FServiceList := TFindList.Create ;
|
|
FServiceList.Sorted := true ;
|
|
FTotService := 0 ;
|
|
FWSocket := TWSocket.Create (AOwner) ;
|
|
FWSocket.OnDnsLookupDone := DoneLookup ;
|
|
FLookupBusy := false ;
|
|
end;
|
|
|
|
destructor TTrafficClass.Destroy;
|
|
begin
|
|
Clear ;
|
|
SetLength (FTrafficInfo, 0) ;
|
|
FreeAndNil (FTrafficList) ;
|
|
SetLength (FServiceInfo, 0) ;
|
|
FreeAndNil (FServiceList) ;
|
|
FreeAndNil (FWSocket) ;
|
|
end;
|
|
|
|
procedure TTrafficClass.Clear ;
|
|
begin
|
|
SetLength (FTrafficInfo, InitialTrafficSize) ;
|
|
FTrafficList.Clear ;
|
|
FTotTraffic := 0 ;
|
|
SetLength (FServiceInfo, 0) ;
|
|
FServiceList.Clear ;
|
|
FTotService := 0 ;
|
|
end;
|
|
|
|
procedure TTrafficClass.Add (PacketInfo: TPacketInfo) ;
|
|
var
|
|
NewTraffic: TTrafficInfo ;
|
|
TrafficRec: PTrafficInfo ;
|
|
recnr, I: integer ;
|
|
begin
|
|
FillChar (NewTraffic, Sizeof(NewTraffic), 0) ;
|
|
with NewTraffic, PacketInfo do
|
|
begin
|
|
if EtherProto <> PROTO_IP then exit ;
|
|
if NOT (ProtoType in [IPPROTO_TCP, IPPROTO_UDP, IPPROTO_ICMP]) then exit ;
|
|
PackType := ProtoType ;
|
|
if SendFlag then
|
|
begin
|
|
AddrLoc := AddrSrc ;
|
|
AddrRem := AddrDest ;
|
|
ServPort := PortDest ;
|
|
BytesSent := PacketLen ;
|
|
PacksSent := 1 ;
|
|
end
|
|
else
|
|
begin
|
|
AddrLoc := AddrDest ;
|
|
AddrRem := AddrSrc ;
|
|
ServPort := PortSrc ;
|
|
BytesRecv := PacketLen ;
|
|
PacksRecv := 1 ;
|
|
end ;
|
|
if ProtoType = IPPROTO_ICMP then
|
|
begin
|
|
ServPort := IcmpType ;
|
|
if ServPort = 0 then ServPort := 8 ; // change echo-reply to echo (ie ping)
|
|
end
|
|
else
|
|
begin
|
|
if (ServPort >= 1024) and (PortSrc < 1024) then
|
|
ServPort := PortSrc
|
|
else if (ServPort >= 1024) and (PortDest < 1024) then
|
|
ServPort := PortDest
|
|
end ;
|
|
LastDT := PacketDT ;
|
|
end ;
|
|
|
|
// see if only got a record for this traffic, update it
|
|
if FTrafficList.Find (@NewTraffic, CompareIPTraffic, recnr) then
|
|
begin
|
|
TrafficRec := FTrafficList [recnr] ;
|
|
if NOT Assigned (TrafficRec) then exit ; // sanity check
|
|
if CompareMem (TrafficRec, @NewTraffic, TrafficIPCompLen) then // double check for correct record
|
|
begin
|
|
inc (TrafficRec^.BytesSent, NewTraffic.BytesSent) ;
|
|
inc (TrafficRec^.PacksSent, NewTraffic.PacksSent) ;
|
|
inc (TrafficRec^.BytesRecv, NewTraffic.BytesRecv) ;
|
|
inc (TrafficRec^.PacksRecv, NewTraffic.PacksRecv) ;
|
|
TrafficRec^.LastDT := NewTraffic.LastDT ;
|
|
exit ;
|
|
end ;
|
|
end ;
|
|
|
|
// otherwise add a new traffic record
|
|
if Length (FTrafficInfo) <= FTotTraffic then
|
|
begin
|
|
SetLength (FTrafficInfo, FTotTraffic * 2) ; // allocate more records in dynamic array
|
|
// must rebuild pointer list since resized array may have moved in memory
|
|
FTrafficList.Clear ;
|
|
FTrafficList.Capacity := FTotTraffic * 2 ;
|
|
for I := 0 to Pred (FTotTraffic) do FTrafficList.Add (@FTrafficInfo [I]) ;
|
|
FTrafficList.Sort (CompareIPTraffic) ;
|
|
end ;
|
|
NewTraffic.FirstDT := NewTraffic.LastDT ;
|
|
FTrafficInfo [FTotTraffic] := NewTraffic ;
|
|
FTrafficList.AddSorted (@FTrafficInfo [FTotTraffic], CompareIPTraffic) ;
|
|
inc (FTotTraffic) ;
|
|
LookupHosts ; // start lookup of host names
|
|
end ;
|
|
|
|
function TTrafficClass.GetUnSortTraf (item: integer): PTrafficInfo ;
|
|
begin
|
|
if item < FTotTraffic then
|
|
result := @FTrafficInfo [item]
|
|
else
|
|
FillChar (result, Sizeof(result), 0) ;
|
|
end;
|
|
|
|
function TTrafficClass.GetSortedTraf (item: integer): PTrafficInfo ;
|
|
begin
|
|
if item < FTotTraffic then
|
|
result := FTrafficList [item]
|
|
else
|
|
FillChar (result, Sizeof(result), 0) ;
|
|
end;
|
|
|
|
function TTrafficClass.GetServNameEx (PackType, ServPort: word): string ;
|
|
begin
|
|
if PackType = IPPROTO_TCP then
|
|
result := Lowercase (GetServName (ServPort))
|
|
else if PackType = IPPROTO_UDP then
|
|
result := Lowercase (GetServName (ServPort))
|
|
else if PackType = IPPROTO_ICMP then
|
|
result := Lowercase (GetICMPType (ServPort))
|
|
else
|
|
result := GetEtherProtoName (PackType) ;
|
|
end ;
|
|
|
|
function TTrafficClass.GetFmtTrafStr (item: integer): string ;
|
|
var
|
|
TrafficRec: PTrafficInfo ;
|
|
disploc, disprem: string ;
|
|
begin
|
|
result := '' ;
|
|
if item >= FTotTraffic then exit ;
|
|
TrafficRec := FTrafficList [item] ;
|
|
if NOT Assigned (TrafficRec) then exit ; // sanity check
|
|
with TrafficRec^ do
|
|
begin
|
|
disploc := HostLoc ;
|
|
disprem := HostRem ;
|
|
if disploc = '' then disploc := IPToStr (AddrLoc) ;
|
|
if disprem = '' then disprem := IPToStr (AddrRem) ;
|
|
if ServName = '' then ServName := GetServNameEx (PackType, ServPort) ;
|
|
result := Format (sTrafficMask, [disploc, disprem, ServName,
|
|
IntToKbyte (BytesSent), '[' + IntToKbyte (PacksSent) + ']',
|
|
IntToKbyte (BytesRecv), '[' + IntToKbyte (PacksRecv) + ']',
|
|
TimeToStr (FirstDT), TimeToStr (LastDT) ]) ;
|
|
end ;
|
|
end;
|
|
|
|
procedure TTrafficClass.UpdateService ;
|
|
var
|
|
I, recnr: integer ;
|
|
NewService: TServiceInfo ;
|
|
ServiceRec: PServiceInfo ;
|
|
|
|
procedure RebuildList ;
|
|
var
|
|
J: integer ;
|
|
begin
|
|
FServiceList.Clear ;
|
|
for J := 0 to Pred (FTotService) do FServiceList.Add (@FServiceInfo [J]) ;
|
|
FServiceList.Sort (CompareServTraffic) ;
|
|
end ;
|
|
|
|
begin
|
|
FServiceList.Clear ;
|
|
FTotService := 0 ;
|
|
if FTotTraffic = 0 then
|
|
begin
|
|
SetLength (FServiceInfo, 0) ;
|
|
exit ;
|
|
end ;
|
|
SetLength (FServiceInfo, InitialTrafficSize) ;
|
|
FServiceList.Capacity := InitialTrafficSize ;
|
|
|
|
// add total record
|
|
FillChar (NewService, Sizeof(NewService), 0) ;
|
|
NewService.ServName := 'TOTALS' ;
|
|
FServiceInfo [FTotService] := NewService ;
|
|
FServiceList.Add (@FServiceInfo [FTotService]) ;
|
|
FTotService := 1 ;
|
|
for I := 0 to Pred (FTotTraffic) do
|
|
begin
|
|
FillChar (NewService, Sizeof(NewService), 0) ;
|
|
NewService.ServPort := FTrafficInfo [I].ServPort ;
|
|
NewService.PackType := FTrafficInfo [I].PackType ;
|
|
NewService.ServName := FTrafficInfo [I].ServName ;
|
|
NewService.BytesSent := FTrafficInfo [I].BytesSent ;
|
|
NewService.BytesRecv := FTrafficInfo [I].BytesRecv ;
|
|
NewService.PacksSent := FTrafficInfo [I].PacksSent ;
|
|
NewService.PacksRecv := FTrafficInfo [I].PacksRecv ;
|
|
NewService.TotalHosts := 1 ;
|
|
|
|
// increment totals
|
|
inc (FServiceInfo [0].BytesSent, NewService.BytesSent) ;
|
|
inc (FServiceInfo [0].PacksSent, NewService.PacksSent) ;
|
|
inc (FServiceInfo [0].BytesRecv, NewService.BytesRecv) ;
|
|
inc (FServiceInfo [0].PacksRecv, NewService.PacksRecv) ;
|
|
inc (FServiceInfo [0].TotalHosts) ;
|
|
|
|
// see if updating existing record
|
|
if FServiceList.Find (@NewService, CompareServTraffic, recnr) then
|
|
begin
|
|
ServiceRec := FServiceList [recnr] ;
|
|
if NOT Assigned (ServiceRec) then continue ; // sanity check
|
|
if CompareMem (ServiceRec, @NewService, ServiceCompLen) then // double check for correct record
|
|
begin
|
|
inc (ServiceRec^.BytesSent, NewService.BytesSent) ;
|
|
inc (ServiceRec^.PacksSent, NewService.PacksSent) ;
|
|
inc (ServiceRec^.BytesRecv, NewService.BytesRecv) ;
|
|
inc (ServiceRec^.PacksRecv, NewService.PacksRecv) ;
|
|
inc (ServiceRec^.TotalHosts) ;
|
|
continue ; // next record
|
|
end ;
|
|
end ;
|
|
|
|
// otherwise add a new service record
|
|
if Length (FServiceInfo) <= FTotService then
|
|
begin
|
|
SetLength (FServiceInfo, FTotService * 2) ; // allocate more records in dynamic array
|
|
// must rebuild pointer list since resized array may have moved in memory
|
|
FServiceList.Clear ;
|
|
FServiceList.Capacity := FTotService * 2 ;
|
|
RebuildList ;
|
|
end ;
|
|
FServiceInfo [FTotService] := NewService ;
|
|
FServiceList.AddSorted (@FServiceInfo [FTotService], CompareServTraffic) ;
|
|
inc (FTotService) ;
|
|
end ;
|
|
SetLength (FServiceInfo, FTotService) ;
|
|
RebuildList ; // keep Delphi 2006 happy
|
|
end ;
|
|
|
|
function TTrafficClass.GetSortedServ (item: integer): PServiceInfo ;
|
|
begin
|
|
if item < FTotService then
|
|
result := @FServiceInfo [item]
|
|
else
|
|
FillChar (result, Sizeof(result), 0) ;
|
|
end ;
|
|
|
|
function TTrafficClass.GetFmtServStr (item: integer): string ;
|
|
var
|
|
ServiceRec: PServiceInfo ;
|
|
begin
|
|
result := '' ;
|
|
if item >= FTotService then exit ;
|
|
if FServiceList [0] <> @FServiceInfo [0] then // sanity check
|
|
begin
|
|
result := 'Dynamic Array Memory Error' ;
|
|
exit ;
|
|
end;
|
|
ServiceRec := FServiceList [item] ;
|
|
if NOT Assigned (ServiceRec) then exit ; // sanity check
|
|
with ServiceRec^ do
|
|
begin
|
|
if ServName = '' then ServName := GetServNameEx (PackType, ServPort) ;
|
|
result := Format (sServiceMask, [ServName, IntToKbyte (BytesSent), '[' +
|
|
IntToKbyte (PacksSent) + ']', IntToKbyte (BytesRecv), '[' +
|
|
IntToKbyte (PacksRecv) + ']', IntToCStr (TotalHosts)]) ;
|
|
end ;
|
|
end ;
|
|
|
|
// total all traffic records
|
|
|
|
function TTrafficClass.GetTotals: TServiceInfo ;
|
|
var
|
|
I: integer ;
|
|
begin
|
|
FillChar (result, Sizeof(result), 0) ;
|
|
if FTotTraffic = 0 then exit ;
|
|
for I := 0 to Pred (FTotTraffic) do
|
|
begin
|
|
inc (result.BytesSent, FTrafficInfo [I].BytesSent) ;
|
|
inc (result.BytesRecv, FTrafficInfo [I].BytesRecv) ;
|
|
inc (result.PacksSent, FTrafficInfo [I].PacksSent) ;
|
|
inc (result.PacksRecv, FTrafficInfo [I].PacksRecv) ;
|
|
end ;
|
|
end ;
|
|
|
|
// look for next DNS lookup that needs doing, keep count of failures to avoid too many
|
|
|
|
procedure TTrafficClass.NextLookup ;
|
|
begin
|
|
if FTotTraffic = 0 then exit ;
|
|
if (FLookupLoc >= 0) then
|
|
begin
|
|
while FLookupLoc < FTotTraffic do
|
|
begin
|
|
with FTrafficInfo [FLookupLoc] do
|
|
begin
|
|
if (HostLoc = '') and (LookupAttempts < MaxDnsLookupAttempts) then
|
|
begin
|
|
if FLookupLoc > 0 then // copy previous record if same address
|
|
begin
|
|
if (AddrLoc.S_addr = FTrafficInfo [Pred (FLookupLoc)].AddrLoc.S_addr) then
|
|
HostLoc := FTrafficInfo [Pred (FLookupLoc)].HostLoc ;
|
|
end ;
|
|
if (HostLoc = '') then
|
|
begin
|
|
inc (LookupAttempts) ;
|
|
FWSocket.ReverseDnsLookup (IPToStr (AddrLoc)) ;
|
|
exit ; // async lookup started
|
|
end ;
|
|
end ;
|
|
end ;
|
|
inc (FLookupLoc) ;
|
|
end ;
|
|
FLookupLoc := - 1 ;
|
|
FLookupRem := 0 ;
|
|
end ;
|
|
if (FLookupRem >= 0) then
|
|
begin
|
|
while FLookupRem < FTotTraffic do
|
|
begin
|
|
with FTrafficInfo [FLookupRem] do
|
|
begin
|
|
if (HostRem = '') and (LookupAttempts < MaxDnsLookupAttempts) then
|
|
begin
|
|
inc (LookupAttempts) ;
|
|
FWSocket.ReverseDnsLookup (IPToStr (AddrRem)) ;
|
|
exit ; // async lookup started
|
|
end ;
|
|
end ;
|
|
inc (FLookupRem) ;
|
|
end ;
|
|
FLookupRem := - 1 ;
|
|
end ;
|
|
FLookupBusy := false ;
|
|
end ;
|
|
|
|
procedure TTrafficClass.DoneLookup (Sender: TObject; Error: Word);
|
|
begin
|
|
if FLookupLoc >= 0 then
|
|
begin
|
|
if Error = 0 then FTrafficInfo [FLookupLoc].HostLoc :=
|
|
Lowercase (FWSocket.DnsResult) ;
|
|
inc (FLookupLoc) ;
|
|
end
|
|
else if FLookupRem >= 0 then
|
|
begin
|
|
if Error = 0 then FTrafficInfo [FLookupRem].HostRem :=
|
|
Lowercase (FWSocket.DnsResult) ;
|
|
inc (FLookupRem) ;
|
|
end ;
|
|
NextLookup ;
|
|
end ;
|
|
|
|
procedure TTrafficClass.LookupHosts ;
|
|
begin
|
|
if FLookupBusy then exit ;
|
|
if FTotTraffic = 0 then exit ;
|
|
FLookupLoc := 0 ;
|
|
FLookupRem := -1;
|
|
NextLookup ;
|
|
end ;
|
|
|
|
end.
|