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: