10 ON ERROR PROCerror(ERR,""):D%=-1:CLEAR:RUN 20 PROCinit:REM *** Reads in all Transferred variables *** 30 PROCprocess(1):PROCdelay(50):PROCprocess(0) 40 REPEAT 50 IF D%=-1 THEN D%=FNmenu 60 IF D%=1 AND Active%>0 THEN PROCshow 70 IF D%=4 AND Active%>0 THEN PROCsearch 80 IF D%=3 AND Active%>0 THEN PROCremove 90 IF D%=5 AND Active%>0 THEN PROCcompact 100 PROCclear 110 IF D%=7 THEN PROCtransfer:PROCprocess(2):PAGE=&1900:CHAIN"SERVER2" 120 IF D%=0 THEN PROCtransfer:PROCprocess(2):PAGE=&1900:CHAIN"SERVER2" 130 IF D%=2 THEN PROCtransfer:PROCprocess(2):PAGE=&1900:CHAIN"SERVER2" 140 IF D%=6 THEN PAGE=&1900:CHAIN"SERVER1" 150 IF D%=8 THEN PROCextend 160 IF D%=9 THEN PROCtransfer:PROCprocess(2):PAGE=&1900:CHAIN"SERVER2" 170 D%=-1:UNTIL FALSE 180 : 190 REM *************** DISPLAY ANIMATION - UP AND DOWN ****************** 200 : 210 DEF PROCaup 220 FOR c%=12 TO 5 STEP -1 230 IF c%=5 THEN PRINTTAB(0,c%);SPC(40);TAB(0,4);bar2$; 240 IF c%>5 THEN PRINTTAB(0,c%);SPC(40);TAB(0,(c%-1));bar$; 250 PROCdelay(1) 260 NEXT 270 ENDPROC 280 : 290 DEF PROCadn 300 FOR c%=5 TO 12 STEP 1 310 PROCdelay(1) 320 IF c%=5 THEN PRINTTAB(0,c%);bar2$;TAB(0,(c%-1));bar3$ 330 IF c%<12 THEN PRINTTAB(0,c%);SPC(40); 340 IF c%<11 THEN PRINTTAB(0,(c%+1));bar$; 350 IF c%=5 THEN PRINTTAB(0,c%);"†PROGRAM ”ê‡" 360 IF c%=6 THEN PRINTTAB(0,c%);"†CATEGORY”ê‡" 370 IF c%=7 THEN PRINTTAB(0,c%);"†DISC ”ê‡" 380 IF c%=8 THEN PRINTTAB(0,c%);"†OPTION ”ê‡" 390 IF c%=9 THEN PRINTTAB(0,c%);"†SOURCE ”ê‡" 400 IF c%=10 THEN PRINTTAB(0,c%);"†FILENAME”ê‡" 410 IF c%=11 THEN PRINTTAB(0,c%);"†DFS ADFS”ê‡" 420 NEXT 430 PRINTTAB(0,12);bar$; 440 ENDPROC 450 : 460 REM ****************** INITIAILISATION PROCEDURE ************************ 470 : 480 DEF PROCinit 490 Text%=134:Entry%=135:Step%=130:Step2%=220 500 File$=$&C00:Data$=$&C20:Notes$=$&C40:Dummy%=A%:Active%=B%:Delete%=C% 510 DIM Sent$(25):Choice%=D% 520 bar2$="”¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬" 530 bar$="”¬¬¬¬¬¬¬¬¬®¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬" 540 bar3$="”¬¬¬¬¬¬¬¬¬ì¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬," 550 *KEY12 1|M 560 *KEY13 0|M 570 *KEY14 1|M 580 *KEY15 0|M 590 ENDPROC 600 : 610 REM ************** SCREEN CLEAR - HIGHLIGHT PROCEDURES ****************** 620 : 630 DEF PROCclear 640 FOR c%=5 TO 22 STEP 1 650 PRINTTAB(0,c%);SPC(40); 660 NEXT c%:PRINTTAB(0,4);bar2$ 670 ENDPROC 680 : 690 DEF PROCbclear 700 FOR c%=13 TO 22 STEP 1 710 PRINTTAB(0,c%);SPC(40); 720 NEXT c% 730 ENDPROC 740 : 750 DEF PROCwclear 760 FOR x%=5 TO 11 STEP 1 770 PRINTTAB(12,x%);SPC(27) 780 NEXT x% 790 ENDPROC 800 : 810 DEF FNhighlight(xpos%,ypos%,len%,max%,start%) 820 o%=ypos% 830 *FX4,2 840 ypos%=ypos%+start% 850 REPEAT 860 PRINTTAB(xpos%,ypos%);CHR$132;CHR$157;CHR$Text%;TAB((xpos%+len%),ypos%);CHR$156 870 *FX15 880 select$=GET$:select%=VAL(select$) 890 IF select$=CHR$13 THEN GOTO 950 900 IF select%=0 THEN select%=-1 910 IF (ypos%+select%)>max% THEN PRINTTAB(xpos%,ypos%);SPC(2):ypos%=o%:GOTO 950 920 IF (ypos%+select%)<(o%) THEN PRINTTAB(xpos%,ypos%);SPC(2):ypos%=max%:GOTO 950 930 PRINTTAB(xpos%,ypos%);SPC(2) 940 ypos%=ypos%+select% 950 UNTIL select$=CHR$13 960 *FX4,0 970 =(ypos%-o%) 980 : 990 REM *************** CURSOR & fn KEYS CONTROL **************************** 1000 : 1010 DEF PROCkon 1020 *FX4,2 1030 ENDPROC 1040 : 1050 DEF PROCkoff 1060 *FX4,0 1070 ENDPROC 1080 IF s%=8 THEN PROCadd:ENDPROC 1090 ENDPROC 1100 VDU23;8202;0;0;0; 1110 ENDPROC 1120 : 1130 DEF PROCcon 1140 VDU23,0,10,64;0;0;0; 1150 ENDPROC 1160 : 1170 DEF PROCcoff 1180 VDU23;8202;0;0;0; 1190 ENDPROC 1200 : 1210 DEF PROCkdis 1220 *FX4,1 1230 ENDPROC 1240 : 1250 REM ******************** MENU PREPARATION & DISPLAY ********************* 1260 : 1270 DEF PROCmenuselect(select%,xpos%,ypos%) 1280 RESTORE 1450 1290 REPEAT 1300 READ menu$,group%,field$ 1310 IF group%=select% THEN PRINTTAB(xpos%,ypos%);CHR$Text%;menu$ 1320 IF group%=select% THEN ypos%=ypos%+1 1330 UNTIL menu$="STOP" 1340 ENDPROC 1350 : 1360 REM *********************** TIME DELAY PROCEDURE ************************* 1370 : 1380 DEF PROCdelay(time%) 1390 TIME=0 1400 REPEAT UNTIL TIME>time% 1410 ENDPROC 1420 : 1430 REM ********************* DATA VARIABLES USED BY MENUSELECT PROC ********* 1440 : 1450 DATA "FORWARDS",1,"NA" 1460 DATA "BACKWARD",1,"NA" 1470 DATA "PRINTER",1,"NA" 1480 DATA "SCREEN",1,"NA" 1490 DATA "RECORD",1,"NA" 1500 DATA "FINISH",1,"NA" 1510 DATA "Loading Gateway",11,"NA" 1520 DATA "Browsing Facilities",11,"NA" 1530 DATA "Revising Facilities",11,"NA" 1540 DATA "Deleting Facilities",11,"NA" 1550 DATA "Searching Facilities",11,"NA" 1560 DATA "Compact Current Database",11,"NA" 1570 DATA "Install Program Database",11,"NA" 1580 DATA "Add New Program Record",11,"NA" 1590 DATA "Extend ADFS Database",11,"NA" 1600 DATA "Close Systems Server",11,"NA" 1610 DATA "CONTINUE",2,"NA" 1620 DATA "ABANDON",2,"NA" 1630 DATA "RECORD",2,"NA" 1640 DATA "FINISH",3,"NA" 1650 DATA "RECORD",3,"NA" 1660 DATA "CONFIRM",6,"NA" 1670 DATA "ABANDON",6,"NA" 1680 DATA "REVISE",6,"NA" 1690 DATA "IGNORE FIELD",4,"NA" 1700 DATA "CHAIN",4,"NA" 1710 DATA "*RUN",4,"NA" 1720 DATA "*EXEC",4,"NA" 1730 DATA "*TYPE",4,"NA" 1740 DATA "*LIST",4,"NA" 1750 DATA "*LOAD",4,"NA" 1760 DATA "LOAD",4,"NA" 1770 DATA "REFERENCE",4,"NA" 1780 DATA "IGNORE",5,"NA" 1790 DATA "DFS Disc",5,"NA" 1800 DATA "ADFS Disc",5,"NA" 1810 DATA "IGNORE FIELD",7,"NA" 1820 DATA "GAME",7,"NA" 1830 DATA "UTILITY",7,"NA" 1840 DATA "ASCII TEXT",7,"NA" 1850 DATA "WORD PROCESSOR",7,"NA" 1860 DATA "DEDICATED FILE",7,"NA" 1870 DATA "ROM RAM IMAGE",7,"NA" 1880 DATA "MISCELLANEOUS",7,"NA" 1890 DATA "START Rec",8,"NA" 1900 DATA "SEARCH No",8,"NA" 1910 DATA "Ne SEARCH",8,"NA" 1920 DATA "To PRINTR",8,"NA" 1930 DATA "Remove Single Record",9,"NA" 1940 DATA "Remove Range Records",9,"NA" 1950 DATA "Remove Entire Database",9,"NA" 1960 DATA "Remove Selected Records",9,"NA" 1970 DATA "Return to Previous Menu",9,"NA" 1980 DATA "Record No",10,"NA" 1990 DATA"STOP",0,"STOP" 2000 : 2010 REM ******************** FIELD ENTRY FUNCTION *************************** 2020 : 2030 DEF FNenter(w1%,w2%,w4%) 2040 w3%=0 2050 IF w1%<>0 THEN w1%=w1%+1 2060 w4%=w4%-1 2070 : 2080 w1$="" 2090 w2$="" 2100 IF w1%=0 AND w2%=0 THEN =w2$ 2110 IF w1%>0 THEN PRINTTAB((w1%-1),w2%);CHR$Entry%; 2120 REPEAT 2130 w1$=GET$ 2140 IF w1$=CHR$13 THEN GOTO 2210 2150 IF w1$=CHR$127 AND w3%<1 THEN VDU7:GOTO 2130 2160 IF w1$=CHR$127 THEN PRINT;CHR$127;:w2$=LEFT$(w2$,(LEN(w2$)-1)):w3%=w3%-1:GOTO 2210 2170 IF w3%>=w4% THEN VDU7:GOTO 2130 2180 w2$=w2$+w1$ 2190 PRINT;w1$; 2200 w3%=w3%+1 2210 UNTIL w1$=CHR$13 2220 =w2$ 2230 : 2240 REM ******************* COMPUTER PROCESSING MESSAGES ******************** 2250 : 2260 DEF PROCprocess(m%) 2270 PRINTTAB(0,24);SPC(39); 2280 IF m%=1 THEN PRINTTAB(29,24);CHR$136;CHR$Text%;"ACCEPTED";:PROCdelay(100):ENDPROC 2290 IF m%=2 THEN PRINTTAB(27,24);CHR$Text%;CHR$136;"PROCESSING"; 2300 IF m%=3 THEN PRINTTAB(29,24);CHR$136;CHR$Text%;"REJECTED";:VDU7:PROCdelay(200):ENDPROC 2310 ENDPROC 2320 : 2330 REM ***************** ERROR TRAPPING AND HANDELING PROCEDURES *********** 2340 : 2350 DEF PROCerror(Error%,Error$) 2360 IF Error%=0 THEN PROCusererr(Error$):ENDPROC 2370 PROCkdis 2380 PROCclear:PROCprocess(0):PROCcoff:PROCkoff 2390 IF Error%=&BF THEN PRINTTAB(11,8);CHR$Text%;"Disc Full" 2400 IF Error%=&BD THEN PRINTTAB(11,8);CHR$Text%;"Access Violation" 2410 IF Error%=&CC THEN PRINTTAB(11,8);CHR$Text%;"Bad Name" 2420 IF Error%=&A8 THEN PRINTTAB(11,8);CHR$Text%;"Broken Dir" 2430 IF Error%=&C7 THEN PRINTTAB(11,8);CHR$Text%;"Disc Error" 2440 IF Error%=&C6 THEN PRINTTAB(11,8);CHR$Text%;"Disc Full" 2450 IF Error%=&D6 THEN PRINTTAB(11,8);CHR$Text%;"Not Found" 2460 IF Error%=&CE THEN PRINTTAB(11,8);CHR$Text%;"Bad Dir" 2470 IF Error%=&FE THEN PRINTTAB(11,8);CHR$Text%;"Bad Command" 2480 IF Error%=&A9 THEN PRINTTAB(11,8);CHR$Text%;"Bad FS Map" 2490 IF Error%=&98 THEN PRINTTAB(11,8);CHR$Text%;"Compact Reqd" 2500 IF Error%=&C3 THEN PRINTTAB(11,8);CHR$Text%;"File Locked" 2510 IF Error%=&CD THEN PRINTTAB(11,8);CHR$Text%;"Bad Drive" 2520 IF Error%=&C9 THEN PRINTTAB(11,8);CHR$Text%;"Disc Protected" 2530 IF Error%=&C9 THEN PRINTTAB(11,8);CHR$Text%;"Disc Changed" 2540 IF Error%=&C5 THEN PRINTTAB(11,8);CHR$Text%;"Drive Fault" 2550 IF Error%=&C4 THEN PRINTTAB(11,8);CHR$Text%;"File Exists" 2560 IF Error%=&C2 THEN PRINTTAB(11,8);CHR$Text%;"File Open" 2570 IF Error%=&C0 THEN PRINTTAB(11,8);CHR$Text%;"Too Many Open" 2580 IF Error%=&BF THEN PRINTTAB(11,8);CHR$Text%;"Can't Extend" 2590 IF Error%=&BE THEN PRINTTAB(11,8);CHR$Text%;"Catalogue Full" 2600 PRINTTAB(11,11);CHR$Text%;"SYSTEM ERROR" 2610 PRINTTAB(0,22);CHR$Text%;"REFERENCE ";ERL;"-";ERR;TAB(25,22);CHR$136;" REFER MANUAL" 2620 PRINTTAB(2,15);CHR$Text%;"RE BOOTING PROGRAM - PRESS RETURN" 2630 *FX15 2640 a=GET 2650 PROCclear:PROCprocess(2):PROCdelay(50):CLOSE#0 2660 ENDPROC 2670 : 2680 DEF PROCusererr(Error$) 2690 PROCprocess(0):PROCcoff:PROCkoff:VDU7:VDU7:PROCdelay(150) 2700 PRINTTAB(39-((LEN(Error$)+2)),24);CHR$136;CHR$Text%;Error$; 2710 PROCdelay(300) 2720 ENDPROC 2730 : 2740 REM ************* CONFIRM FIELDS - Position determined by x% y% ********** 2750 : 2760 DEF FNconfirm(x%,y%) 2770 PROCkon:PROCcoff:PROCmenuselect(6,(x%+2),y%) 2780 s%=FNhighlight(x%,y%,12,(y%+2),0) 2790 =s% 2800 : 2810 REM ****************** HIGHLIGHTED HEADINGS ****************************: 2820 : 2830 DEF PROCbar(xpos%,ypos%,text$) 2840 PRINTTAB(xpos%,ypos%);CHR$132;CHR$157;CHR$Text%;text$;TAB((xpos%+(LEN(text$)+5)),ypos%);CHR$156 2850 ENDPROC 2860 : 2870 DEF PROCshow 2880 PROCclear:PROCadn 2890 PROCwclear:PROCbar(12,14,"BROWSE") 2900 PROCcon:PROCkdis:PRINTTAB(8,16);CHR$Text%;"RECORD No" 2910 browse%=VAL(FNenter(18,16,4)):PROCcoff 2920 IF browse%<1 OR browse%>Active% THEN browse%=1 2930 PROCbclear:PROCprocess(2) 2940 X=OPENIN (Data$) 2950 PROCprocess(1):PROCprocess(0) 2960 browse%=browse%-1:start%=0 2970 REPEAT 2980 PTR#X=(Step%*browse%) 2990 INPUT#X,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 3000 PROCdisplay:PROCbclear 3010 PROCmenuselect(1,2,14) 3020 c%=FNhighlight(0,14,13,19,start%):start%=0 3030 IF c%=0 AND browse%<(Active%-1) THEN browse%=browse%+1 3040 IF c%=1 AND browse%>0 THEN browse%=browse%-1:start%=1 3050 IF c%=2 THEN remem%=browse%:PROCprint:VDU3:browse%=remem%:VDU3 3060 IF c%=3 THEN remem%=browse%:browse%=browse%+1:PROCshowlist:browse%=remem% 3070 UNTIL c%=4 OR c%=5 3080 IF c%=4 THEN CLOSE#X:PROCbclear:GOTO 2890 3090 PROCprocess(0):PROCbclear:PROCprocess(2):PROCdelay(10) 3100 CLOSE#X:PROCprocess(1):PROCprocess(0):PROCaup 3110 ENDPROC 3120 : 3130 DEF PROCdisplay 3140 PROCwclear 3150 PRINTTAB(11,5);CHR$Entry%;Program$ 3160 PRINTTAB(11,6);CHR$Entry%;Cat$ 3170 PRINTTAB(11,7);CHR$Entry%;Disc$ 3180 PRINTTAB(11,8);CHR$Entry%;Opt$ 3190 PRINTTAB(11,9);CHR$Entry%;Source$ 3200 PRINTTAB(11,10);CHR$Entry%;Name$ 3210 PRINTTAB(11,11);CHR$Entry%;Da$ 3220 PRINTTAB(0,24);SPC(39);TAB(25,24);CHR$Text%;"RECORD No";CHR$Entry%;(browse%+1); 3230 IF Mfd%=9 THEN PRINTTAB(21,11);CHR$Text%;CHR$136;"Deletion Pending"; 3240 ENDPROC 3250 : 3260 DEF PROCshowlist 3270 PROCbclear:PROCprocess(0):PROCaup 3280 pos%=6 3290 IF browse%>Active% THEN browse%=Active% 3300 IF browse%<1 THEN browse%=1 3310 browse%=browse%-1:REPEAT 3320 PTR#X=(Step%*browse%) 3330 INPUT#X,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$:IF Mfd%=9 THEN GOTO 3380 3340 PRINTTAB((3-LEN(STR$(browse%+1))),pos%);CHR$Entry%;(browse%+1);TAB(4,pos%);CHR$Text%;Program$ 3350 pos%=pos%+1 3360 IF pos%=18 THEN IF FNnextp=1 THEN browse%=(Active%+1) 3370 IF pos%=18 THEN pos%=6:PROCclear 3380 browse%=browse%+1 3390 UNTIL browse%>=Active%:browse%=browse%-1 3400 IF browse%>Active% THEN GOTO 3430 3410 PROCmenuselect(3,2,20) 3420 IF FNhighlight(0,20,11,21,0)=1 THEN PROCclear:PRINTTAB(0,22);CHR$Text%;"RECORD No":PROCcon:PROCkdis:browse%=VAL(FNenter(10,22,4)):PROCcoff:PROCbclear:GOTO 3280 3430 PROCclear:PROCadn:ENDPROC 3440 : 3450 DEF FNnextp 3460 PROCmenuselect(2,2,19) 3470 q%=(FNhighlight(0,19,13,21,0)) 3480 IF q%=2 THEN PROCclear:PRINTTAB(0,22);CHR$Text%;"RECORD No":PROCcon:PROCkdis:browse%=VAL(FNenter(10,22,4)):PROCcoff:PROCbclear:browse%=browse%-2 3490 IF q%=2 AND browse%<-1 THEN browse%=-1 3500 IF q%=2 AND browse%>(Active%-1) THEN browse%=(Active%-1) 3510 =q% 3520 : 3530 REM ***************** PRINTING PROCEDURES ********************** 3540 : 3550 DEF PROCprint 3560 PROCbclear:PROCbar(3,14,"PRINTER") 3570 PROCcon:PROCkdis 3580 PRINTTAB(0,16);CHR$Text%;"START RECORD No":start%=VAL(FNenter(16,16,4)) 3590 PRINTTAB(0,17);CHR$Text%;"STOP RECORD No":stop%=VAL(FNenter(16,17,4)) 3600 PRINTTAB(0,18);CHR$Text%;"PRINTER ON-LINE":oline$=FNenter(16,18,2) 3610 IF oline$<>"Y" AND oline$<>"y" THEN PROCcoff:ENDPROC 3620 IF start%<1 OR start%>Active% THEN start%=1 3630 IF stop%<=start% OR stop%>Active% THEN stop%=Active% 3640 PRINTTAB(16,16);CHR$Entry%;SPC(10);TAB(17,16);start% 3650 PRINTTAB(16,17);CHR$Entry%;SPC(10);TAB(17,17);stop% 3660 c%=FNconfirm(3,20) 3670 IF c%=1 THEN PROCcoff:PROCbclear:ENDPROC 3680 IF c%=2 THEN GOTO 3560 3690 PROCbclear 3700 PROCprocess(2) 3710 OSCLI("FX 15,0") 3720 VDU2:VDU21:VDU2 3730 PRINTSPC(1000) 3740 PROCpagehead 3750 count%=start% 3760 REPEAT 3770 PTR#X=(Step%*(count%-1)) 3780 INPUT#X,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 3790 PRINTProgram$;TAB(28);Cat$;TAB(43);Disc$;TAB(59);Source$ 3800 count%=count%+1 3810 UNTIL count%>stop% OR count%>Active% 3820 PRINT STRING$(79,"_") 3830 PRINT'"End of Report" 3840 PRINTSPC(1000) 3850 VDU3:VDU6:VDU3 3860 PROCprocess(1) 3870 ENDPROC 3880 : 3890 DEF PROCpagehead 3900 PRINT"S Y S T E M S SERVER VERSION 6a (C) Duncan Webster 1991" 3910 PRINT"Hard Report of specified records - Serial Number ";$&C62;$&C60;$&C64 3920 PRINT"No Records ";Dummy%;" Active ";Active%;" Pending Deletion ";Delete% 3930 PRINT 3940 PRINT"PROGRAM NAME";TAB(28);"CATEGORY";TAB(43);"DISC REFERENCE";TAB(59);"PROG No/Source" 3950 PRINT 3960 ENDPROC 3970 : 3980 DEF PROCsearch 3990 PROCclear:PROCadn:PROCcon:PROCkdis 4000 PROCbar(12,15,"SEARCH"):PRINTTAB(9,17);CHR$Text%;"ENTER SEARCH DATA" 4010 SProgram$=FNenter(11,5,28) 4020 PROCbclear:SCat$=FNcat:PRINTTAB(11,6);CHR$Entry%;SCat$:PROCbclear 4030 PROCcon:PROCkdis:SDisc$=FNenter(11,7,16) 4040 SOpt$=FNopt:PRINTTAB(11,8);CHR$Entry%;SOpt$:PROCbclear 4050 PROCcon:PROCkdis:SSource$=FNenter(11,9,21) 4060 SName$=FNenter(11,10,11) 4070 SDa$=FNda:PRINTTAB(11,11);CHR$Entry%;SDa$:PROCbclear 4080 c%=FNconfirm(12,16):IF c%=1 THEN PROCbclear:PROCaup:ENDPROC 4090 IF c%=2 THEN PROCbclear:PROCaup:GOTO 3990 4100 PROCbclear:PROCmenuselect(8,0,14):PROCcon:PROCkdis 4110 start%=VAL(FNenter(10,14,4)):IF start%<1 OR start%>Active% THEN start%=1 4120 number%=VAL(FNenter(10,15,4)):IF number%+start%>Active% THEN number%=0 4130 fuzzy$=FNenter(10,16,2):IF fuzzy$<>"Y" AND fuzzy$<>"N" THEN fuzzy$="N" 4140 print$=FNenter(10,17,2):IF print$<>"Y" AND print$<>"N" THEN print$="N" 4150 PRINTTAB(11,14);start%;SPC(5);TAB(11,15);number%;SPC(5);TAB(11,16);fuzzy$;TAB(11,17);print$ 4160 PROCcoff:c%=FNconfirm(0,19) 4170 IF c%=1 THEN PROCbclear:PROCaup:ENDPROC 4180 IF c%=2 THEN GOTO 4100 4190 PROCbclear:PROCprocess(2) 4200 IF print$="Y" THEN VDU2:VDU21:VDU2:PRINTSPC(1000):PROCpagehead 4210 X=OPENIN (Data$):start%=start%-1:line%=6 4220 IF number%<>0 THEN end%=start%+number% ELSE end%=Active% 4230 REM ***** insert a READY PRINTER message here if needed ****** 4240 REPEAT:PTR#X=(Step%*start%) 4250 INPUT#X,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,w2$,w3$ 4260 match=TRUE 4270 IF SCat$<>"" THEN IF FNcase(SCat$)<>FNcase(Cat$) THEN match=FALSE 4280 IF SDisc$<>"" THEN IF FNcase(SDisc$)<>FNcase(Disc$) THEN match=FALSE 4290 IF SOpt$<>"" THEN IF FNcase(SOpt$)<>FNcase(Opt$) THEN match=FALSE 4300 IF SSource$<>"" THEN IF FNcase(SSource$)<>FNcase(Source$) THEN match=FALSE 4310 IF SName$<>"" THEN IF FNcase(SName$)<>FNcase(Name$) THEN match=FALSE 4320 IF SDa$<>"" THEN IF FNcase(SDa$)<>FNcase(Da$) THEN match=FALSE 4330 IF FNfuzzy(fuzzy$,Program$,SProgram$)=FALSE THEN match=FALSE 4340 IF match=TRUE THEN PROCsdisp 4350 start%=start%+1:abort=INKEY(1) 4360 UNTIL start%>Active% OR start%>=end% OR abort=101 OR abort=69 4370 IF print$="Y" THEN PRINT STRING$(79,"_") 4380 IF print$="Y" THEN PRINT'"End of Report" 4390 IF print$="Y" THEN PRINTSPC(2000) 4400 VDU3:VDU6:VDU3 4410 CLOSE#X:PROCprocess(1):PROCdelay(100):PROCprocess(0) 4420 IF print$="Y" THEN PROCbclear:PROCaup:PROCprocess(0) 4430 IF print$="N" THEN PROCkdis:PRINTTAB(0,22);CHR$132;CHR$157;CHR$Text%;"FINISH";TAB(11,22);CHR$156:A=GET 4440 ENDPROC 4450 : 4460 DEF FNcat:PROCcoff 4470 PROCmenuselect(7,12,14) 4480 s%=FNhighlight(10,14,19,21,0) 4490 IF s%=1 THEN ="GAME" 4500 IF s%=2 THEN ="UTILITY" 4510 IF s%=3 THEN ="ASCII TEXT" 4520 IF s%=4 THEN ="WORD PROCESSOR" 4530 IF s%=5 THEN ="DEDICATED FILE" 4540 IF s%=6 THEN ="ROM IMAGE" 4550 IF s%=7 THEN ="MISCELLANEOUS" 4560 IF s%=0 THEN ="" 4570 ="" 4580 : 4590 REM ****************** LOAD OPTION SELECTION **************************** 4600 : 4610 DEF FNopt 4620 PROCcoff 4630 PROCmenuselect(4,14,14) 4640 s%=FNhighlight(12,14,17,22,0) 4650 IF s%=1 THEN ="CHAIN" 4660 IF s%=2 THEN ="*RUN" 4670 IF s%=3 THEN ="*EXEC" 4680 IF s%=4 THEN ="*TYPE" 4690 IF s%=5 THEN ="*LIST" 4700 IF s%=6 THEN ="*LOAD" 4710 IF s%=7 THEN ="LOAD" 4720 IF s%=8 THEN ="REFERENCE" 4730 IF s%=0 THEN ="" 4740 ="" 4750 : 4760 REM ******************* DFS ADFS SELECTION ******************************* 4770 : 4780 DEF FNda 4790 PROCcoff:PROCmenuselect(5,14,16) 4800 s%=FNhighlight(12,16,15,18,0) 4810 IF s%=1 THEN ="DFS" 4820 IF s%=2 THEN ="ADFS" 4830 IF s%=0 THEN ="" 4840 ="" 4850 : 4860 DEFFNcase(s$) 4870 IFs$=""THEN="" 4880 s2$="":FOR g%=1 TO LEN(s$) 4890 a%=ASC(MID$(s$,g%,1)) 4900 IF a%=32 THEN GOTO 4950 4910 IF a%>64 AND a%<91 THEN GOTO 4940 4920 IF a%>96 AND a%<123 THEN GOTO 4940 4930 GOTO4950 4940 a%=(a% AND &DF) 4950 s2$=s2$+CHR$a% 4960 NEXT g% 4970 =s2$ 4980 : 4990 DEF FNfuzzy(a$,b$,c$) 5000 IF a$="N" AND SProgram$<>"" THEN IF FNcase(SProgram$)<>FNcase(Program$) THEN =FALSE 5010 IF INSTR(FNcase(Program$),FNcase(SProgram$))=0 THEN =FALSE 5020 =TRUE 5030 : 5040 DEF PROCsdisp 5050 IF line%=6 AND print$="N" THEN PROCclear 5060 IF print$="N" THEN PRINTTAB((3-LEN(STR$(start%+1))),line%);CHR$Entry%;(start%+1);TAB(4,line%);CHR$Text%;Program$ 5070 IF print$="Y" THEN PRINTProgram$;TAB(28);Cat$;TAB(43);Disc$;TAB(64);(start%+1) 5080 IF print$="Y" AND Mfd%=9 THEN PRINT"(Record Pending Deletion)" 5090 line%=line%+1 5100 IF line%>20 AND print$="N" THEN PROCprocess(0):PROCkdis:PRINTTAB(0,22);CHR$132;CHR$157;CHR$Text%;"CONTINUE";TAB(13,22);CHR$156:A=GET:line%=6:PROCprocess(2) 5110 ENDPROC 5120 : 5130 REM ***************** DELETING FACILITIES ************************* 5140 : 5150 DEF PROCremove 5160 X=OPENUP (File$) 5170 Y=OPENUP (Data$) 5180 Z=OPENUP (Notes$) 5190 PTR#X=0:PTR#Y=0:PTR#Z=0 5200 REPEAT 5210 PROCclear:PROCcoff:PROCkdis:PROCmenuselect(9,7,10) 5220 c%=FNhighlight(5,10,28,14,0) 5230 IF c%=0 THEN PROCdsingle 5240 IF c%=1 THEN PROCdrange 5250 IF c%=2 THEN PROCdentire 5260 IF c%=3 THEN PROCdselect 5270 UNTIL c%=4 5280 PROCclear:PROCprocess(2) 5290 CLOSE#X 5300 CLOSE#Y 5310 CLOSE#Z 5320 PROCprocess(1):PROCdelay(10):PROCprocess(0) 5330 ENDPROC 5340 : 5350 DEF PROCdsingle 5360 PROCclear:PROCbar(12,10,"DELETE") 5370 PRINTTAB(12,13);CHR$Text%;"Record":PROCcon:PROCkdis 5380 drec%=VAL(FNenter(19,13,4)) 5390 PROCcoff:IF drec%<1 OR drec%>Active% THEN ENDPROC 5400 PROCprocess(2) 5410 drec%=drec%-1:PTR#Y=(Step%*drec%):PTR#Z=(Step2%*drec%):PTR#X=150 5420 INPUT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 5430 IF Mfd%=9 THEN GOTO 5490 5440 INPUT#Z,Dir$,Notes1$,Notes2$,Notes3$,Nfd% 5450 PTR#Y=(Step%*drec%):PTR#Z=(Step2%*drec%) 5460 PRINT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,9,s1$,s2$ 5470 PRINT#Z,Dir$,Notes1$,Notes2$,Notes3$,9 5480 Delete%=Delete%+1:PRINT#X,Delete% 5490 PROCprocess(1):PROCdelay(50):PROCprocess(0) 5500 ENDPROC 5510 : 5520 DEF PROCdrange 5530 PROCclear:PROCbar(12,10,"DELETE") 5540 PRINTTAB(7,13);CHR$Text%;"START Record" 5550 PRINTTAB(7,14);CHR$Text%;" STOP Record" 5560 PROCcon:PROCkdis 5570 srec%=VAL(FNenter(20,13,4)) 5580 frec%=VAL(FNenter(20,14,4)) 5590 IF srec%<1 OR srec%>=frec% OR srec%>=Active% THEN PROCcoff:ENDPROC 5600 IF frec%<=srec% OR frec%>Active% THEN PROCcoff:ENDPROC 5610 srec%=srec%-1:frec%=frec%-1 5620 PROCcoff:PROCprocess(2):count%=0 5630 FOR s1%=srec% TO frec% STEP 1 5640 PTR#Y=(Step%*s1%):PTR#Z=(Step2%*s1%) 5650 INPUT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 5660 INPUT#Z,Dir$,Notes1$,Notes2$,Notes3$,Nfd% 5670 PTR#Y=(Step%*s1%):PTR#Z=(Step2%*s1%) 5680 PRINT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,9,s1$,s2$ 5690 PRINT#Z,Dir$,Notes1$,Notes2$,Notes3$,9 5700 IF Mfd%<>9 THEN count%=count%+1 5710 NEXT s1% 5720 PTR#X=150:Delete%=Delete%+count%:PRINT#X,Delete% 5730 PROCprocess(1):PROCdelay(50):PROCprocess(0) 5740 ENDPROC 5750 : 5760 DEF PROCdentire 5770 PROCclear:PROCbar(12,10,"DELETE") 5780 PRINTTAB(9,12);CHR$Text%;"ENTIRE DATABASE" 5790 PRINTTAB(11,14);CHR$Text%;"CONFIRM" 5800 PROCcon:PROCkdis:c$=FNenter(19,14,4):IF c$<>"YES" THEN PROCcoff:ENDPROC 5810 PROCcoff:PROCprocess(2) 5820 CLOSE#X:CLOSE#Y:CLOSE#Z 5830 OSCLI("DELETE "+File$) 5840 OSCLI("DELETE "+Data$) 5850 OSCLI("DELETE "+Notes$) 5860 PROCprocess(1):PROCdelay(50):PROCprocess(0) 5870 CLEAR:PAGE=&1900:CHAIN"SERVER1" 5880 ENDPROC 5890 : 5900 DEF PROCdselect 5910 PROCclear:PROCbar(12,6,"DELETE") 5920 FOR d%=1 TO 10 STEP 1 5930 PROCmenuselect(10,10,(d%+7)) 5940 NEXT d% 5950 PROCcon:PROCkdis 5960 drec1%=VAL(FNenter(20,8,4)) 5970 drec2%=VAL(FNenter(20,9,4)) 5980 drec3%=VAL(FNenter(20,10,4)) 5990 drec4%=VAL(FNenter(20,11,4)) 6000 drec5%=VAL(FNenter(20,12,4)) 6010 drec6%=VAL(FNenter(20,13,4)) 6020 drec7%=VAL(FNenter(20,14,4)) 6030 drec8%=VAL(FNenter(20,15,4)) 6040 drec9%=VAL(FNenter(20,16,4)) 6050 drec10%=VAL(FNenter(20,17,4)) 6060 c%=FNconfirm(12,19) 6070 IF c%=1 THEN ENDPROC 6080 IF c%=2 THEN GOTO 5910 6090 FOR x%=19 TO 21 STEP1:PRINTTAB(0,x%);SPC(39):NEXT x% 6100 PROCprocess(2):counter%=0 6110 PROCchkdel(drec1%):PROCchkdel(drec2%):PROCchkdel(drec3%):PROCchkdel(drec4%):PROCchkdel(drec5%) 6120 PROCchkdel(drec6%):PROCchkdel(drec7%):PROCchkdel(drec8%):PROCchkdel(drec9%):PROCchkdel(drec10%) 6130 PTR#X=150:Delete%=Delete%+counter%:PRINT#X,Delete% 6140 PROCprocess(1):PROCdelay(50):PROCprocess(0) 6150 ENDPROC 6160 : 6170 DEF PROCchkdel(ch%) 6180 IF ch%<1 OR ch%>Active% THEN ENDPROC 6190 ch%=ch%-1 6200 PTR#Y=(Step%*ch%):PTR#Z=(Step2%*ch%) 6210 INPUT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 6220 INPUT#Z,Dir$,Notes1$,Notes2$,Notes3$,Nfd% 6230 PTR#Y=(Step%*ch%):PTR#Z=(Step2%*ch%) 6240 PRINT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,9,s1$,s2$ 6250 PRINT#Z,Dir$,Notes1$,Notes2$,Notes3$,9 6260 IF Mfd%<>9 THEN counter%=counter%+1 6270 ENDPROC 6280 : 6290 DEF PROCtransfer 6300 A%=Dummy%:B%=Active%:C%=Delete% 6310 ENDPROC 6320 : 6330 DEF PROCcompact 6340 Zpoint%=0:NoDel%=0 6350 PROCclear:PROCbar(12,10,"COMPACT") 6360 PRINTTAB(9,12);CHR$Text%;"CURRENT DATABASE" 6370 PRINTTAB(12,14);CHR$Text%;"CONFIRM" 6380 PROCcon:PROCkdis:c$=FNenter(20,14,4):IF c$<>"YES" THEN PROCcoff:ENDPROC 6390 PROCcoff:PROCprocess(2) 6400 X=OPENUP (File$) 6410 Y=OPENUP (Data$) 6420 Z=OPENUP (Notes$) 6430 PTR#Y=0:PTR#Z=0:PROCprocess(1):PROCdelay(20) 6440 PROCprocess(2) 6450 FOR Ypoint%=0 TO (Active%-1) STEP 1 6460 PTR#Y=(Step%*Ypoint%):PTR#Z=(Step2%*Ypoint%) 6470 INPUT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 6480 INPUT#Z,Dir$,Notes1$,Notes2$,Notes3$,Nfd% 6490 IF Mfd%=9 AND Nfd%=9 THEN NoDel%=NoDel%+1:GOTO 6540 6500 PTR#Y=(Step%*Zpoint%):PTR#Z=(Step2%*Zpoint%) 6510 PRINT#Y,Program$,Cat$,Disc$,Opt$,Source$,Name$,Da$,Mfd%,s1$,s2$ 6520 PRINT#Z,Dir$,Notes1$,Notes2$,Notes3$,Nfd% 6530 Zpoint%=Zpoint%+1 6540 NEXT Ypoint% 6550 Active%=Active%-NoDel%:Delete%=Delete%-NoDel% 6560 PTR#X=150:PRINT#X,Delete%:PTR#X=125:PRINT#X,Active% 6570 PROCprocess(1):PROCdelay(100):PROCprocess(0) 6580 CLOSE#X:CLOSE#Y:CLOSE#Z 6590 ENDPROC 6600 : 6610 DEF FNmenu 6620 PROCprocess(0) 6630 PROCclear:PROCkoff:PROCcoff 6640 PROCmenuselect(11,8,6) 6650 PRINTTAB(4,17);CHR$Text%;"No RECORDS";CHR$Entry%;Dummy% 6660 PRINTTAB(4,18);CHR$Text%;"No ACTIVE ";CHR$Entry%;Active% 6670 PRINTTAB(4,19);CHR$Text%;"No DELETE ";CHR$Entry%;Delete% 6680 PRINTTAB(4,20);CHR$Text%;"No SPARE ";CHR$Entry%;(Dummy%-Active%) 6690 PRINTTAB(20,17);CHR$Text%;"SERIAL No";CHR$Entry%;$&C62;$&C60;$&C64 6700 PRINTTAB(20,18);CHR$Text%;"DATABASE ";CHR$Entry%;File$ 6710 PRINTTAB(20,19);CHR$Text%;"VERSION ";CHR$Entry%;"6a" 6720 PRINTTAB(20,20);CHR$Text%;"SUBTYPE ";CHR$Entry%;"TST" 6730 s%=FNhighlight(6,6,29,15,0) 6740 =s% 6750 : 6760 DEF PROCextend 6770 PROCclear 6780 PROCbar(12,11,"EXTENSION") 6790 PRINTTAB(13,13);CHR$Text%;"RECORDS";TAB(13,14);CHR$Text%;"CONFIRM" 6800 PROCcon:PROCkdis:ext%=VAL(FNenter(21,13,4)):PROCcoff 6810 IF ext%<1 THEN ENDPROC 6820 PROCcon:PROCkdis:c$=FNenter(21,14,4):PROCcoff 6830 IF c$<>"YES" THEN ENDPROC 6840 PROCprocess(2) 6850 X=OPENUP (File$) 6860 Y=OPENUP (Data$) 6870 Z=OPENUP (Notes$) 6880 PTR#X=0:PTR#Y=0:PTR#Z=0 6890 PTR#Y=(Step%*Active%) 6900 PTR#Z=(Step2%*Active%) 6910 FOR e%=Active% TO (Active%+ext%) STEP 1 6920 PRINT#Y,STRING$(28,"#"),STRING$(15,"#"),STRING$(15,"#"),STRING$(15,"#"),STRING$(20,"#"),STRING$(10,"#"),"#",0,"#","#" 6930 PRINT#Z,STRING$(80,"#"),STRING$(40,"#"),STRING$(40,"#"),STRING$(40,"#"),0 6940 PTR#Y=(Step%*(e%+1)):PTR#Z=(Step2%*(e%+1)) 6950 NEXT e% 6960 Dummy%=Dummy%+ext%:PTR#X=100:PRINT#X,Dummy% 6970 CLOSE#X 6980 CLOSE#Y 6990 CLOSE#Z 7000 PROCprocess(1):PROCprocess(0):ENDPROC