packhdrs.pas

Magenta Systems Internet Packet Monitoring Components are a set of Delphi components designed to cap

unit packhdrs;

{ Magenta Systems Internet Packet Monitoring Components

Magenta Systems raw socket packet headers and helpers.
Updated by Angus Robertson, Magenta Systems Ltd, England, v1.1 31st October 2005
[e-mail], 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.

}

interface

uses
  Windows, Messages, Classes, SysUtils, magsubs1, MagClasses, WSocket, Winsock ;

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: string ;      // 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                       }