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