10MODE7:PROCload2:PROCoff:PROCinit:PR
OCmenu
20DEFPROCtitle:VDU26:CLS:VDU132,157,1
41:PRINT" BBC DBASE BY A.S.SHAKOOR 1992
";CHR$(156):VDU132,157,141:PRINT" BB
C DBASE BY A.S.SHAKOOR 1992 ";CHR$(1
56):VDU28,0,24,39,3:ENDPROC
30DEFPROCmenu:PROCtitle:ONERRORPROCof
f:VDU28,0,24,39,3:CLS:GOTO40
40PROChead
50GT$=INKEY$(1):IF GT$="F" OR GT$="f"
PROCload
60IF quit=1 OR ch1=1 GOTO 120
70 IF GT$="1" AND fields=15 PROCno:PR
OCmenu:ENDPROC ELSE IF GT$="!" AND field
s=15 PROCno:PROCmenu:ENDPROC
80IF GT$="1" OR GT$="!" PROCcreate EL
SE IF GT$="J" OR GT$="j" END ELSE IF GT$
="I" OR GT$="i" PROCstamp
90 IF ch=1 GOTO 110
100IF GT$="5" OR GT$="%" PROCclear ELS
E IF GT$="7" OR GT$="'" PROCamend ELSE I
F GT$="6" OR GT$="&" PROCdel
110 IF fields=0 GOTO160
120IF GT$="E" OR GT$="e" PROCsave ELSE
IF GT$="2" OR GT$=CHR$(34) PROCpfields
130 IF quit=1 GOTO 150
140 IF GT$="3" OR GT$="#" PROCsort
150IF GT$="4" OR GT$="$" PROClist
160 IF GT$="H" OR GT$="h" PROCconnect
ELSE IF GT$="G" OR GT$="g" PROCcon ELSE
IF GT$="I" OR GT$="i" PROCstamp ELSE IF
GT$="J" OR GT$="j" END
170 IF ch=1 GOTO50
180 IF record=50 GOTO 210
190 IF GT$="8" OR GT$="(" PROCenter
200 IF ch1=0 GOTO 220
210IF GT$="9" OR GT$=")" PROCview ELSE
IF GT$="C" OR GT$="c" PROCalter ELSE IF
GT$="B" OR GT$="b" PROCdrec ELSE IF GT$
="A" OR GT$="a" PROCprec ELSE IF GT$="D"
OR GT$="d" PROCcrec
220 GOTO50:ENDPROC
230DEFPROCcreate:PROCtitle:ch=0
240fields=fields+1:PRINTTAB(0,2);:VDU1
32,157:PRINT" NEW FIELD ";TAB(16)" FIE
LD NO. ";fields;TAB(35);CHR$(156)
250 PRINTTAB(0,10)" NOTE : MAXIMUM NO.
OF CHARACTERS"'" FOR EACH FIELD IS 13"
260PRINTTAB(2,5)" ":PROCon:INPUTTAB(2,
5)" "fld$(fields):PROCoff
270IF fld$(fields)="" fields=fields-1:
PROCmenu:ENDPROC
280IF LENfld$(fields)>13 PROCshort(fie
lds):PRINTTAB(0,10);STRING$(80," "):PRIN
TTAB(0,10);:VDU132,157:PRINT" FIELD SHOR
TENED TO 13 CHARACTERS ";CHR$(156):VDU1
32,157:PRINT" ";fld$(fields);TAB(35);CHR
$(156)
290IF fields=11 PROCno
300PRINTTAB(0,18);:VDU132,157:PRINT" P
RESS * TO RETURN TO MENU,OR PRESS ":VDU1
32,157:PRINT" ANY OTHER KEY":Y$=GET$:IF
Y$="*" OR Y$=":" PROCmenu:ENDPROC
310CLS:GOTO 240
320DEFPROCinit:DIM fld$(11),a$(11,50):
OSCLI"FX210,0":ENDPROC
330DEFPROCenter:PROCtitle:IF ch2=1 GOT
O 350
340IF ch1<>1 PROCwarn
350ch1=1:record=record+1:CLS:PRINTTAB(
0,0);:VDU132,157:PRINT" DATA FILE ";reco
rd;" ";CHR$(156)''
360 FOR j=1 TO fields:PRINT" ";fld$(j)
" :";:INPUT""a$(j,record):NEXT
370PRINT':VDU132,157:PRINT" PRESS * TO
RETURN TO MENU,OR PRESS":VDU132,157:PRI
NT" ANY OTHER KEY":Y$=GET$:IF Y$=":" OR
Y$="*" PROCmenu:ENDPROC
380IFrecord=max CLS:PRINT':VDU132,157:
PRINT" END OF FILE REACHED ";CHR$(156)
:Y$=GET$:GOTO400
390GOTO350
400PROCmenu:ENDPROC
410DEFPROCwarn:PRINTTAB(0,3);:quit=0
420VDU132,157:PRINT" WARNING : IF YOU
WISH TO CONTINUE":VDU132,157:PRINT" WITH
THIS OPTION,NO MORE NEW FIELDS":VDU132,
157:PRINT" CAN BE CREATED":PRINT':VDU132
,157:PRINT" DO YOU WISH TO CONTINUE (Y/N
) ?"
430G$=GET$
440IF G$="Y" OR G$="y" ch1=1:quit=1:EN
DPROC ELSE PROCmenu:ENDPROC
450DEFPROClist:PROCtitle:VDU132,157:PR
INT" FIELDS CREATED ... ";CHR$(156)':F
ORt=1TOfields:PRINT" ";t") ";TAB(5);fld$
(t):NEXT:IF amend=1 ENDPROC
460PROCkey:ENDPROC
470DEFPROCno:quit=0:ch1=0:CLS:VDU132,1
57:PRINT" SORRY,NO MORE FIELDS CAN BE CR
EATED":PROCkey:ENDPROC
480DEFPROCview:PROCtitle:view=1
490PRINTTAB(0,0);:VDU132,157:PRINT" DA
TA FILE ";view;" ";CHR$(156)':FORj=1 T
O fields:PRINTfld$(j)" :";a$(j,view):NEX
T
500PRINT':VDU132,157:PRINT" PRESS * TO
RETURN TO THE MAIN MENU":VDU132,157:PRI
NT" OR PRESS ANY OTHER KEY":G$=GET$:IF G
$="*" OR G$=":" PROCmenu:ENDPROC
510IF view=record PROCmenu:ENDPROC ELS
E view=view+1:CLS:GOTO 490
520DEFPROCamend:amend=1:PROClist
530 PRINT'" WHICH FIELD DO YOU WISH TO
"'" CHANGE (1-";fields;")";
540INPUT"? "chan:IF chan<1 OR chan>fie
lds PROCkey:ENDPROC
550PRINTTAB(4,1+chan)" ? ":
INPUTTAB(4,1+chan)" "fld$(chan):VDU7:CLS
:IF LENfld$(chan)>13 CLS:PROCshort(chan)
:PRINT:VDU132,157:PRINT" FIELD SHORTENED
TO 13 CHARACTERS ";CHR$(156):VDU132,15
7:PRINT" ";fld$(chan);TAB(38);CHR$(156)
560PROCkey:ENDPROC
570DEFPROCshort(l):VDU7:fld$(l)=LEFT$(
fld$(l),13):ENDPROC
580DEFPROCcon:IF snd$=" ON" snd$=" OFF
":OSCLI"FX210,1":GOTO600
590 IF snd$=" OFF" snd$=" ON":OSCLI"FX
210,0"
600PROCmenu:ENDPROC
610DEFPROCconnect:IF print=0 print=1:p
rint$=" ON":GOTO630
620IF print=1 print=0:print$=" OFF"
630PROCmenu:ENDPROC
640DEFPROCclear:PROCtitle
650PRINT:VDU132,157:PRINT" DO YOU WISH
TO CLEAR ALL THE FIELDS":VDU132,157:PRI
NT" (Y/N) ?":H$=GET$:IF H$="Y" OR H$="y"
GOTO670
660PROCmenu:ENDPROC
670quit=0:ch=1:ch1=0:fields=0:FORt=1TO
15:fld$(t)="":NEXT:PRINT':VDU132,157:PRI
NT" ALL FIELDS ARE CLEARED":PROCkey:ENDP
ROC
680DEFPROCsort:PROCtitle:FORt=1TOfield
s:PRINT" ";t") ";TAB(5);fld$(t):NEXT
690 PRINT':VDU132,157:PRINT" DO YOU WI
SH TO SORT THE FIELDS IN":VDU132,157:PRI
NT" ALPHABETICAL ORDER (Y/N) ?":t$=GET$:
IF t$="Y" OR t$="y" GOTO 710
700PROCkey:ENDPROC
710PRINT'" SORTING ...":FORt=1TOfields
:FOR t1=1TOfields:IF fld$(t)<fld$(t1) h$
=fld$(t):fld$(t)=fld$(t1):fld$(t1)=h$
720 NEXT:NEXT
730CLS:FORt=1TOfields:PRINT" ";t") ";T
AB(5);fld$(t):NEXT:PRINT'" SORTED":PROCk
ey:ENDPROC
740DEFPROCpfields:PROCtitle:PROCcp:VDU
132,157:PRINT" PRESS ANY KEY TO PRINT...
";CHR$(156):G$=GET$:VDU13,132,157:PRI
NT" PRINTING ... ";CHR$(156):VDU2,1,27
,1,77,1,27,1,69,1,27,1,87,1,1,1,27,1,45,
1,1:PRINT"FIELDS"':VDU1,27,1,45,1,0
750FORt=1TOfields:PRINT"";t") ";TAB(5)
;fld$(t):NEXT:VDU3,1,27,1,87,1,0:PRINT:V
DU132,157:PRINT" PRINTING FINISHED ";C
HR$(156):PROCkey:ENDPROC
760DEFPROCcp:IF print=0 CLS:PRINT'':VD
U132,157:PRINT" PRINTER NOT CONNECTED
";CHR$(156):PROCkey:ENDPROC ELSE ENDPROC
770DEFPROCdel:PROCtitle:IF fields<2 PR
INT':VDU132,157:PRINT" SORRY,AT LEAST 2
FIELDS ARE NEEDED ";CHR$(156):PROCkey:EN
DPROC
780FORt=1TOfields:PRINT" ";t") ";TAB(5
);fld$(t):NEXT:PRINT:VDU132,157:PRINT" W
HICH FIELD YOU WISH TO REMOVE":VDU132,15
7:PRINT" (1-";fields") ? ";:PROCon:INPUT
""df:PROCoff
790IF df<1 OR df>fields PROCmenu:ENDPR
OC
800fld$(df)="z":VDU13,132,157:PRINT" D
ELETED..PRESS ANY KEY TO SORT":VDU132,15
7:PRINT" CURRENT FIELDS INTO ORDER":G$=G
ET$:FORt=1 TO fields:FOR t1=1 TO fields:
IF fld$(t)<fld$(t1) h$=fld$(t):fld$(t)=f
ld$(t1):fld$(t1)=h$
810NEXT:NEXT:fields=fields-1:CLS:FORt=
1TOfields:PRINT" ";t") ";TAB(5);fld$(t):
NEXT:PRINT:VDU132,157:PRINT" FIELDS ARE
NOW SORTED INTO ORDER":PROCkey:ENDPROC
820DEFPROCprec:PROCtitle:PROCcp:PRINT:
VDU132,157:PRINT" DO YOU WISH TO... ";
CHR$(156):PRINT:PRINTTAB(5);:VDU132,157:
PRINT" 1) PRINT A SINGLE RECORD";TAB(38)
;CHR$(156):PRINT:PRINTTAB(5);:VDU132,157
:PRINT" 2) PRINT ALL RECORDS";TAB(38);CH
R$(156)
830INPUT'" >>> "t:IF t<1 OR t>2 PROCke
y:ENDPROC
840IF t=1 pch=0 ELSE pch=1:GOTO 880
850PRINT:VDU132,157:PRINT" WHICH RECOR
D DO YOU WISH TO PRINT":VDU132,157:PRINT
" (1-";record") ?";:INPUT" "G
860IF G<1 OR G>record PROCkey
870IF a$(1,G)="" CLS:VDU132,157:PRINT"
THERE IS NO DATA IN THIS RECORD ";CHR$
(156):PROCkey:ENDPROC
880CLS:VDU132,157:PRINT" PRINTING ...
";CHR$(156):VDU2,1,27,1,87,1,0,1,27,1,
77,1,27,1,69
890PRINT:IF pch=0 FOR t=1 TO fields:PR
INTfld$(t);TAB(20)": ";a$(t,G):NEXT:GOTO
920
900FOR t1=1 TO record:FOR t=1 TO field
s:PRINTfld$(t);TAB(20)": ";a$(t,t1)
910NEXT:VDU3:PRINT''" PRESS ANY KEY TO
CONTINUE ":GT$=GET$:VDU2:PRINT:NEXT
920VDU3:PROCkey:ENDPROC
930DEFPROCdrec:PROCtitle:IF record=1 P
RINT':VDU132,157:PRINT" SORRY..2 RECORDS
ARE NEEDED MINIMUM.":PROCkey:ENDPROC
940IF record=1 PRINT''" SORRY..2 RECOR
DS ARE NEEDED MINIMUM.":PROCkey:ENDPROC
950VDU132,157:PRINT" WHICH RECORD DO Y
OU WISH TO":VDU132,157:PRINT" DELETE (1-
";record;") ? ";:INPUT ""t
960IF t<1 OR t>record PROCkey:ENDPROC
970FORd=1TOfields:a$(d,t)="NO DATA":NE
XT:PRINT':VDU132,157:PRINT" DELETED..
";CHR$(156):PROCkey:ENDPROC
980DEFPROCcrec:PROCtitle:VDU132,157:PR
INT" DO YOU WISH TO CLEAR ALL THE":VDU13
2,157:PRINT" RECORDS PRESENT IN MEMORY (
Y/N) ?";:G$=GET$:IF G$="Y" OR G$="y" GOT
O 1000
990PROCkey:ENDPROC
1000FORx=1TOfields:FORt=1TOrecord:a$(x,
t)="":NEXT:NEXT:record=0:ch1=0:ch2=1:PRI
NT:VDU132,157:PRINT" ALL RECORDS CLEARED
";CHR$(156):PROCkey:ENDPROC
1010DEFPROCalter:PROCtitle:VDU132,157:P
RINT" WHICH RECORD DO YOU WISH TO ":VDU1
32,157:PRINT" ALTER ? (1-";record;") : "
;:INPUT""alter
1020IF alter<1 OR alter>record PROCkey:
ENDPROC
1030m=1:t=alter:CLS:VDU132,157:PRINT" D
ATA FILE ";alter;" ";CHR$(156)'
1040CLS:VDU132,157:PRINT" DATA FILE ";a
lter;" ";CHR$(156)':FOR j=1 TO fields:
PRINT" ";j;") ";fld$(j);TAB(18)" ";a$(j,
t):NEXT
1050PRINT''" INPUT NUMBER (1-";fields;"
) : ";:INPUT""change:IF change<1 OR chan
ge>fields PROCmenu:ENDPROC
1060PRINTTAB(18,change+1)" ?
":VDU7:INPUTTAB(18,change+1)" "a$(
change,t)
1070CLS:PROCkey:ENDPROC
1080DEFPROCsave:PROCtitle:PRINT:VDU132,
157:PRINT" FILENAME : ";CHR$(156);:INPU
T""file$
1090IF LEN(file$)>7 VDU7:file$=LEFT$(fi
le$,7):PRINT:VDU132,157:PRINT" FILENAME
HAS BEEN SHORTENED":VDU132,157:PRINT" TO
";file$
1100PRINT:VDU132,157:PRINT" DO YOU WISH
TO RETURN TO THE":VDU132,157:PRINT" MAI
N MENU (Y/N) ? ";:G$=GET$:IF G$="Y" OR G
$="y" PROCkey:ENDPROC
1110X=OPENOUT(file$):FOR g=1 TO 11:FOR
g1=1 TO 50:PRINT#X,a$(g,g1):NEXT:NEXT:FO
R t=1 TO 11:PRINT #X,fld$(t):NEXT:PRINT#
X,fields,record,ch,quit,ch1,amend,max,sn
d$,del,print$,print,date$:CLOSE#0
1120 CLOSE#0
1130PRINT:VDU132,157:PRINT" SAVED ";C
HR$(156):PROCkey:ENDPROC
1140DEFPROCload:PROCtitle:PRINT:VDU132,
157:PRINT" FILENAME TO LOAD FROM : ";:IN
PUT""file$
1150IF LEN(file$)>7 VDU7:file$=LEFT$(fi
le$,7):PRINT:VDU132,157:PRINT" FILENAME
HAS BEEN SHORTENED":VDU132,157:PRINT" TO
";file$
1160PRINT:VDU132,157:PRINT" DO YOU WISH
TO RETURN TO THE":VDU132,157:PRINT" MAI
N MENU (Y/N) ? ";:G$=GET$:IF G$="Y" OR G
$="y" PROCkey:ENDPROC
1170X=OPENIN(file$):FOR g=1 TO 11:FOR g
1=1 TO 50:INPUT#X,a$(g,g1):NEXT:NEXT:FOR
t=1 TO 11:INPUT#X,fld$(t):NEXT:INPUT#X,
fields,record,ch,quit,ch1,amend,max,snd$
,del,print$,print,date$:CLOSE#0
1180PRINT:VDU132,157:PRINT" LOADED ";
CHR$(156):PROCkey:ENDPROC
1190DEFPROCfields:VDU28,0,24,39,6:CLS:V
DU132,157:PRINTTAB(25);CHR$(156):VDU132,
157:PRINT" FIELDS : ";fields;" CREATED
";TAB(25);CHR$(156):VDU132,157:PRINT"
£££££ ";TAB(25);CHR$(156)
1200IF quit=1 GOTO 1220
1210VDU132,157:PRINT" 1) CREATE FIELDS"
;TAB(25);CHR$(156):IF quit=1 GOTO 1250
1220VDU132,157:PRINT" 2) PRINT FIELDS";
TAB(25);CHR$(156)
1230 IF quit=1 GOTO 1250
1240 VDU132,157:PRINT" 3) SORT FIELDS";
TAB(25);CHR$(156)
1250VDU132,157:PRINT" 4) VIEW FIELDS";T
AB(25);CHR$(156)
1260 IF quit=1 GOTO 1270 ELSE VDU132,15
7:PRINT" 5) CLEAR FIELDS";TAB(25);CHR$(1
56)
1270 IF quit=1 GOTO 1290
1280VDU132,157:PRINT" 6) DELETE A FIELD
";TAB(25);CHR$(156):VDU132,157:PRINT" 7)
ALTER FIELDS";TAB(25);CHR$(156)
1290 VDU132,157:PRINTTAB(25);CHR$(156)
1300ENDPROC
1310 DEFPROCrecords
1320 VDU28,0,24,39,6:CLS
1330 VDU132,157:PRINTTAB(25);CHR$(156)
1340 VDU132,157:PRINT" RECORDS : ";reco
rd;" CREATED";TAB(25);CHR$(156)
1350 VDU132,157:PRINT" ";TAB(25
);CHR$(156)
1360 VDU132,157:PRINT" 8) ENTER RECORDS
";TAB(25);CHR$(156)
1370 IF ch1=0 GOTO 1400
1380VDU132,157:PRINT" 9) VIEW RECORDS";
TAB(25);CHR$(156):VDU132,157:PRINT" A) P
RINT RECORDS";TAB(25);CHR$(156):VDU132,1
57:PRINT" B) DELETE RECORDS";TAB(25);CHR
$(156):VDU132,157:PRINT" C) ALTER RECORD
S";TAB(25);CHR$(156)
1390VDU132,157:PRINT" D) CLEAR RECORDS"
;;TAB(25);CHR$(156)
1400VDU132,157:PRINTTAB(25);CHR$(156):E
NDPROC
1410DEFPROCoptions:VDU28,0,24,39,6:CLS:
VDU132,157:PRINTTAB(25);CHR$(156):VDU132
,157:PRINT" OPTIONS";TAB(25);CHR$(156)
1420VDU132,157:PRINT" ";TAB(25)
;CHR$(156):VDU132,157:PRINT" E) SAVE ALL
DATA";TAB(25);CHR$(156):VDU132,157:PRIN
T" F) LOAD NEW DATA";TAB(25);CHR$(156):V
DU132,157:PRINT" G) SOUND IS";snd$;TAB(2
5);CHR$(156)
1430VDU132,157:PRINT" H) PRINTER IS";pr
int$;TAB(25);CHR$(156):VDU132,157:PRINT"
I) DATE : ";date$;TAB(25);CHR$(156):VDU
132,157:PRINT" J) END";TAB(25);CHR$(156)
:VDU132,157:PRINTTAB(25);CHR$(156):ENDPR
OC
1440DEFPROChead:PRINTTAB(0,0)"
pppppppppppppppppppppppppppppp":VDU132,1
57:PRINT" (F)ield (R)ecord (O)ptio
ns ";CHR$(156);:PRINT"
££££££££££££££££££££££££"
1450G$=GET$:IF G$="F" OR G$="f" PROCfie
lds:ENDPROC ELSE IF G$="R" OR G$="r" PRO
Crecords:ENDPROC ELSE IF G$="O" OR G$="o
" PROCoptions:ENDPROC
1460GOTO 1450:ENDPROC
1470DEFPROCstamp:PROCtitle:PRINTTAB(0,3
);:VDU132,157:PRINT" ENTER DATE ... ";
CHR$(156):PRINTTAB(0,15);:VDU132,157:PRI
NT" OLD DATE : ";date$;" ";CHR$(156):d
ate$=""
1480PRINTTAB(10,5)"??/??/??";:FORt=10 T
O 16 STEP 3:PRINTTAB(t,5);:G$=GET$:PRINT
TAB(t,5);G$:date$=date$+G$:PRINTTAB(t+1,
12);:G$=GET$:PRINTTAB(t+1,5);G$:date$=da
te$+G$+"."
1490NEXT:PROCkey:ENDPROC
1500DEFPROCon:VDU23,0,10,12,0,0,0,0,0,0
:ENDPROC
1510DEFPROCoff:VDU23;8202;0;0;0;:ENDPRO
C
1520DEFPROCkey:PRINT':VDU132,157:PRINT"
PRESS ANY KEY TO CONTINUE ";CHR$(156)
:GT$=GET$:PROCmenu:ENDPROC
1530DEFPROCload2:X=OPENIN("INFO"):INPUT
#X,fields,record,ch,quit,ch1,amend,max,s
nd$,del,ch2,date$,print$,print:CLOSE#0:E
NDPROC