10 REM This program written by John Porter
20 REM Dept. Environmental Sciences, Univ. of Virginia
30 REM Charlottesville, VA 22903
40 REM copyright (c) 1984 by John Porter
50 REM NOT TO BE SOLD
60 REM  3/13/84 
70 CLEAR,46999!
80 VERSI$ =" 9"
90 DIM ISTR$(30),CSTR$(30),KEY$(30,5,15),NKEY(15)
100 DEFINT I-N
110 DEF USR1=47000!
120 REM DEFINE CLEAR SCREEN CHARACTER
130 CLS$=CHR$(26)
140 REM DEFINE BELL CHARACTER (SET TO "" IF YOU DON'T WANT THE BELL)
150 BELL$=CHR$(7)
160 REM DEFINE ERROR TRAPPING ROUTINE FOR INPUT FILE ERRORS
170 ON ERROR GOTO 4000
180 PRINT CLS$:PRINT:PRINT "REFFIND - VERSION ";VERSI$:PRINT
190 PRINT "This program locates key strings within references."
200 PRINT " References should have single vertical spacing and"
210 PRINT " be separated from one another by double spacing."
220 PRINT 
230 PRINT "References that contain the appropriate key strings will"
240 PRINT " be written to another file in the same format."
250 PRINT:PRINT "You will be able to use multiple input files on different"
260 PRINT "   disks (or, if you want, the same disk). BUT YOU CAN NOT "
270 PRINT "   CHANGE THE DISK THE OUTPUT FILE IS ON!!!!!"
280 IFILE=1
290 PRINT:PRINT:PRINT "PUT IN THE DISKS YOU WANT TO READ FROM OR WRITE TO"
300 INPUT " AND HIT A CARRIAGE RETURN";A$
310 RESET
320 PRINT:PRINT
330 REM THIS READS IN THE MACHINE LANGUAGE SUBROUTINE USR1
340 FOR I=0 TO 70
350 READ J
360 POKE I+47000!,J
370 NEXT I
380 INPUT "What is the file name for INPUT";F1$
390 DUM$=F1$
400 GOSUB 2000
410 F1$=DUM$
420 INPUT "What is the file name for OUTPUT";F2$
430 DUM$=F2$
440 GOSUB 2000
450 F2$=DUM$
460 OPEN "I",#1,F1$
470 OPEN "O",#2,F2$
480 REM *************** go read in key strings
490 NSET=1
500 NKEY(NSET)=1
510 PRINT 
520 PRINT "Input KEY STRINGS"
530 PRINT  "Up to 5 keys may be input on a single line, separated by commas."
540 PRINT "When more than one key string is input per line, ALL of the "
550 PRINT "key strings in the line MUST OCCUR in a reference for it to be"
560 PRINT "included. "
570 OLDK$=K$
580 PRINT
590 PRINT "Input key string (Input 2 empty key strings to start search) "
600 LINE INPUT K$
610 ICOM=0
620 IKEY=1
630 IF K$="" THEN 670
640 NCOM=ICOM: ICOM=INSTR(ICOM+1,K$,","):IF IKEY>5 THEN PRINT"EXTRA KEY(S) IGNORED":GOTO 570
650 IF ICOM><0 THEN KEY$(NSET,IKEY,NKEY(NSET))=MID$(K$,NCOM+1,(ICOM-NCOM-1)):IKEY=IKEY+1:GOTO 640
660 KEY$(NSET,IKEY,NKEY(NSET))=MID$(K$,NCOM+1):NKEY(NSET)=NKEY(NSET)+1:PRINT:PRINT " OR":GOTO 570
670 IF OLDK$<>""THEN NKEY(NSET)=NKEY(NSET)-1:NSET=NSET+1:NKEY(NSET)=1:PRINT:PRINT "***** AND *****":GOTO 570
680 NSET=NSET-1
690 PRINT #2, "-SET","  KEY"
700 FOR I1=1 TO NSET
710 FOR I2=1 TO NKEY(I1)
720 FOR I3=1 TO 5
730 DUM$=KEY$(I1,I3,I2)
740 GOSUB 2000
750 KEY$(I1,I3,I2)=DUM$
760 NEXT I3
770 PRINT #2,I1,KEY$(I1,1,I2);",";KEY$(I1,2,I2);",";KEY$(I1,3,I2);",";KEY$(I1,4,I2);",";KEY$(I1,5,I2)
780 NEXT I2
790 NEXT I1
800 PRINT #2,""
810 PRINT CLS$
820 REM this section reads in the references
830 REM the raw references are stored in array istr$
840 REM compressed, upper case refs are stored in cstr$
850 REM overlapping words are stored in ostr$
860 WHILE NOT EOF(1)
870 NB=1
880 NREF=NREF+1
890 ISTR$(1)=""
900 OSTR$=""
910 LINE INPUT #1, ISTR$(NB)
920  DUM$=ISTR$(NB):GOSUB 2000:CSTR$(NB)=DUM$
930 IF CSTR$(NB)<>"" THEN NB=NB+1:GOTO 910
940 FOR I1=1 TO NB
950 IF LEN(ISTR$(I1))=255 THEN OSTR$=OSTR$+RIGHT$(ISTR$(I1),12)+LEFT$(ISTR$(I1+1),12)
960 NEXT I1
970 DUM$=OSTR$:GOSUB 2000: OSTR$=DUM$
980 GOSUB 3000
990 PRINT CLS$:PRINT:PRINT :PRINT
1000 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
1010 IF MC<NSET THEN 1080
1020 NFOU=NFOU+1
1030 PRINT CLS$:PRINT:PRINT :PRINT
1040 PRINT ,"REFS CHECKED = ";NREF,"NUMBER OF MATCHES = ";NFOU
1050 FOR I1=1 TO NB
1060 IF LEN(ISTR$(I1))=255 THEN PRINT #2,ISTR$(I1); :ELSE PRINT #2, ISTR$(I1)
1070 NEXT I1
1080 WEND
1090 CLOSE #1
1100 FOR I= 1 TO 10:PRINT BELL$:NEXT I : PRINT CLS$
1110 IFILE=IFILE+1
1120 PRINT:PRINT:PRINT "Place the disk with input file #";IFILE;" in a disk drive"
1130 PRINT" DO NOT remove the disk containing the output file!!!!!"
1140 PRINT: PRINT
1150 PRINT:INPUT "What is the new INPUT file name (Hit 'RETURN' to end)";F1$   
1160 DUM$=F1$: GOSUB 2000: F1$=DUM$
1170 IF F1$ = "" THEN CLOSE:PRINT BELL$,BELL$:PRINT "FINISHED":PRINT:PRINT NREF;"References checked",NFOU;"put on output file: ";F2$:PRINT:PRINT:SYSTEM:END
1180 OPEN "I",#1,F1$
1190 GOTO 860
2000 REM this subroutine converts strings to upper case and eliminates
2010 REM control characters, punct.  and spaces  and resets high order bits
2020 REM input the string to be cleaned as DUM$
2030 DUM$=USR1(DUM$)+""
2040 RETURN
3000 REM this subroutine checks for matches with keys. MC keeps count 
3010 REM    of the sets with at least one match  
3020 MC=0
3030 FOR I1=1 TO NSET
3040 FOR I2=1 TO NKEY(I1)
3050 FOR I4=1 TO 5
3060 IF KEY$(I1,I4,I2)="" THEN GOTO 3120
3070 FOR I3=1 TO NB
3080 IF INSTR(CSTR$(I3),KEY$(I1,I4,I2))<>0 THEN GOTO 3110
3090 NEXT I3
3100 IF INSTR(OSTR$,KEY$(I1,I4,I2))=0 THEN GOTO 3130
3110 NEXT I4
3120 MC=MC+1: GOTO 3150
3130 NEXT I2
3140 RETURN
3150 NEXT I1
3160 RETURN
4000 REM ERROR TRAPPING ROUTINE
4010 IF ERR=53 AND ERL=1180 THEN PRINT "INPUT FILE NOT FOUND - TRY AGAIN":PRINT:RESUME 1120
4020 IF ERR=62 THEN CLOSE #1:PRINT "IMPROPER FILE END - LAST REFERENCE MAY BE IGNORED":RESUME 1110
4030 REM RE-ENABLE ERROR TRAPPING FOR OTHER FATAL ERRORS
4040 ON ERROR GOTO 0
5000 REM THIS IS THE DATA FOR THE ASSEMBLY LANGUAGE SUBROUTINE
5010 DATA &HEB,&H46,&H0E,&H00,&HE5,&H23,&H5E,&H23,&H56,&HEB,&H11
5020 DATA &HDF,&HB7,&H78,&HA7,&HCA,&HD0,&HB7,&H7E,&HE6,&H7F,&HFE
5030 DATA &H5B,&HDA,&HB7,&HB7,&HD6,&H20,&HC3,&HAD,&HB7,&HFE,&H2D
5040 DATA &HDA,&HCB,&HB7,&HFE,&H41,&HD2,&HC6,&HB7,&HFE,&H3B,&HD2
5050 DATA &HCB,&HB7,&HEB,&H77,&H23,&H0C,&HEB,&H05,&H23,&HC3,&HA5
5060 DATA &HB7,&HE1,&HE5,&H71,&H11,&HDF,&HB7,&H23,&H73,&H23,&H72
5070 DATA &H3E,&H03,&HE1,&HEB,&HC9
HEB,&H05,&H23,&HC3,&HA5
5060 DATA &HB7,&HE1,&HE5,&H71,&H11,&HDF,&HB7,&H23,&H73,&H23,&H72
5070 DATA &H3E,&H0