Compute! Gazette 1993 May/1993-05.d64/database

Commodore BASIC | 1993-01-01 | 3.8 KB | 182 lines

10 rem copyright 1993 - compute publications intl ltd - all rights reserbed
20 poke53280,6:poke53281,6:print"[147]"
100 rem simple flat file data base
110 n9=50
120 dim a$(n9),b$(n9),c$(n9),d(n9)
130 s$="                 "
140 m9$="..janfebmaraprmayjunjulaugsepoctnovdec"
200 open 15,8,15
210 open 1,8,3,"0:mydata,s,r"
220 input#15,e,e$
230 if e=0 goto 300
240 close 1:close 15
250 print "i cannot find file 'mydata'"
260 input "continue";x$
270 if x$="y" or x$="yes" goto 400
280 end
300 n=n+1
310 input#1,a$(n),b$(n),c$(n),d(n)
320 if st=0 goto 300
330 close 1:close 15
340 print n;"records found on file."
350 if n+10>n9 then print "file almost full!"
400 if n>0 then print "show, ";
410 if n<n9 then print "add, ";
420 if n>0 then print "delete, change, ";
430 print "quit?"
440 input x$:x$=left$(x$,1)
450 if n=0 goto 490
460 if x$="s" goto 4000
470 if x$="d" goto 2000
480 if x$="c" goto 3000
490 if n=n9 goto 510
500 if x$="a" goto 1000
510 if x$<>"q" goto 400
520 rem quit .. but perhaps write file
530 if f9=0 or n=0 then end
540 print "ready to write file!"
550 print "press any key."
560 get x$,x$,x$
570 get x$:if x$="" goto 570
580 rem delete archive if present
590 open 15,8,15
600 print#15,"s0:mydata.old"
610 rem rename previous data file
620 print#15,"r0:mydata.old=0:mydata"
630 rem write new master file
640 open 1,8,3,"0:mydata,s,w"
650 input#15,e,e$
660 if e<>0 then print e;e$:close 1:close 15:end
670 for j=1 to n
680 print#1,a$(j)
690 print#1,b$(j)
700 print#1,c$(j)
710 print#1,d(j)
720 next j
730 input#15,e,e$,e1,e2
740 if e<>0 then print e;e$
750 close 1:close 15
760 end
1000 rem add a record
1010 input "last name";a$(n+1)
1020 input "first name";b$(n+1)
1030 v=n+1:gosub 8000 : rem get date
1040 input "high score";d(n+1)
1050 print
1060 print a$(n+1)
1070 print b$(n+1)
1080 print c$(n+1)
1090 print d(n+1)
1100 input "is the above ok";x$
1110 if x$="y" or x$="yes" goto 1140
1120 print ">>> record cancelled! <<<"
1130 goto 400
1140 n=n+1:f9=1
1150 print n;"records total."
1160 goto 400
2000 rem delete a record
2010 gosub 5000
2020 if x=0 goto 400
2030 print "ready to delete record:"
2040 print "  ";a$(x)
2050 print "  ";b$(x)
2060 m=val(mid$(c$(x),5,2))
2065 print "  ";left$(c$(x),4);mid$(m9$,m*3,3);right$(c$(x),2)
2070 print "  ";d(x)
2080 input "ok to delete";x$
2090 if x$="y" or x$="yes" goto 2120
2100 print "record >>>not<<< deleted!"
2110 goto 400
2120 n=n-1
2130 if x>n goto 2220
2140 for j=x to n
2150 a$(j)=a$(j+1)
2160 b$(j)=b$(j+1)
2170 c$(j)=c$(j+1)
2180 d(j)=d(j+1)
2190 next j
2200 f9=1
2210 print ">>> record deleted! <<<"
2220 goto 400
3000 rem change a record
3010 gosub 5000
3020 if x=0 goto 400
3030 print "ready to change record:"
3040 print "1:";a$(x)
3050 print "2:";b$(x)
3060 m=val(mid$(c$(x),5,2))
3065 print "3:";left$(c$(x),4);mid$(m9$,m*3,3);right$(c$(x),2)
3070 print "4:";d(x)
3080 input "change which field (0=none)";j
3090 j=int(j):if j<1 or j>4 then j=0
3100 on j goto 3120,3140,3160,3180
3110 goto 400
3120 input "last name";a$(x)
3130 f9=1:goto 3040
3140 input "first name";b$(x)
3150 f9=1:goto 3040
3160 v=x:gosub 8000 : rem get date
3170 f9=1:goto 3040
3180 input "high score";d(x)
3190 f9=1:goto 3040
4000 rem show - display or print
4010 input "screen or printer";x$
4020 x$=left$(x$,1)
4030 if x$="p" goto 4190
4040 if x$<>"s" goto 4010
4050 j=1
4060 k=j+20:if k=n then k=n+1
4070 print left$(a$(j)+s$,13);
4080 print left$(b$(j)+s$,10);
4090 m=val(mid$(c$(j),5,2))
4100 print left$(c$(j),4);mid$(m9$,m*3,3);right$(c$(j),2);
4110 print right$(s$+str$(d(j)),7)
4120 j=j+1:if j<>k goto 4170
4130 print "  >> more - press any key <<";chr$(145)
4140 get x$,x$,x$,x$
4150 get x$:if x$="" goto 4150
4160 goto 4060
4170 if j<=n goto 4070
4180 goto 400
4190 rem send to printer
4200 open 4,4
4210 for j=1 to n
4220 print#4,left$(a$(j)+s$,20);
4230 print#4,left$(b$(j)+s$,15);
4240 m=val(mid$(c$(j),5,2))
4250 print#4,left$(c$(j),4);mid$(m9$,m*3,3);right$(c$(j),2);
4260 print#4,right$(s$+str$(d(j)),10)
4270 next j
4280 close 4
4290 goto 400
5000 print "select which record:"
5010 j=1
5020 k=j+20:if k>n then k=n
5030 for s=j to k
5040 print right$(s$+str$(s),3);": ";left$(a$(s)+s$,12);
5050 print left$(b$(s)+s$,6);
5060 print left$(c$(s)+s$,8);
5070 print right$(s$+str$(d(s)),7)
5080 next s
5090 print ">> select record number, or 0 ";
5100 if k<>n then print "for more <<"
5110 if k=n then print "to quit <<"
5120 input x
5130 x=int(x):if x>n then x=0
5140 j=k
5150 if x=0 and k<>n goto 5020
5160 return
8000 input "year";y
8010 if y<1900 or y>9999 goto 8000
8020 input "month";m$
8030 m=val(m$):if m>0 and m<13 goto 8050
8040 m$=left$(m$+s$,3)
8050 for j=1 to 12
8060 if m$=mid$(m9$,j*3,3) then m=j
8070 next j
8080 if m<1 or m>12 goto 8020
8090 input "day";d
8100 if d<1 or d>31 goto 8090
8110 c$(v)=right$(str$(y),4)+right$(str$(m+100),2)+right$(str$(d+100),2)
8120 return