'===========================================================================
' Subject: HTML READER                       Date: 02-01-00 (11:22)       
' Author:  James A. Davis                    Code: QB, PDS                
' Origin:  jad@iswt.com                    Packet: HTML.ABC
'===========================================================================
'*** 2-1-2000   2100
                    '** j'htm.bas ***
    ' *** use at your own risk this can wipe old files ***
'** this should be in same location as the htm file
' ** I am James Davis : email   jad@iswt
'** USE  qb45/L
'** It Doesn't clean all of the junk off
'** it will read, or read and save as a text file,or read and print
'** some times it misses some or doesn't get it all
'** must of the time its no trouble to finish cleaning in word processor
'** I think''

  '** not responsible  **  use at your own risk ****
'****************   declare    100    **************************************
TYPE REGTYPE
     ax    AS INTEGER
     bx    AS INTEGER
     cx    AS INTEGER
     dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     DS    AS INTEGER
     flags AS INTEGER
END TYPE


50
ty = FRE(" ")     '** house cleaning
CLS
CLEAR
RESET
DIM inreg AS REGTYPE, outreg AS REGTYPE
DIM thefile$(4000)

DIM dta AS STRING * 44

NULL$ = CHR$(0)
DIM as$(81)
ON ERROR GOTO 5000
SCREEN 9

        inreg.ax = 0
        inreg.bx = 0
        inreg.cx = 0
        inreg.dx = 0


 inreg.ax = 0
 GOSUB 3900
 PRINT outreg.bx

   CLS
   ct = 1
   n = 1
   K = 4: t = 5
   COLOR 8: LOCATE 1, 7: PRINT "jad  (c) 1997": COLOR 12
   COLOR 12: LOCATE 5, 28: PRINT "JAD'S HTM READER"

   COLOR 11
   LOCATE 11, 20: INPUT "WHERES THE HTM FILES  "; filespec$
 IF filespec$ = "q" OR filespec$ = "Q" THEN CLS : END
 IF filespec$ = "" THEN filespec$ = "*.htm": spec$ = "": GOTO 100

 CLS
   spec$ = filespec$ + "\"
   filespec$ = filespec$ + "\*.htm"
   re$ = LEFT$(filespec$, 1)
 IF re$ = "a" OR re$ = "A" THEN re = 0: GOTO 6000
 IF re$ = "b" OR re$ = "B" THEN re = 1: GOTO 6000
100


150
  CLS

   COLOR 8: LOCATE 1, 70: PRINT "jad": COLOR 12

  GOSUB 900
  DO WHILE LEN(dir$)
   as$(ct) = dir$
   ct = ct + 1

  IF ct >= 80 THEN GOTO 210  '** last name = 40
   filespec$ = ""
 GOSUB 900
 LOOP

209
  IF ct < 2 THEN CLS : LOCATE 12, 23: PRINT "NO HTM FILES HERE TRY AGAIN": LOCATE 13, 23: PRINT "PRESS ANY KEY": DO WHILE INKEY$ = "": LOOP: GOTO 50
 

210
   ct = ct - 1                   'because it is one name short
 
280
  GOTO 568
565             ' a is the count; c is down; dd is across
567
568  a = 1: dd = 5: c = 4:  COLOR 11
570 FOR a = 1 TO ct: LOCATE c, dd: PRINT as$(a);
    c = c + 1

  IF a = 20 THEN dd = 25:  c = 4  'a=counter c where up or down, dd = over
  IF a = 40 THEN dd = 45:  c = 4
  IF a = 60 THEN dd = 65:  c = 4

575 NEXT: a = 1: dd = 5: c = 4
  yy = 0

590   aN$ = ""

  COLOR 15: LOCATE c, dd: PRINT as$(a); : COLOR 11  '3 '** bright line
 '***** files are on screen at this place  **********
595 nN$ = INKEY$:
   olda = a
   oldc = c
   oldaa = aa
GOTO 4000           '** mouse moving on menu


596

  IF nN$ = CHR$(13) THEN 690
  IF LEN(nN$) = 1 THEN 595
610 aN$ = RIGHT$(nN$, 1)

600 IF aN$ = "P" THEN 625  ' DOWN
605 IF aN$ = "H" THEN 635   ' NN$ = ""' UP
607 IF aN$ = "M" THEN nN$ = "": GOTO 640' >
609 IF aN$ = "K" THEN nN$ = "": GOTO 650 '<
612 IF aN$ = CHR$(27) THEN CLS : END
      
620
 GOTO 595

625  a = a + 1    '****** DOWN

   yy = yy + 1

630 LOCATE c, dd: COLOR 11: PRINT as$(a - 1); '** files
  c = c + 1
632
633  IF a = 21 THEN dd = 25: c = 4  'a=counter c where up or down dd = over
     IF a = 41 THEN dd = 45:  c = 4:
     IF a = 61 THEN dd = 65:  c = 4:
     IF a > ct THEN a = 1: dd = 5: c = 4
COLOR 15: LOCATE c, dd: PRINT as$(a); : COLOR 11  '   'BRIGHT
634 GOTO 595


635  a = a - 1       '******* UP

636  LOCATE c, dd: COLOR 11: PRINT as$(a + 1):
   c = c - 1


638   ss = ct MOD 20
     
     IF a = 0 AND ct <= 22 THEN a = ct: c = ct + 3:  'changed was ct+2
     IF c = 3 AND dd > 5 THEN c = 23: dd = dd - 20
     IF a = 0 AND ss = 0 THEN DS = ct \ 20: dd = (20 * DS) + 5: IF ss = 0 THEN c = 23: dd = dd - 20: : : a = ct: '  COLOR 15: LOCATE c, dd:   PRINT as$(a);
     IF a = 0 THEN DS = ct \ 20: dd = (20 * DS) + 5: c = (ct MOD 20) + 3: : a = ct: LOCATE 2, 2: ' : COLOR 15: LOCATE c, dd: PRINT as$(a);

                   
   COLOR 15: LOCATE c, dd: PRINT as$(a); CHR$(30): COLOR 11 '   'BRIGHT

639 GOTO 595

         '**right
640  IF a + 20 > ct THEN 595 ELSE LOCATE c, dd: COLOR 11: PRINT as$(a): dd = dd + 20: a = a + 20:
645 GOSUB 671: GOTO 595
        '** left
650 IF a - 20 <= 0 THEN 595 ELSE LOCATE c, dd: COLOR 11: PRINT as$(a): dd = dd - 20: a = a - 20
657 GOSUB 671: GOTO 595
659

670 GOTO 590
671 COLOR 15: LOCATE c, dd: PRINT as$(a): COLOR 11: RETURN
690  CLS
GOTO 1000  '** has shown all file and one has been selected; going to load it

END
900

inreg.ax = &H1A00
inreg.bx = 0
inreg.cx = 0
inreg.dx = VARPTR(dta)
inreg.DS = -1
CALL interrupt(&H21, inreg, outreg)


IF LEN(filespec$) THEN
filespecz$ = filespec$ + NULL$
inreg.ax = &H4E00
inreg.cx = 0
inreg.dx = SADD(filespecz$)
inreg.DS = -1
                            
ELSE
inreg.ax = &H4F00
END IF


CALL interrupt(&H21, inreg, outreg)

IF outreg.flags AND 1 THEN
dir$ = ""

ELSE
NULL = INSTR(31, dta, NULL$) 'searchs dta, starting at # 31 looking for a null

dir$ = MID$(dta, 31, NULL - 31)

END IF

RETURN
1000

                      '********* above is the dir to slect from
                      '***********  STARTS HERE **************


inreg.ax = 0
inreg.bx = 0
inreg.cx = 0
inreg.dx = 0




GOSUB 3900
inreg.ax = 1
GOSUB 3900
                '**  could start here using command$ and removing mouse part
                '** you would have to keep the dim statements

COLOR 7
CLS
   COLOR 8: LOCATE 1, 70: PRINT "jad": COLOR 12

COLOR 14: LOCATE 2, 35: PRINT "jad's HTM READER"
COLOR 11: LOCATE 4, 8: PRINT "YOU HAVE SELECTED "
COLOR 12: LOCATE 4, 36: PRINT as$(a)
til$ = LEFT$(as$(a), LEN(as$(a)) - 3)

LOCATE 6, 8: COLOR 11: PRINT "Press"; : COLOR 12: PRINT " Any Key"; : COLOR 11: PRINT " To GO and Stop"
LOCATE 7, 8: COLOR 11: PRINT "Go   "; : COLOR 12: PRINT "Right Mouse "; : COLOR 11: PRINT " Stop"; : COLOR 12: PRINT "  Left Mouse "; : :
LOCATE 8, 8: COLOR 11: PRINT "Press"; : COLOR 12: PRINT " Q"; : COLOR 11: PRINT " to quit"
LOCATE 9, 8: COLOR 11: PRINT "Press"; : COLOR 12: PRINT " P"; : COLOR 11: PRINT " to print and show"
LOCATE 10, 8: COLOR 11: PRINT "Press"; : COLOR 12: PRINT " S"; : COLOR 11: PRINT " to save and to show "

COLOR 11
2010 b$ = INKEY$
inreg.ax = 1
GOSUB 3900
inreg.ax = 3
GOSUB 3900
aa = (outreg.cx \ 14)
b = (outreg.dx \ 14 - 4)
bb = outreg.bx
IF aa > 3 AND aa < 20 AND b = 1 AND (bb = 1 OR bb = 2) THEN b$ = "": GOTO 2011
IF aa > 3 AND aa < 24 AND b = 2 AND (bb = 1 OR bb = 2) THEN b$ = "": GOTO 2011
IF aa > 3 AND aa < 14 AND b = 3 AND (bb = 1 OR bb = 2) THEN CLS : inreg.bx = 2: GOSUB 3900: END
IF aa > 3 AND aa < 19 AND b = 4 AND (bb = 1 OR bb = 2) THEN lp$ = "p": GOTO 2011
IF aa > 3 AND aa < 20 AND b = 5 AND (bb = 1 OR bb = 2) THEN s$ = "s": GOTO 2011
IF b$ = "p" OR b$ = "P" THEN lp$ = "p": GOTO 2011
IF b$ = "q" OR b$ = "Q" THEN CLS : END
IF b$ = "s" OR b$ = "S" THEN s$ = "s": GOTO 2011

IF b$ <> "" THEN 2011
GOTO 2010
2011
outreg.bx = 2
inreg.ax = 2: GOSUB 3900
CLS
'LOCATE 1, 70:

        '****     the part that reads the HTM files  follows



 spec$ = spec$ + as$(a)

OPEN spec$ FOR BINARY AS #1
IF LOF(1) = 0 THEN PRINT : PRINT "File Not Found"
CLOSE
    
OPEN spec$ FOR INPUT AS #1

DO UNTIL (EOF(1))
LINE INPUT #1, Temp$
LET lines = lines + 1
LOOP
                 CLOSE
    til$ = til$ + "txt"      '** saving

IF s$ = "s" THEN CLOSE 2: OPEN til$ FOR OUTPUT AS 2


OPEN spec$ FOR INPUT AS #1

FOR i = 1 TO lines
2015
LINE INPUT #1, thefile$(i)

      FOR x = 1 TO LEN(thefile$(i))

2020
'.******************************************************************************
'*************************************************************************

     d$ = MID$(thefile$(i), x, 1)
     h$ = MID$(thefile$(i), x + 1, 1):
     dh$ = MID$(thefile$(i), x + 2, 1)
    ddh$ = MID$(thefile$(i), x + 3, 1)
    dddh$ = MID$(thefile$(i), x + 26, 1)

       ' ** GETTING RID OF UNWANTED INSTRUCTION
   '** looks at d$ and goes into loop ,which is not added to f$ it loops till
   '** it finds the limiter, in line below its a ">" this applies to a bunch
   '** of commands   "I think"
2110
    IF d$ = "<" THEN GOSUB 2500: F$ = F$ + " ": GOTO 2190  '** this removes most
    IF d$ = "{" THEN GOSUB 2530: F$ = F$ + " ": GOTO 2190
    IF d$ = "&" AND h$ = "n" THEN GOSUB 2510: : GOTO 2190
    IF d$ = "H" AND h$ = "R" AND dh$ = "E" THEN GOSUB 2500: GOTO 2190
    IF d$ = "h" AND h$ = "r" AND dh$ = "e" AND ddh$ = "f" THEN GOSUB 2500: GOTO 2190
    IF d$ = "S" AND h$ = "R" AND dh$ = "C" AND ddh$ = "=" THEN GOSUB 2500: GOTO 2190
    IF d$ = "p" AND h$ = "b" AND dh$ = "l" AND ddh$ = "o" THEN GOSUB 2500: GOTO 2190
    IF d$ = "v" AND h$ = "a" AND dh$ = "r" AND ddh$ = " " THEN GOSUB 2520: GOTO 2190
    IF d$ = "f" AND h$ = "u" AND dh$ = "n" AND dddh$ = ")" THEN GOSUB 2500: GOTO 2190 ' * function       )
    IF d$ = CHR$(34) AND h$ = " " AND dh$ = "b" THEN GOSUB 2500: GOTO 2190





    F$ = F$ + d$      '**making f$

2190
IF i > lines THEN i = lines


NEXT


IF LEN(F$) <= 2 THEN i = i + 1: IF i > lines THEN i = lines: GOTO 2230 ELSE GOTO 2015
'*** above line trying to skip blank lines
'*** in first 2 lines where  i took out the <  > at location line 2110 i
'*** had to put a space back in to seperate the letters. got some blank lines
'*** i am trying to get around them   "I think"

  thefile$(i) = ""
    IF F$ = "" THEN GOTO 2300
IF s$ = "s" THEN PRINT #2, F$
 


 dd = INSTR(F$, "//")    '**getting rid of "//"

 IF dd > 0 THEN GOTO 2209
 da = INSTR(F$, "-->")      '**getting rid of "-->"

 IF da > 0 THEN GOTO 2209

               
     F$ = LTRIM$(RTRIM$(F$))           '** removing blanks



   PRINT F$
 
     IF lp$ = "p" THEN LPRINT F$ ELSE
2209
  d$ = ""
  F$ = ""
2210

2230
 
     dd$ = INKEY$
2231    IF dd$ <> "" THEN ss$ = INKEY$: IF ss$ = "" THEN 2231
    IF dd$ = "q" OR dd$ = "Q" THEN CLS : END
    inreg.ax = 3: GOSUB 3900   '** CHECK IF A BUTTON HAS BEEN PRESSED
    IF outreg.bx = 1 THEN GOSUB 3950  '** PUT IT IN A LOOP TILL YOU DO SOMETHING

   t! = TIMER: DO:    LOOP UNTIL TIMER > t! + .05: '** slows the scroll down

2300
NEXT

CLOSE 1
CLOSE 2
   
       lines = 0
       lp$ = ""
PRINT "end   Press any key"

     
 
   SLEEP
GOTO 50

  END
2500
     '*******************************************
 
                                     
     d$ = MID$(thefile$(i), x, 1)
      IF d$ <> ">" AND x < LEN(thefile$(i)) THEN x = x + 1: GOTO 2500
       d$ = ""  '** getting rid of <title>, <center>,and <what> ever between <   >
 
       RETURN


2510    '*************************
                                               
     d$ = MID$(thefile$(i), x, 1)
    IF d$ <> " " AND x < LEN(thefile$(i)) THEN x = x + 1: : GOTO 2510
     d$ = ""     ' getting rid of a bunch "&nbsp"
    


RETURN

2520       '********************************
'**not used    all below
RETURN
d$ = MID$(thefile$(i), x, 1)
      IF d$ <> ";" AND x < LEN(thefile$(i)) THEN x = x + 1: : GOTO 2520
       d$ = ""
                '** removing var cuid="      " ;

 RETURN

2530      '*******************************
     d$ = MID$(thefile$(i), x, 1)
      IF d$ <> "}" AND x < LEN(thefile$(i)) THEN x = x + 1: : GOTO 2530
       d$ = ""    'removing { to }
     
             
              RETURN


2600


3900     '****mouse
CALL interrupt(&H33, inreg, outreg)
RETURN
3950              '** when left button is pushed this loops
                  '** till right one is pushed or a key is pressed

IF INKEY$ <> "" THEN RETURN

inreg.ax = 3
 CALL interrupt(&H33, inreg, outreg)
IF outreg.bx <> 2 THEN GOTO 3950
RETURN



4000        '** part of mouse on the display
    
aa = ((outreg.cx - 30) \ 160) + 1      '* across
b = (outreg.dx \ 14) - 2  '** up + down
inreg.ax = 1
GOSUB 3900

inreg.ax = 3
GOSUB 3900


           ' **             aa = across    b = up + down
IF outreg.bx = 1 OR outreg.bx = 2 THEN s = a: c = b + 3: a = ((aa - 1) * 20) + b: aa = aa - 1: aa = (aa * 20) + 5: GOSUB 4100: 'GOTO '690 '596
GOTO 596

4100
IF a > ct THEN RETURN


inreg.ax = 3
GOSUB 3900
vc = outreg.cx
vd = outreg.dx
inreg.ax = 2
GOSUB 3900
inreg.ax = 33
GOSUB 3900


COLOR 15: LOCATE c, aa: PRINT as$(a); : COLOR 11'   'BRIGHT

  inreg.ax = 4
  inreg.cx = vc
  inreg.dx = vd
  GOSUB 3900
nN$ = CHR$(13)
  
 RETURN

5000 CLS
   COLOR 8: LOCATE 1, 70: PRINT "jad": COLOR 12
LOCATE 12, 20: PRINT "An Error Has Occured"; : COLOR 12: PRINT "      Press Any Key"
             DO: LOOP WHILE INKEY$ = ""
GOTO 50

6000
     drive% = 0
FOR i% = 1 TO 3
   
         inreg.ax = &H401
        inreg.cx = &H101
         inreg.dx = &H100 + re
          CALL interrupt(&H13, inreg, outreg)
                     
                      ot = outreg.ax

      inreg.ax = 0
   
        CALL interrupt(&H13, inreg, outreg)
        'PRINT ot
NEXT i%
IF ot = 1 THEN 150
IF ot <> 1 THEN CLS : LOCATE 10, 22: PRINT "There has been a drive error"
IF ot <> 1 THEN LOCATE 12, 22: PRINT "Press any key to continue"
DO WHILE INKEY$ = "": LOOP




GOTO 50