10REM Simple Data Base
20REM By Andrew York
30REM For Model B and for Master.
40:
50ON ERROR IF ERR=17 THEN PROCclose E
LSE PROCerror:END
60MODE1:VDU23,1,0;0;0;0;:*FX4,2
70REM
80*FX200,1
90GCOL0,1
100COLOUR 2
110VDU19,1,1,0;0
120CLS
130MOVE50,990
140DRAW1260,990
150DRAW1260,30
160DRAW50,30
170DRAW50,990
180MOVE55,985
190DRAW1256,985
200DRAW1256,35
210MOVE1255,35
220DRAW55,35
230DRAW55,985
240MOVE50,900
250DRAW1260,900
260:
270hello$="Simple Data Base"
280:
290REM" Change hello$ to your own
300REM" title if you want.
310:
320PRINTTAB(12,2);hello$
330PRINTTAB(9,10);"1. Create a new fil
e"
340PRINTTAB(9,12);"2. Update a file"
350PRINTTAB(9,14);"3. Display a file"
360PRINTTAB(9,16);"4. Print a file"
370PRINTTAB(14,7);"Main Menu"
380PRINTTAB(9,18);"5. OS Command"
390PRINTTAB(9,22);"Enter your choice";
400VDU28,2,29,38,4:COLOUR 7
410REPEAT
420A$=GET$
430IF A$="1" THEN PROCcreate
440IF A$="2" THEN PROCupdate
450IF A$="3" THEN PROCdisplay
460IF A$="4" THEN PROCprint
470IF A$="5" THEN PROCcommand
480UNTIL FALSE
490END
500DEFPROCbox(title$)
510GCOL0,1
520COLOUR 2
530VDU19,1,6,0;0
540VDU26:CLS
550MOVE50,990
560DRAW1260,990
570DRAW1260,30
580DRAW50,30
590DRAW50,990
600MOVE55,985
610DRAW1256,985
620DRAW1256,35
630MOVE1255,35
640DRAW55,35
650DRAW55,985
660REM
670MOVE50,900
680DRAW1260,900
690MOVE50,120
700DRAW1260,120
710PRINTTAB(12,2);title$
720IF title$="Displaying a file" THEN
PRINTTAB(2,29);" Shift-Scrolls. Esc-Exit
to Menu.":VDU14:ELSE PRINTTAB(2,29);" E
sc-Exit to Menu."
730VDU28,2,27,38,4:COLOUR 7
740ENDPROC
750DEFPROCfile(name$):COLOUR 2
760VDU28,2,27,38,20:CLS:VDU23,1,1;0;0;
0;
770PRINTTAB(7,4);"File to ";name$;" ?"
;
780INPUTLINE""file$
790IF LEN(file$) >8 THEN PRINTTAB(5,6)
;"File name to long press any key";:A$=G
ET$:GOTO 760
800CLS:VDU23,1,0;0;0;0;:ENDPROC
810DEFPROCcreate
820PROCfile("create"):A=0
830PROCwait:CH=OPENOUT(file$)
840PROCbox("Creating a file."):ON ERRO
R IF ERR=17 THEN PROCclose ELSE PROCerro
r:END
850PRINT:*FX200,1
860VDU23,1,1;0;0;0;:REPEAT:*FX200,0
870PROCinput
880PRINT:PRINT#CH,Name$,Address$,Telep
hone,Post$:SOUND1,28,90,1
890A=A+1:UNTIL A >3150
900CLOSE# CH:RUN:ENDPROC
910DEFPROCupdate
920PROCfile("update"):A=0
930PROCwait:CH=OPENUP(file$)
940IF CH=0 THEN PROCnotfound
950PROCbox("Updating a file."):ON ERRO
R IF ERR=17 THEN PROCclose ELSE PROCerro
r:END
960*FX200,0
970REPEAT
980INPUT#CH,Name$,Address$,Telephone,P
ost$
990REM PROCoutput
1000A=A+1:UNTIL EOF#CH
1010A=0:VDU23,1,1;0;0;0;:REPEAT:*FX200,
0
1020PROCinput
1030PRINT:PRINT#CH,Name$,Address$,Telep
hone,Post$:SOUND1,28,90,1
1040A=A+1:UNTIL A>3150
1050CLOSE# CH:RUN:ENDPROC
1060DEFPROCdisplay:PROCfile("display"):
CLS:PRINTTAB(7,4);"Whole file ?":REPEAT:
A$=GET$:UNTIL A$="Y" OR A$="y" OR A$="N"
OR A$="n":IF A$="N"OR A$="n" THEN PROCd
isplayone
1070PROCwait:CH=OPENUP(file$)
1080IF CH=0 THEN PROCnotfound
1090PROCbox("Displaying a file"):ON ERR
OR IF ERR=17 THEN PROCclose ELSE PROCerr
or:END
1100*FX200,0
1110REPEAT
1120INPUT#CH,Name$,Address$,Telephone,P
ost$:SOUND1,28,90,1
1130PROCoutput
1140PRINT:UNTIL EOF#CH
1150CLOSE# CH
1160PROCspace:RUN:ENDPROC
1170DEFPROCspace:VDU3:VDU15:COLOUR2:PRI
NT:PRINTTAB(7);"Press space":VDU23,1,0;0
;0;0;:COLOUR 7:REPEAT:A$=GET$:UNTIL A$="
":ENDPROC
1180DEFPROCprint
1190PROCfile("print")
1200COLOUR 2
1210PRINTTAB(4,3)"When you are ready to
print"
1220PRINTTAB(10,5)"Press space.";:REPEA
T:A$=GET$:UNTIL A$=" "
1230PROCwait:CH=OPENUP(file$):PROCbox("
Printing a file"):ON ERROR IF ERR=17 THE
N PROCclose ELSE PROCerror:END
1240IF CH=0 THEN PROCnotfound
1250VDU2:*FX200,0
1260GOTO1110
1270ENDPROC
1280DEFPROCcommand:VDU23,1,1;0;0;0;:ON
ERROR IF ERR=17 THEN PROCclose ELSE PROC
error:END
1290CLS:INPUTLINE"*"COMMAND$
1300IF COMMAND$="" THEN RUN
1310CLS:$&900=COMMAND$:X%=0:Y%=9:CLS:CA
LL&FFF7:PROCspace:RUN:ENDPROC
1320DEFPROCwait
1330CLS
1340PRINTTAB(7,3);"Please wait...";
1350ENDPROC
1360DEFPROCerror
1370REM Put here :'CLOSE#0' for Model B
1380ON ERROR OFF
1390*FX200,1
1400IF ERR=17 THEN RUN
1410PRINT
1420COLOUR2
1430REPORT
1440PROCspace
1450RUN
1460ENDPROC
1470DEFPROCdisplayone:VDU23,1,1;0;0;0;
1480CLS:PRINTTAB(3,3);" Enter persons n
ame:";
1490INPUTLINE""name$
1500CLS:VDU23,1,0;0;0;0;:PROCwait:CH=OP
ENIN(file$)
1510IF CH=0 THEN PROCnotfound
1520REPEAT
1530INPUT#CH,Name$,Address$,Telephone,P
ost$
1540UNTIL name$=Name$ OR EOF# CH
1550VDU23,1,0;0;0;0;:CLOSE#CH
1560IF Name$<> name$ CLS:PRINTTAB(6,4);
"Name not found":PROCspace:CLOSE#0:RUN
1570PROCbox("Displaying details")
1580PROCoutput
1590PRINT:PROCspace:RUN:ENDPROC
1600ENDPROC
1610DEFPROCnotfound
1620CLS:VDU23,1,0;0;0;0;:VDU3
1630COLOUR 2
1640PRINTTAB(7,4);"Sorry the file ":PRI
NTTAB(7,5);file$;" does not exist":PROCs
pace:RUN:ENDPROC
1650DEFPROCinput
1660PRINT
1670*FX200,0
1680INPUTLINE"Name :"Name$
1690*FX200,1
1700INPUTLINE"Address :"Address$
1710INPUTLINE"Telephone:"Telephone
1720INPUTLINE"Post code:"Post$
1730ENDPROC
1740DEFPROCoutput
1750PRINT
1760PRINT"Name :";Name$
1770PRINT"Address :";Address$
1780PRINT"Telephone:";Telephone
1790PRINT"Post code:";Post$
1800ENDPROC
1810DEFPROCclose:VDU3:VDU14
1820IF ERL=1680 OR ERL=1760 THEN CLOSE#
CH
1830IF ERL>1060 AND ERL<1150 THEN CLOSE
# CH
1831IF ERL>1750 AND ERL<1810 THEN CLOSE
# CH
1840RUN:ENDPROC
1850REM The above five lines close
1860REM the file.
1870REM (well I hope so!!)