10 '	*****************************************************

	*****	      UTILITY  SEARCH  PROGRAM		*****

	*****						*****
11 '	*****		  by Richard Altman		*****

	*****		  ////  2/6/90  \\\		*****

	*****						*****
12 '	*****	Copyright (c) 1990 by Richard Altman	*****

   ' **************************************************************************
13 '
14 '	 USER SUPPORTED
15 '	 ==== =========
16 '
17 '     This program is user-supported software.  It is copyrighted and cannot
18 ' be sold for profit (without the author's express written permission),  but
19 ' it may be copied and distributed for free.
20 '
21 '     The  SHAREWARE  concept is a  distribution method  that dispenses with
22 ' heavy  marketing/advertising costs and gives the user the  opportunity  to
23 ' try a software program before buying.   Its continued existence depends on
24 ' each user paying for what he does, in fact, use.
25 '
26 '     If you find this program [SEARCH.BAS] useful,  please send the $20 (or
27 ' more) registration fee directly to the author:
28 '
29 '		Richard S. Altman -- P.O. Box 4388 -- Clearlake, CA 95422
30 '
31 '      Upon registration,  you will receive a floppy diskette containing the
32 ' latest version of this program, as well as a printed manual and a COMPILED
33 ' version.  You will also receive a FREE calendar printing program and other
34 ' programs by the same author.
35 '
36 '      WHEN ORDERING,  please be sure to indicate  single or double  density
37 ' disk drive,  and the name of the program  [SEARCH.BAS].   Comments on pro-
38 ' grams are also most welcome!
39 '
40 '     Due to  possible unforeseen circumstances,  the above offer is subject
41 ' to change without notice.
42 '
43 '***************************************************************************
44 '
45 '	SET UP VARIABLES:	   String:   A$-F$, I$

	Integer:  G-H, J, T-Z	   Single Precision:   K-S


46 DEFINT G-J,T-Z:DEFSTR A-F,I:DIM F(24),D(8):E=CHR$(32):A=CHR$(34)
47 CLS=CHR$(26):CLR=CHR$(24):CX=CHR$(23):PRINT CLS:ESC$=CHR$(27):FE=ESC+"="
48 FOR X=1 TO 24:F(X)=FE+CHR$(X+31)+E:NEXT:GOSUB 5020:C7=CHR$(7):WIDTH 255
49 DEF FNF(X,Y)=FE+CHR$(X+31)+CHR$(Y+31):DEF FNRN(X)=INT(RND*X)+1
50 DEF FNTITLE$(X,M$)=FNF(X,1)+STRING$((80-LEN(M$))/2,12)+M$
51 FS=STRING$(79,45):F=STRING$(6,32):ON ERROR GOTO 6500
52 U$=" UTILITY  SEARCH  PROGRAM ":GOSUB 75:GOTO 100
55 '
60 PRINT FNF(4,7)X"Line";:IF X<>1 THEN PRINT"s";
65 PRINT" to SEARCH in `"FLNAME"'"F;FNF(4,60)"Date: "D2$:RETURN
75 PRINT CLS;FS:L$=FNF(2,25)+E+U$+E:GOSUB 5065:PRINT:PRINT FS:RETURN
80 '
100 '	Display Opening Screen
105 PRINT FNF(7,7)"This program will search your program for any string(s)"
110 PRINT F"you wish.  To use it, you must:"
115 PRINT FNF(10,10)"1.  Be sure each line of your program is less than ";
120 PRINT"245 bytes."FNF(11,10)"2.  Save your program in ";:L$="ASCII format"
125 GOSUB 5050:PRINT":  ("A"FILENAME"A",A)."
130 PRINT FNF(12,10)"3.  The Disk must have enough free space for a 2nd ";
135 PRINT"ASCII copy."FNF(13,10)"4.  Run this SEARCH UTILITY."
140 L$=FNF(18,10)+"  Are you ready to run the SEARCH Utility ?   (Y/N)  "+C7
145 PRINT FNF(19,37)"~~~~~~ ~~~~~~~"
150 GOSUB 5065:PRINT"	";
155 GOSUB 6000:IF AK="Y" OR AK=CHR$(13) THEN 165
160 IF AK="N" THEN PRINT:PRINT:END:GOTO 155 ELSE 155
165 PRINT FNF(18,10)CX"What is the FILENAME of your program--- ";
170 INPUT FLNAME:IF FLNAME="" THEN 165
175 IF RIGHT$(FLNAME,4)<>".BAS" THEN FLNAME=FLNAME+".BAS"
180 '
200 '	Check for File's existance
210 L$=FNF(18,10)+"Checking to see if `"+FLNAME+"' exists...."
220 GOSUB 5050:PRINT"   "CX;:FOR T=1 TO 750:NEXT
230 NAME FLNAME AS FLNAME
240 L1=LEN(FLNAME):A1=FLNAME:FOR X=1 TO L1
250 IF ASC(MID$(A1,X,1))>90 THEN MID$(A1,X,1)=CHR$(ASC(MID$(A1,X,1))-32)
260 NEXT:FLNAME=A1:GOSUB 8000
270 '
300 '	Check for Long Lines
310 L$="Checking for over-long lines....":PRINT FNF(20,10)CX;:GOSUB 5050
320 PRINT"   ";:OPEN "I",1,FLNAME:X=0
330 IF EOF(1) THEN CLOSE:IF O=1 THEN 1500 ELSE 500
340 X=X+1:LINE INPUT #1,A
350 IF O=1 THEN 360 ELSE IF LEN(A)>245 THEN PRINT FNF(6,7)L$;CX;F(8)
360 IF LEN(A)>245 THEN PRINT"Line "LEFT$(A,INSTR(A," "))"is"LEN(A)"bytes.":O=1
370 GOTO 330
380 '
500 '	Input Search Strings
505 PRINT F(6)CX;FNF(7,7)"Filename:  "FLNAME"		Today's Date: "D2$
510 U=9:PRINT F(U)CX;C7
515 'M=5:D(1)="SEARCH":D(2)="STRING$":D(3)="PRINT":D(4)="FNF(":GOTO 1000
520 FOR M=1 TO 8:PRINT F(M+U)F"Enter string  #"M"---  ";
525 BX="":LINE INPUT BX:D(M)=BX:L(M)=LEN(BX)
530 IF BX="" THEN IF M=1 THEN 520 ELSE PRINT:GOTO 545
535 NEXT M:PRINT FNF(20,7)"You have reached the maximum of eight searches."
540 PRINT FNF(22,7)"Press <ANY KEY> to continue.   ";:GOSUB 6000
545 PRINT F(19)CX:PRINT F;:L$=" Check the above SEARCHES. ":GOSUB 5065
550 PRINT"    ";:L$=" Are they correct? ":GOSUB 5065:PRINT:PRINT
555 PRINT F;STRING$(60,45);F(20)STRING$(59,12)"(Y/N)  "C7;
560 GOSUB 6000:IF AK="Y" OR AK=CHR$(13) THEN 1000
565 IF AK<>"N" THEN 560
570 PRINT FNF(22,7)"Press <A> to ABORT `NO' answer and continue."CX
575 PRINT FNF(23,7)"Press <RETURN> to retype above responses.   ";
580 GOSUB 6000:IF AK="A" THEN 1000
585 IF AK=CHR$(13) THEN 510 ELSE 580
590  '
1000 '	====  SEARCH  ====
1010 OPEN "I",1,FLNAME:PRINT F(6) CX:GOSUB 60:PRINT FS
1020 XX=X+1:DIM E(X+2):NL=6:NF=1:J=1
1030 GOSUB 5025:IF EOF(1) THEN 1750
1040 LINE INPUT #1,A:QL=1:LN=INSTR(A," "):AL=LEFT$(A,LN)
1050 FOR Q=1 TO M-1:N=1: N=INSTR(N,A,D(Q)):NX=NL
1060 GOSUB 60:IF N<1 THEN 1110
1070 IF NL=6 AND NF=1 THEN PRINT F(5)FS;CX
1080 IF QL=1 THEN E(J)=AL+"--- "+D(Q):PRINT FNF(NL,NF)LEFT$(E(J),38);:QL=2:NL=NL+1:J=J+1:GOTO 1110
1090 IF NL=6 THEN NK=23:NF=1 ELSE NK=NL-1
1100 IF QL=2 THEN E(J-1)=E(J-1)+"  "+D(Q):PRINT FNF(NK,NF)LEFT$(E(J-1),38)
1110 NEXT Q:X=X-1
1120 IF NL>22 THEN NL=6:NF=40:GOSUB 1200
1130 GOTO 1030
1140 '
1200 '	End of Page Subroutine
1210 N2=N2+1:IF N2=1 OR N2=3 OR N2=5 OR N2=7 OR N2=9 THEN RETURN
1220 L$=FNTITLE$(24,"   Press <ANY KEY> to continue the list.   ")
1230 GOSUB 5020:GOSUB 1240:NL=6:NF=1:GOTO 5025
1240 AQ=INKEY$:AK=""
1250 GOSUB 5065:TX=0
1260 AK=INKEY$:IF AK<>"" THEN RETURN ELSE TX=TX+1:IF TX<150 THEN 1260
1270 PRINT L$;:TX=0
1280 AK=INKEY$:IF AK<>"" THEN RETURN ELSE TX=TX+1:IF TX<100 THEN 1280
1290 GOTO 1250
1300 '
1500 '	Some lines need to be shortened.
1510 PRINT:PRINT:PRINT F;
1520 L$="  Your program has NOT been searched.   The above lines need to  "
1530 GOSUB 5065:PRINT:PRINT F;C7;
1540 L$="  be shortened.  You will have to edit them before continuing.   "
1550 GOSUB 5065:END:GOTO 555
1560 '
1750 GOSUB 5020:Z=22
1760 '
2000 '	Search is Finished/ Display Options
2010 PRINT F(Z):L$=STRING$(79,32):GOSUB 5050:PRINT C7:L$=" OPTIONS: "
2020 GOSUB 5065:PRINT"  [R]  Repeat List      [Q]  Quit (End Program)     "CX;
2030 PRINT"[P] Print List";:CLOSE:GOSUB 5025
2040 GOSUB 6000:IF AK="R" OR AK=CHR$(13) THEN 3000
2050 IF AK="P" THEN 3500
2060 IF AK="Q" THEN 4000 ELSE 2040
2070 '
3000 '	Repeat List
3010 GOSUB 75:X=XX-1:GOSUB 60:PRINT FS
3020 GOSUB 5025:NL=6:NF=1:N2=0
3030 FOR Y=1 TO J:IF E(Y)="" THEN 3080
3040 IF NL=6 AND NF=1 THEN PRINT F(5)FS;CX
3050 PRINT FNF(NL,1)LEFT$(E(Y),38);FNF(NL,40)LEFT$(E(Y+17),38)
3060 NL=NL+1:IF NL>22 AND E(Y+17)="" THEN 1750
3070 IF NL>22 THEN NL=6:N2=N2+1:Y=Y+17:GOSUB 1200
3080 NEXT Y:GOTO 1750
3090 '
3500 '	Print List on Printer
3510 GOSUB 75:X=XX-1:GOSUB 60:PRINT FS:GOSUB 5020
3520 PRINT FNF(10,7)"SEARCH List is being output to Printer.   ";
3530 LPRINT ESC$"N"ESC$"!":WIDTH LPRINT 80:JK=J/2
3540 LPRINT FS:LPRINT"     "FLNAME;TAB(27)U$;TAB(60)"Date: "D2$
3550 LPRINT FS:LPRINT ESC$"E";ESC$;CHR$(34):WIDTH LPRINT 96
3560 FOR Y=1 TO JK:IF E(Y)="" THEN 3580
3570 LPRINT F;E(Y);TAB(45)E(Y+JK)
3580 NEXT Y:LPRINT CHR$(12):Z=14:GOTO 2000
3590 '
4000 '	End Program   ***   Load Original Program
4010 GOSUB 75:L$=FNF(10,7)+" SEARCH UTILITY FINISHED "+C7
4020 GOSUB 5065:PRINT"  The original program  `"FLNAME"'"
4030 PRINT F"remains on the disk in its ASCII format.":PRINT
4040 PRINT F"It is now being loaded back in.  You should SAVE it back on"
4050 PRINT F"disk again so it will load faster than the ASCII version."
4060 GOSUB 5020:CLOSE:PRINT F(17):LOAD FLNAME:END:RUN
4070 '
5000 '	*****	Misc. Subroutines
5005 '
5010 PRINT ESC"B0";:RETURN:'	Inverse Video ON/OFF
5015 PRINT ESC"C0";:RETURN:
5020 PRINT ESC"B4";:RETURN:'	Turn Cursor ON/OFF
5025 PRINT ESC"C4";:RETURN:
5030 PRINT ESC"B1";:RETURN:'	Reduced Intensity ON/OFF
5035 PRINT ESC"C1";:RETURN:
5040 PRINT ESC"B3";:RETURN:'	Underline ON/OFF
5045 PRINT ESC"C3";:RETURN:
5050 GOSUB 5040:PRINT L$;:GOTO 5045:'	Underline L$
5055 '
5060 GOSUB 5010:GOSUB 5030:PRINT L$;:GOSUB 5015:GOTO 5035:'	Revrs. Video L$
5065 GOSUB 5010:PRINT L$;:GOTO 5015:'				BRIGHT Video L$
5070 '
6000 '	INKEY$ Subroutines
6010 K$=INKEY$:AK=""
6020 AK=INKEY$:IF AK="" THEN 6020
6030 IF ASC(AK)>96 THEN AK=CHR$(ASC(AK)-32)
6040 RETURN
6050 K$=INKEY$:IN=""
6060 IN=INKEY$:IF IN<>CHR$(13) THEN 6060 ELSE RETURN
6070 '
6500 '	ERROR LINE Subroutine
6510 IF ERR=53 THEN L$=FNF(19,10)+"  ERROR:  File not found.  "+C7:GOSUB 5065:FOR T=1 TO 5000:NEXT:RESUME 165
6520 IF ERR=58 THEN RESUME 240
6530 PRINT:PRINT C7"Error"ERR"in Line"ERL:END:RUN
6540 '
8000 RESTORE 8080:'	Today's Date CALCULATION  (= D2$)
8010 FOR X=1 TO 6:READ ID%(X):NEXT
8020 FOR Y=3 TO 6:ID%=ID%(Y):GOSUB 8050:CV%(Y)=CVAL%:NEXT
8030 M$=STR$(CV%(5)):D$=STR$(CV%(6)):Y$=STR$(CV%(3))
8040 D2$=RIGHT$(M$,2)+"/"+RIGHT$(D$,2)+"/"+RIGHT$(Y$,2):RETURN
8050 OUT 32,ID%:BCD%=INP(36)
8060 SX=INT(BCD%/16):S1=BCD%-16*SX
8070 CVAL%=10*SX+S1:RETURN
8080 DATA 0,0,9,0,7,6
):RETURN
8050 OUT 32,ID%:BCD%=INP(36)
8060 SX=INT(BCD%/16):