8-Bit Software Online Conversion
SYSTEMS Server PROGRAM - Listing
10*FX220
20REMON ERROR PROCerror(ERR,""):CLOSE
#0:CLEAR:RUN
30MODE7:PROCcoff
40PROCinit:PROChead:PROCtop:PROCfoot
50PROCinstall:PROCclear:PROCprocess(2
)
60CHAIN"SERVER2"
70:
80REM *** Module 1: Loads datafiles a
nd sorts out essential ***
90REM *** variables for tra
nsfer to main module 2 ***
100REM *** If no datafile pr
esent then new one is ***
110REM *** offered for creat
ion. ***
120:
130REM ********* PROCEDURES AND FUNCTI
ONS **************
140:
150DEF PROChead
160PRINTTAB(0,0)
170PRINT"
";
180PRINT" Program Co
pyrighted ";
190PRINT" Duncan Web
ster 1991 ";
200ENDPROC
210:
220DEF PROCfoot
230PRINTTAB(0,23);bar2$;
240ENDPROC
250:
260DEF PROCtop
270PRINTTAB(0,4);bar2$;
280ENDPROC
290:
300DEF PROCinstall
310PROCbar(12,10,"DATABASE")
320PRINTTAB(10,13);CHR$Text%;"USERNAME
"
330PROCkdis:PROCcon:File$=FNenter(19,1
3,11):PROCcoff
340IF File$="TFR5P" THEN PROCtransfer(
1)
350IF File$="TFR4" THEN PROCtransfer(2
)
360PROCprocess(2):PROCdelay(10)
370X=OPENIN (File$)
380IF X=0 THEN CLOSE#X:PROCnewfile:CLE
AR:CHAIN"SERVER1"
390PTR#X=0:INPUT#X,Data$:PTR#X=50:INPU
T#X,Notes$:PTR#X=100:INPUT#X,Dummy%:PTR#
X=125:INPUT#X,Active%:PTR#X=150:INPUT#X,
Delete%:CLOSE#X
400$&C00=File$:$&C20=Data$:$&C40=Notes
$:A%=Dummy%:B%=Active%:C%=Delete%:D%=-1
410PROCprocess(1):PROCprocess(0)
420ENDPROC
430:
440DEF FNenter(w1%,w2%,w4%)
450w3%=0
460IF w1%<>0 THEN w1%=w1%+1
470w4%=w4%-1
480w1$=""
490w2$=""
500IF w1%=0 AND w2%=0 THEN =w2$
510IF w1%>0 THEN PRINTTAB((w1%-1),w2%)
;CHR$Entry%;
520IF w1%<=0 THEN w1%=0:PRINTTAB(w1%,w
2%);CHR$Entry%;
530REPEAT
540w1$=GET$
550 IF w1$=CHR$13 THEN GOTO 620
560IF w1$=CHR$127 AND w3%<1 THEN VDU7:
GOTO 540
570 IF w1$=CHR$127 THEN PRINT;CHR$127;
:w2$=LEFT$(w2$,(LEN(w2$)-1)):w3%=w3%-1:G
OTO 620
580IF w3%>=w4% THEN VDU7:GOTO 540
590w2$=w2$+w1$
600PRINT;w1$;
610w3%=w3%+1
620UNTIL w1$=CHR$13
630=w2$
640:
650DEF PROCprocess(m%)
660PRINTTAB(0,24);SPC(39);
670IF m%=1 THEN PRINTTAB(29,24);CHR$13
6;CHR$Text%;"ACCEPTED";:PROCdelay(100):E
NDPROC
680IF m%=2 THEN PRINTTAB(27,24);CHR$Te
xt%;CHR$136;"PROCESSING";
690IF m%=3 THEN PRINTTAB(29,24);CHR$13
6;CHR$Text%;"REJECTED";:VDU7:PROCdelay(2
00):ENDPROC
700ENDPROC
710:
720DEF PROCnewfile
730PROCprocess(0)
740PROCclear:PROCbar(13,8,"NEW")
750PROCmenuselect(2,10,10)
760PRINTTAB(20,10);CHR$Entry%;File$
770PROCcon:Data$=FNenter(20,11,11)
780Notes$=FNenter(20,12,11)
790d$=FNenter(20,13,4):Dummy%=VAL(d$):
IF Dummy%=0 THEN Dummy%=50
800PRINTTAB(20,13);CHR$Entry%;Dummy%;S
PC(10)
810*FX15
820PRINTTAB(20,14);CHR$Entry%;
830c$=FNenter(20,14,4):PROCcoff
840IF c$<>"YES" THEN CLOSE#0:CLEAR:RUN
850PROCprocess(2):PROCdelay(50)
860IF Data$="" OR File$="" OR Notes$="
" THEN PROCerror(0,"INACCURATE ENTRIES")
:GOTO 730
870PROCprocess(2)
880PRINTTAB(6,17);CHR$Text%;"CREATING
USERNAME ";CHR$Entry%;File$
890X=OPENOUT (File$)
900PTR#X=0:PRINT#X,Data$:PTR#X=50:PRIN
T#X,Notes$:PTR#X=100:PRINT#X,Dummy%:PTR#
X=125:PRINT#X,0:PTR#X=150:PRINT#X,0:CLOS
E#X
910PROCprocess(1):PROCprocess(0)
920PRINTTAB(6,18);CHR$Text%;"CREATING
DATABASE ";CHR$Entry%;Data$
930PROCprocess(2)
940X=OPENIN (Data$)
950CLOSE#X:IF X<>0 THEN PROCexists(Fil
e$):CLEAR:RUN
960X=OPENOUT (Data$)
970PROCprocess(1):PROCprocess(0):PROCp
rocess(2)
980PRINTTAB(6,19);CHR$Text%;"RESERVING
RECORD ";CHR$Entry%
990FOR c%=0 TO (Dummy%-1)
1000PTR#X=(c%*Step%)
1010PRINT#X,STRING$(28,"#"),STRING$(15,
"#"),STRING$(15,"#"),STRING$(15,"#"),STR
ING$(20,"#"),STRING$(10,"#"),"#",0,"#","
#"
1020PRINTTAB(26,19);(c%+1)
1030NEXT c%
1040CLOSE#X:PROCprocess(1):PROCprocess(
0):PROCprocess(2)
1050X=OPENIN (Notes$)
1060CLOSE#X:IF X<>0 THEN PROCexists2(Fi
le$,Data$):CLEAR:RUN
1070X=OPENOUT (Notes$)
1080PRINTTAB(6,20);CHR$Text%;"RESERVING
NOTES ";CHR$Entry%
1090FOR c%=0 TO (Dummy%-1)
1100PTR#X=(c%*Step2%)
1110PRINT#X,STRING$(80,"#"),STRING$(40,
"#"),STRING$(40,"#"),STRING$(40,"#"),0
1120PRINTTAB(26,20);(c%+1)
1130NEXT c%
1140CLOSE#X:PROCprocess(1):PROCprocess(
0):PROCdelay(50)
1150CLOSE#0:ENDPROC
1160:
1170DEF PROCexists(d$)
1180OSCLI("DELETE "+d$)
1190PROCerror(0,"DATABASE EXISTS")
1200ENDPROC
1210:
1220DEF PROCexists2(d1$,d2$)
1230OSCLI("DELETE "+d1$)
1240OSCLI("DELETE "+d2$)
1250PROCerror(0,"NOTEFILE EXISTS")
1260ENDPROC
1270:
1280DEF PROCerror(Error%,Error$)
1290PROCcoff:IF Error%=0 THEN PROCusere
rr(Error$):ENDPROC
1300PROCkdis
1310PROCclear:PROChead:PROCtop:PROCfoot
:PROCprocess(0):PROCcoff:PROCkoff
1320IF Error%=&BF THEN PRINTTAB(11,8);C
HR$Text%;"Disc Full"
1330IF Error%=&BD THEN PRINTTAB(11,8);C
HR$Text%;"Access Violation"
1340IF Error%=&CC THEN PRINTTAB(11,8);C
HR$Text%;"Bad Name"
1350IF Error%=&A8 THEN PRINTTAB(11,8);C
HR$Text%;"Broken Dir"
1360IF Error%=&C7 THEN PRINTTAB(11,8);C
HR$Text%;"Disc Error"
1370IF Error%=&C6 THEN PRINTTAB(11,8);C
HR$Text%;"Disc Full"
1380IF Error%=&D6 THEN PRINTTAB(11,8);C
HR$Text%;"Not Found"
1390IF Error%=&CE THEN PRINTTAB(11,8);C
HR$Text%;"Bad Dir"
1400IF Error%=&FE THEN PRINTTAB(11,8);C
HR$Text%;"Bad Command"
1410IF Error%=&A9 THEN PRINTTAB(11,8);C
HR$Text%;"Bad FS Map"
1420IF Error%=&98 THEN PRINTTAB(11,8);C
HR$Text%;"Compact Reqd"
1430IF Error%=&C3 THEN PRINTTAB(11,8);C
HR$Text%;"File Locked"
1440IF Error%=&CD THEN PRINTTAB(11,8);C
HR$Text%;"Bad Drive"
1450IF Error%=&C9 THEN PRINTTAB(11,8);C
HR$Text%;"Disc Protected"
1460IF Error%=&C9 THEN PRINTTAB(11,8);C
HR$Text%;"Disc Changed"
1470IF Error%=&C5 THEN PRINTTAB(11,8);C
HR$Text%;"Drive Fault"
1480IF Error%=&C4 THEN PRINTTAB(11,8);C
HR$Text%;"File Exists"
1490IF Error%=&C2 THEN PRINTTAB(11,8);C
HR$Text%;"File Open"
1500IF Error%=&C0 THEN PRINTTAB(11,8);C
HR$Text%;"Too Many Open"
1510IF Error%=&BF THEN PRINTTAB(11,8);C
HR$Text%;"Can't Extend"
1520IF Error%=&BE THEN PRINTTAB(11,8);C
HR$Text%;"Catalogue Full"
1530PRINTTAB(11,11);CHR$Text%;"SYSTEM E
RROR"
1540PRINTTAB(0,22);CHR$Text%;"REFERENCE
";ERL;"-";ERR;TAB(25,22);CHR$136;" REFE
R MANUAL"
1550PRINTTAB(2,15);CHR$Text%;"RE BOOTIN
G PROGRAM - PRESS RETURN"
1560*FX15
1570a=GET
1580CLOSE#0
1590ENDPROC
1600:
1610DEF PROCusererr(Error$)
1620PROCprocess(0):PROCcoff:PROCkoff:VD
U7:VDU7:PROCdelay(150)
1630PRINTTAB(39-((LEN(Error$)+2)),24);C
HR$136;CHR$Text%;Error$;
1640PROCdelay(300)
1650ENDPROC
1660:
1670DEF PROCinit
1680bar2$="
,,,,,,,,,,,,"
1690bar$="
,,,,,,,,,,,"
1700bar3$="
,,,,,,,,,,,,"
1710$&C00="XXXXXXXXXXXXXXXXXXXX":REM **
* File$ Stored Here ***
1720$&C20="XXXXXXXXXXXXXXXXXXXX":REM **
* Data$ Stored Here ***
1730$&C40="XXXXXXXXXXXXXXXXXXXX":REM **
* Notes$ Stored Here ***
1740T=OPENIN"SERVER9":IF T=0 THEN CLOSE
#0:CLS:PRINT"User ID Invalid":END
1750PTR#T=12:INPUT#T,$&C60:PTR#T=4:INPU
T#T,$&C62:PTR#T=70:INPUT#T,$&C64:CLOSE#T
1760A%=0:REM *** Dummy% ***
1770B%=0:REM *** Active% ***
1780C%=0:REM *** Delete% ***
1790D%=-1:REM *** Menu Selection Choice
***
1800Text%=134:Entry%=135:Step%=130:Step
2%=220
1810*KEY12 1|M
1820*KEY13 0|M
1830*KEY14 1|M
1840*KEY15 0|M
1850ENDPROC
1860:
1870DEF PROCclear
1880FOR c%=5 TO 22 STEP 1
1890PRINTTAB(0,c%);SPC(40);
1900NEXT c%
1910ENDPROC
1920:
1930DEF PROCkon
1940*FX4,2
1950ENDPROC
1960:
1970DEF PROCkoff
1980*FX4,0
1990ENDPROC
2000IF s%=8 THEN PROCadd:ENDPROC
2010ENDPROC
2020VDU23;8202;0;0;0;
2030ENDPROC
2040:
2050DEF PROCcon
2060VDU23,0,10,64;0;0;0;
2070ENDPROC
2080:
2090DEF PROCcoff
2100VDU23;8202;0;0;0;
2110ENDPROC
2120:
2130DEF PROCkdis
2140*FX4,1
2150ENDPROC
2160:
2170DEF PROCdelay(time%)
2180TIME=0
2190REPEAT UNTIL TIME>time%
2200ENDPROC
2210:
2220DEF PROCmenuselect(select%,xpos%,yp
os%)
2230RESTORE 2330
2240REPEAT
2250READ menu$,group%,field$
2260IF group%=select% THEN PRINTTAB(xpo
s%,ypos%);CHR$Text%;menu$
2270IF group%=select% THEN ypos%=ypos%+
1
2280UNTIL menu$="STOP"
2290ENDPROC
2300:
2310REM ************** DATA VARS FOR ME
NUSELECT ***************
2320:
2330DATA "USERNAME",2,"NA"
2340DATA "FILENAME",2,"NA"
2350DATA "NOTEFILE",2,"NA"
2360DATA "RESERVE",2,"NA"
2370DATA "CONFIRM",2,"NA"
2380DATA "STOP",0,"STOP"
2390:
2400REM ****************** HIGHLIGHTED
HEADINGS ****************************:
2410:
2420DEF PROCbar(xpos%,ypos%,text$)
2430PRINTTAB(xpos%,ypos%);CHR$132;CHR$1
57;CHR$Text%;text$;TAB((xpos%+(LEN(text$
)+5)),ypos%);CHR$156
2440ENDPROC
2450:
2460DEF PROCtransfer(t%)
2470PROCclear
2480PROCbar(11,6,"TRANSFER")
2490IF t%=1 THEN PRINTTAB(6,8);CHR$Text
%;"VERSION No ";CHR$Entry%;"5a PILOT" EL
SE PRINTTAB(6,8);CHR$Text%;"VERSION No "
;CHR$Entry%;"4"
2500PRINTTAB(6,9);CHR$Text%;"TRANSFER O
F";CHR$Entry%;"<csd>.PROGFLE"
2510PRINTTAB(6,10);CHR$Text%;"6a USERNA
ME";CHR$Entry%
2520PRINTTAB(6,11);CHR$Text%;"6a FILENA
ME";CHR$Entry%
2530PRINTTAB(6,12);CHR$Text%;"6a NOTEFI
LE";CHR$Entry%
2540PRINTTAB(6,13);CHR$Text%;"No RECORD
S ";CHR$Entry%
2550PRINTTAB(6,14);CHR$Text%;"CONFIRMED
";CHR$Entry%
2560PROCcon:PROCkdis
2570File$=FNenter(18,10,11)
2580IF File$="" THEN GOTO 2570
2590Data$=FNenter(18,11,11)
2600IF Data$="" THEN GOTO 2590
2610Notes$=FNenter(18,12,11)
2620IF Notes$="" THEN GOTO 2610
2630rec%=VAL(FNenter(18,13,4)):IF rec%<
1 THEN PRINTTAB(18,13);CHR$Entry%;"All"
2640c$=FNenter(18,14,4)
2650IF c$<>"YES" THEN CLEAR:RUN
2660PROCcoff
2670PROCprocess(2)
2680X=OPENIN (File$):Y=OPENIN (Data$):Z
=OPENIN (Notes$)
2690IF X<>0 OR Y<>0 OR Z<>0 THEN VDU7:C
LOSE#X:CLOSE#Y:CLOSE#Z:CLEAR:RUN
2700CLOSE#X:CLOSE#Y:CLOSE#Z
2710Q=OPENIN"PROGFLE":IF Q=0 THEN CLOSE
#Q:VDU7:CLEAR:RUN
2720X=OPENOUT (File$)
2730Y=OPENOUT (Data$)
2740Z=OPENOUT (Notes$)
2750Q=OPENIN"PROGFLE"
2760PTR#X=0:PTR#Y=0:PTR#Z=0:PTR#Q=0
2770IF rec%>=(EXT#Q/220) THEN rec%=0:PR
INTTAB(18,13);CHR$Entry%;"All"
2780IF rec%=0 THEN rec%=(EXT#Q/220)
2790Active%=0:Dummy%=0:Delete%=0
2800FOR loop%=1 TO rec% STEP 1
2810PRINTTAB(6,16);CHR$Text%;"READING R
ec";CHR$Entry%;loop%
2820PTR#Q=(220*(loop%-1)):PTR#Y=(Step%*
(loop%-1)):PTR#Z=(Step2%*(loop%-1))
2830INPUT#Q,prog$,type$,opt$,surface$,d
isc$,owner$,filename$,dir$,ProNo%,notes1
$,notes2$,Mfd%
2840IF type$="Utility" THEN type$="UTIL
ITY"
2850IF type$="Game" THEN type$="GAME"
2860IF type$="Incomplete" THEN type$="M
ISCELLANEOUS"
2870IF type$="ROM Image" THEN type$="RO
M RAM IMAGE"
2880IF type$="Datafile" THEN type$="DED
ICATED FILE"
2890IF type$="Text" THEN type$="ASCII T
EXT"
2900IF type$="Word Processor" THEN type
$="WORD PROCESSOR"
2910IF type$="Non BASIC" THEN type$="MI
SCELLANEOUS"
2920IF type$="Other" THEN type$="MISCEL
LANEOUS"
2930IF type$="Not Input" THEN type$=""
2940IF opt$="MENU ONLY" THEN opt$="REFE
RENCE"
2950IF surface$="A" THEN Da$="ADFS" ELS
E Da$="DFS"
2960PRINT#Y,LEFT$(prog$,28),type$,LEFT$
(disc$,15),opt$,LEFT$(owner$,20),LEFT$(f
ilename$,10),Da$,Mfd%,"",""
2970PRINT#Z,LEFT$(dir$,80),LEFT$(notes1
$,40),LEFT$(notes2$,40),"",Mfd%
2980PRINTTAB(6,17);CHR$Text%;"WRITING R
ec";CHR$Entry%;loop%
2990Active%=Active%+1:Dummy%=Dummy%+1
3000IF Mfd%=9 THEN Delete%=Delete%+1
3010IF (loop%*220)>EXT#Q THEN loop%=rec
%
3020NEXT loop%
3030PTR#X=0:PRINT#X,Data$:PTR#X=50:PRIN
T#X,Notes$:PTR#X=100:PRINT#X,Dummy%:PTR#
X=125:PRINT#X,Active%:PTR#X=150:PRINT#X,
Delete%
3040CLOSE#X
3050CLOSE#Y
3060CLOSE#Z
3070CLOSE#Q
3080PROCprocess(1):PROCprocess(0)
3090ENDPROC
3100: