5748273 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n findword.bas
   1: DECLARE SUB CheckRedun ()
   2: DECLARE SUB ChkInk (t$, t!)
   3: DECLARE SUB Optns ()
   4: DECLARE SUB Ink ()
   5: DECLARE SUB Add ()
   6: DECLARE SUB Sec ()
   7: DIM wrds(100) AS INTEGER
   8: DIM SHARED otp AS STRING
   9: OPEN "CON" FOR OUTPUT AS #3
  10: WIDTH 80, 50
  11: 60 CLS
  12: PRINT "(O)ptions"
  13: PRINT "(E)xclude/Included sections"
  14: PRINT "(A)dd word or words"
  15: PRINT "Add (S)ection or sections"
  16: PRINT "(B)egin"
  17: PRINT "(Q)uit"
  18: LOCATE , , 1
  19: a$ = INPUT$(1)
  20: IF UCASE$(a$) = "O" THEN Optns
  21: IF UCASE$(a$) = "E" THEN Ink
  22: IF UCASE$(a$) = "A" THEN Add
  23: IF UCASE$(a$) = "Q" THEN END
  24: IF UCASE$(a$) = "S" THEN Sec
  25: IF UCASE$(a$) = "B" THEN GOTO 50
  26: IF UCASE$(a$) = CHR$(13) THEN END
  27: GOTO 60
  28: 50 OPEN "words.!1!" FOR INPUT AS #1
  29: LINE INPUT "Phrase-->"; phr$
  30: phr$ = UCASE$(phr$)
  31: tmp$ = UCASE$(tmp$)
  32: phr$ = RTRIM$(phr$)
  33: phr$ = LTRIM$(phr$)
  34: tmp$ = RTRIM$(tmp$)
  35: tmp$ = LTRIM$(tmp$)
  36: ln = 0
  37: DO UNTIL EOF(1)
  38: wrd$ = ""
  39: wd = 0
  40: FOR q = 1 TO 100: wrds(q) = 0: NEXT q
  41: ieo = 0
  42: g = 0
  43: LINE INPUT #1, tmp$
  44: 30 IF MID$(tmp$, 1, 1) = "[" AND MID$(tmp$, LEN(tmp$), 1) = "]" THEN sce$ = MID$(tmp$, 2, LEN(tmp$) - 2): ChkInk sce$, ioe: IF ioe = 0 THEN LINE INPUT #1, tmp$: ln = ln + 1: DO: LINE INPUT #1, tp$: ln = ln + 1: LOOP UNTIL MID$(tp$, 1, 1) = "[" OR EOF(1): CLOSE 1: OPEN "Words.!1!" FOR INPUT AS #1: FOR q = 1 TO ln: LINE INPUT #1, tpm$: NEXT q: GOTO 30 ELSE GOTO 40
  45: 40 FOR a = 1 TO LEN(tmp$)
  46: FOR b = 1 TO LEN(phr$)
  47: IF wrds(b) = 1 THEN GOTO 20
  48: IF MID$(tmp$, a, 1) = MID$(phr$, b, 1) THEN wrd$ = wrd$ + MID$(phr$, b, 1): wd = wd + 1: wrds(b) = 1: GOTO 10
  49: 'PRINT MID$(tmp$, a, 1); " "; MID$(phr$, b, 1); wrd
  50: 20 NEXT b
  51: 10 NEXT a
  52: IF wrd$ = tmp$ THEN PRINT #3, wrd$
  53: IF wd > LEN(tmp$) THEN PRINT "Error!! Matched letters greater than word length": END
  54: ln = ln + 1
  55: LOOP
  56: CLOSE 3
  57: 
  58: SUB Add
  59: 90 LINE INPUT "Section-->"; Sc$
  60: LINE INPUT "Word-->"; wrds$
  61: IF Sc$ = "" OR wrds$ = "" THEN EXIT SUB
  62: OPEN "words.!1!" FOR INPUT AS #1
  63: OPEN "word.tmp" FOR OUTPUT AS #2
  64: c$ = "[" + UCASE$(Sc$) + "]"
  65: DO UNTIL b$ = c$ OR EOF(1)
  66: LINE INPUT #1, b$
  67: PRINT UCASE$(b$); " "; UCASE$(wrds$)
  68: PRINT #2, UCASE$(b$)
  69: LOOP
  70: IF EOF(1) THEN PRINT #2, c$
  71: PRINT #2, UCASE$(wrds$)
  72: IF EOF(1) THEN CLOSE 1: CLOSE 2: KILL "words.!1!": NAME "word.tmp" AS "words.!1!": EXIT SUB
  73: DO UNTIL EOF(1)
  74: LINE INPUT #1, b$
  75: PRINT #2, UCASE$(b$)
  76: LOOP
  77: CLOSE 1: CLOSE 2
  78: KILL "words.!1!": NAME "word.tmp" AS "words.!1!"
  79: GOTO 90
  80: END SUB
  81: 
  82: SUB CheckRedun
  83: 
  84: END SUB
  85: 
  86: SUB ChkInk (t$, t)
  87: t = 0
  88: OPEN "section.ink" FOR INPUT AS #2
  89: DO UNTIL EOF(2) OR t = 1
  90: LINE INPUT #2, b$
  91: b$ = RTRIM$(b$)
  92: b$ = LTRIM$(b$)
  93: IF UCASE$(b$) = UCASE$(t$) THEN t = 1
  94: LOOP
  95: CLOSE 2
  96: END SUB
  97: 
  98: SUB Ink
  99: DIM nmse(1 TO 300) AS STRING
 100: OPEN "section.ink" FOR OUTPUT AS #1
 101: OPEN "words.!1!" FOR INPUT AS #2
 102: q = 1
 103: DO UNTIL EOF(2)
 104: LINE INPUT #2, tp$
 105: IF MID$(tp$, 1, 1) = "[" AND MID$(tp$, LEN(tp$), 1) = "]" THEN sce$ = MID$(tp$, 2, LEN(tp$) - 2): PRINT q; sce$: nmse(q) = sce$: q = q + 1
 106: LOOP
 107: PRINT "Press number of section to include and enter to quit"
 108: 310 PRINT ">"; : b$ = INPUT$(1)
 109: IF VAL(b$) > q THEN GOTO 310
 110: IF b$ = CHR$(13) THEN PRINT : CLOSE 1: CLOSE 2: EXIT SUB
 111: PRINT b$
 112: PRINT #1, nmse(VAL(b$))
 113: GOTO 310
 114: END SUB
 115: 
 116: SUB Optns
 117: CLOSE 3
 118: otp$ = "SCREEN": otp2$ = "CON"
 119: 70 CLS
 120: PRINT "(O)utput to: "; otp$
 121: PRINT "(C)heck for redundant words"
 122: PRINT "(R)eturn to Main Menu"
 123: b$ = INPUT$(1)
 124: IF UCASE$(b$) = "C" THEN CheckRedun: GOTO 70
 125: IF UCASE$(b$) = "R" THEN GOTO 80
 126: IF UCASE$(b$) = "O" THEN
 127: PRINT "--------------------------------------------------------------------------------";
 128: PRINT "(S)creen"
 129: PRINT "(F)ile"
 130: PRINT "(P)rinter"
 131: c$ = INPUT$(1)
 132: c$ = UCASE$(c$)
 133: IF c$ = "S" THEN otp$ = "SCREEN": otp2$ = "CON"
 134: IF c$ = "F" THEN INPUT "Filename"; otp$: otp2$ = UCASE$(otp$): otp$ = UCASE$(otp$)
 135: IF c$ = "P" THEN otp$ = "PRINTER": otp2$ = "LPT1"
 136: END IF
 137: GOTO 70
 138: 80 OPEN otp2$ FOR OUTPUT SHARED AS #3
 139: END SUB
 140: 
 141: SUB Sec
 142: LINE INPUT "Section-->"; Sc$
 143: scton = 0
 144: OPEN "words.!1!" FOR INPUT AS #1
 145: c$ = "[" + UCASE$(Sc$) + "]"
 146: DO UNTIL EOF(1)
 147: LINE INPUT #1, b$
 148: IF UCASE$(b$) = UCASE$(c$) THEN scton = scton + 1
 149: LOOP
 150: IF scton >= 1 THEN PRINT "Section already exist!": CLOSE 1: EXIT SUB
 151: CLOSE 1
 152: OPEN "words.!1!" FOR APPEND AS #1
 153: PRINT #1, c$
 154: CLOSE 1
 155: END SUB
 156: 
5748274 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:02:43