1 ON ERROR GOTO 12000
2 DEF FNAT$(I,J)=CHR$(27)+CHR$(61)+CHR$(I+32)+CHR$(J+32)
3 OPEN "I",1,"CONTROL.DAT":INPUT #1,FIL$:CLOSE
4 FIL$=LEFT$(FIL$,10)
5 DIM M(200,2),A(6),Y(10),A$(1000)
10 PRINT CHR$(26):PRINT "M A I L L I S T   D A T A B A S E  E D I T O R":PRINT "         Copyright 1986  Eric A. Shore"
15 PRINT:PRINT:PRINT:PRINT "This will allow you to edit the datafile, and"
16 PRINT "make any corrections or deletions..."
20 PRINT:PRINT "Hit <RETURN> to continue"
21 PRINT FNAT$(10,0);"or enter <Q>uit editor ";CHR$(7);:INPUT B$:IF B$="" THEN 60
22 IF B$="Q" OR B$="q" THEN PRINT CHR$(26):PRINT FNAT$(15,33);"Thankyou...";CHR$(7);:SYSTEM ELSE 21
30 STOP
60 DEFINT A-Z:BEL=-1:PRINT CHR$(26):PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
440 RL=128
460 OPEN "R",1,FIL$+".DAT",RL:FIELD #1,RL AS RR$:RE=1
480 GET#1,1:QQ=VAL(RR$)+1:FOR RE=2 TO QQ
490 GET#1,RE:GOSUB 1470:A$(RE-1)=S$:NEXT:F=RE-2:CLOSE:GOTO 560
500 GET#1,RE:GOSUB 1470:IF S$=" 9999" THEN CLOSE:F=RE:GOTO 560
510 A$(RE+1)=S$:RE=RE+1:GOTO 500
520 REM
530 F=F+1:A$=MID$(STR$(F),2):IF F<100 THEN A$=""+A$:

	IF F<10 THEN A$=""+A$
540 PRINT:PRINT A$;"> ";:GOSUB 1570:IF SAV$="" THEN F=F-1:PRINT:GOTO 560
550 B$=SAV$:A$(F)=B$+" ":GOTO 520
560 NJ=0:A1$="(A)bort, (C)ontinue, (D)elete, (E)dit, "+

	CHR$(13)+CHR$(10)+"(I)nsert, (L)ist, (S)ave; Select?"
570 GOSUB 1050:C=1:GOSUB 1180:C=0
580 IF B$<>"L" THEN 630
590 GOSUB 1050:A1$="Line # (c/r=ALL):":N=1:GOSUB 1050:GOSUB 1180:LQ=VAL(B$)+1
600 GOSUB 1050:FOR L=LQ TO F:GOSUB 1050:A$=MID$(STR$(L),2)+"-- "+A$(L)
610 GOSUB 1050:NJ=NJ+1:IF BK THEN 560 ELSE NEXT L
620 GOSUB 1050:GOTO 560
630 IF B$="A" THEN PRINT:A$="*** Aborted ***":GOSUB 1050:GOTO 10
640 IF B$="D" THEN 840
650 IF B$="I" THEN 890
660 IF B$="C" THEN 530
670 IF B$="E" THEN 700
680 IF B$="S" THEN 950
690 PRINT:GOTO 560
700 GOSUB 1050:A1$="Line #:":N=1:GOSUB 1050:GOSUB 1180:L=VAL(B$):PP$=""
710 IF L=0 OR L>F THEN PRINT:GOTO 560 ELSE PRINT:PRINT "Was:  ";:A$=A$(L):GOSUB 1050:PRINT "Enter '\Old string\New string\'"
711 PRINT "           CR = No Change"
720 PRINT "Edit: ";:GOSUB 1570:B$=SAV$
730 IF LEN(B$)=0 THEN PRINT:GOTO 560:ELSE A=LEN(A$(L)):B=LEN(B$):Y=1
740 FOR X=1 TO B:IF MID$(B$,X,1)="\" THEN A(Y)=X:Y=Y+1

	:IF Y>4 THEN 760
750 NEXT X
760 IF Y<>4 THEN PRINT:PRINT "Incorrect editing entry":PRINT:

	GOTO 710
770 X1=0:IF A(2)=3 AND A(3)>5 AND MID$(B$,2,1)+MID$(B$,2,1)=

	MID$(B$,4,2) THEN 710
780 IF Y<>4 THEN A$(L)=B$:GOTO 710
790 B1$=MID$(B$,A(1)+1,A(2)-A(1)-1):

	B2$=MID$(B$,A(2)+1,A(3)-A(2)-1):

	B1=LEN(B1$):B2=LEN(B2$):X=1
800 IF X=A-B1+2 THEN 710
810 IF X=1 AND B1$=MID$(A$(L),X,B1) THEN A$(L)=

	B2$+MID$(A$(L),X+B1,A-X+B1):

	A=LEN(A$(L)):GOTO 710
820 IF X>1 AND B1$=MID$(A$(L),X,B1) THEN A$(L)=

	LEFT$(A$(L),X-1)+B2$+MID$(A$(L),X+B1,A-X+B1):

	A=LEN(A$(L)):GOTO 710
830 X=X+1:GOTO 800
840 REM DELETE A LINE
850 PRINT:GOSUB 1050:A1$="Line #:":N=1:GOSUB 1050:GOSUB 1180:D=VAL(B$):

	IF D=0 OR D>F THEN PRINT "No such line":PRINT:

	GOTO 560
860 PRINT"Line #";D;":";:PRINT A$(D)
870 PRINT"Confirm (Y/N): ";:C=1:GOSUB 1180:C=0:

	IF B$<>"Y" THEN PRINT "Not deleted":PRINT:GOTO 560
880 FOR X= D-1 TO F:A$(X)= A$(X+1):NEXT:F=F-1:

	PRINT "Killed":PRINT:GOTO 560
890 REM INSERT A LINE
900 PRINT:A1$="At line #:":N=1:GOSUB 1050:GOSUB 1180:LN=VAL(B$):

	IF LN=0 OR LN>F THEN PRINT "No such line":PRINT:GOTO 560
910 A$=STR$(LN)+">":IF LN<10 THEN A$=" "+A$
920 N=1:GOSUB 1050:GOSUB 1570:IF LEN(SAV$)=0 THEN PRINT:GOTO 560
930 FOR X= F TO LN STEP -1:A$(X+1)=A$(X):NEXT X:F=F+1
940 A$(LN)=SAV$:PRINT:GOTO 560
950 REM
960 PRINT "Saving Datafile..."
970 NAME FIL$+".DAT" AS FIL$+".BAK"
980 OPEN "R",1,FIL$+".DAT",RL
990 FIELD#1,RL AS RR$:S$=STR$(F):GOSUB 1420:PUT#1,1
1000 FOR RE=1 TO F+1:S$=A$(RE):GOSUB 1420:PUT#1,RE+1:NEXT RE:

	CLOSE:GOTO 10
1050 REM ***PRINT STRING FROM A$ ON CONSOLE***
1060 IF NJ=3 THEN GOSUB 14000
1070 IF SAV$<>"" AND A1$<>"" THEN A1$="":RETURN
1080 IF A1$<>"" THEN A$=A1$:A1$=""
1090 IF RIGHT$(A$,1)="?" OR N=1 THEN PRINT A$;" ";:PP$=A$:GOTO 1150
1100 CON=(INP(&H1) AND 1):DCH=(INP(&H81) AND 1):BI=0:BK=0
1110 IF CON THEN BI=(INP(&H0) AND 127)
1120 IF DCH THEN BI=(INP(&H80) AND 127)
1130 IF BI=19 THEN BI=ASC(INPUT$(1))
1140 IF BI=11 THEN BK=-1:GOTO 1160 ELSE PRINT A$
1150 A=A+LEN(A$)
1160 A$="":N=0
1170 RETURN
1180 REM
1190 REM ***ACCEPT STRING INTO B$ FROM CONSOLE***
1200 REM
1210 IF BEL AND SAV$="" THEN PRINT CHR$(7);
1220 B$="":BK=0
1230 IF SAV$="" THEN GOSUB 1570
1240 SP=INSTR(SAV$,";"):IF SP=0 THEN B$=SAV$:SAV$="":GOTO 1260
1250 B$=LEFT$(SAV$,SP-1):SAV$=MID$(SAV$,SP+1)
1260 IF LEN(B$)=0 THEN RETURN
1270 IF C=0 THEN 1290
1280 FOR ZZ=1 TO LEN(B$):

     MID$(B$,ZZ,1)=CHR$(ASC(MID$(B$,ZZ,1))+32*(ASC(MID$(B$,ZZ,1))>96)):NEXT ZZ
1290 IF LEN(B$)<64 THEN 1340
1300 A$="Input line too long - would be truncated to:":GOSUB 1050
1310 B$=LEFT$(B$,63):PRINT B$
1320 LINE INPUT "Retype line (Y/N): ",QQ$:QQ$=LEFT$(QQ$,1)
1330 IF QQ$="Y" OR QQ$="y" THEN PRINT PP$;:SAV$="":GOTO 1180
1340 D=D+LEN(B$):RETURN
1350 RETURN
1420 REM
1430 REM FILL AND STORE DISK RECORD
1440 REM
1450 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
1460 RETURN
1470 REM
1480 REM UNPACK DISK RECORD
1490 REM
1500 ZZ=LEN(RR$)-2
1510 WHILE MID$(RR$,ZZ,1)=" "
1520 ZZ=ZZ-1:IF ZZ=1 THEN 1540
1530 WEND
1540 S$=LEFT$(RR$,ZZ)
1550 IF MID$(S$,ZZ,1)="?" THEN S$=S$+" "
1560 RETURN
1570 CHC=0: SAV$="":ERS$=CHR$(8)+" "+CHR$(8)
1580 NCH=ASC(INPUT$(1))
1590 IF NCH<32 OR NCH=127 THEN 1660
1600 IF CHC>=128 THEN PRINT CHR$(7);:GOTO 1580
1610 SAV$=SAV$+CHR$(NCH): CHC=CHC+1:PRINT CHR$(NCH);
1620 IF CHC=128 THEN PRINT CHR$(7);
1630 GOTO 1580
1640 IF CHC=0 THEN 1580 ELSE PRINT ERS$;
1650 CHC=CHC-1:SAV$=LEFT$(SAV$,CHC):GOTO 1580
1660 IF NCH=127 OR NCH=8 THEN 1640
1670 IF NCH=9 THEN 1740
1680 IF NCH=18 THEN PRINT CHR$(13);SAV$;:GOTO 1580
1690 IF NCH=13 THEN PRINT: RETURN
1700 IF NCH=21 THEN PRINT "^U": GOTO 1570
1710 IF NCH=24 AND NOT BKS THEN PRINT "^X":GOTO 1570
1720 IF NCH<>24 OR CHC=0 THEN 1580
1730 FOR BCC=1 TO CHC: PRINT ERS$;: NEXT BCC: GOTO 1570
1740 TP=(CHC AND 248):TP=TP+8:TP=TP-CHC
1750 PRINT SPACE$(TP);:SAV$=SAV$+SPACE$(TP):CHC=CHC+TP:GOTO 1580
1760 END
2260 REM
2270 REM FILL AND STORE DISK RECORD
2280 REM
2290 LSET RR$=LEFT$(S$+SPACE$(RL-2),RL-2)+CHR$(13)+CHR$(10)
2300 RETURN
3200 REM unpack record
3210 ZZ=LEN(R1$)-2
3220 WHILE MID$(R1$,ZZ,1)=" "
3230 ZZ=ZZ-1:IF ZZ=1 THEN 3250
3240 WEND
3250 KL$=LEFT$(R1$,ZZ)
3260 RETURN
12000 IF ERL=3 THEN RESUME 13000
12001 RESUME NEXT
13000 PRINT CHR$(26):PRINT FNAT$(15,15);"Sorry! <CONTROL.DAT> file not available...";CHR$(7);:SYSTEM
14000 PRINT
14001 N=0:PRINT "Hit <RETURN> for more ";CHR$(7);
14002 XX$=INPUT$(1):IF XX$=CHR$(13) THEN BK$="1":GOTO 14003 ELSE 14003
14003 FOR I=1 TO 32:PRINT CHR$(8);:NEXT I
14004 PRINT "                                 "
14005 ZZZ=0
14006 NJ=0:RETURN
14007 FOR I=1 TO 32:PRINT CHR$(8);:NEXT I:NJ=0:GOTO 14001
                                 "
14005 ZZZ=0
14006 NJ=0:RETURN
14007 FOR 