10 '     *** DIR.BAS *** IBM Version 2.0 ***
20 '     *** March                  1983 ***
30 '
40 '     *** Written by Wes Meier (70215,1017) ***
50 '     *** 230 B Park Lake Circle            ***
60 '     *** Walnut Creek, CA 94598            ***
70 '
80 '  ****************************************************************
90 '  * *** For Public Domain....Private Sales Rights Reserved ! *** *
100 ' ****************************************************************
110 '
120 '    REMark...This program was written for an IBM PC with 128K RAM,
130 '    Two disk drives, Color Adapter Card, Electrohome Color
140 '    Monitor (80 Column), and an Epson MX-80 printer equipped
150 '    with the GRAFTRAX ROMS.
160 '
170 DEFINT B-Z:DEFSTR A
180 AV=CHR$(34):AL=STRING$(80,196):AQ="("+AV+"*"+AV+" to QUIT) "
190 DIM A(1000)
200 KEY OFF:WIDTH 40:SCREEN 0,1:COLOR 4,3,3:CLS
210 LOCATE 9,7,0,0,7:PRINT CHR$(201)STRING$(28,205)CHR$(187)
220 PRINT TAB(7) CHR$(186)SPC(3)"*** Disk Directory ***   "CHR$(186)
230 PRINT TAB(7) CHR$(186)SPC(3)" *** Version 2.00 ***    "CHR$(186)
240 PRINT TAB(7) CHR$(186)SPC(3)" *** March , 1983 ***    "CHR$(186)
250 PRINT TAB(7) CHR$(186)SPC(3)" *** By Wes Meier ***    "CHR$(186)
260 PRINT TAB(7)CHR$(204)STRING$(28,205)CHR$(185)
270 PRINT TAB(7)CHR$(186)SPC(2)"Reading: "AV SPC(15)AV CHR$(186)
280 PRINT TAB(7)CHR$(200)STRING$(28,205)CHR$(188)
290 ADRV="A:":ON ERROR GOTO 310
300 GOTO 350
310 IF ERR=53 THEN RESUME 320 ELSE ON ERROR GOTO 0
320 MID$(ADRV,1,1)=CHR$(ASC(ADRV)+1)
330 IF ASC(ADRV)>66 THEN ON ERROR GOTO 0 ELSE 350
340 CLOSE:ADRV="A:":OPEN "O",1,ADRV+"DIR.DAT":CLOSE
350 OPEN "I",1,ADRV+"DIR.DAT":ON ERROR GOTO 0
360 ENTRIES=0
370 WHILE NOT EOF(1)
380      ENTRIES=ENTRIES+1
390      INPUT #1,A(ENTRIES)
400      LOCATE 15,20,0
410      PRINT A(ENTRIES);
420 WEND
430 CLOSE
440 'Check for Color Card
450 SCRSEG=&HB800
460 DEF SEG=SCRSEG
470 POKE 0,95:IF PEEK(0)<>95 THEN SCRSEG=&HB000:DEF SEG=SCRSEG
480 GOTO 970
490 '********************** SUBROUTINES **********************
500 '
510 '**********************************
520 '*** Blinking Cursor Subroutine ***
530 '**********************************
540 T=POS(0):L=CSRLIN
550 LOCATE L,T,0:PRINT "?";:FOR O=1 TO 30:ANSWER$=INKEY$
560 IF ANSWER$<>""THEN IF ANSWER$="*"THEN RETURN 970 ELSE RETURN ELSE NEXT
570 LOCATE L,T,0:PRINT CHR$(220);:FOR O=1 TO 30:ANSWER$=INKEY$
580 IF ANSWER$<>""THEN IF ANSWER$="*"THEN RETURN 970 ELSE RETURN ELSE NEXT
590 GOTO 550
600 ' ********************************
610 ' *** Yes/No Answer Subroutine ***
620 ' ********************************
630 GOSUB 510:LOCATE L,T
640 IF ANSWER$="Y" OR ANSWER$="y" OR ANSWER$=CHR$(13) THEN 670
650 IF ANSWER$="0" OR ANSWER$="n" OR ANSWER$="N" THEN 680
660 SOUND 250,4:GOTO 630
670 ANSWER$="Y":PRINT "? Yes":RETURN
680 ANSWER$="N":PRINT "? No":RETURN
690 '
700 '******* SUBROUTINE TO DUMP DATA TO DISK ********
710 'DRIVE=0 IF DRIVE "A" OR 1 IF DRIVE "B"
720 SCREEN ,,0,0:COLOR 31,4,4:CLS
730 LOCATE 12,14,0:PRINT"Saving Data to Disk.....";
740 IF DRIVE=0 THEN OPEN"O",1,"DIR.DAT":GOTO 760
750 OPEN"O",1,"B:DIR.DAT"
760 FOR X=1 TO ENTRIES:IF A(X)="" THEN 770 ELSE WRITE #1,A(X)
770 NEXT:CLOSE:RETURN
780 '*****************************************************
790 '*   SUBROUTINE TO SORT THE DATA ARRAY BY FILESPEC   *
800 '*****************************************************
810 PRINT"Sorting Data.........."
820 M=ENTRIES:N=M:C=0
830 M=INT(M/2):IF M=0 THEN SORTFLAG=0:RETURN ELSE J=1:K=N-M
840 I=J
850 L=I+M:C=C+1
860 IF A(I)K THEN 830 ELSE 840
880 '*****************************************************
890 '*   SUBROUTINE TO SORT THE DATA ARRAY BY DISK NO.   *
900 '*****************************************************
910 PRINT"Sorting Data.........."
920 FOR X=1 TO ENTRIES:A(X)=RIGHT$(A(X),3)+LEFT$(A(X),12):NEXT
930 GOSUB 820
940 SORTFLAG=1
950 FOR X=1 TO ENTRIES:A(X)=RIGHT$(A(X),12)+LEFT$(A(X),3):NEXT
960 RETURN
970 '                           ************
980 '                         ****  MENU  ****
990 '                           ************
1000 IF SORTFLAG=1 THEN GOSUB 810
1010 IF PAGE=1 THEN COLOR ,,1:SCREEN ,,1,1:GOTO 1570
1020 WIDTH 80:SCREEN 0,1,1,1:COLOR ,1,1:PAGE=1
1030 CLS
1040 COLOR 6
1050 LOCATE 5,1,0
1060 PRINT CHR$(201)STRING$(78,205)CHR$(187);
1070 PRINT CHR$(186);
1080 COLOR 13
1090 PRINT TAB(13)"*** DISK DIRECTORY *** MENU ****";
1100 PRINT ENTRIES"ENTRIES ON RECORD ***";
1110 COLOR 6
1120 PRINT TAB(80)CHR$(186);
1130 PRINT CHR$(204)STRING$(78,205)CHR$(185);
1140 PRINT CHR$(186)TAB(13);
1150 COLOR 3:PRINT"Enter:"TAB(80):COLOR 6:PRINT CHR$(186);
1160 PRINT CHR$(186)TAB(19);
1170 COLOR 27:PRINT"1. ";:COLOR 3
1180 PRINT"To FIND an item."TAB(80);
1190 COLOR 6:PRINT CHR$(186);
1200 PRINT CHR$(186)TAB(19);
1210 COLOR 27:PRINT"2. ";:COLOR 3
1220 PRINT"To ENTER an item or an entire disk."TAB(80);
1230 COLOR 6:PRINT CHR$(186);
1240 PRINT CHR$(186)TAB(19);
1250 COLOR 27:PRINT"3. ";:COLOR 3
1260 PRINT"To DELETE an item or an entire disk."TAB(80);
1270 COLOR 6:PRINT CHR$(186);
1280 PRINT CHR$(186)TAB(19);
1290 COLOR 27:PRINT"4. ";:COLOR 3
1300 PRINT"To LIST the file to the CRT or the PRINTER."TAB(80);
1310 COLOR 6:PRINT CHR$(186);
1320 PRINT CHR$(186)TAB(19);
1330 COLOR 27:PRINT"5. ";:COLOR 3
1340 PRINT"To LIST the directory of a disk."TAB(80);
1350 COLOR 6:PRINT CHR$(186);
1360 PRINT CHR$(186)TAB(19);
1370 COLOR 27:PRINT"6. ";:COLOR 3
1380 PRINT"To BACKUP the data file or this program."TAB(80);
1390 COLOR 6:PRINT CHR$(186);
1400 PRINT CHR$(186)TAB(19);
1410 COLOR 27:PRINT"   ";:COLOR 3
1420 PRINT TAB(80);
1430 COLOR 6:PRINT CHR$(186);
1440 PRINT CHR$(186)TAB(19);
1450 COLOR 27:PRINT"   ";:COLOR 3
1460 PRINT TAB(80);
1470 COLOR 6:PRINT CHR$(186);
1480 PRINT CHR$(186)TAB(19);
1490 COLOR 27:PRINT"9. ";:COLOR 3
1500 PRINT"To RETURN to DOS."TAB(80);
1510 COLOR 6:PRINT CHR$(186);
1520 PRINT CHR$(204)STRING$(78,205)CHR$(185);
1530 PRINT CHR$(186)TAB(27);
1540 COLOR 20,7:PRINT" *** ENTER YOUR CHOICE *** ";
1550 COLOR 6,1:PRINT TAB(80)CHR$(186);
1560 PRINT CHR$(200)STRING$(78,205)CHR$(188);
1570 BEEP
1580 CHOICE$=INKEY$:IF CHOICE$="" THEN 1580
1590 X=INSTR("123456789",CHOICE$):IF X=0 THEN 1570
1600 SCREEN ,,0,0:COLOR 6,1,1:CLS
1610 ON X GOTO 1620,2040,2850,3280,10010,10410,1570,1570,11130
1620 '****************************************
1630 '*     ***  Find an ITEM routine ***    *
1640 '****************************************
1650 COLOR ,3,3:CLS
1660 COLOR 16:PRINT AL;:COLOR 1
1670 PRINT TAB(26)"*** FIND AN ITEM ROUTINE ***"
1680 COLOR 16:PRINT AL
1690 COLOR 4:PRINT"Enter complete or partial ";
1700 PRINT"filespec of ITEM to be found "AQ"........"
1710 COLOR 1:INPUT AT:IF AT="*" THEN 970' Return to menu.
1720 FOR X=1 TO LEN(AT)
1730 IF ASC(MID$(AT,X,1))>96 THEN MID$(AT,X,1)=CHR$(ASC(MID$(AT,X,1))-32)
1740 NEXT
1750 FOR X=1 TO ENTRIES
1760 IF INSTR(A(X),AT)=0 OR LEFT$(A(X),12)=LEFT$(AX,12) THEN 1850
1770 AX=A(X)
1780 PRINT AV;LEFT$(A(X),12);AV" can be found on disks: ";
1790 FOR Y=X TO ENTRIES
1800 IF LEFT$(AX,12)=LEFT$(A(Y),12) THEN PRINT RIGHT$(A(Y),3)", ";:GOTO 1820
1810 Y=ENTRIES
1820 NEXT
1830 PRINT:PRINT:PRINT"Is this the ITEM you wanted to find ";
1840 GOSUB 610:IF ANSWER="Y"THEN 1870
1850 NEXT:PRINT:PRINT"I cannot locate any incidence of "AV;AT;AV". Try again."
1860 PRINT:GOTO 1690
1870 PRINT:PRINT"Do you want to RUN "AV;AX;AV" ";
1880 GOSUB 610:IF ANSWER="N" THEN 970
1890 ON ERROR GOTO 1910
1900 GOTO 1920
1910 IF ERR=53 THEN RESUME 1930 ELSE ON ERROR GOTO 0
1920 IF MID$(AX,10,3)="BAS" THEN RUN LEFT$(AX,12) ELSE 2000
1930 ON ERROR GOTO 1940:RUN "B:"+LEFT$(AX,12)
1940 IF ERR=53 THEN RESUME 1950 ELSE ON ERROR GOTO 0
1950 ON ERROR GOTO 0:COLOR 4:PRINT:BEEP:BEEP:PRINT"I cannot locate "AV;AX;AV;
1960 PRINT" on either drive "AV"A"AV" or drive "AV"B"AV"!!!"
1970 PRINT"Please check to see that Disk #";
1980 PRINT RIGHT$(AX,3)" is mounted and press any"
1990 PRINT"key to continue ";:COLOR 1:GOSUB 540:PRINT:GOTO 1870
2000 PRINT:PRINT"Since "AV;AX;AV" doesn't have the "AV".BAS"AV" extension,";
2010 PRINT "I can't RUN it!"
2020 PRINT"Press any key to return to the menu...("AV"*"AV" to jump to DOS) ";
2030 GOSUB 510:IF ANSWER<>"*"THEN 970 ELSE SYSTEM
2040 '****************************
2050 '**** ITEM ENTRY ROUTINE ****
2060 '****************************
2070 COLOR 4,7,7:CLS
2080 COLOR 1:PRINT AL;:COLOR 4
2090 PRINT TAB(27)"*** Item Entry Routine ***"
2100 COLOR 1:PRINT AL:COLOR 4
2110 LOCATE 12,1
2120 PRINT"Do you want to enter from the ";:COLOR 17:PRINT"K";:COLOR 4
2130 PRINT "eyboard or read a ";:COLOR 17:PRINT "D";:COLOR 4:PRINT "isk "AQ;
2140 COLOR 1
2150 GOSUB 510:COLOR 4
2160 IF ANSWER="*"THEN 970 ELSE IF ANSWER="k" OR ANSWER="K" THEN 2190
2170 IF ANSWER="D" OR ANSWER="d" THEN 2420
2180 LOCATE L,T:BEEP:GOTO 2150
2190 ' Keyboard item entry routine
2200 LOCATE 12,1:PRINT SPACE$(79)
2210 LOCATE 4,1
2220 PRINT AV".BAS"AV" is the default extension."
2230 PRINT "Enter filespec "AQ;:INPUT A:IF A="*"THEN 970
2240 IF LEN(A)>12 THEN BEEP:PRINT A" is too long !":GOTO 2230
2250 INPUT "Enter disk # ";AD
2260 IF VAL(AD)<1 OR VAL(AD)>999 THEN BEEP:GOTO 2250
2270 AD=RIGHT$("00"+AD,3)
2280 K=INSTR(A,".")
2290 IF K=0 THEN A=LEFT$(A+"       ",8)+".BAS":GOTO 2280
2300 A=LEFT$(MID$(A,1,K-1)+"       ",8)+RIGHT$(A,LEN(A)-(K-1))
2310 A=LEFT$(A+"   ",12)+AD
2320 FOR X=1 TO LEN(A)
2330 IF MID$(A,X,1)<"a" OR MID$(A,X,1)>"z" THEN 2350
2340 MID$(A,X,1)=CHR$(ASC(MID$(A,X,10))-32)
2350 NEXT
2360 PRINT"Is "AV;A;AV" correct ";
2370 GOSUB 610:IF ANSWER$="N"THEN 2230
2380 ENTRIES=ENTRIES+1
2390 A(ENTRIES)=A:A="":PRINT"Entered. Do you have any more entries ";
2400 IF ADRV="A:" THEN DRIVE=0 ELSE DRIVE=1
2410 GOSUB 610:IF ANSWER="N"THEN GOSUB 780:GOSUB 720:RUN ELSE 2220
2420 'Read disk entry routine
2430 LOCATE 12,1:PRINT SPACE$(79)
2440 LOCATE 4,1
2450 PRINT "Enter disk number to be read "AQ;
2460 INPUT ADISK:IF ADISK="*"THEN 970 ELSE DISK=VAL (ADISK)
2470 IF DISK<0 OR DISK>999 THEN BEEP:GOTO 2450
2480 ADISK=STR$(DISK):MID$(ADISK,1)="0":ADISK=RIGHT$("00"+ADISK,3)
2490 PRINT "Enter drive (A or B) (B is the default) ";
2500 GOSUB 510:ADRIVE=ANSWER$:IF ADRIVE=CHR$(13) THEN ADRIVE="B":GOTO 2550
2510 IF ADRIVE="A" OR ADRIVE="a" THEN 2540
2520 IF ADRIVE="B" OR ADRIVE="b" THEN 2540
2530 LOCATE L,T:BEEP:GOTO 2500
2540 IF ADRIVE="a" THEN ADRIVE="A" ELSE IF ADRIVE="b" THEN ADRIVE="B"
2550 LOCATE L,T:PRINT "? "ADRIVE
2560 PRINT:PRINT"Read disk #"ADISK" on drive "AV;ADRIVE;AV". Is this correct ";
2570 GOSUB 610:IF ANSWER$="N"THEN 2450
2580 PRINT"Deleting references to disk #"ADISK"......"
2590 FOR X=1 TO ENTRIES
2600 IF RIGHT$(A(X),3)=ADISK THEN A(X)=""
2610 NEXT
2620 '              ******************************************
2630 '            ***** Routine to Read a Disk's Directory *****
2640 '              ******************************************
2650 CLS
2660 PRINT AL;
2670 IF ADRIVE="A"THEN FILES ELSE FILES "B:*.*"
2680 PRINT:PRINT AL;
2690 FOR LN=2 TO 20
2700   FOR PT=1 TO 78 STEP 13
2710     K=(PT-1)*2+(LN-1)*160
2720     A=""
2730     IF PEEK(K)=32 THEN 2820
2740     FOR P=K TO K+23 STEP 2
2750       A=A+CHR$(PEEK(P))
2760       POKE P+1,14
2770     NEXT
2780   ENTRIES=ENTRIES+1
2790   A(ENTRIES)=A+ADISK
2800   NEXT
2810 NEXT
2820 PRINT:PRINT"Do you have another disk to read ";
2830 IF ADRV="A:" THEN DRIVE=0 ELSE DRIVE=1
2840 GOSUB 610:IF ANSWER$="N" THEN GOSUB 780:GOSUB 720:RUN ELSE CLS:GOTO 2440
2850 '          *****************************************************
2860 '          *   *** DELETE AN ITEM OR ENTIRE DISK ROUTINE ***   *
2870 '          *****************************************************
2880 COLOR 2,0,0:CLS
2890 PRINT AL;
2900 PRINT TAB(22)"*** DELETE AN ITEM OR DISK ROUTINE ***"
2910 PRINT AL;
2920 LOCATE 12,1
2930 PRINT"Delete an ";
2940 COLOR 20,7:PRINT"I";
2950 COLOR 2,0:PRINT"tem or an entire ";
2960 COLOR 20,7:PRINT"D";
2970 COLOR 2,0:PRINT"isk "AQ;
2980 COLOR 4,7:GOSUB 520:COLOR 2,0
2990 IF ANSWER$="*"THEN 970 ELSE IF ANSWER$="I" THEN 3050
3000 IF ANSWER$="i" THEN 3050
3010 IF ANSWER$="D" THEN 3190
3020 IF ANSWER$="d" THEN 3190
3030 SOUND 350,4:LOCATE L,T
3040 GOTO 2980
3050 '*** Item Delete ***
3060 LOCATE L,T:PRINT"? Item":PRINT
3070 PRINT"Enter complete or partial filespec of item to be deleted "AQ;
3080 INPUT AT:IF AT="*"THEN 970
3090 FOR X=1 TO ENTRIES
3100 IF INSTR(A(X),AT)<>0 THEN 3130
3110 NEXT
3120 PRINT"I can't locate "AV;AT;AV". Try again.":GOTO 3070
3130 PRINT"Is "AV;A(X);AV" the item you want to delete ";
3140 GOSUB 610:IF ANSWER$="N"THEN 3110
3150 A(X)="":PRINT"Deleted. Do you have any other items to delete ";
3160 GOSUB 610:IF ANSWER$="Y"THEN 3070
3170 IF ADRV="A:" THEN DRIVE=0 ELSE DRIVE=1
3180 GOSUB 700:RUN
3190 '*** Disk Delete ***
3200 PRINT"Enter number of disk to be deleted ";:INPUT D
3210 PRINT"Searching.......";
3220 FOR X=1 TO ENTRIES
3230 IF VAL(RIGHT$(A(X),3))=D THEN A(X)=""
3240 NEXT
3250 PRINT"Done."
3260 PRINT"Do you have any other disks to delete ";
3270 GOSUB 610:IF ANSWER$="Y"THEN 3200 ELSE 3170
3280 '**************************
3290 '*  *** LIST ROUTINE ***  *
3300 '**************************
3310 COLOR 4,3,3:CLS
3320 LOCATE 11,1:PRINT"Do you want the list Sorted by Disk number ";
3330 GOSUB 610:IF ANSWER$="Y"THEN GOSUB 910
3340 PRINT"List to ";
3350 COLOR 30,0:PRINT"C";
3360 COLOR 4,3:PRINT"RT or ";
3370 COLOR 30,0:PRINT"P";
3380 COLOR 4,3:PRINT"rinter ";
3390 GOSUB 520:IF ANSWER$="*"THEN 970
3400 IF ANSWER$="c" OR ANSWER$="C"THEN 3450
3410 IF ANSWER$="p" OR ANSWER$="P"THEN 3600
3420 SOUND 200,5
3430 LOCATE L,T
3440 GOTO 3390
3450 '*** List to CRT Routine ***
3460 WIDTH 40:COLOR 4,3,3:CLS:PAGE=0:BACK=0
3470 FOR X=1 TO ENTRIES
3480 IF X/22=INT(X/22) THEN 3570
3490 PRINT USING "###  ";X;
3500 COLOR 1
3510 PRINT LEFT$(A(X),12);:COLOR 4
3520 PRINT"  Disk # ";:COLOR 1:PRINT RIGHT$(A(X),3):COLOR 4
3530 NEXT
3540 LOCATE 25,1:COLOR 20,7
3550 PRINT"End of listing. Press any key ";
3560 GOSUB 520:GOTO 970
3570 COLOR 20,7
3580 LOCATE 25,1:PRINT"Press any key to continue ";
3590 GOSUB 520:COLOR 4,3:CLS:GOTO 3490
3600 '*** List to Printer ***
3601 PRINT:PRINT"Printing Directory .... Press any key to abort ....
3610 PAGES=INT(ENTRIES/162)+1
3620 AFMT="Disk: ### - \          \  "
3630 FOR PAGE=1 TO PAGES
3640   LPRINT:LPRINT
3650   LPRINT"Disk Directory        "DATE$",  "TIME$;TAB(65)"Page"PAGE"of"PAGES
3660   LPRINT STRING$(79,"-")
3670   FOR X=(PAGE-1)*162+1 TO (PAGE-1)*162+54
3680     FOR Y=0 TO 2
3690       IF A(X+Y*54)="" THEN 3710
3700       LPRINT USING AFMT;VAL(RIGHT$(A(X+Y*54),3)),LEFT$(A(X+Y*54),12);
3702       IF INKEY$<>"" THEN LPRINT CHR$(12):GOTO 970
3710     NEXT
3720     LPRINT
3730   NEXT
3740   LPRINT STRING$(79,"-")
3750   LPRINT CHR$(12)
3760 NEXT
10000 GOTO 970
10010 '******************************************************
10020 '*   *** Routine to list the Directory of a Disk ***  *
10030 '******************************************************
10040 CLS
10050 PRINT AL;
10060 PRINT TAB(20)"*** Display Disk Directory Routine ***"
10070 PRINT AL
10080 PRINT"Do you want an ";
10090 COLOR 31,0:PRINT"A";
10100 COLOR 6,1:PRINT"ctual Disk Directory or the ";
10110 COLOR 31,0:PRINT"D";
10120 COLOR 6,1:PRINT "ata of a Disk as stored by "AV"DIR"AV"."
10130 PRINT AQ;
10140 GOSUB 520:IF ANSWER$="*"THEN 970
10150 IF ANSWER$="A" OR ANSWER$="a" THEN 10180
10160 IF ANSWER$="D" OR ANSWER$="d" THEN 10290
10170 SOUND 234,5:LOCATE L,T:GOTO 10140
10180 '*** List Actual Directory ***
10190 LOCATE L,T:PRINT "? Actual Directory"
10200 PRINT"Enter drive "AV"A"AV" or "AV"B"AV" ";
10210 GOSUB 520:IF ANSWER$="*"THEN 970
10220 IF ANSWER$="a" OR ANSWER$="A"THEN ANSWER$="A":GOTO 10250
10230 IF ANSWER$="b" OR ANSWER$="B"THEN ANSWER$="B":GOTO 10250
10240 SOUND 231,5:LOCATE L,T:GOTO 10210
10250 LOCATE L,T:PRINT "? "ANSWER$
10260 PRINT AL:COLOR 0,2
10270 FILES ANSWER$+":*.*"
10280 COLOR 6,1:GOTO 10070
10290 LOCATE L,T:PRINT"? Data":PRINT "Enter disk number "AQ;
10300 INPUT AD:IF AD="*"THEN 970
10310 D=VAL(AD):C=0
10320 PRINT AL:COLOR 0,2
10330 FOR X=1 TO ENTRIES
10340 IF D<>VAL(RIGHT$(A(X),3))THEN 10380
10350 IF POS(0)>=78 THEN PRINT
10360 PRINT LEFT$(A(X),12)" ";
10370 C=C+1
10380 NEXT
10390 IF C=0 THEN PRINT"Disk number"D"isn't listed."
10400 GOTO 10280
10410 '********************************************************************
10420 '*          *** Backup Data File and/or Program Routine ***         *
10430 '********************************************************************
10440 IF BACK=1 THEN SCREEN ,,2,2:COLOR 6,1,1:GOTO 11000
10450 WIDTH 80:SCREEN 0,1,2,2:COLOR ,1,1:BACK=1
10460 CLS
10470 COLOR 6
10480 LOCATE 5,1,0
10490 PRINT CHR$(201)STRING$(78,205)CHR$(187);
10500 PRINT CHR$(186);
10510 COLOR 13
10520 PRINT TAB(13)"     *** Backup Data File and/or Program Routine ***";
10530 COLOR 6
10540 PRINT TAB(80)CHR$(186);
10550 PRINT CHR$(204)STRING$(78,205)CHR$(185);
10560 PRINT CHR$(186)TAB(13);
10570 COLOR 3:PRINT"Enter:"TAB(80):COLOR 6:PRINT CHR$(186);
10580 PRINT CHR$(186)TAB(19);
10590 COLOR 27:PRINT"1. ";:COLOR 3
10600 PRINT"To BACKUP the Data File to drive "AV"A"AV"."TAB(80);
10610 COLOR 6:PRINT CHR$(186);
10620 PRINT CHR$(186)TAB(19);
10630 COLOR 27:PRINT"2. ";:COLOR 3
10640 PRINT"To BACKUP the Data File to drive "AV"B"AV"."TAB(80);
10650 COLOR 6:PRINT CHR$(186);
10660 PRINT CHR$(186)TAB(19);
10670 COLOR 27:PRINT"3. ";:COLOR 3
10680 PRINT"To BACKUP the Data File to both drives."TAB(80);
10690 COLOR 6:PRINT CHR$(186);
10700 PRINT CHR$(186)TAB(19);
10710 COLOR 27:PRINT"4. ";:COLOR 3
10720 PRINT"To BACKUP this PROGRAM to drive "AV"A"AV"."TAB(80);
10730 COLOR 6:PRINT CHR$(186);
10740 PRINT CHR$(186)TAB(19);
10750 COLOR 27:PRINT"5. ";:COLOR 3
10760 PRINT"To BACKUP this PROGRAM to drive "AV"B"AV"."TAB(80);
10770 COLOR 6:PRINT CHR$(186);
10780 PRINT CHR$(186)TAB(19);
10790 COLOR 27:PRINT"6. ";:COLOR 3
10800 PRINT"To BACKUP this PROGRAM to both drives."TAB(80);
10810 COLOR 6:PRINT CHR$(186);
10820 PRINT CHR$(186)TAB(19);
10830 COLOR 27:PRINT"7. ";:COLOR 3
10840 PRINT"To BACKUP the Data file and this ";
10850 PRINT"PROGRAM to drive "AV"B"AV"."TAB(80);
10860 COLOR 6:PRINT CHR$(186);
10870 PRINT CHR$(186)TAB(19);
10880 COLOR 27:PRINT"8. ";:COLOR 3
10890 PRINT"To BACKUP the Data file and this PROGRAM to both drives."TAB(80);
10900 COLOR 6:PRINT CHR$(186);
10910 PRINT CHR$(186)TAB(19);
10920 COLOR 27:PRINT"9. ";:COLOR 3
10930 PRINT"To RETURN to the main MENU."TAB(80);
10940 COLOR 6:PRINT CHR$(186);
10950 PRINT CHR$(204)STRING$(78,205)CHR$(185);
10960 PRINT CHR$(186)TAB(27);
10970 COLOR 20,7:PRINT" *** ENTER YOUR CHOICE *** ";
10980 COLOR 6,1:PRINT TAB(80)CHR$(186);
10990 PRINT CHR$(200)STRING$(78,205)CHR$(188);
11000 BEEP
11010 CHOICE$=INKEY$:IF CHOICE$="" THEN 11010
11020 X=INSTR("123456789",CHOICE$):IF X=0 THEN 11000
11030 ON X GOSUB 11050,11060,11070,11080,11090,11100,11110,11120,970
11040 GOTO 10410
11050 DRIVE=0:GOSUB 700:RETURN
11060 DRIVE=1:GOSUB 700:DRIVE=0:RETURN
11070 GOSUB 11050:GOSUB 11060:RETURN
11080 SAVE"DIR":RETURN
11090 SAVE"B:DIR":RETURN
11100 GOSUB 11080:GOSUB 11090:RETURN
11110 GOSUB 11090:GOSUB 11060:RETURN
11120 GOSUB 11110:GOSUB 11080:GOSUB 11050:RETURN
11130 '******* RETURN TO DOS ROUTINE *******
11140 CLS
11150 SYSTEM