packhdrs.pas

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

    ( 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;