Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / bbslists / findrcpm.lbr / FINDRCPM.BQS / FINDRCPM.BAS

Wrap

BASIC Source File | 1986-07-15 | 12.1 KB | 327 lines

10 REM FINDRCPM Release 1.00 - Copyright (C) 1985 by George M. Sipe. 20 REM 30 REM Notice: This program is NOT public domain. Copyright is retained by 40 REM George M. Sipe, 4873 Scotts Mill Way, Duluth, GA, 30136. 50 REM 60 REM License is granted for free use and re-distribution, providing 70 REM such use and re-distribution contain this notice and copyright 80 REM notice displayed upon program execution. No restriction is 90 REM placed on commercial use, other than written notice of such to 100 REM the copyright holder identified above. 110 REM 120 REM This program scans for entries of interest in the monthly RCP/M list 130 REM generously published by Jud Newell, Kim Levitt, and Steve Sanders. 140 REM 150 REM The format of the specification file is assumed to be... 160 REM 170 REM General requirements (unless always include or exclude): 180 REM 190 REM 1. Minimum storage in megabytes required (e.g. 30.25) 200 REM 2. Transmission speed required (e.g. b) 210 REM 3. Output filename (e.g. rcpm-#.sum) 220 REM (Note: # gets replaced by 3 digit input number.) 230 REM 4. Blank line 240 REM 250 REM Always include if mentioned (unless always excluded): 260 REM 270 REM 5. Minimum storage in megabytes required (e.g. 5.0) 280 REM 6. Transmission speed required (e.g. 3b) 290 REM 7. Strings to match (case insensitive, 1 per line) 300 REM - Blank line 310 REM 320 REM Always exclude if mentioned (overrides all else): 330 REM 340 REM - Minimum storage in megabytes to match (e.g. 5.0) 350 REM - Transmission speeds to match (e.g. 3b) 360 REM - Strings to match (case insensitive, 1 per line) 370 REM 380 REM The format of the RCP/M list is assumed to be... 390 REM 400 REM 1. Header is terminated by a blank line 410 REM 2. Region names follow lines containing "=====" 420 REM 3. States' names are on lines with '[' in column 1 430 REM 4. Entries have a non-blank in the first column 440 REM 5. Entries end with new entries or blank lines 450 REM 6. Specifications are in "(baud;size)" format in entries 460 REM 7. Specifications are on the second line of each entry 470 REM 8. Size is in KB unless followed by M (before ')') 480 REM 9. The first entry starts after the first region marker 490 REM 10. The last entry ends at the 'region' "NOTES:" 500 REM 510 REM This program is compatible with most versions of Microsoft Basic, 520 REM including CP/M-80 and IBM-PC versions. For maximum performance, it 530 REM is suggested that this program be compiled with Microsoft BASCOM. 540 REM 550 REM ---------------------------------------------------------------------- 560 REM Make declarations... 570 REM ---------------------------------------------------------------------- 580 OPTION BASE 1 590 DEFINT A-Z 600 DIM SFILE$(25),INUM$(3),IFILE$(25),OFILE$(25) 610 DIM ENTRY$(25),LCENTRY$(25),TEXT$(3,50),SPEED$(3) 620 DIM MEG!(3),COUNT(3) 630 MREGION$="=====" 640 DONE$="NOTES:" 650 REGION$="" 660 STATE$="" 670 COUNT=0 680 TOTAL=0 690 REM ---------------------------------------------------------------------- 700 REM Get selection specifications... 710 REM ---------------------------------------------------------------------- 720 REM (Replace the next line with your terminal's clear code.) 730 PRINT CHR$(27)+"[2J" 740 REM (The next line MAY NOT be removed from this program.) 750 PRINT "FINDRCPM Release 1.00 - Copyright (C) 1985 by George M. Sipe." 760 PRINT 770 INPUT "Specification file name [FINDRCPM.DAT]";SFILE$ 780 IF LEN(SFILE$)=0 THEN SFILE$="FINDRCPM.DAT" 790 OPEN "I",#1,SFILE$ 800 FOR I=1 TO 3 810 COUNT(I)=0 820 MEG!(I)=0! 830 SPEED$(I)="" 840 NEXT I 850 ON ERROR GOTO 990 860 FOR I=1 TO 3 870 INPUT #1, MEG!(I) 880 INPUT #1, ILINE$ 890 GOSUB 3030 900 SPEED$(I)=ILINE$ 910 INPUT #1, ILINE$ 920 IF LEN(ILINE$)=0 THEN 970 930 GOSUB 3030 940 COUNT(I)=COUNT(I)+1 950 TEXT$(I,COUNT(I))=ILINE$ 960 GOTO 910 970 NEXT I 980 GOTO 1000 990 RESUME 1000 1000 ON ERROR GOTO 2060 1010 CLOSE 1020 IF LEN(TEXT$(1,1))=0 THEN 1070 1030 ILINE$=TEXT$(1,1) 1040 GOSUB 3130 1050 TEXT$(1,1)=ILINE$ 1060 GOTO 1080 1070 TEXT$(1,1)="RCPM-#.SUM" 1080 COUNT(1)=1 1090 REM ---------------------------------------------------------------------- 1100 REM Get file name and selection criteria... 1110 REM ---------------------------------------------------------------------- 1120 INPUT "Which RCP/M list";INUM$ 1130 INUM$=RIGHT$("000"+INUM$,3) 1140 IFILE$="RCPM-"+INUM$+".LST" 1150 OFILE$=TEXT$(1,1) 1160 P1=INSTR(1,OFILE$,"#") 1170 IF P1=0 THEN 1200 1180 TEXT$(1,1)=LEFT$(OFILE$,P1-1)+INUM$+RIGHT$(OFILE$,LEN(OFILE$)-P1) 1190 OFILE$=TEXT$(1,1) 1200 OPEN "I",#1,IFILE$ 1210 OPEN "O",#2,OFILE$ 1220 REM ---------------------------------------------------------------------- 1230 REM Get heading from file... 1240 REM ---------------------------------------------------------------------- 1250 LINE INPUT #1, ILINE$ 1260 IF LEN(ILINE$)=0 THEN 1250 1270 GOTO 1290 1280 LINE INPUT #1, ILINE$ 1290 PRINT ILINE$ 1300 PRINT #2, ILINE$ 1310 IF LEN(ILINE$)<>0 THEN 1280 1320 REM ---------------------------------------------------------------------- 1330 REM Write selection criteria... 1340 REM ---------------------------------------------------------------------- 1350 PRINT "Selection criteria used:" 1360 PRINT #2, "Selection criteria used:" 1370 I=1 1380 GOSUB 1520 1390 IF COUNT(2)=0 THEN 1450 1400 PRINT " * * * O R * * *" 1410 PRINT #2, " * * * O R * * *" 1420 I=2 1430 GOSUB 1520 1440 GOSUB 1580 1450 IF COUNT(3)=0 THEN 1650 1460 PRINT " * * * BUT NEVER * * *" 1470 PRINT #2, " * * * BUT NEVER * * *" 1480 I=3 1490 GOSUB 1520 1500 GOSUB 1580 1510 GOTO 1730 1520 REM Print disk storage and baud rate info... 1530 PRINT ,"Minimum disk storage of";MEG!(I);"megabytes on-line." 1540 PRINT #2, ,"Minimum disk storage of";MEG!(I);"megabytes on-line." 1550 PRINT ,"Transfer code one of ->";SPEED$(I);"<-." 1560 PRINT #2, ,"Transfer code one of ->";SPEED$(I);"<-." 1570 RETURN 1580 REM Print text strings... 1590 PRINT ,"Mention of: "; 1600 PRINT #2, ,"Mention of: "; 1610 FOR J=1 TO COUNT(I) 1620 IF LEN(TEXT$(I,J))+POS(0)<70 THEN 1670 1630 PRINT 1640 PRINT #2, 1650 PRINT ," "; 1660 PRINT #2, ," "; 1670 PRINT " '";TEXT$(I,J);"'"; 1680 PRINT #2, " '";TEXT$(I,J);"'"; 1690 NEXT J 1700 PRINT 1710 PRINT #2, 1720 RETURN 1730 FOR I=1 TO 2 1740 PRINT 1750 PRINT #2, 1760 NEXT I 1770 REM ---------------------------------------------------------------------- 1780 REM Find first region marker... 1790 REM ---------------------------------------------------------------------- 1800 LINE INPUT #1,ILINE$ 1810 IF INSTR(1,ILINE$,MREGION$)=0 THEN 1800 1820 REM ---------------------------------------------------------------------- 1830 REM Look for next entry in file... 1840 REM ---------------------------------------------------------------------- 1850 IF INSTR(1,ILINE$,MREGION$)=0 THEN 1900 1860 LINE INPUT #1, REGION$ 1870 IF REGION$=DONE$ THEN 1970 1880 LINE INPUT #1, ILINE$ 1890 GOTO 1830 1900 IF LEFT$(ILINE$,1)<>"[" THEN 1940 1910 STATE$=ILINE$ 1920 LINE INPUT #1, ILINE$ 1930 GOTO 1830 1940 IF LEN(ILINE$)<>0 AND LEFT$(ILINE$,1)<>" " THEN 2110 1950 LINE INPUT #1, ILINE$ 1960 IF NOT EOF(1) THEN 1830 1970 PRINT 1980 PRINT #2, 1990 PRINT "Selected ";COUNT;" out of ";TOTAL;" entries." 2000 PRINT #2, "Selected ";COUNT;" out of ";TOTAL;" entries." 2010 CLOSE 2020 PRINT 2030 PRINT "Done." 2040 SYSTEM 2050 GOTO 2040 2060 REM Check for EOF error... 2070 IF ERR=62 THEN 1970 2080 ON ERROR GOTO 0 2090 SYSTEM 2100 REM ---------------------------------------------------------------------- 2110 REM Found entry... 2120 REM ---------------------------------------------------------------------- 2130 TOTAL=TOTAL+1 2140 ENTRIES=0 2150 REM ---------------------------------------------------------------------- 2160 REM Add new line to line table... 2170 REM ---------------------------------------------------------------------- 2180 ENTRIES=ENTRIES+1 2190 ENTRY$(ENTRIES)=ILINE$ 2200 GOSUB 3030 2210 LCENTRY$(ENTRIES)=ILINE$ 2220 REM ---------------------------------------------------------------------- 2230 REM Get next line and check for entry terminator... 2240 REM ---------------------------------------------------------------------- 2250 LINE INPUT #1, ILINE$ 2260 IF LEFT$(ILINE$,1)=" " THEN 2160 2270 REM ---------------------------------------------------------------------- 2280 REM Find system specifications... 2290 REM ---------------------------------------------------------------------- 2300 P2=1 2310 IF ENTRIES<2 THEN 1830 2320 P1=INSTR(P2,LCENTRY$(2),"(") 2330 IF P1=0 THEN 1830 2340 P1=P1+1 2350 P2=INSTR(P1,LCENTRY$(2),")") 2360 IF P2=0 THEN 1830 2370 SPECS$=MID$(LCENTRY$(2),P1,P2-P1) 2380 P3=INSTR(1,SPECS$,";") 2390 IF P3=0 THEN 2320 2400 REM ---------------------------------------------------------------------- 2410 REM Isolate baud rates and disk capacity... 2420 REM ---------------------------------------------------------------------- 2430 SPEEDS$=LEFT$(SPECS$,P3-1) 2440 MEGS!=VAL(MID$(SPECS$,P3+1,LEN(SPECS$)-P3)) 2450 IF RIGHT$(SPECS$,1)<>"m" THEN MEGS!=MEGS!/1000 2460 REM ---------------------------------------------------------------------- 2470 REM Check for must exclude... 2480 REM ---------------------------------------------------------------------- 2490 I=3 2500 GOSUB 2860 2510 IF FLAG=1 THEN 1830 2520 REM ---------------------------------------------------------------------- 2530 REM Check for must include... 2540 REM ---------------------------------------------------------------------- 2550 I=2 2560 GOSUB 2860 2570 IF FLAG=1 THEN 2650 2580 REM ---------------------------------------------------------------------- 2590 REM Check for general inclusion... 2600 REM ---------------------------------------------------------------------- 2610 I=1 2620 GOSUB 2860 2630 IF FLAG=0 THEN 1830 2640 REM ---------------------------------------------------------------------- 2650 REM Output entry... 2660 REM ---------------------------------------------------------------------- 2670 IF LEN(REGION$)=0 THEN 2730 2680 PRINT 2690 PRINT #2, 2700 PRINT MREGION$;REGION$;MREGION$ 2710 PRINT #2, MREGION$;REGION$;MREGION$ 2720 REGION$="" 2730 IF LEN(STATE$)=0 THEN 2790 2740 PRINT 2750 PRINT #2, 2760 PRINT STATE$ 2770 PRINT #2, STATE$ 2780 STATE$="" 2790 FOR I=1 TO ENTRIES 2800 PRINT ENTRY$(I) 2810 PRINT #2, ENTRY$(I) 2820 NEXT I 2830 COUNT=COUNT+1 2840 GOTO 1830 2850 REM ---------------------------------------------------------------------- 2860 REM Check entry against specified conditions... 2870 REM ---------------------------------------------------------------------- 2880 FLAG=0 2890 IF MEGS!<MEG!(I) THEN RETURN 2900 FOR J=1 TO LEN(SPEED$(I)) 2910 IF INSTR(1,SPEEDS$,MID$(SPEED$(I),J,1)) THEN FLAG=1 2920 NEXT J 2930 IF FLAG=0 OR I=1 THEN RETURN 2940 FLAG=0 2950 IF COUNT(I)=0 THEN RETURN 2960 FOR J=1 TO COUNT(I) 2970 FOR K=1 TO ENTRIES 2980 IF INSTR(1,LCENTRY$(K),TEXT$(I,J)) THEN FLAG=1 2990 NEXT K 3000 NEXT J 3010 RETURN 3020 REM ---------------------------------------------------------------------- 3030 REM Convert $ILINE to lower case 3040 REM ---------------------------------------------------------------------- 3050 FOR LC=1 TO LEN(ILINE$) 3060 CHAR$=MID$(ILINE$,LC,1) 3070 IF CHAR$<"A" OR CHAR$>"Z" THEN 3100 3080 CHAR$=CHR$(ASC(CHAR$)+32) 3090 ILINE$=LEFT$(ILINE$,LC-1)+CHAR$+RIGHT$(ILINE$,LEN(ILINE$)-LC) 3100 NEXT LC 3110 RETURN 3120 REM ---------------------------------------------------------------------- 3130 REM Convert $ILINE to upper case 3140 REM ---------------------------------------------------------------------- 3150 FOR UC=1 TO LEN(ILINE$) 3160 CHAR$=MID$(ILINE$,UC,1) 3170 IF CHAR$<"a" OR CHAR$>"z" THEN 3200 3180 CHAR$=CHR$(ASC(CHAR$)-32) 3190 ILINE$=LEFT$(ILINE$,UC-1)+CHAR$+RIGHT$(ILINE$,LEN(ILINE$)-UC) 3200 NEXT UC 3210 RETURN 3220 END =CHR$(ASC(CHAR$)-32) 3190 ILINE$=LEFT$(ILINE$,UC-1)+CHAR$+RIGHT$(ILINE$,LEN(ILINE$)-UC) 3200 NEXT UC 3210 RETURN 3220 E