PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #22)
[PCjs Machine "ibm5150"]
Waiting for machine "ibm5150" to load....
Information about “CHECKDIR”
There are two versions of a sorted menu display program for BASIC
users on this disk. BMENU.BAS requires BASICA to run.
BMENUD.BAS will run with disk BASIC, but without the former's use
of function keys. The operating instructions are in the file
BMENU.DOC. The program LDIR.BAS lists a directory from BASIC.
LDIRC.BAS is used as input for the BASIC compiler. The CHECKDIR
program is used to compare diskette directories with a catalog
file generated by the XDIR 3.0 catalog program (restricted to DOS
160KB diskettes.
How to Start: To run an EXE program simply type it's name and press
<ENTER>. For instructions on running BASIC programs, please refer to the
GETTING STARTED section in this catalog. To read DOC files simply enter
TYPE filename.ext and press <ENTER>.
File Descriptions:
PC-MAP BAS A utility to help you use PC-FILE.
BMENU DOC Documentation for BMENU.BAS.
BMENU BAS Program to create menus for BASIC programs.
LDIR BAS List Directory /FAT.
CHECKDIR DOC Documentation for CHECKDIR.EXE.
CHECKDIR EXE Check a disk against catalog to see if duplicates.
BMENUD BAS Same as BMENU except uses Disk BASIC.
LDIRC BAS Input for BASIC COMPILER version of above.
BMENU.BAS
10 '
20 ' DO NOT RENUM OR RENAME OR COMPILE THIS PROGRAM.
30 '
40 ' BASIC MENU PROGRAM. VERSION 1.0
50 ' A MAXIMUM OF 112 BASIC FILES WILL BE HANDLED BY THIS PROGRAM.
60 ' SEE BMENU.DOC FOR MORE INFORMATION. BOB STEPHENS SAN JOSE 12/1/82
70 DEFINT A-Z:DIM ARRAY$(113)
80 DEF SEG=0:MN=PEEK(&H410) AND &H30:IF MN=&H30 THEN MN=1 ELSE MN=0
90 SCREEN 0:IF MN=0 THEN COLOR 14,1,4 ELSE COLOR 7,0
110 KEY OFF :KEY 10,"RUN"+CHR$(34)+"BMENU"+CHR$(13)
120 KEY 1,"UPDATE":KEY 2,"HELP":KEY 3,"BASIC":KEY 4,"DOS":KEY 5,"DATE"
130 KEY(1) ON:KEY(2) ON:KEY(3) ON:KEY(4) ON:KEY(5) ON
140 ON KEY(1) GOSUB 1210:ON KEY(2) GOSUB 1670:ON KEY(3) GOSUB 1730
150 ON KEY(4) GOSUB 1740:ON KEY(5) GOSUB 1720:KEY ON
160 ' THE FOLLOWING STATEMENTS WILL BE MODIFIED WITH F1
500 'BEGIN
505 KEY OFF
510 CLS:COLOR 0,7: PRINT " PROGRAM INFORMATION ":COLOR 7,0
520 PRINT "This program provides a sorted menu"
530 PRINT "display of the BASIC programs on your"
540 PRINT "diskette and allows for menu selected"
550 PRINT "execution of the BASIC programs."
560 PRINT " "
570 PRINT "Function key F1 is used whenever BASIC"
580 PRINT "programs are added or deleted from the"
590 PRINT "diskette. While F1 is slow to"
600 PRINT "execute the result will be a high"
610 PRINT "performance (for BASIC) menu program."
620 PRINT "F1 will create and kill file"
630 PRINT "BMENU.TMP and will modify itself."
640 PRINT "Be sure the default drive (set by DOS)"
650 PRINT "is the same as the drive containing"
660 PRINT "the menu program. See BMENU.DOC."
670 PRINT
680 COLOR 0,7:PRINT "Do not renum or change the name of this"
690 PRINT "program. This message will self "
700 PRINT "destruct (forever) when you ENTER. ":COLOR 7,0:PRINT
710 PRINT " BOB STEPHENS SAN JOSE 12/1/82"
720 PRINT
730 INPUT "Press ENTER to continue...",A$
740 GOTO 1210
999 ' END
1000 ' END OF MODIFIED AREA
1005 CLS:IF ARRAY$(64)="" THEN WIDTH 40 ELSE WIDTH 80
1010 P=0:I=0:CLS:LOCATE 1,4:COLOR 14,0
1020 PRINT "BASIC programs on this diskette:"
1030 FOR DC=1 TO 66 STEP 13
1040 FOR DR=3 TO 23
1050 I=I+1
1060 IF ARRAY$(I)="" THEN 1130 ELSE LOCATE DR,DC
1070 IF MN=1 THEN COLOR 0,7 ELSE COLOR 1,14,4
1080 PRINT USING "###";I;
1090 IF MN=1 THEN COLOR 7,0 ELSE COLOR 14,1,4
1100 PRINT " ";ARRAY$(I)
1110 NEXT DR
1120 NEXT DC
1130 LOCATE 24,1,1,7,11:PRINT "Enter number of program desired: ";:B$=""
1140 A$=INKEY$:IF A$="" THEN 1140 ELSE IF ASC(A$)=13 THEN 1160
1150 IF (ASC(A$)<48) OR (ASC(A$)>57) THEN 1130 ELSE PRINT A$;:B$=B$+A$:GOTO 1140
1160 P=VAL(B$):IF P < 1 OR P >= I THEN 160
1170 WIDTH 80:CLS:PRINT "Press F10 to return to menu when finished"
1180 PRINT "or enter RUN";:PRINT CHR$(34);:PRINT "BMENU if F10 is changed."
1190 GOSUB 1650:ON ERROR GOTO 1750:RUN ARRAY$(P)
1200 ' MENU UPDATE AREA
1210 WIDTH 80:ON ERROR GOTO 1620
1220 KILL "BMENU.TMP"
1230 ON ERROR GOTO 0
1240 CLS:FILES "*.BAS":AR=0
1250 PRINT:PRINT:PRINT "Reading files":PRINT
1260 FOR I=1 TO 113
1270 ARRAY$(I)=""
1280 NEXT I
1290 FOR DR=1 TO 24
1300 FOR DC=0 TO 65 STEP 13
1310 IF CHR$(SCREEN(DR,DC+1)) = " " THEN 1390
1320 AR=AR+1:IF AR=113 THEN PRINT "To many files":END
1330 FOR L=1 TO 8
1340 ARRAY$(AR)=ARRAY$(AR)+CHR$(SCREEN(DR,DC+L))
1350 NEXT L
1360 NEXT DC
1370 NEXT DR
1380 ' SORT
1390 CKSW=1:PRINT "Sorting in BMENU.TMP";
1400 WHILE CKSW=1:CKSW=0
1410 FOR I=2 TO AR
1420 IF ARRAY$(I-1)>ARRAY$(I) THEN CKSW=1:SWAP ARRAY$(I-1),ARRAY$(I)
1430 NEXT I
1440 WEND
1450 ON ERROR GOTO 1580
1460 OPEN "BMENU.TMP" FOR OUTPUT AS #1
1470 ON ERROR GOTO 0
1480 PRINT #1,"500 'BEGIN"
1490 FOR I=1 TO AR
1500 PRINT #1,STR$(I+500) + " ARRAY$(" + STR$(I) + " )=" + CHR$(34) + ARRAY$(I) + CHR$(34)
1510 NEXT I
1520 PRINT #1,"999 'END"
1530 ON ERROR GOTO 1630
1540 CLOSE
1550 CHAIN MERGE "BMENU.TMP",1560,ALL,DELETE 500-999
1560 KILL "BMENU.TMP":SAVE "BMENU
1570 RUN"BMENU
1580 IF (ERR=70) AND (ERL=1460) THEN RESUME 1590 ELSE ON ERROR GOTO 0
1590 CLS:PRINT "The disk is write protected!"
1600 PRINT "Remove tab and press F10 or abort the program.":PRINT
1610 GOSUB 1650:END
1620 IF (ERR=53) AND (ERL=1220) THEN RESUME NEXT ELSE ON ERROR GOTO 0
1630 IF (ERR=5) AND (ERL=1550) THEN RESUME 1640 ELSE ON ERROR GOTO 0
1640 ON ERROR GOTO 0:CHAIN MERGE "BMENU.TMP",1560,ALL:GOTO 1560
1650 KEY OFF:KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34)
1660 KEY 4,"SAVE"+CHR$(34):KEY 5,"CONT"+CHR$(13):KEY ON:RETURN
1670 CLS:PRINT "Exit to DOS and enter TYPE BMENU.DOC to"
1680 PRINT "display the information distributed"
1690 PRINT "with this program."
1700 ON ERROR GOTO 0:PRINT:PRINT "Press any key to continue...";
1710 A$=INKEY$:IF A$="" THEN 1710 ELSE RETURN 90
1720 CLS:PRINT:PRINT "DATE: " DATE$ " TIME: " TIME$:GOTO 1700
1730 WIDTH 80:GOSUB 1650:END
1740 SYSTEM
1750 IF (ERR=53) AND (ERL=1190) THEN GOTO 1760 ELSE ON ERROR GOTO 0
1760 PRINT:PRINT "File " ARRAY$(P) ".BAS not found":RESUME 1700
BMENU.DOC
BASIC MENU (BMENU) PROGRAM FOR THE IBM PC
VERSION 1.0
The program BMENU provides a sorted menu display of the BASIC programs
on your diskette and allows for menu selected execution of the BASIC
programs.
Two versions of BMENU are supplied. BMENU.BAS requires Advanced BASIC
and uses function keys F1-F5 while BMENUD.BAS will run on Disk BASIC
without the use of F1-F5. BMENU is also larger in size than BMENUD.
The remainder of this document refers to both versions with significant
differences noted.
BMENU (BMENUD) is easy to use and only requires that you copy the
program onto your diskette containing your BASIC programs. First time
execution of the program will display some tutorial information. Read
this information before continuing as it will be overwritten and never
displayed again (unless of course the diskette is write protected).
Speaking of writing to your diskette - BMENU (BMENUD) does indeed write
to your diskette and you should be aware of the following: BMENU
(BMENUD) as distributed knows nothing about which BASIC files are
contained on your diskette. After the tutorial information mentioned
above is displayed the following steps are executed to capture and
retain the names of the BASIC programs on your diskette.
1. Clear the screen
2. Issue the files"*.bas command
3. Read the file names from the screen
4. Sort the file names
5. Kill"bmenu.tmp if it exists
6. Save the file names in bmenu.tmp
7. Merge bemnu.tmp into lines 500-999
8. Save"bmenu.bas (or bmenud.bas)
9. Kill"bmenu.tmp
10. Display the updated menu
Every attempt has been made to ensure that the program works correctly
without causing unwanted side effects or loss of data. However, you
would be wise to first try the program on a backed-up diskette until
you are sure you have received a complete and working copy. You can
also execute the above steps by entering option F1 after you add or
delete BASIC programs from your diskette. Option F1 is the slowest
executing part of BMENU but produces a fast (for BASIC) menu display
when completed. If you are not adding or deleting BASIC programs from
your diskette then option F1 is only executed once. For BMENUD the
update option is executed by entering a 99 (instead of F1) for the
program number.
BMENU changes the definition of function key F10 to run"bmenu (ENTER)
so that you may easily return to BMENU by pressing F10 after executing
your BASIC program. If however, your BASIC program changes the
definition of F10 then type run"bmenu (ENTER) to run BMENU. For
BMENUD use F10 or run"bmenud (ENTER).
The program was written for 40 character displays and works equally
well on 80 character displays. Before executing a BASIC program the
screen is switched to WIDTH 80. If you want to stay in WIDTH 40 then
change the line WIDTH 80:CLS:PRINT "Press etc. to WIDTH 40: (CAUTION -
be sure to make a backup copy of your diskette first). Do not change
other WIDTH statements in the program. Run the program and enter F1
(option 99 for BMENUD.BAS) and your modified program will be saved.
For double sided diskettes containing more than 63 BASIC programs
(up to 112) the display is changed to WIDTH 80.
The menu is defined to display in reverse video on the monochrome
monitor and uses color on color monitors. BMENU has a more elaborate
color display than BMENUD.
The function keys F1-F5 have been defined for BMENU (not availale for
BMENUD) to the following:
1. F1 - Update BMENU
2. F2 - Help
3. F3 - Return to BASIC
4. F4 - Return to DOS
5. F5 - Display the date and time
Do NOT renum, compile or change the name BMENU (BMENUD) or otherwise
modify the program since it is self modifying, line number dependent
and not very tolerant of program bugs.
Bob Stephens
San Jose, Ca.
12/1/82
BMENUD.BAS
10 '
20 ' DO NOT RENUM OR RENAME OR COMPILE THIS PROGRAM.
30 '
40 ' BASIC MENU PROGRAM. VERSION 1.0
50 ' A MAXIMUM OF 112 BASIC FILES WILL BE HANDLED BY THIS PROGRAM.
60 ' SEE BMENU.DOC FOR MORE INFORMATION. BOB STEPHENS SAN JOSE 12/1/82
70 DEFINT A-Z
80 DIM ARRAY$(113)
90 SCREEN 0:KEY OFF :KEY 10,"RUN"+CHR$(34)+"BMENUD"+CHR$(13)
110 ' THE FOLLOWING STATEMENTS WILL BE MODIFIED WITH OPTION 99
500 'BEGIN
510 CLS:COLOR 0,7: PRINT " PROGRAM INFORMATION ":COLOR 7,0
520 PRINT "This program provides a sorted menu"
530 PRINT "display of the BASIC programs on your"
540 PRINT "diskette and allows for menu selected"
550 PRINT "execution of the BASIC programs."
560 PRINT " "
570 PRINT "Option 99 is used whenever BASIC"
580 PRINT "programs are added or deleted from the"
590 PRINT "diskette. While option 99 is slow to"
600 PRINT "execute the result will be a high"
610 PRINT "performance (for BASIC) menu program."
620 PRINT "Option 99 will create and kill file"
630 PRINT "BMENU.TMP and will modify itself."
640 PRINT "Be sure the default drive (set by DOS)"
650 PRINT "is the same as the drive containing"
660 PRINT "the menu program."
670 PRINT
680 COLOR 0,7:PRINT "Do not renum or change the name of this"
690 PRINT "program. This message will self "
700 PRINT "destruct (forever) when you ENTER. ":COLOR 7,0:PRINT
710 PRINT " BOB STEPHENS SAN JOSE 12/1/82"
720 PRINT
730 INPUT "Press ENTER to continue...",A$
740 GOTO 1190
999 ' END
1000 ' END OF MODIFIED AREA
1005 CLS:IF ARRAY$(64)="" THEN WIDTH 40 ELSE WIDTH 80
1010 P=0:I=0:CLS:LOCATE 1,4:COLOR 14,0
1020 PRINT "BASIC programs on this diskette:"
1030 FOR DC=1 TO 66 STEP 13
1040 FOR DR=3 TO 23
1050 I=I+1
1060 IF ARRAY$(I)="" THEN 1110 ELSE LOCATE DR,DC
1070 COLOR 0,7:PRINT USING "###";I;
1080 COLOR 7,0:PRINT " ";ARRAY$(I)
1090 NEXT DR
1100 NEXT DC
1110 LOCATE 24,1:PRINT "Enter 99 to update menu";
1120 LOCATE 25,1:INPUT "Enter number of program desired: ",P
1130 IF P < 1 OR P >= I THEN 1170
1140 WIDTH 80:CLS:PRINT "Press F10 to return to menu when finished"
1150 PRINT "or enter RUN";:PRINT CHR$(34);:PRINT "BMENUD if F10 is changed."
1160 RUN ARRAY$(P)
1170 IF P=99 THEN 1190 ELSE 110
1180 ' MENU UPDATE AREA
1190 WIDTH 80:ON ERROR GOTO 1640
1200 KILL "BMENU.TMP"
1210 ON ERROR GOTO 0
1220 CLS
1230 FILES "*.BAS":AR=0
1240 PRINT:PRINT:PRINT "Reading files":PRINT
1250 FOR I=1 TO 113
1260 ARRAY$(I)=""
1270 NEXT I
1280 FOR DR=1 TO 24
1290 FOR DC=0 TO 65 STEP 13
1300 IF CHR$(SCREEN(DR,DC+1)) = " " THEN 1380
1310 AR=AR+1:IF AR=113 THEN PRINT "To many files":END
1320 FOR L=1 TO 8
1330 ARRAY$(AR)=ARRAY$(AR)+CHR$(SCREEN(DR,DC+L))
1340 NEXT L
1350 NEXT DC
1360 NEXT DR
1370 ' SORT
1380 CKSW=1
1390 PRINT "Sorting in BMENU.TMP";
1400 WHILE CKSW=1:CKSW=0
1410 FOR I=2 TO AR
1420 IF ARRAY$(I-1)>ARRAY$(I) THEN CKSW=1:SWAP ARRAY$(I-1),ARRAY$(I)
1430 NEXT I
1440 WEND
1450 ON ERROR GOTO 1600
1460 OPEN "BMENU.TMP" FOR OUTPUT AS #1
1470 ON ERROR GOTO 0
1480 PRINT #1,"500 'BEGIN"
1490 FOR I=1 TO AR
1500 IF ARRAY$(I)="" THEN 1530
1510 PRINT #1,STR$(I+500) + " ARRAY$(" + STR$(I) + " )=" + CHR$(34) + ARRAY$(I) + CHR$(34)
1520 NEXT I
1530 PRINT #1,"999 'END"
1540 ON ERROR GOTO 1650
1550 CLOSE
1560 CHAIN MERGE "BMENU.TMP",1570,ALL,DELETE 500-999
1570 KILL "BMENU.TMP"
1580 SAVE "BMENUD
1590 GOTO 90
1600 IF (ERR=70) AND (ERL=1460) THEN RESUME 1610 ELSE ON ERROR GOTO 0
1610 CLS:PRINT "The disk is write protected!"
1620 PRINT "Remove tab and press F10 or abort the program.":PRINT
1630 KEY ON:END
1640 IF (ERR=53) AND (ERL=1200) THEN RESUME NEXT ELSE ON ERROR GOTO 0
1650 IF (ERR=5) AND (ERL=1560) THEN RESUME 1660 ELSE ON ERROR GOTO 0
1660 ON ERROR GOTO 0:CHAIN MERGE "BMENU.TMP",1570,ALL:GOTO 1570
CHECKDIR.DOC
CHECKDIR - Compare Directory with XDIR Catalog
Russ Williams, San Jose PC Club
CHECKDIR reads diskette directories and compares them with a given
catalog file, as produced by XDIR 3.0.
OPERATION: To run the program, make sure DOS is active and the
diskette containing CHECKDIR.EXE is in the default drive, and
type
CHECKDIR fileid [outputid]
where "fileid" is the id of the XDIR catalog file (including the
"DAT" extension), and "outputid" is the id of the output file
(shown in brackets to indicate that it is optional). If
"outputid" is omitted, it defaults to "con:". Type "lpt1:" to
print on the printer. If neither parameter is included, the
program will display "PARMLIST:" and wait for you to type in the
parameter(s).
The remainder is repeated for each diskette to be tested.
CHECKDIR will display the message "Enter the name of the diskette
to be tested, or null". Insert a diskette in drive B and enter
its name, or else just press the ENTER key to end the program.
METHOD: The test diskette's directory is read into main storage,
and each entry in the catalog file is checked against the
directory. If a file-id match is found, both the catalog entry
and the directory entry are displayed. Example:
--------------------------------
PACMAN .BAS 10/28/82 TESTDISK
PACMAN .BAS 8/29/81 ADX000X
--------------------------------
Note that the ordering of this list will reflect the ordering of
the XDIR catalog. When the entire catalog has been read, a
separate list is displayed showing any directory entries that
were never matched.
RESTRICTIONS: CHECKDIR runs under DOS, and currently handles only
DOS 160KB diskettes. The catalog to be referenced must be the same
format as is written by XDIR30. (This format is not compatible
with previous versions of XDIR.)
nced must be the same
format as is written b
CRC.TXT
PC-SIG Disk No. #22, version v1.1
The following is a list of the file checksums which should be produced by
the CRCK4 program on disk #9 (and others). If the CRC numbers do not match
you may have a bad file. To use type: CRCK4 <filespec>
CRCK4 output for this disk:
CRCK ver 4.2B (MS DOS VERSION )
CTL-S pauses, CTL-C aborts
--> FILE: PC-MAP .BAS CRC = C9 96
--> FILE: CHECKDIR.EXE CRC = 44 A1
--> FILE: CHECKDIR.DOC CRC = D8 74
--> FILE: LDIR .BAS CRC = 0B F3
--> FILE: BMENU .BAS CRC = FB 64
--> FILE: BMENUD .BAS CRC = 55 F6
--> FILE: BMENU .DOC CRC = A3 13
--> FILE: LDIRC .BAS CRC = 7C 44
---------------------> SUM OF CRCS = 63 4F
DONE
These and other Public Domain and user-supported programs from:
PC Software Interest Group
1125 Stewart Ct Suite G
Sunnyvale, CA 94086
(408) 730-9291
LDIR.BAS
10 'Display File Allocation Table and Directory
20 CLS 'Requires Advanced Basic with 512 byte file buffer: BASICA /S:512
30 ON ERROR GOTO 60 :COM(1) OFF :ON ERROR GOTO 0
40 CLEAR ,16384! ' by J.L. Aker - San Jose CA
50 IF VARPTR(#2)-VARPTR(#1) > 699 THEN 90
60 PRINT"Hold it! You didn't call Basica with /s: 512"
70 PRINT"Reload: Basica /s:512"
80 SYSTEM
90 DEFINT B,D,F,I,T,S,K,N,R
100 C$=STRING$(28,"1") 'dummy string for code
110 DIM SS(318),NA$(112) : CR$=CHR$(13)
120 INPUT"Drive, A or B";SG$
130 IF SG$="b" OR SG$="B" THEN DRV=1
140 INPUT"Screen or Printer, S or P";SG$
150 IF SG$="p" OR SG$="P" THEN DEV$="LPT1:" ELSE DEV$="SCRN:" : GOTO 180
160 INPUT"Condensed print, Y or N";SG$
170 IF SG$="n" OR SG$="N" THEN SG$="2"+CHR$(18) ELSE SG$="0"+CHR$(15)
180 INPUT"Skip Deleted Directory slots, Y or N";DS$
190 OPEN DEV$ FOR OUTPUT AS 1
200 IF DEV$="LPT1:" THEN LPRINT CHR$(27);SG$;
210 DATA 16,BA,00,00,B9,04,00,B8
220 DATA 79,0E,8B,D8,B8,01,02,CD
230 DATA 13,B7,00,8A,DC,9A,07,00
240 DATA 00,F6,17,CB
250 OFS=VARPTR(C$) 'string descriptor
260 OFC=PEEK(OFS+2)*256+PEEK(OFS+1) 'address of code
270 DEF USR0=OFC 'point to code and move in code bytes
280 FOR I = 0 TO LEN(C$)-1
290 READ S$
300 POKE OFC+I,VAL("&h"+S$)
310 NEXT I
320 OT=OFC+6 : OS=OFC+5 : OH=OFC+3
330 SOFS=VARPTR(#2)+188
340 POKE OFC+8,SOFS AND &HFF : POKE OFC+9,SOFS\256
350 'get fat sector
360 POKE OT,0 :POKE OS,2 :POKE OFC+2,DRV
370 GOSUB 1110 ' read sector
380 N=0 'Get the data bytes in array SS; SS(0)=4095 => 320kb format
390 FOR I = 0 TO 474 STEP 3
400 B1=PEEK(I+SOFS)
410 B2=PEEK(I+1+SOFS)
420 B3=PEEK(I+2+SOFS)
430 SS(N)=B1+(B2 AND &HF)*256
440 SS(N+1)=(B2 AND &HF0)\16+B3*16
450 N=N+2
460 NEXT I
470 IF SS(0)=4095 THEN DSD=-1 ELSE DSD=0
480 PRINT #1, "File Allocation Table:";CR$;" ";
490 FOR I=0 TO 15 :PRINT #1, USING"\ \";" --"+HEX$(I); :NEXT I
500 PRINT #1, SPC(3);"Tracks"
510 PRINT #1, "00- "; :T=0
520 FOR I=0 TO 314-DSD*2 STEP 16
530 FOR K=0 TO 15
540 IF SS(I+K)=0 THEN FSEC=FSEC+1
550 PRINT #1, USING "\ \";RIGHT$("00"+HEX$(SS(I+K)),3);
560 IF I+K=314-DSD*2 THEN 600
570 NEXT K
580 PRINT #1, USING "###";T;T+1;T+2
590 PRINT #1, RIGHT$("0"+HEX$((I+16)\16),2)"- "; :T=T+2
600 NEXT I
610 PRINT #1, SPC(20+DSD*8);
620 PRINT #1, USING "###";T;T+1 :PRINT #1," ";SPC(1-DSD);
630 IF DSD THEN 660
640 FOR I=5 TO 20 : PRINT#1,RIGHT$(" "+STR$((I MOD 8)+1),4); :NEXT I
650 PRINT #1," << Sectors" :GOTO 730
660 FOR H=.9 TO 4 STEP .2
670 FOR S=7 TO 14 STEP 2
680 PRINT#1,STR$(INT(H) MOD 2);":";RIGHT$(STR$(S MOD 8),1);
690 H=H+.2
700 NEXT S,H
710 PRINT#1," << Hd:Sec"
720 PRINT#1," ";
730 ' Get the Directory
740 HD$="Name Ext MM/DD/YY HH:MM S/C Length"
750 FOR S=3 TO 6-3*DSD
760 IF S>7 THEN POKE OH,1
770 POKE OS,(S MOD 8)+1
780 GOSUB 1110 ' read sector
790 FOR I=0 TO 15
800 N$=""
810 FOR X=0 TO 31
820 N$=N$+CHR$(PEEK(I*32+X+SOFS))
830 NEXT X
840 NA$((S-3)*16+I)=N$
850 NEXT I
860 NEXT S
870 PRINT #1, FSEC;"Free S/C,";512*(1-DSD)*FSEC;"Bytes free"
880 PRINT #1,"Directory:";CR$;HD$;" ";HD$
890 FOR I=0 TO 63-DSD*48
900 IF LEFT$(NA$(I),1)<>CHR$(&HE5) THEN 930
910 IF MID$(NA$(I),2,1)=CHR$(&HF6) THEN I=64-DSD*48 : GOTO 1060
920 IF DS$="n" OR DS$="N" THEN MID$(NA$(I),1,1)="*" ELSE 1070
930 PRINT #1, LEFT$(NA$(I),8);" ";MID$(NA$(I),9,3);
940 B1=ASC(MID$(NA$(I),25,1)) : B2=ASC(MID$(NA$(I),26,1))
950 B3=ASC(MID$(NA$(I),28,1)) : B4=ASC(MID$(NA$(I),27,1))
960 B5=ASC(MID$(NA$(I),32,1)) : B6=ASC(MID$(NA$(I),31,1))
970 B7=ASC(MID$(NA$(I),30,1)) : B8=ASC(MID$(NA$(I),29,1))
980 B9=ASC(MID$(NA$(I),23,1)) : BA=ASC(MID$(NA$(I),24,1))
990 PRINT #1," ";RIGHT$(STR$(100+(B1 AND &HE0)\32+(B2 AND 1)*8),2);
1000 PRINT #1,"-";RIGHT$(STR$(100+(B1 AND &H1F)),2);
1010 PRINT #1,"-";RIGHT$(STR$((B2 AND &HFE)\2+80),2);
1020 PRINT #1," ";RIGHT$(STR$(100+BA\8),2);
1030 PRINT #1,":";RIGHT$(STR$(100+B9\32+(BA AND &H7)*8),2);
1040 PRINT #1, USING "\ \";" "+RIGHT$("00"+HEX$(B3*256+B4),3);
1050 PRINT #1, USING "#######";(B5*256+B6)*65536!+B7*256+B8;
1060 IF POS(0)>72 THEN PRINT #1, ELSE PRINT #1, " ";
1070 NEXT I
1080 IF DEV$="LPT1:" THEN LPRINT CR$;DATE$,TIME$;CHR$(27)"2";CHR$(18);CHR$(12)
1090 CLOSE #1
1100 END
1110 RET=USR0(0)
1120 IF RET<>0 THEN RET=USR0(0) 'do a retry on error
1130 IF RET<>0 THEN PRINT"Disk error status: ";RIGHT$("0"+HEX$(RET),2) :END
1140 RETURN
1150 SAVE "LDIR.BAS"
LDIRC.BAS
10 REM for compilation only - not to be interpreted
20 'Display File Allocation Table and Directory
30 CLS :CLEAR ' by J.L. Aker - San Jose CA
40 DEFINT B,D,F,I,T,S,K,N,R :DEF SEG
50 C$=STRING$(28,"1") 'dummy string for code
60 BFR$=STRING$(512,"1") 'buffer for data
70 DIM SS(318),NA$(112) : CR$=CHR$(13)
80 INPUT"Drive, A or B";SG$
90 IF SG$="b" OR SG$="B" THEN DRV=1
100 INPUT"Screen or Printer, S or P";SG$
110 IF SG$="p" OR SG$="P" THEN DEV$="LPT1:" ELSE DEV$="SCRN:" : GOTO 140
120 INPUT"Condensed print, Y or N";SG$
130 IF SG$="n" OR SG$="N" THEN SG$="2"+CHR$(18) ELSE SG$="0"+CHR$(15)
140 INPUT"Skip Deleted Directory slots, Y or N";DS$
150 OPEN DEV$ FOR OUTPUT AS 1
160 IF DEV$="LPT1:" THEN LPRINT CHR$(27);SG$;
170 DATA 16,BA,00,00,B9,04,00,B8
180 DATA 79,0E,8B,D8,B8,01,02,CD
190 DATA 13,B7,00,8A,DC,9A,07,00
200 DATA 00,F6,17,CB
210 OFS=VARPTR(C$) 'string descriptor
220 OFC=PEEK(OFS+3)*256+PEEK(OFS+2) 'address of code
230 DEF USR0=OFC 'point to code and move in code bytes
240 FOR I = 0 TO LEN(C$)-1
250 READ S$
260 POKE OFC+I,VAL("&h"+S$)
270 NEXT I
280 OT=OFC+6 : OS=OFC+5 : OH=OFC+3
290 SPTR=VARPTR(BFR$)
300 SOFS=PEEK(SPTR+3)*256+PEEK(SPTR+2)
310 POKE OFC+8,SOFS AND &HFF : POKE OFC+9,SOFS\256
320 'get fat sector
330 POKE OT,0 :POKE OS,2 :POKE OFC+2,DRV
340 GOSUB 1110 ' read sector
350 N=0 'Get the data bytes in array SS; SS(0)=4095 => 320kb format
360 FOR I = 0 TO 474 STEP 3
370 B1=PEEK(I+SOFS)
380 B2=PEEK(I+1+SOFS)
390 B3=PEEK(I+2+SOFS)
400 SS(N)=B1+(B2 AND &HF)*256
410 SS(N+1)=(B2 AND &HF0)\16+B3*16
420 N=N+2
430 NEXT I
440 IF SS(0)=4095 THEN DSD=-1 ELSE DSD=0
450 PRINT #1, "File Allocation Table:";CR$;" ";
460 FOR I=0 TO 15 :PRINT #1, USING"\ \";" --"+HEX$(I); :NEXT I
470 PRINT #1, SPC(3);"Tracks"
480 PRINT #1, "00- "; :T=0
490 FOR I=0 TO 314-DSD*2 STEP 16
500 FOR K=0 TO 15
510 IF SS(I+K)=0 THEN FSEC=FSEC+1
520 PRINT #1, USING "\ \";RIGHT$("00"+HEX$(SS(I+K)),3);
530 IF I+K=314-DSD*2 THEN 570
540 NEXT K
550 PRINT #1, USING "###";T;T+1;T+2
560 PRINT #1, RIGHT$("0"+HEX$((I+16)\16),2)"- "; :T=T+2
570 NEXT I
580 PRINT #1, SPC(20+DSD*8);
590 PRINT #1, USING "###";T;T+1 :PRINT #1," ";SPC(1-DSD);
600 IF DSD THEN 630
610 FOR I=5 TO 20 : PRINT#1,RIGHT$(" "+STR$((I MOD 8)+1),4); :NEXT I
620 PRINT #1," << Sectors" :GOTO 700
630 FOR H=.9 TO 4 STEP .2
640 FOR S=7 TO 14 STEP 2
650 PRINT#1,STR$(INT(H) MOD 2);":";RIGHT$(STR$(S MOD 8),1);
660 H=H+.2
670 NEXT S,H
680 PRINT#1," << Hd:Sec"
690 PRINT#1," ";
700 ' Get the Directory
710 HD$="Name Ext MM/DD/YY HH:MM S/C Length"
720 FOR S=3 TO 6-3*DSD
730 IF S>7 THEN POKE OH,1
740 POKE OS,(S MOD 8)+1
750 GOSUB 1110 ' read sector
760 FOR I=0 TO 15
770 N$=""
780 FOR X=0 TO 31
790 N$=N$+CHR$(PEEK(I*32+X+SOFS))
800 NEXT X
810 NA$((S-3)*16+I)=N$
820 NEXT I
830 NEXT S
840 CNT#=512#*(1-DSD)*FSEC
850 PRINT #1, FSEC;"Free S/C,";CNT#;"Bytes free"
860 PRINT #1,"Directory:";CR$;HD$;" ";HD$
870 FOR I=0 TO 63-DSD*48
880 IF LEFT$(NA$(I),1)<>CHR$(&HE5) THEN 910
890 IF MID$(NA$(I),2,1)=CHR$(&HF6) THEN I=64-DSD*48 : GOTO 1040
900 IF DS$="n" OR DS$="N" THEN MID$(NA$(I),1,1)="*" ELSE 1050
910 PRINT #1, LEFT$(NA$(I),8);" ";MID$(NA$(I),9,3);
920 B1=ASC(MID$(NA$(I),25,1)) : B2=ASC(MID$(NA$(I),26,1))
930 B3=ASC(MID$(NA$(I),28,1)) : B4=ASC(MID$(NA$(I),27,1))
940 B5!=ASC(MID$(NA$(I),32,1)) : B6!=ASC(MID$(NA$(I),31,1))
950 B7!=ASC(MID$(NA$(I),30,1)) : B8!=ASC(MID$(NA$(I),29,1))
960 B9=ASC(MID$(NA$(I),23,1)) : BA=ASC(MID$(NA$(I),24,1))
970 PRINT #1," ";RIGHT$(STR$(100+(B1 AND &HE0)\32+(B2 AND 1)*8),2);
980 PRINT #1,"-";RIGHT$(STR$(100+(B1 AND &H1F)),2);
990 PRINT #1,"-";RIGHT$(STR$((B2 AND &HFE)\2+80),2);
1000 PRINT #1," ";RIGHT$(STR$(100+BA\8),2);
1010 PRINT #1,":";RIGHT$(STR$(100+B9\32+(BA AND &H7)*8),2);
1020 PRINT #1, USING "\ \";" "+RIGHT$("00"+HEX$(B3*256+B4),3);
1030 PRINT #1, USING "#######";(B5!*256+B6!)*65536!+B7!*256+B8!;
1040 IF POS(0)>72 THEN PRINT #1, ELSE PRINT #1, " ";
1050 NEXT I
1060 IF DEV$="LPT1:" THEN LPRINT CR$;DATE$,TIME$;CHR$(27)"2";CHR$(18);CHR$(12)
1070 CLOSE #1 : LOCATE 25,1
1080 INPUT "Run again, Y or N";Q$
1090 IF Q$="y" OR Q$="Y" THEN GOTO 30
1100 cls:END
1110 RET=USR0(0)
1120 IF RET<>0 THEN RET=USR0(0) 'do a retry on error
1130 IF RET<>0 THEN PRINT"Disk error status: ";RIGHT$("0"+HEX$(RET),2) :END
1140 RETURN
PC-MAP.BAS
1 '*********************************************************************
2 '* PC-MAP. This program recreates a PC-File database into a new *
3 '* Format. Fields may be added or deleted, renamed, *
4 '* rearranged, and lengthened or shortened. Output is a *
5 '* Data file and Header file. After using PC-File to *
6 '* sort the file (thus creating a new index), the new *
7 '* database is ready to go. *
8 '* (1982) by F. Neil Lamka. *
9 '*********************************************************************
10 DEFINT A-Z:COMMON F$,DL,XL,NR
20 CLS:RC=80
25 ERCOUNT = 0
30 FALSE=0:TRUE=1
40 MC=RC\2:F9=RC\2+2
50 SCREEN 0,0:COLOR 7,0
60 WIDTH RC:KEY OFF
70 DIM OFM$(42),OFL(42) 'set up arrays for field names and lengths
80 DIM NFM$(42),NFL(42) 'set up arrays for new data base
90 CLS:LOCATE 10,MC-9:PRINT"PC-MAP Version 1.4";
95 LOCATE 12,MC-17:PRINT"A PC-FILE Data Base Conversion Aid";
100 LOCATE 14,MC-11:PRINT"(1982) F. Neil Lamka"
110 DR$="Which drive (ABCD) contains the origional data base? "
120 CL = 0
130 UC=1:GOSUB 20000
140 IF DR$<"A" OR DR$>"D" GOTO 110
150 OF$ = DR$+":" 'set file name for old data base
155 TF$=OF$
160 DR$="Which drive (ABCD) will contain the new data base? "
170 CL = -3 'set value for message color (15-3)
180 UC=1:GOSUB 20000
190 CL = 0 'reset line color value
200 IF DR$<"A" OR DR$>"D" GOTO 160
210 NF$ = DR$+ ":" 'set file name for new data base
220 ON ERROR GOTO 250
230 CLS:LOCATE 5,1:PRINT"Choose one of these files to convert:"
240 FILES OF$+"*.HDR":GOSUB 30000:ON ERROR GOTO 0:GOTO 260
250 RESUME 260
260 DR$="Which file:":UC=1:GOSUB 20000
270 IF DR$="" THEN 260 ELSE OF$ = TF$ + DR$ 'set file name to be used
280 ON ERROR GOTO 330
290 VL$=".HDR":FILES OF$+VL$ 'see if the hdr file exists
300 VL$=".DTA":FILES OF$+VL$ 'see if the data file exists
310 ON ERROR GOTO 0
320 CLS:GOTO 360 'go get new file name
330 RESUME 340
340 ON ERROR GOTO 0:DR$=OF$+VL$+" does not exist...please respecify: "
341 CL=-4:UC=1:SOUND 500,9:GOSUB 20000:CL=0
342 IF DR$="" THEN 260 ELSE OF$=TF$+DR$
350 GOTO 280
360 TF$=NF$
365 DR$="Enter name for new data base: ":CL= -3:UC=1:GOSUB 20000
370 IF DR$="" THEN 360 ELSE NF$=NF$+DR$ 'set new data base name
375 IF NF$=OF$ THEN DR$="INVALID NAME - SAME AS THE FIRST ONE - RESPECIFY ":NF$=TF$:UC=1:CL=-4:SOUND 500,4:GOSUB 20000:CL=0:GOTO 370
380 ON ERROR GOTO 440
400 VL$=".HDR":FILES NF$+VL$ 'see if a hdr file exists
410 CLS:DR$=NF$+VL$+" already exists...respecify or hit ENTER to reuse: "
415 ON ERROR GOTO 0
420 UC=1:CL=-4:SOUND 500,4:GOSUB 20000:CL=0
430 IF DR$="" THEN KILL NF$+VL$:GOTO 450 ELSE NF$=TF$+DR$:GOTO 380
440 RESUME 450 'if we get here then the files did not exist
450 ON ERROR GOTO 0
452 ON ERROR GOTO 462:VL$=".DTA":FILES NF$+VL$
454 CLS:DR$=NF$+VL$+" already exists...respecify or hit ENTER to reuse: "
456 ON ERROR GOTO 0
458 UC=1:CL=-3:SOUND 500,9:GOSUB 20000:CL=0
460 IF DR$="" THEN KILL NF$+VL$:GOTO 464 ELSE NF$=TF$+DR$:GOTO 380
462 RESUME 464 'files did not exist if we are here
464 ON ERROR GOTO 0
500 REM All files have been verified...now start the work
510 ODL=0:ODF=0 'set record length and number of entries in old db
520 NDL=0:NDF=0 'set record length and number of entries in new db
530 CLS
540 PRINT"Reading origional data base records ";MID$(OF$,3)
550 OPEN"i",#1,OF$+".HDR" 'open old header file
560 WHILE NOT EOF(1) 'read old data base header description
570 INPUT#1,TS$:ODF =ODF + 1:OFM$(ODF) = TS$ 'read label
580 INPUT#1,OFL(ODF):ODL = ODL + OFL(ODF)
590 WEND 'end of the loop
595 CLOSE#1 'done with the old header file
600 CLS:LOCATE 2,1:PRINT "Origional Data Base Fields";
602 LOCATE 3,1:PRINT OF$+".HDR";
605 LC=4:MAXLEN = 0
610 LOCATE LC,1
620 FOR I = 1 TO ODF
630 IF OFL(I) > MAXLEN THEN MAXLEN=OFL(I)
635 LOCATE LC+I,1:PRINT OFM$(I);:PRINT,USING" ###";OFL(I)
640 NEXT I
650 IF MAXLEN+3+2 <= 40 THEN NEXTFIELD=40 ELSE NEXTFIELD=0
700 LOCATE 1,1:COLOR 12,0:SOUND 800,4:PRINT"Enter values for the new headers";
703 LOCATE 2,NEXTFIELD:COLOR 15,0:PRINT"New Data Base fields";
705 LOCATE 3,NEXTFIELD:PRINT NF$+".HDR";
710 ATLINE = 1:NDF=0:NEWEND = FALSE
715 CURMAX = 12:COLOR 15,0
720 WHILE NEWEND = FALSE
725 IF ATLINE+LC >24 THEN GOSUB 10000:ATLINE = 1
730 LOCATE ATLINE+LC,NEXTFIELD
740 LINE INPUT;"";TS$:IF TS$="" THEN NEWEND=TRUE:GOTO 750 ELSE NDF=NDF+1:NFM$(NDF) = TS$
741 IF LEN(NFM$(NDF)) > 12 THEN NFM$(NDF)=LEFT$(NFM$(NDF),12):LOCATE ATLINE+LC,NEXTFIELD:PRINT NFM$(NDF)+SPACE$(LEN(TS$)-12);
745 ATLINE = ATLINE + 1
750 WEND:COLOR 7,0
752 DR$="Is this HDR information correct (Y or N)? ":UC=1:CL=0:GOSUB 20000
753 IF DR$="" THEN 752 ELSE IF DR$ = "N" THEN GOSUB 40000:GOTO 710 ELSE IF DR$ <> "Y" THEN 752
759 NDL=0:LOCATE 1,1:PRINT" "
760 LOCATE 1,40:COLOR 12,0:PRINT"Enter the width of each field ";:COLOR 4,0
765 SOUND 800,5
770 FOR I = 1 TO NDF
780 LOCATE LC+I,NEXTFIELD+CURMAX+1
790 LINE INPUT;"";TS$:NFL(I)=VAL(TS$):NDL=NDL+NFL(I)
792 IF NFL(I) = 0 THEN LOCATE 25,1:PRINT"Spceified field length is not valid..Please reenter";:SOUND 500,9:GOTO 780
795 LOCATE LC+I,NEXTFIELD+CURMAX+1:PRINT,USING"###";NFL(I)
796 LOCATE 25,1:PRINT" ";
800 NEXT I
802 DR$="Is this field width information correct (Y or N)? ":UC=1:CL=0:GOSUB 20000
803 IF DR$="" THEN 802 ELSE IF DR$ = "N" THEN GOSUB 50000:GOTO 759 ELSE IF DR$ <> "Y" THEN 802
810 COLOR 7,0
900 CLS 'now that the data fields have been defined...we need relationships
910 LOCATE 1,1:PRINT"Define field relationship values";
920 LOCATE 2,1:PRINT"For each field in the new data base indicate the";
930 LOCATE 3,1:PRINT"corresponding old data base field number or 0";
940 LOCATE 4,1
950 FOR I = 1 TO NDF 'output new data fields
960 LOCATE 4+I,1:PRINT NFM$(I);
980 NEXT I
990 FOR I = 1 TO ODF 'output old data base fields
1000 LOCATE 4+I,50:PRINT OFM$(I)
1005 LOCATE 4+I,30:PRINT,USING"###";I;
1010 NEXT I
1015 DIM FR(42) 'set the size of the relationship matrix to the # of data flds
1020 FOR I = 1 TO NDF 'get field relationship value
1030 LOCATE 4+I,25
1040 LINE INPUT;"";TS$:IF TS$ = "" THEN 1030
1050 IF (VAL(TS$) > ODF) OR (VAL(TS$) < 0) THEN LOCATE 25,1:PRINT"Invalid field relationship specified";:SOUND 500,9:GOTO 1030
1060 LOCATE 25,1:PRINT" ";
1070 FR(I) = VAL(TS$) 'set the field relationship matrix value
1080 NEXT I
1082 DR$="Are these field relationships correct (Y or N)? ":CL=0:UC=1:GOSUB 20000
1084 IF DR$="" THEN 1082 ELSE IF DR$="N" THEN GOSUB 60000:GOTO 1020 ELSE IF DR$ <> "Y" THEN 1082
1100 CLS 'now we have all we need to remap the data base
1110 DIM OFILE$(42),NFILE$(42) 'set up to map the data base
1120 CLS:PRINT"Writing new HDR file ";:COLOR 12,0
1130 PRINT NF$+".HDR":COLOR 7,0
1140 OPEN"o",#1,NF$+".HDR"
1150 FOR I = 1 TO NDF 'loop until end of header info
1160 PRINT#1,NFM$(I) 'write out the header name
1170 PRINT#1,NFL(I) 'write out the field lenght
1180 NEXT I
1190 CLOSE#1 'close the new header file
1200 PRINT"New Header file created"
1210 REM open the DTA data sets for processing
1220 OPEN"r",#2,OF$+".DTA",ODL+1
1230 FIELD#2,ODL AS ODF$ 'set up a field for direct read
1240 OPEN"r",#3,NF$+".DTA",NDL+1
1250 FIELD#3,NDL AS NDF$ 'this will be the outputfield
1260 X = 1 'set initial record number
1265 FEND = FALSE
1270 WHILE FEND = FALSE 'read until \ record found in data base
1280 GET#2,X 'read record from the old data base
1290 IF LEFT$(ODF$,1) = "\" THEN FEND=TRUE:DR$="\":GOTO 1400
1295 'IF LEFT($(ODF$,2)="//" THEN GOTO 1408 check for deleted record
1300 CPOS = 1 'map old data record to array
1310 FOR I = 1 TO ODF
1320 OFILE$(I)=MID$(ODF$,CPOS,OFL(I)):CPOS=CPOS+OFL(I)
1330 NEXT I
1340 FOR J = 1 TO NDF
1350 IF FR(J)=0 THEN NFILE$(J)=SPACE$(NFL(J)):GOTO 1372
1362 IF NFL(J)<=OFL(FR(J)) THEN NFILE$(J)=LEFT$(OFILE$(FR(J)),NFL(J)):GOTO 1372
1364 IF NFL(J)>OFL(FR(J)) THEN NFILE$(J)=OFILE$(FR(J))+SPACE$(NFL(J)-OFL(FR(J)))
1372 NEXT J
1375 DR$=""
1376 FOR K=1 TO NDF:DR$=DR$+LEFT$(NFILE$(K),NFL(K)):NEXT K
1400 LSET NDF$=DR$:PUT#3,X 'write the new record
1401 CLS:LOCATE 1,1:PRINT"Processing record number(",X,")";
1402 LOCATE 2,1:PRINT"New File Record";
1403 LOCATE 2,40:PRINT"Old File Record";
1406 FOR K = 1 TO NDF:LOCATE 3+K,1:PRINT NFILE$(K);:NEXT K
1407 FOR K = 1 TO ODF:LOCATE 3+K,40:PRINT OFILE$(K);:NEXT K
1408 X=X+1
1410 WEND
1420 CLOSE#2:CLOSE#3
1500 CLS 'output final file stats
1510 LOCATE 8,28:PRINT"File conversion complete";
1520 LOCATE 9,28:PRINT"Data Base Statistics are";
1530 LOCATE 11,1 :PRINT"Origional Data Base = ";:LOCATE 11,30:PRINT OF$;
1550 LOCATE 12,1:PRINT"Origional number of fields = ";:LOCATE 12,30:PRINT ODF;
1552 LOCATE 13,1:PRINT"Record Length = ";:LOCATE 13,30:PRINT ODL;
1555 COLOR 15,0
1560 LOCATE 15,1:PRINT"New Data Base = ";:LOCATE 15,30:PRINT NF$;
1570 LOCATE 16,1:PRINT"New number of fields = ";:LOCATE 16,30:PRINT NDF;
1580 LOCATE 17,1:PRINT"New Total Record Length = ";:LOCATE 17,30:PRINT NDL;
1590 LOCATE 20,1:PRINT"Number of Data Records Read = ",X-1;
1600 COLOR 7,0
1610 GOSUB 60990 'go wait for input key to continue
1615 CLS:PRINT"Your new database is built."
1620 PRINT:PRINT"You must remember to sort the database"
1625 PRINT:PRINT"the first time you use it."
1640 END
10000 FOR LP = LC+1 TO 24
10010 LOCATE LP,NEXTFIELD:PRINT SPC(79-NEXTFIELD)
10020 NEXT LP
10030 RETURN
20000 GOSUB 20110
20010 SOUND 200,9
20020 LOCATE 25,1:COLOR 15+CL,0
20030 PRINT DR$;:COLOR 7,0
20040 LINE INPUT;"";DR$
20050 IF LEN(DR$)<1 GOTO 20110
20060 IF UC=0 GOTO 20110
20070 FOR NN = 1 TO LEN(DR$) 'fold to upper case
20080 X=ASC(MID$(DR$,NN,1))
20090 IF X>=97 AND X <= 122 THEN MID$(DR$,NN,1)=CHR$(X-32)
20100 NEXT:UC = 0
20110 LOCATE 25,1:PRINT SPACE$(RC-1);:LOCATE 25,1:RETURN
30000 FOR R = 6 TO 24
30010 FOR C = 9 TO RC-2 STEP 13
30020 LOCATE R,C:PRINT" ";
30030 NEXT C:NEXT R
30040 RETURN
40000 FOR I = 1 TO NDF 'routine called if new field names incorrect
40010 NFM$(I) = ""
40020 LOCATE LC+I,NEXTFIELD:PRINT SPC(RC-NEXTFIELD);
40030 NEXT I
40040 RETURN
50000 FOR I = 1 TO NDF 'routine to be called if new field width incorrect
50020 NFL(I)=0
50025 LOCATE LC+I,NEXTFIELD+CURMAX+1:PRINT,USING"###";NFL(I);
50030 NEXT I
50040 RETURN
60000 FOR I = 1 TO NDF 'routine to be used if relationship vals incorrect
60010 LOCATE 4+I,25:PRINT SPC(5)
60020 FR(I) = 0
60030 NEXT I
60040 RETURN
60990 REM 'Wait for input key subroutine
60991 LOCATE 25,1:PRINT"Hit any key to continue";
60992 K$=INKEY$:IF K$="" THEN 60992 ELSE RETURN
Directory of PC-SIG Library Disk #0022
Volume in drive A has no label
Directory of A:\
PC-MAP BAS 10880 1-11-83
CRC TXT 936 11-09-84 8:28a
CHECKDIR EXE 36224 12-07-82 9:25p
CHECKDIR DOC 1920 12-07-82 9:35p
LDIR BAS 4480 8-15-82 10:53a
BMENU BAS 3968 12-01-82 12:00a
BMENUD BAS 3200 12-01-82 12:00a
BMENU DOC 4037 12-01-82 12:00a
LDIRC BAS 4382 9-02-82 8:49p
CRCK4 COM 1536 10-21-82 7:54p
10 file(s) 71563 bytes
87040 bytes free