[Coco] Disk BASIC - OPEN with append?

[Bob Devries]

A long time ago I wrote a simple name & address database programme using 
Direct Access filing. It was principally a teaching tool for the user 
group. It allows the user to add records to the end of the file.

Here it is:

10 'SIMPLE ADDRESS DATABASE USING DIRECT ACCESS FILING
20 GOTO 50
30 SAVE"DATABASE":DIR:PRINTFREE(0)
40 END
50 CLS:CLEAR500:RECORD=0
60 PRINT at 3,"SURNAME:--------------------:";
70 PRINT at 33,"FIRSTNAME:--------------------:";
80 PRINT at 68,"STREET:--------------------:";
90 PRINT at 102,"CITY:--------------------:";
100 PRINT at 129,"POSTCODE:----:";
110 PRINT at 143,"PHONE:----------:";
120 PRINT at 449,"RECORD####";:PRINT at 472,"LOF ###";:PRINT at 480,"sEARCH eDIT 
gOTO pRINT hELP qUI";:POKE&H5FF,&H54
130 GOSUB1010
140 PRINT at 456,USING"###";RECORD;
150 PRINT at 476,USING"###";LF;
160 KEY$=INKEY$:IF KEY$=""THEN160
170 KEY=INSTR("PEGHSQ",KEY$)
180 ONKEY+1 GOSUB 210,240,410,540,650,760,220
190 GOSUB 590
200 IF KEY$="H" THEN GOTO 50 ELSE GOTO 160
210 RETURN
220 CLS:END
230 'PRINT ONE RECORD OR ALL RECORDS
240 PRINT at 420,"RECORD # OR aLL";:INPUTR$:PRINT at 420,STRING$(19,32);
250 IF R$="" THEN RETURN ELSEIF LEFT$(R$,1)="A" THEN 360
260 R1=VAL(R$):IF R1=0 THEN GOSUB600:GOTO240 ELSE IF R1>LF THEN 
GOSUB600:GOTO 240
270 RECORD=R1:GOSUB1190
280 PRINT#-2,"  SURNAME: ";N1$
290 PRINT#-2,"FIRSTNAME: ";N2$
300 PRINT#-2,"   STREET: ";S$
310 PRINT#-2,"     CITY: ";C$
320 PRINT#-2," POSTCODE: ";P1$
330 PRINT#-2,"    PHONE: ";P2$
340 PRINT#-2,CHR$(13);CHR$(13)
350 RETURN
360 FOR X=1 TO LF
370 R1=X:GOSUB270
380 NEXT X
390 RETURN
400 'EDIT RECORD
410 GOSUB420:GOTO490
420 GOSUB520:LINEINPUT"SURNAME:";N$:IFN$<>"" THEN N1$ = 
LEFT$(N$+STRING$(20,32),20)
430 GOSUB520:LINEINPUT"FIRSTNAME:";N$:IFN$<>"" THEN N2$ = 
LEFT$(N$+STRING$(20,32),20)
440 GOSUB520:LINEINPUT"STREET:";N$:IFN$<>""THEN S$ = 
LEFT$(N$+STRING$(20,32),20)
450 GOSUB520:LINEINPUT"CITY:";N$:IFN$<>"" THEN C$ = 
LEFT$(N$+STRING$(20,32),20)
460 GOSUB520:LINEINPUT"POSTCODE:";N$:IF N$<>""THEN P1$ = 
LEFT$(N$+STRING$(4,32),4)
470 GOSUB520:LINEINPUT"PHONE:";N$:IF N$<>""THEN P2$ = 
RIGHT$(STRING$(10,32)+N$,10)
480 RETURN
490 GOSUB1060:GOSUB890
500 GOSUB520:PRINT at 270,"CORRECT ?";
510 K$=INKEY$:IFK$=""THEN510 ELSE IF K$="Y" OR K$="y" THEN PRINT at 270," 
        ";:GOTO 130 ELSE 410
520 PRINT at 256,STRING$(31,32):PRINT at 257,"";:RETURN
530 'GOTO RECORD NUMBER
540 PRINT at 420,"";:INPUT"RECORD #";R1
550 IF R1=LF+1 THEN GOSUB 970:GOTO580 ELSE IFR1>LF OR R1=0 THEN 600
560 RECORD=R1
570 GOSUB1190:'GET RECORD
580 PRINT at 456,USING"###";RECORD;:GOSUB 890:'PRINT RECORD TO SCREEN
590 PRINT at 420,STRING$(14,32):RETURN
600 PRINT at 420,"INVALID RECORD";
610 FOR TD=1 TO 300:NEXTTD
620 PRINT at 420,STRING$(14,32)
630 RETURN
640 'HELP SCREENS
650 CLS:PRINT at 8,"MINI DATA BASE":PRINT at 40,"BY BOB DEVRIES"
660 PRINT:PRINT" THIS IS A VERY SIMPLE DATABASE  AND ITS FEATURES ARE 
SIMPLE TO  UNDERSTAND.":PRINT" S. SEARCHES THE DATABASE FOR AN ENTRY. 
YOU MAY USE ONE OR ALL   FIELDS, AND LEAVE THE UNUSED    ONES BLANK."
670 PRINT" E. EDITS THE CURRENT RECORD     THAT IS THE ONE DISPLAYED, 
BUT  USE THE GOTO COMMAND FIRST. IF  YOU YOU DON'T WANT TO CHANGE A 
FIELD JUST PRESS ENTER.":PRINT" PRESS ANY KEY TO CONTINUE";
680 I$=INKEY$:IFI$=""THEN680
690 CLS:PRINT" G. GOTO A RECORD. RECORD NUMBER MUST LESS THAN OR EQUAL 
TO LOF  OR TO INSERT A NEW RECORD, GOTO LOF + 1. E.G. IF LOF=3 THEN 
GOTO 4 WILL CREATE A NEW BLANK  RECORD FOR YOU TO EDIT.":PRINT" P. PRINT 
RECORDS. YOU WILL BE";
700 PRINT"   PROMPTED FOR RECORD NUMBER OR   ALL. IF 'A' IS CHOSEN ALL 
THE   FIELDS WILL BE PRINTED ON THE   PRINTER"
710 PRINT:PRINT" DIRECT ANY QUESTIONS TO:        BOB DEVRIES PH 3727816"
720 PRINT at 481,"PRESS ANY KEY TO CONTINUE";
730 I$=INKEY$:IF I$="" THEN 730
740 RETURN
750 'SEARCH FOR ENTRY
760 N1$="":N2$="":S$="":C$="":P1$="":P2$="":X=0:GOSUB420
770 N3$=N1$:N4$=N2$:S1$=S$:C1$=C$:P3$=P1$:P4$=P2$
780 X=X+1:IF X>LF THEN PRINT at 420,"NOT FOUND";:GOSUB520:FORTD=1 TO 
50:NEXT TD:RETURN
790 RECORD=X:GOSUB1190
800 IF N3$="" THEN 810 ELSE IFN3$<>N1$ THEN GOTO 870
810 IF N4$="" THEN 820 ELSE IFN4$<>N2$ THEN GOTO 870
820 IF S1$="" THEN 830 ELSE IFS1$<>S$ THEN GOTO 870
830 IF C1$="" THEN 840 ELSE IFC1$<>C$ THEN GOTO 870
840 IF P3$="" THEN 850 ELSE IFP3$<>P1$ THEN GOTO 870
850 IF P4$="" THEN 860 ELSE IFP4$<>P2$ THEN GOTO 870
860 GOSUB 890:PRINT at 456,USING"###";RECORD;:GOSUB520:RETURN
870 GOTO780
880 'PRINT RECORD ON SCREEN
890 PRINT at 11,N1$;
900 PRINT at 43,N2$;
910 PRINT at 75,S$;
920 PRINT at 107,C$;
930 PRINT at 138,P1$;
940 PRINT at 149,P2$;
950 RETURN
960 'PREPARE FOR NEW RECORD
970 A$ = STRING$(20,"-"):N1$ = A$:N2$ = A$:S$ = A$:C$ = A$:P1$ = 
"----":P2$ = "----------"
980 RECORD=R1
990 RETURN
1000 'FIND FILE SIZE OR CREATE IF NONE
1010 OPEN"D",#1,"DATABASE/DAT:0",100
1020 LF=LOF(1)
1030 CLOSE#1
1040 RETURN
1050 'OPEN FILE TO 'PUT' DATA INTO IT
1060 OPEN"D",#1,"DATABASE/DAT:0",100
1070 FIELD #1,20 AS SN$,20 AS CN$,20 AS ST$,20 AS CT$,4 AS PC$,10 AS 
PH$,6 AS SP$
1080 LSET SN$=N1$
1090 LSET CN$=N2$
1100 LSET ST$=S$
1110 LSET CT$=C$
1120 LSET PC$=P1$
1130 RSET PH$=P2$
1140 LSET SP$=STRING$(6,"-")
1150 PUT#1,RECORD
1160 CLOSE#1
1170 RETURN
1180 'OPEN FILE TO 'GET' DATA FROM IT
1190 OPEN"D",#1,"DATABASE/DAT:0",100
1200 FIELD #1,20 AS SN$,20 AS CN$,20 AS ST$,20 AS CT$,4 AS PC$,10 AS 
PH$,6 AS SP$
1210 GET#1,RECORD
1220 N1$=SN$:N2$=CN$:S$=ST$:C$=CT$:P1$=PC$:P2$=PH$
1230 CLOSE#1
1240 RETURN


Regards, Bob Devries
Dalby, QLD, Australia


On 30/12/2014 1:22 PM, Allen Huffman wrote:
> Does Disk BASIC have a way to open a sequential file ("O") and append to the end?
>