'===========================================================================
' Subject: TCP/IP Network Analyzer            Date: 06-15-01 (19:34)       
'  Author: Sebastian Mate                     Code: QB,  PDS               
'  Origin: JMate@t-online.de                Packet: MODEM.ABC
'===========================================================================
' -------------------------------------------------------------------------
'            TCP/IP Network Analyzer ("sniffer") for QuickBasic
' -------------------------------------------------------------------------
'                 version 1.00, (C) 2001 Sebastian Mate
'
'    Before you use this software, you *must* agree with README.TXT!

DEFINT A-Z
REM $STATIC
DECLARE SUB Main ()
DECLARE SUB GetAddress ()
DECLARE SUB ShowInfo ()
DECLARE SUB ShowError (in%)
DECLARE SUB FreeBuffer CDECL ()
DECLARE SUB ReleaseType CDECL (BYVAL Handle)
DECLARE SUB SetRcvMode CDECL (BYVAL Handle, BYVAL Mode)
DECLARE FUNCTION NewBuffer CDECL ()
DECLARE FUNCTION GetCounterA CDECL ()
DECLARE FUNCTION GetCounterB CDECL ()
DECLARE FUNCTION GetCountX CDECL ()
DECLARE FUNCTION GetBufferSegment CDECL ()
DECLARE FUNCTION GetBufferOffset CDECL ()
DECLARE FUNCTION AccessType CDECL (BYVAL class, BYVAL tpe, BYVAL number, BYVAL tpe2, BYVAL driver)

DIM SHARED BUFFER AS STRING * 10, BUFFER2 AS STRING, CLASS1(1 TO 100) AS STRING, IFTYPE AS STRING * 2
DIM SHARED IPBUFFER(1 TO 256)  AS STRING

TYPE RegType                        'Define the registers
     AX AS INTEGER
     BX AS INTEGER
     cx AS INTEGER
     DX AS INTEGER
     BP AS INTEGER
     SI AS INTEGER
     DI AS INTEGER
  FLAGS AS INTEGER
     DS AS INTEGER
     ES AS INTEGER
END TYPE

DIM SHARED regs AS RegType          'Create an array of registers

CLS

FOR n% = 1 TO 100
 READ CLASS1(n%)
NEXT n%

' -----------------------------------------------------------------------

Main   'The program seems to work only if it's in a sub?!

' -----------------------------------------------------------------------

' The Ethernet types. I use a datafield instead of 100 IF-commands :-)
DATA "3COM 3C500/3C501"
DATA "3COM 3C505"
DATA "InterLan NI50103"
DATA "BICC Data Networks 4110"
DATA "BICC Data Networks 4117"
DATA "InterLan NP600"
DATA "???"
DATA "Ungermann-Bass PC-NIC"
DATA "Univation NC-516"
DATA "TRW PC-2000"
DATA "InterLan NI5210"
DATA "3COM 3C503"
DATA "3COM 3C523"
DATA "Western Digital WD8003"
DATA "Spider Systems S4"
DATA "Torus Frame Level"
DATA "10NET Communications"
DATA "Gateway PC-bus"
DATA "Gateway AT-bus"
DATA "Gateway MCA-bus"
DATA "IMC Pcnic"
DATA "IMC PCnic II"
DATA "IMC PCnic 8bit"
DATA "Tigan Communications"
DATA "Micromatic Research"
DATA "Clarkson Multiplexor"
DATA "D-Link 8-bit"
DATA "D-Link 16-bit"
DATA "D-Link PS/2"
DATA "Research Machines parallel"
DATA "Research Machines 16"
DATA "Research Machines MCA"
DATA "Radix Microsys. EXM1 16-bit"
DATA "InterLan NI9210"
DATA "InterLan NI6510"
DATA "Vestra LANMASTER 16-bit"
DATA "Vestra LANMASTER 8-bit"
DATA "Allied Telesis PC/XT/AT"
DATA "Allied Telesis NEC PC-98"
DATA "Allied Telesis Fujitsu FMR"
DATA "Ungermann-Bass NIC/PS2"
DATA "Tiara LANCard/E AT"
DATA "Tiara LANCard/E MC"
DATA "Tiara LANCard/E TP"
DATA "Spider Comm. SpiderComm 8"
DATA "Spider Comm. SpiderComm 16"
DATA "AT&T Starlan NAU"
DATA "AT&T Starlan-10 NAU"
DATA "AT&T Ethernet NAU"
DATA "Intel smart card"
DATA "Xircom Pocket Adapter / Credit Card Adapter"
DATA "Aquila Ethernet"
DATA "Novell NE-1000"
DATA "Novell NE-2000"
DATA "IMC PC-510"
DATA "AT&T Fiber NAU"
DATA "NDIS to Packet Driver adapter"
DATA "InterLan ES3210"
DATA "General Systems ISDN simulated Ether"
DATA "Hewlett-Packard"
DATA "IMC EtherNic-8"
DATA "IMC EtherNic-16"
DATA "IMC EtherNic-MCA"
DATA "NetWorth EtherNext"
DATA "Dataco Scanet"
DATA "DEC DEPCA"
DATA "C-net"
DATA "Gandalf LANLine"
DATA "Apricot built-in"
DATA "David Systems Ether-T"
DATA "ODI to Packet Driver adapter"
DATA "AMD Am2110 16-bit"
DATA "Intel ICD Network controller family"
DATA "Intel ICD PCL2"
DATA "Intel ICD PCL2A"
DATA "AT&T LANPacer"
DATA "AT&T LANPacer+"
DATA "AT&T EVB"
DATA "AT&T StarStation"
DATA "SLIP simulated ether (skl)"
DATA "InterLan NIA310"
DATA "InterLan NISE"
DATA "InterLan NISE30"
DATA "InterLan NI6610"
DATA "Ether over IP/UDP"
DATA "ICL EtherTeam 16"
DATA "David Systems Ether-T AT Plus"
DATA "NCR WaveLAN"
DATA "Thomas Conrad TC5045"
DATA "Parallel Port driver"
DATA "Intel EtherExpress 16"
DATA "IBMTOKEN simulated Ether on 802.5"
DATA "Zenith Data Systems Z-Note"
DATA "3Com 3C509"
DATA "Mylex LNE390"
DATA "Madge Smart Ringnode"
DATA "Novell NE2100"
DATA "Allied Telesis 1500"
DATA "Allied Telesis 1700"
DATA "Fujitsu EtherCoupler"

SUB GetAddress
   
   'Not used in the program, but you can use it as base for other
   'packet driver services. See documentation for interrupts!

   regs.AX = (6 * 256) + 0
   regs.DS = VARSEG(BUFFER)
   regs.DI = VARPTR(BUFFER)
   regs.cx = LEN(BUFFER)
   CALL INTERRUPT(&H60, regs, regs)

   PRINT "Network address: ";

   FOR n% = 1 TO regs.cx - 1
    PRINT HEX$(ASC(MID$(BUFFER, n%, 1))); ":";
   NEXT
   PRINT HEX$(ASC(MID$(BUFFER, regs.cx, 1)))

END SUB

DEFSNG A-Z
'DEFINT A-Z
SUB Main

COLOR 15, 1
PRINT " TCP/IP in QuickBasic - SNIFFER 1.0                 (C) 2001 Sebastian Mate    "
PRINT : COLOR 15, 0
ShowInfo       ' Show informations, and, if required, exit.
PRINT

'            ***** Error-Message? Haha! Read the documentation!
'            *
Handle% = AccessType(1, &HFFFF, 0, 0, 0) 'See documentation!
SetRcvMode Handle%, 6

DEF SEG = GetBufferSegment
Ofs% = GetBufferOffset

DO

  IF NewBuffer = 1 THEN ' NewBuffer returns 1 on new packets...
 
  Type1% = PEEK(12 + Ofs%)
  Type2% = PEEK(13 + Ofs%)
 
  IF CSRLIN >= 24 THEN
   COLOR 7, 0: CLS
   COLOR 15, 1
   PRINT "                                                                               "
   LOCATE 1, 1:
   PRINT STR$(100 - INT((GetCounterB / GetCounterA) * 100)); "% packet loss, ";
   PRINT PCS%; "Computers"
   PRINT
  END IF

  EthType$ = "UNKNOWN": COLOR 15, 1
  FROM$ = "   unknown    "
  DEST$ = "   unknown    "
 
  'Is it an IP- or an ARP-packet?
  IF Type1% = 8 AND Type2% = 0 THEN EthType$ = "TCP/IP ": FROM$ = "": DEST$ = "": COLOR 14, 4
  IF Type1% = 8 AND Type2% = 6 THEN EthType$ = "ARP    ": FROM$ = "": DEST$ = "": COLOR 10, 2
 
  ' IP-packet: read the IP-addresses
  IF Type1% = 8 AND Type2% = 0 THEN
 
   FOR A% = 26 TO 28
    FROM$ = FROM$ + STR$(PEEK(A% + Ofs%))
   NEXT
   FROM$ = FROM$ + STR$(PEEK(29 + Ofs%))
  
   FOR A% = 30 TO 32
    DEST$ = DEST$ + STR$(PEEK(A% + Ofs%))
   NEXT
   DEST$ = DEST$ + STR$(PEEK(33 + Ofs%))

  END IF
 
  ' ARP-packet: read the IP-addresses
  IF Type1% = 8 AND Type2% = 6 THEN
  
   FOR A% = 28 TO 30
    FROM$ = FROM$ + STR$(PEEK(A% + Ofs%))
   NEXT
   FROM$ = FROM$ + STR$(PEEK(31 + Ofs%))
 
   FOR A% = 38 TO 40
    DEST$ = DEST$ + STR$(PEEK(A% + Ofs%))
   NEXT
   DEST$ = DEST$ + STR$(PEEK(41 + Ofs%))
  
  END IF

  'Should be 16 chars. Looks better!
  FROM$ = FROM$ + SPACE$(16 - LEN(FROM$))
  DEST$ = DEST$ + SPACE$(16 - LEN(DEST$))

  PRINT " "; EthType$;
 
  ' Look, if that was a new IP (=new computer!)
 
  A% = 0
  FOUND% = 0
  DO
   A% = A% + 1
   IF FROM$ = IPBUFFER(A%) THEN FOUND% = 1
  LOOP UNTIL IPBUFFER(A%) = "" OR FOUND% = 1
  COLOR 15, 0
  PRINT " from ";
  COLOR 15, A% MOD 8
  PRINT FROM$;
  IF FOUND% = 0 THEN
   PCS% = PCS% + 1
   IPBUFFER(A%) = FROM$
   'PRINT "        -> New computer found: "; FROM$
  END IF
 
  A% = 0
  FOUND% = 0
  DO
   A% = A% + 1
   IF DEST$ = IPBUFFER(A%) THEN FOUND% = 1
  LOOP UNTIL IPBUFFER(A%) = "" OR FOUND% = 1
  COLOR 15, 0
  PRINT " to ";
  COLOR 15, A% MOD 8
  PRINT DEST$;
  IF FOUND% = 0 THEN
   IPBUFFER(A%) = DEST$
   PCS% = PCS% + 1
   'PRINT "        -> New computer found: "; DEST$;
  END IF

' -------------------Packet analyzer. Uncommet code to use it... ------------
'   COLOR 15, 0
'   LN% = GetCountX
'   BUFFER2 = ""
'   FOR X% = 0 TO LN%
'    BUFFER2 = BUFFER2 + CHR$(PEEK(X% + Ofs%))
'   NEXT X%
'   BUFFER2 = UCASE$(BUFFER2)
'   PRINT "       ";
'   IF INSTR(BUFFER2, "HTTP") > 0 THEN
'    COLOR 15, 4
'    PRINT "HTTP-request";
'   END IF
'
'  IF INSTR(BUFFER2, "</") > 0 OR INSTR(BUFFER2, "<a") > 0 THEN COLOR 15, 1: PRINT "HTML";
'
' ---------------------------------------------------------------------------
 
  PRINT
  COLOR 15, 7
 
  FreeBuffer ' Clear buffer to make "place" for the next one!

 END IF

LOOP UNTIL INKEY$ <> ""

COLOR 7, 0
CLS
PRINT "Some statistics:"
PRINT GetCounterA; "packets have passed your computer"
PRINT GetCounterB; "packets were detected by this program"
PRINT
PRINT "Please visit www.sm-gimi.de for updates and related software!"

CALL ReleaseType(Handle%) ' !!! Very important, or you PC crashes!

END

END SUB

DEFINT A-Z
SUB ShowError (in%)
SELECT CASE in%
 CASE 1: PRINT "1       BAD_HANDLE      Invalid handle number!"
 CASE 2: PRINT "2       NO_CLASS        No interfaces of specified class found!"
 CASE 3: PRINT "3       NO_TYPE         No interfaces of specified type found!"
 CASE 4: PRINT "4       NO_NUMBER       No interfaces of specified number found!"
 CASE 5: PRINT "5       BAD_TYPE        Bad packet type specified!"
 CASE 6: PRINT "6       NO_MULTICAST    This interface does not support multicast!"
 CASE 7: PRINT "7       CANT_TERMINATE  This packet driver cannot terminate!"
 CASE 8: PRINT "8       BAD_MODE        An invalid receiver mode was specified!"
 CASE 9: PRINT "9       NO_SPACE        Operation failed because of insufficient space!"
 CASE 10: PRINT "10      TYPE_INUSE      The type had previously been accessed and not released!"
 CASE 11: PRINT "11      BAD_COMMAND     The command was out of range, or not implemented!"
 CASE 12: PRINT "12      CANT_SEND       The packet couldn't be sent (usually hardware error)!"
 CASE 13: PRINT "13      CANT_SET        Hardware address couldn't be changed (more than 1 handle open)!"
 CASE 14: PRINT "14      BAD_ADDRESS     Hardware address has bad length or format!"
 CASE 15: PRINT "15      CANT_RESET      Couldn't reset interface (more than 1 handle open)!"
END SELECT
END SUB

SUB ShowInfo

   ' ----------------------------------------------------------------------
   ' Routine to detect the packet driver.
   ' Originally by Carl Gorringe.
 
    RetNum% = 0
    FOR IRQ% = &H60 TO &H80

    VectorOff% = IRQ% * 4  '<-- Point to IRQ # in Interupt Vector Table

    DEF SEG = 0
       CodeSeg& = PEEK(VectorOff% + 3) * 256& + PEEK(VectorOff% + 2)
       CodeOff& = PEEK(VectorOff% + 1) * 256& + PEEK(VectorOff% + 0)

    DEF SEG = CodeSeg&
       Char1% = PEEK(CodeOff& + 3)
       Char2% = PEEK(CodeOff& + 4)
       Char3% = PEEK(CodeOff& + 5)
       Char4% = PEEK(CodeOff& + 6)
       Char5% = PEEK(CodeOff& + 7)
       Char6% = PEEK(CodeOff& + 8)
       Char7% = PEEK(CodeOff& + 9)
       Char8% = PEEK(CodeOff& + 10)
       Char9% = PEEK(CodeOff& + 11)

    DEF SEG

    ProgID$ = CHR$(Char1%) + CHR$(Char2%) + CHR$(Char3%)
    ProgID$ = ProgID$ + CHR$(Char4%) + CHR$(Char5%) + CHR$(Char6%)
    ProgID$ = ProgID$ + CHR$(Char7%) + CHR$(Char8%)

    'PRINT ProgID$        '*** Test ***

    IF ProgID$ = "PKT DRVR" AND Char9% = 0 THEN
       RetNum% = IRQ%
       EXIT FOR
    END IF

   NEXT IRQ%

   PRINT "Packet driver found on IRQ 0x"; HEX$(RetNum%)
   ' ----------------------------------------------------------------------
  
   IF RetNum% = 0 THEN
    PRINT
    COLOR 14, 4
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  CONFIGURATION ERROR FOUND...                        "
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  No packet driver installed. Please load one of the  "
    LOCATE , 4: PRINT "  packet drivers on interrupt 0x60. Read the          "
    LOCATE , 4: PRINT "  documentation!                                      "
    LOCATE , 4: PRINT "                                                      "
   END
   END IF
  
   regs.AX = (1 * 256) + 255
   CALL INTERRUPT(RetNum%, regs, regs)

   class% = regs.cx / 256
   TYP% = regs.DX
   VERSION% = regs.BX
   FCT% = regs.AX MOD 256
   
   CLASSSTR$ = "Unknown"
   TYPESTR$ = "Unknown"
   
   IF class% = 1 THEN
      CLASSSTR$ = "DEC/Intel/Xerox 'Bluebook' Ethernet"
      IF regs.DX > 0 AND regs.DX <= 100 THEN TYPESTR$ = CLASS1(TYP%)
   END IF
   
   IF class% = 2 THEN
      CLASSSTR$ = "ProNET-10"
      IF TYP% = 1 THEN TYPESTR$ = "Proteon p1300"
      IF TYP% = 2 THEN TYPESTR$ = "Proteon p1800"
   END IF

   IF class% = 3 THEN
      CLASSSTR$ = "IEEE 802.5 without expanded RIFs"
      IF TYP% = 1 THEN TYPESTR$ = "IBM Token ring adapter"
      IF TYP% = 2 THEN TYPESTR$ = "Proteon p1340"
      IF TYP% = 3 THEN TYPESTR$ = "Proteon p1344"
      IF TYP% = 4 THEN TYPESTR$ = "Gateway PC-bus"
      IF TYP% = 5 THEN TYPESTR$ = "Gateway AT-bus"
      IF TYP% = 6 THEN TYPESTR$ = "Gateway MCA-bus"
      IF TYP% = 7 THEN TYPESTR$ = "Madge ???"
      IF TYP% = 57 THEN TYPESTR$ = "NDIS to Packet Driver adapter"
      IF TYP% = 71 THEN TYPESTR$ = "ODI to Packet Driver adapter"
   END IF

   IF class% = 4 THEN CLASSSTR$ = "Omninet"

   IF class% = 5 THEN
      CLASSSTR$ = "Appletalk"
      IF TYP% = 1 THEN TYPESTR$ = "ATALK.SYS adapter"
   END IF

   IF class% = 6 THEN
      CLASSSTR$ = "Serial line (SLIP)"
      IF TYP% = 1 THEN TYPESTR$ = "Clarkson 8250-SLIP / PC/TCP's SLP16550.COM"
      IF TYP% = 2 THEN TYPESTR$ = "Clarkson Multiplexor"
      IF TYP% = 3 THEN TYPESTR$ = "Eicon Technologies"
   END IF

   IF class% = 7 THEN CLASSSTR$ = "Starlan"

   IF class% = 8 THEN
      CLASSSTR$ = "ArcNet"
      IF TYP% = 1 THEN TYPESTR$ = "Datapoint RIM"
   END IF

   IF class% = 9 THEN
      CLASSSTR$ = "AX.25"
      IF TYP% = 1 THEN TYPESTR$ = "Ottawa PI card"
      IF TYP% = 2 THEN TYPESTR$ = "Eicon Technologies"
   END IF

   IF class% = 10 THEN CLASSSTR$ = "KISS"

   IF class% = 11 THEN CLASSSTR$ = "IEEE 802.3 w/802.2 hd"

   IF class% = 12 THEN CLASSSTR$ = "FDDI w/802.2 hdrs"

   IF class% = 13 THEN
      CLASSSTR$ = "Internet X.25"
      IF TYP% = 1 THEN TYPESTR$ = "Western Digital"
      IF TYP% = 2 THEN TYPESTR$ = "Frontier Technology"
      IF TYP% = 3 THEN TYPESTR$ = "Emerging Technologies"
      IF TYP% = 4 THEN TYPESTR$ = "The Software Forge"
      IF TYP% = 5 THEN TYPESTR$ = "Link Data Intelligent X.25"
      IF TYP% = 6 THEN TYPESTR$ = "Eicon Technologies"
   END IF

   IF class% = 14 THEN
      CLASSSTR$ = "N.T. LANSTAR (encapsulating DIX)"
      IF TYP% = 1 THEN TYPESTR$ = "NT LANSTAR/8"
      IF TYP% = 2 THEN TYPESTR$ = "NT LANSTAR/MC"
   END IF

   IF class% = 15 THEN
      CLASSSTR$ = "SLFP (MIT serial spec)"
      IF TYP% = 1 THEN TYPESTR$ = "MERIT"
   END IF

   IF class% = 16 THEN
      CLASSSTR$ = "Point to Point Protocol (no LCP)"
      IF TYP% = 1 THEN TYPESTR$ = "8250/16550 UART"
      IF TYP% = 2 THEN TYPESTR$ = "Niwot Networks synch"
      IF TYP% = 3 THEN TYPESTR$ = "Eicon Technologies"
   END IF

   IF class% = 17 THEN CLASSSTR$ = "IEEE 802.5 with expanded RIFs"

   IF class% = 18 THEN
      CLASSSTR$ = "Point to Point Protocol (with LCP)"
      IF TYP% = 1 THEN TYPESTR$ = "Class 16 to class 18 converter"
      IF TYP% = 2 THEN TYPESTR$ = "PC/TCP's PPP16550.COM"
   END IF
   
   PRINT "Device Type"; TYP%; "- "; TYPESTR$
   PRINT "Device Class"; class%; "- "; CLASSSTR$
  
   regs.AX = (6 * 256) + 0
   regs.DS = VARSEG(BUFFER)
   regs.DI = VARPTR(BUFFER)
   regs.cx = LEN(BUFFER)
   CALL INTERRUPT(RetNum%, regs, regs)
  
   PRINT "Your Network address is ";

   ADD$ = ""
   FOR n% = 1 TO regs.cx - 1
    PRINT HEX$(ASC(MID$(BUFFER, n%, 1))); ":";
    ADD$ = ADD$ + HEX$(ASC(MID$(BUFFER, n%, 1))) + ":"
   NEXT
   PRINT HEX$(ASC(MID$(BUFFER, regs.cx, 1)))
   ADD$ = ADD$ + HEX$(ASC(MID$(BUFFER, regs.cx, 1)))
  
   PRINT "Driver Version"; VERSION%
   PRINT "Driver Functionality"; FCT%;
    IF FCT% = 1 THEN PRINT "- Basic functions present"
    IF FCT% = 2 THEN PRINT "- Basic and extended functions present"
    IF FCT% = 5 THEN PRINT "- Basic and high-performance functions present"
    IF FCT% = 6 THEN PRINT "- Basic, high-performance and extended functions present"

 

   IF FCT% <> 2 AND FCT% <> 6 THEN
    PRINT
    COLOR 14, 4
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  CONFIGURATION ERROR FOUND (?)                       "
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  You Driver Fuctionality is not enough for this      "
    LOCATE , 4: PRINT "  program. Use a newer driver!                        "
    LOCATE , 4: PRINT "                                                      "
   END IF
  
   IF ADD$ = "FF:FF:FF:FF:FF:FF" OR ADD$ = "0:0:0:0:0:0" THEN
    PRINT
    COLOR 14, 4
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  CONFIGURATION ERROR FOUND...                        "
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  Your harware address is reported to be              "
    LOCATE , 4: PRINT "  FF:FF:FF:FF:FF:FF or 0:0:0:0:0:0, this indicates    "
    LOCATE , 4: PRINT "  that you have entered bad IRQ or address settings   "
    LOCATE , 4: PRINT "  while loading the driver. Please refer to the       "
    LOCATE , 4: PRINT "  documentation!                                      "
    LOCATE , 4: PRINT "                                                      "
   END
   END IF

   IF HEX$(RetNum%) <> "60" AND RetNum% > 0 THEN
    PRINT
    COLOR 14, 4
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  CONFIGURATION ERROR FOUND...                        "
    LOCATE , 4: PRINT "                                                      "
    LOCATE , 4: PRINT "  The packet driver is not installed on IRQ 0x60.     "
    LOCATE , 4: PRINT "  Load the driver with 'driver.com 0x60' instead of   "
    LOCATE , 4: PRINT "  'driver.com 60'.                                    "
    LOCATE , 4: PRINT "                                                      "
   END
   END IF



END SUB