1000 'DBCLINIC.BAS IS A UTILITY PROGRAM FOR UPDATING THE FILE HEADER IN .DBF
1010 'FILES CREATED UNDER DBASEII.  IT ALSO WILL GET A CORRECT RECORD COUNT
1020 'FOR .DBF OR .TXT FILES AND EVEN A RECORD LENGTH FOR .TXT FILES.  THIS
1030 'VERSION IS SET UP FOR A 80-COLUMN BY 24-LINE SCREEN AND TO RECOGNIZE 
1040 'DRIVES A: THRU D: ONLY (SEE LINE 1230.).
1050 '
1060 '====================== STANDARD 'TRANSFORM' EQUATES =========================
1070 '
1080 DEFINT A-Z: WIDTH 79: WIDTH LPRINT 131
1090 ZERO=0: ONE=1: TWO=2: THREE=3: FOUR=4: FIVE=5: SIX=6: SEVEN=7: EIGHT=8: NINE=9
1100 AFFIRM=ONE: NEGATIVE=TWO: DEFAULT=THREE: FALSE=ZERO: TRUE=NOT(FALSE)
1110 OFFSET=32: FILEERR=53
1120 BACKSPACE$=CHR$(EIGHT): BELL$=CHR$(SEVEN): CARRIAGERETURN$=CHR$(13)
1130 COLON$=":": COMMA$=",": DELETEKEY$=CHR$(127): ESCAPEKEY$=CHR$(27)
1140 LINEFEED$=CHR$(10): NLLSTR$="": ONESPACE$=" ": PERIOD$=".": QUOTE$=CHR$(34)
1150 SEMICOLON$=";": SPACEBAR$=CHR$(32): TABKEY$=CHR$(NINE)
1160 DEF FNPR(N)=N>31 AND N<127	'TESTS FOR ALL PRINTABLE ASCII CHARACTERS
1170 DEF FNAL(N)=N>96 AND N<123	'TESTS FOR LOWER-CASE ASCII CHARACTERS ONLY
1180 DEF FNAU(N)=N>64 AND N<91	'TESTS FOR UPPER-CASE ASCII CHARACTERS ONLY
1190 DEF FNNU(N)=N>47 AND N<58	'TESTS FOR NUMERIC ASCII CHARACTERS ONLY
1200 '
1210 '
1220 DIM PART$(TWO),FLD$(32)
1230 DEF FNDV(N)=N>64 AND N<69    'ASCII CODE RANGE OF ACCEPTABLE DRIVES (A-D)
1240 CLEARSCREEN$=CHR$(26) 	     'THIS MAY BE DIFFERENT FOR YOUR TERMINAL
1250 DBFHEADER=520                'NUMBER OF CHARACTERS (BYTES) IN .DBF HEADER
1260 PASTENDERR=62: NOFILE=FALSE
1270 DATEFORM$="mm/dd/yy"
1280 '
1290 ON ERROR GOTO 6580
1300 FOR SCROLL=ONE TO 40: PRINT: NEXT SCROLL
1310 ' REPEAT	[MAINLINE PROGRAM STARTS HERE]
1320 ' REPEAT
1330 PRINT "                        * * * * * * * * * * * * * * *"
1340 PRINT "                        *    DICK'S DBASE CLINIC    *"
1350 PRINT "                        *  Version 2.0     9/11/84  *"
1360 PRINT "                        * * * * * * * * * * * * * * *"
1370 PRINT: PRINT: PRINT
1380 PRINT "       Copyright 1984 by Dick Bollinger.  Permission granted for private"
1390 PRINT "       use only.  Not to be sold in any form for commercial profit."
1400 PRINT: PRINT: PRINT
1410 PRINT "                  THIS PROGRAM ACCEPTS ONLY STANDARD DATABASE"
1420 PRINT "                  (DBF) AND SDF (TXT) FILENAMES CREATED UNDER"
1430 PRINT "                  ASHTON-TATE'S DBASEII (TM).  ALWAYS ENTER A"
1440 PRINT "                    COMPLETE FILENAME: (E.G., A:MYFILE.DBF)"
1450 PRINT: PRINT
1460 PRINT "            < < AFTER A DISK CHANGE, PRESS RETURN KEY FOR RESET > >"
1470 PRINT: PRINT
1480 PRINT "     ENTER FILENAME (DIR=DIRECTORY): ";
1490 ' REPEAT
1500 GOSUB 6800
1510 IF NOT (LEN(DUMMY$)>ONE) THEN 1540
1520 DRV$=LEFT$(DUMMY$,TWO)
1530 DRV=ASC(LEFT$(DRV$,ONE))
1540 ' ENDIF
1550 IF NOT (DUMMY$=NLLSTR$) THEN 1590
1560 FILEOK=FALSE
1570 RESET
1580 GOTO 1830
1590 IF NOT (LEFT$(DUMMY$,TWO)="DI") THEN 1640
1600 FILEOK=FALSE
1610 GOSUB 5840
1620 PRINT: PRINT: GOTO 1460
1630 GOTO 1830
1640 IF NOT (FNDV(DRV)=FALSE OR MID$(DRV$,TWO,TWO)<>COLON$) THEN 1720
1650 FILEOK=FALSE
1660 NASTY$=" Specify Disk Drive! "
1670 PRINT NASTY$;BELL$;
1680 ENTRYLEN=LEN(DUMMY$)
1690 GOSUB 5740
1700 GOSUB 5790
1710 GOTO 1830
1720 IF NOT (RIGHT$(DUMMY$,FOUR)<>".DBF" AND RIGHT$(DUMMY$,FOUR)<>".TXT") THEN 1800
1730 FILEOK=FALSE
1740 NASTY$=" Invalid File Type! "
1750 PRINT NASTY$;BELL$;
1760 ENTRYLEN=LEN(DUMMY$)
1770 GOSUB 5740
1780 GOSUB 5790
1790 GOTO 1820
1800 ' ELSE
1810 FILEOK=TRUE
1820 ' ENDIF
1830 ' ENDIF
1840 IF NOT (FILEOK=TRUE) THEN 1490
1850 FILETRY$=DUMMY$
1860 EXT$=RIGHT$(FILETRY$,THREE)
1870 FILEFOUND=FALSE: NOFILE=FALSE
1880 OPEN "I",# ONE,FILETRY$
1890 IF NOT (NOFILE<>TRUE) THEN 1920
1900 FILEFOUND=TRUE
1910 GOTO 1970
1920 ' ELSE
1930 PRINT: PRINT: PRINT
1940 PRINT "        * * * ERROR: Data File Entered Was Not Found! - Check Spelling!"
1950 PRINT BELL$: PRINT: PRINT: PRINT: PRINT
1960 GOSUB 5740
1970 ' ENDIF
1980 CLOSE # ONE
1990 PRINT CLEARSCREEN$: PRINT
2000 IF NOT (FILEFOUND=TRUE) THEN 1320
2010 ' REPEAT
2020 CLOSE: MODE=ZERO
2030 PRINT CLEARSCREEN$;"     ";FILETRY$
2040 PRINT: PRINT: PRINT
2050 PRINT "                     <  <  <   M A I N   M E N U   >  >  >"
2060 PRINT: PRINT
2070 PRINT "          WARD [A]  -  DISPLAY FILE RECORD LENGTH   (DBF OR TXT FILE)"
2080 PRINT
2090 PRINT "          WARD [B]  -  DISPLAY FULL FILE STRUCTURE    (DBF FILE ONLY)"
2100 PRINT
2110 PRINT "          WARD [C]  -  COUNT # OF RECORDS IN FILE   (DBF OR TXT FILE)"
2120 PRINT
2130 PRINT "          WARD [D]  -  DISPLAY/CHANGE RECORD COUNT    (DBF FILE ONLY)"
2140 PRINT
2150 PRINT "          WARD [E]  -  DISPLAY/CHANGE ENTRY DATE      (DBF FILE ONLY)"
2160 PRINT: PRINT
2170 PRINT "             [F] = SELECT ANOTHER FILENAME      [X] = EXIT TO CP/M"
2180 PRINT: PRINT
2190 PRINT "     YOUR CHOICE (A-F,X):  [ ]"; BACKSPACE$; BACKSPACE$;
2200 VALID=FALSE
2210 ' REPEAT
2220 DUMMY$=INKEY$
2230 IF NOT (LEN(DUMMY$)=ONE) THEN 2600
2240 IF NOT (FNPR(ASC(DUMMY$))=TRUE) THEN 2590
2250 J=ASC(DUMMY$)
2260 IF NOT (FNAL(ASC(DUMMY$))=TRUE) THEN 2280
2270 DUMMY$=CHR$(J-OFFSET)
2280 ' ENDIF
2290 IF NOT (DUMMY$="F") THEN 2330
2300 NEWFILE=TRUE: VALID=TRUE
2310 MODE=ZERO: PRINT "F] ";
2320 GOTO 2580
2330 IF NOT (DUMMY$="X") THEN 2370
2340 EXIT=TRUE: VALID=TRUE
2350 MODE=ZERO: PRINT "X] ";
2360 GOTO 2570
2370 ' ELSE
2380 NEWFILE=FALSE: EXIT=FALSE
2390 MODE=ASC(DUMMY$)-64
2400 IF NOT (MODE>FIVE OR MODE<ONE) THEN 2430
2410 PRINT BELL$;: VALID=FALSE
2420 GOTO 2560
2430 IF NOT (EXT$="TXT" AND NOT(MODE=ONE OR MODE=THREE)) THEN 2520
2440 NASTY$=" Sorry!  'TXT' Files NOT ALLOWED In This WARD! "
2450 PRINT NASTY$;BELL$;
2460 ENTRYLEN=ZERO
2470 GOSUB 5740
2480 GOSUB 5790
2490 PRINT " ]";BACKSPACE$;BACKSPACE$;
2500 VALID=FALSE
2510 GOTO 2550
2520 ' ELSE
2530 VALID=TRUE
2540 PRINT DUMMY$;"] ";
2550 ' ENDIF
2560 ' ENDIF
2570 ' ENDIF
2580 ' ENDIF
2590 ' ENDIF
2600 ' ENDIF
2610 IF NOT (VALID=TRUE) THEN 2210
2620 IF NOT (MODE>ZERO AND MODE<SIX) THEN 5260
2630 IF NOT (EXT$="DBF") THEN 2730
2640 OPEN "R",# ONE,FILETRY$,EIGHT
2650 FIELD # ONE, SIX AS SPACER$, TWO AS RECLEN$
2660 GET # ONE,ONE
2670 CLOSE # ONE
2680 RECLEN=CVI(RECLEN$)
2690 IF NOT (RECLEN = -ONE) THEN 2710
2700 RECLEN=ZERO
2710 ' ENDIF
2720 GOTO 2880
2730 ' ELSE
2740 DUMY1$=NLLSTR$: DUMY2$=DUMY1$: DUMY3$=DUMY2$: DUMY4$=DUMY3$
2750 OPEN "I",# ONE,FILETRY$
2760 LINE INPUT # ONE, DUMY1$
2770 IF NOT (LEN(DUMY1$)=255) THEN 2850
2780 LINE INPUT # ONE, DUMY2$
2790 IF NOT (LEN(DUMY2$)=255) THEN 2840
2800 LINE INPUT # ONE, DUMY3$
2810 IF NOT (LEN(DUMY3$)=255) THEN 2830
2820 LINE INPUT # ONE, DUMY4$
2830 ' ENDIF
2840 ' ENDIF
2850 ' ENDIF
2860 RECLEN=LEN(DUMY1$)+LEN(DUMY2$)+LEN(DUMY3$)+LEN(DUMY4$)
2870 CLOSE # ONE
2880 ' ENDIF
2890 ON MODE GOTO 2900, 3060, 3840, 4480, 4890
2900 ' WARD-A
2910 PRINT CLEARSCREEN$
2920 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
2930 PRINT "             RECORD LENGTH OF  ";FILETRY$;"  IS ";RECLEN;" CHARACTERS"
2940 PRINT
2950 IF NOT (EXT$="DBF" AND RECLEN<> ZERO) THEN 2980
2960 PRINT "             (This Total INCLUDES a Single SPACE Record Delimiter)"
2970 GOTO 3040
2980 IF NOT (EXT$="TXT" AND RECLEN<>ZERO) THEN 3010
2990 PRINT "             (This Total DOES NOT Include CR/LF Record Delimiter)"
3000 GOTO 3030
3010 ' ELSE
3020 PRINT
3030 ' ENDIF
3040 ' ENDIF
3050 GOTO 5190
3060 ' WARD-B
3070 GOSUB 5320
3080 CLOSE # ONE
3090 OPEN "R",# ONE,FILETRY$,THREE
3100 FIELD # ONE, ONE AS SPACER$, TWO AS FILSIZE$
3110 GET # ONE,ONE
3120 FILSIZE=CVI(FILSIZE$)
3130 CLOSE # ONE
3140 OPEN "R",# ONE,FILETRY$,EIGHT
3150 FIELD #ONE,EIGHT AS HDR$
3160 HDR=ONE
3170 FOR FLDNO=ONE TO 32
3180 FOR PARTNO=ONE TO TWO
3190 HDR=HDR+ONE
3200 GET #ONE,HDR
3210 PART$(PARTNO)=HDR$
3220 NEXT PARTNO
3230 FLD$(FLDNO)=PART$(ONE)+PART$(TWO)
3240 NEXT FLDNO
3250 CLOSE # ONE
3260 PRINT CLEARSCREEN$
3270 PRINT TAB(22);"STRUCTURE FOR FILE:  ";FILETRY$
3280 ARGU=FILSIZE: FMT=FIVE
3290 GOSUB 6350
3300 FILSIZE$=ARGU$
3310 PRINT TAB(22);"NUMBER OF RECORDS:   ";FILSIZE$
3320 PRINT TAB(22);"DATE OF LAST UPDATE: ";DATE$
3330 PRINT TAB(22);"PRIMARY USE DATABASE"
3340 PRINT TAB(22);"FLD       NAME      TYPE WIDTH   DEC"
3350 FLD=ONE: NOMORE=FALSE
3360 ' REPEAT
3370 IF NOT (LEFT$(FLD$(FLD),ONE)<>CHR$(13)) THEN 3690
3380 IF NOT (FLD=32) THEN 3400
3390 NOMORE=TRUE
3400 ' ENDIF
3410 ARGU=FLD: FMT=THREE
3420 GOSUB 6350
3430 FLD1$=ARGU$
3440 NAM$=LEFT$(FLD$(FLD),10)
3450 TYP$=MID$(FLD$(FLD),12,ONE)
3460 WID=ASC(MID$(FLD$(FLD),13,ONE))
3470 ARGU=WID: FMT=THREE
3480 GOSUB 6350
3490 WID$=ARGU$
3500 DEC=ASC(RIGHT$(FLD$(FLD),ONE))
3510 IF NOT (DEC>ZERO) THEN 3560
3520 ARGU=DEC: FMT=THREE
3530 GOSUB 6350
3540 DEC$=ARGU$
3550 GOTO 3580
3560 ' ELSE
3570 DEC$=NLLSTR$
3580 ' ENDIF
3590 PRINT TAB(22);FLD1$; TAB(30);NAM$; TAB(43);TYP$; TAB(48);WID$; TAB(55);DEC$
3600 FLD=FLD+ONE
3610 IF NOT (FLD=13 OR FLD=31) THEN 3670
3620 PRINT TAB(22);"[more...]";BELL$;
3630 ' REPEAT
3640 DMY$=INKEY$
3650 IF NOT (LEN(DMY$)=ONE) THEN 3630
3660 PRINT CARRIAGERETURN$;
3670 ' ENDIF
3680 GOTO 3710
3690 ' ELSE
3700 NOMORE=TRUE
3710 ' ENDIF
3720 IF NOT (NOMORE=TRUE) THEN 3360
3730 IF NOT (FLD>ONE) THEN 3790
3740 ARGU=RECLEN: FMT=FIVE
3750 GOSUB 6350
3760 RECLEN$=ARGU$
3770 PRINT TAB(22);"** TOTAL **             ";RECLEN$
3780 GOTO 3820
3790 ' ELSE
3800 PRINT
3810 PRINT "           * * ERROR: File Structure of  ";FILETRY$;"  Is Vacant!!"
3820 ' ENDIF
3830 GOTO 5190
3840 ' WARD-C
3850 ANSWER=ZERO: DISPLCNT=ZERO
3860 IF NOT (RECLEN>ZERO) THEN 4320
3870 IF NOT (EXT$="TXT") THEN 3890
3880 RECLEN=RECLEN+TWO
3890 ' ENDIF
3900 FACTOR#=128/RECLEN
3910 OPEN "R",# ONE,FILETRY$,128
3920 FIELD # ONE, 128 AS DUMMY1$
3930 FILE=ONE
3940 GOSUB 7060
3950 IF NOT (ANSWER<32767) THEN 4300
3960 IF NOT (NORECORDS=FALSE) THEN 4270
3970 PULLBACK=16
3980 OKAYREC=ANSWER-PULLBACK
3990 IF NOT (OKAYREC<=ZERO) THEN 4010
4000 OKAYREC=ONE
4010 ' ENDIF
4020 EOFLOC=ZERO
4030 WHILE EOFLOC=ZERO AND OKAYREC<=ANSWER
4040 GET # ONE,OKAYREC
4050 A$=DUMMY1$
4060 EOFLOC=INSTR(A$,CHR$(26))
4070 IF NOT (EOFLOC=ZERO) THEN 4100
4080 OKAYREC=OKAYREC+ONE
4090 GOTO 4120
4100 ' ELSE
4110 OKAYREC=OKAYREC-ONE
4120 ' ENDIF
4130 WEND
4140 FILENGTH#=(OKAYREC*128)+EOFLOC
4150 IF NOT (EXT$="DBF") THEN 4180
4160 DATALEN#=FILENGTH#-DBFHEADER
4170 GOTO 4200
4180 ' ELSE
4190 DATALEN#=FILENGTH#
4200 ' ENDIF
4210 RECVALUE#=DATALEN#/RECLEN
4220 DISPLCNT=CINT(RECVALUE#) 
4230 IF NOT (EXT$="TXT") THEN 4250
4240 RECLEN=RECLEN-TWO
4250 ' ENDIF
4260 GOTO 4290
4270 ' ELSE
4280 DISPLCNT=ZERO
4290 ' ENDIF
4300 ' ENDIF
4310 CLOSE # ONE
4320 ' ENDIF
4330 PRINT CLEARSCREEN$
4340 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
4350 IF NOT (DISPLCNT<ONE) THEN 4380
4360 PRINT "                 THERE ARE >> NO << RECORDS IN ";FILETRY$
4370 GOTO 4460
4380 IF NOT (ANSWER=32767) THEN 4430
4390 RECVALUE#=ANSWER*FACTOR#
4400 DISPLCNT=CINT(RECVALUE#)
4410 PRINT "               LIMITED OUT AT ";DISPLCNT;" RECORDS - PROBABLY MORE!!"
4420 GOTO 4450
4430 ' ELSE
4440 PRINT "             FILE  ";FILETRY$;"  CONTAINS ";DISPLCNT;" RECORDS, BY COUNT"
4450 ' ENDIF
4460 ' ENDIF
4470 GOTO 5190
4480 ' WARD-D
4490 OPEN "R",# ONE,FILETRY$,THREE
4500 FIELD # ONE, ONE AS SPACER$, TWO AS FILSIZE$
4510 GET # ONE,ONE
4520 FILSIZE=CVI(FILSIZE$)
4530 PRINT CLEARSCREEN$
4540 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
4550 PRINT "             FILE HEADER OF  ";FILETRY$;"  SHOWS ";FILSIZE;" RECORDS"
4560 PRINT: PRINT
4570 PRINT "     ENTER RECORD COUNT CHANGE: ";
4580 ' REPEAT
4590 ACCUM=ZERO
4600 GOSUB 7210
4610 IF NOT (NUMCOUNT=ZERO) THEN 4680
4620 NASTY$=" I Must Have A Number!! "
4630 PRINT NASTY$;BELL$;
4640 ENTRYLEN=ZERO
4650 GOSUB 5740
4660 GOSUB 5790
4670 GOTO 4790
4680 IF NOT (VAL(DUMMY$)>32767) THEN 4760
4690 NASTY$=" Limited to 32,767 Records!! "
4700 PRINT NASTY$;BELL$;
4710 ENTRYLEN=LEN(DUMMY$)
4720 NUMCOUNT=ZERO
4730 GOSUB 5740
4740 GOSUB 5790
4750 GOTO 4780
4760 ' ELSE
4770 ACCUM=VAL(DUMMY$)
4780 ' ENDIF
4790 ' ENDIF
4800 IF NOT (NUMCOUNT>ZERO) THEN 4580
4810 LSET FILSIZE$=MKI$(ACCUM)
4820 PUT # ONE,ONE
4830 GET # ONE,ONE
4840 CLOSE # ONE
4850 PRINT: PRINT: PRINT
4860 FILSIZE=CVI(FILSIZE$)
4870 PRINT "                   FILE HEADER UPDATED TO ";FILSIZE;" RECORDS"
4880 GOTO 5190
4890 ' WARD-E
4900 GOSUB 5320
4910 PRINT CLEARSCREEN$
4920 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
4930 PRINT "              FILE  ";FILETRY$;"  LAST ENTRY DATE IS:  ";DATE$
4940 PRINT: PRINT
4950 PRINT "     ENTER 'LAST ENTRY' DATE CHANGE:  ";DATEFORM$;STRING$(EIGHT,EIGHT);
4960 ENTRIES=ZERO: DUMMY$=NLLSTR$
4970 WHILE ENTRIES<>NINE
4980 GOSUB 5560
4990 DUMMY$=DUMMY$+DIGITS$
5000 ENTRIES=ENTRIES+THREE
5010 PRINT CHR$(12);
5020 WEND
5030 IF NOT (DUMMY$="000000") THEN 5060
5040 DATE$=CHR$(0)+CHR$(0)+CHR$(0)
5050 GOTO 5110
5060 ' ELSE
5070 MON$=CHR$(VAL(LEFT$(DUMMY$,TWO)))
5080 DAY$=CHR$(VAL(MID$(DUMMY$,THREE,TWO)))
5090 YEAR$=CHR$(VAL(RIGHT$(DUMMY$,TWO)))
5100 DATE$=MON$+DAY$+YEAR$
5110 ' ENDIF
5120 OPEN "R",# ONE,FILETRY$,SIX
5130 FIELD # ONE, THREE AS SPACER$, THREE AS FILDATE$
5140 LSET SPACER$=SPACER1$: LSET FILDATE$=DATE$
5150 PUT # ONE,ONE: CLOSE # ONE
5160 GOSUB 5320
5170 PRINT: PRINT: PRINT
5180 PRINT "              FILE HEADER UPDATED TO  ";DATE$;"  'LAST ENTRY' DATE"
5190 ' ENDGOTO
5200 PRINT: PRINT: PRINT
5210 PRINT "               <  <  Press Any Key To Return To Main Menu  >  >"
5220 PRINT
5230 ' REPEAT
5240 DUMMY$=INKEY$
5250 IF NOT (LEN(DUMMY$)=ONE) THEN 5230
5260 ' ENDIF
5270 IF NOT (NEWFILE=TRUE OR EXIT=TRUE) THEN 2010
5280 PRINT CLEARSCREEN$: PRINT
5290 IF NOT (EXIT=TRUE) THEN 1310
5300 SYSTEM
5310 ' [END OF MAINLINE PROGRAM]
5320 ' GET_FILE_DATE
5330 OPEN "R",# ONE,FILETRY$,SIX
5340 FIELD # ONE,THREE AS SPACER$,THREE AS FILDATE$
5350 GET # ONE, ONE
5360 SPACER1$=SPACER$: DATE$=FILDATE$: CLOSE # ONE
5370 IF NOT (DATE$=NLLSTR$) THEN 5400
5380 DATE$="00/00/00"
5390 GOTO 5540
5400 ' ELSE
5410 MON=ASC(LEFT$(DATE$,ONE))
5420 DAY=ASC(MID$(DATE$,TWO,ONE))
5430 YEAR=ASC(RIGHT$(DATE$,ONE))
5440 ARGU=MON: FMT=TWO
5450 GOSUB 6350
5460 MON$=ARGU$+"/"
5470 ARGU=DAY: FMT=TWO
5480 GOSUB 6350
5490 DAY$=ARGU$+"/"
5500 ARGU=YEAR
5510 GOSUB 6350
5520 YEAR$=ARGU$
5530 DATE$=MON$+DAY$+YEAR$
5540 ' ENDIF
5550 RETURN
5560 ' GET_TWO_DIGITS
5570 DIGITS$=NLLSTR$: DIGIT$=NLLSTR$
5580 ' REPEAT
5590 DIGIT$=INKEY$
5600 IF NOT (LEN(DIGIT$)=ONE) THEN 5710
5610 IF NOT (ASC(DIGIT$)>47 AND ASC(DIGIT$)<58) THEN 5650
5620 DIGITS$=DIGITS$+DIGIT$
5630 PRINT DIGIT$;
5640 GOTO 5700
5650 IF NOT (ASC(DIGIT$)=EIGHT) THEN 5690
5660 PRINT STRING$(ENTRIES+LEN(DIGITS$),EIGHT);
5670 PRINT CHR$(24);DATEFORM$;STRING$(EIGHT,EIGHT);
5680 ENTRIES=ZERO: DUMMY$=NLLSTR$: DIGITS$=NLLSTR$: DIGIT$=NLLSTR$
5690 ' ENDIF
5700 ' ENDIF
5710 ' ENDIF
5720 IF NOT (LEN(DIGITS$)=TWO) THEN 5580
5730 RETURN
5740 ' NASTYTIMER
5750 FOR TIMER=ONE TO 400
5760 NOP=ZERO
5770 NEXT TIMER
5780 RETURN
5790 ' NASTYCLEAR
5800 FOR CLEARING=ONE TO LEN(NASTY$)+ENTRYLEN
5810 PRINT BACKSPACE$;ONESPACE$;BACKSPACE$;
5820 NEXT CLEARING
5830 RETURN
5840 ' GET_DIRECTORY
5850 PRINT CLEARSCREEN$: PRINT: PRINT
5860 PRINT "     WHICH DRIVE?  [ ]";BACKSPACE$;BACKSPACE$;
5870 DUMMY$=NLLSTR$: OKAY=FALSE
5880 ' REPEAT
5890 DUMMY$=INKEY$
5900 IF NOT (LEN(DUMMY$)=ONE) THEN 6030
5910 IF NOT (FNPR(ASC(DUMMY$))=TRUE) THEN 6020
5920 J=ASC(DUMMY$)
5930 IF NOT (FNAL(J)=TRUE) THEN 5950
5940 DUMMY$=CHR$(J-OFFSET)
5950 ' ENDIF
5960 IF NOT (FNDV(ASC(DUMMY$))=TRUE) THEN 5990
5970 OKAY=TRUE: PRINT DUMMY$;"] "
5980 GOTO 6010
5990 ' ELSE
6000 PRINT BELL$;
6010 ' ENDIF
6020 ' ENDIF
6030 ' ENDIF
6040 IF NOT (OKAY=TRUE) THEN 5880
6050 DRV$=DUMMY$+COLON$
6060 PRINT: PRINT
6070 PRINT "     [1] = ALL FILES    [2] = *.DBF FILES ONLY    [3] = *.TXT FILES ONLY"
6080 PRINT: PRINT
6090 PRINT "     CHOICE: [ ]";BACKSPACE$;BACKSPACE$;
6100 DUMMY=ZERO
6110 ' REPEAT
6120 DUMMY$=INKEY$
6130 IF NOT (LEN(DUMMY$)=ONE) THEN 6200
6140 IF NOT (DUMMY$="1" OR DUMMY$="2" OR DUMMY$="3") THEN 6170
6150 DUMMY=VAL(DUMMY$)
6160 GOTO 6190
6170 ' ELSE
6180 PRINT BELL$;
6190 ' ENDIF
6200 ' ENDIF
6210 IF NOT (DUMMY>ZERO AND DUMMY<FOUR) THEN 6110
6220 IF NOT (DUMMY=ONE) THEN 6250
6230 FIL$=DRV$+"*.*"
6240 GOTO 6310
6250 IF NOT (DUMMY=TWO) THEN 6280
6260 FIL$=DRV$+"*.DBF"
6270 GOTO 6300
6280 ' ELSE
6290 FIL$=DRV$+"*.TXT"
6300 ' ENDIF
6310 ' ENDIF
6320 PRINT CARRIAGERETURN$;"DIRECTORY FOR  ";FIL$;"     ": PRINT
6330 FILES FIL$: PRINT
6340 RETURN
6350 ' FORMAT_DIGITS
6360 IF NOT (ARGU<10) THEN 6390
6370 ARGU$=RIGHT$(STR$(ARGU),ONE)
6380 GOTO 6510
6390 IF NOT (ARGU<100) THEN 6420
6400 ARGU$=RIGHT$(STR$(ARGU),TWO)
6410 GOTO 6510
6420 IF NOT (ARGU<1000) THEN 6450
6430 ARGU$=RIGHT$(STR$(ARGU),THREE)
6440 GOTO 6510
6450 IF NOT (ARGU<10000) THEN 6480
6460 ARGU$=RIGHT$(STR$(ARGU),FOUR)
6470 GOTO 6500
6480 ' ELSE
6490 ARGU$=RIGHT$(STR$(ARGU),FIVE)
6500 ' ENDIF
6510 ' ENDIF
6520 IF NOT (FMT<>ZERO) THEN 6560
6530 PAD$="000000"
6540 PAD=FMT-LEN(ARGU$)
6550 ARGU$=LEFT$(PAD$,PAD)+ARGU$
6560 ' ENDIF
6570 RETURN
6580 ' CANT_FIND_FILE
6590 IF NOT (ERR=FILEERR) THEN 6630
6600 CLOSE: NOFILE=TRUE
6610 RESUME NEXT
6620 GOTO 6790
6630 IF NOT (ERR=PASTENDERR) THEN 6710
6640 PRINT CLEARSCREEN$;BELL$
6650 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
6660 PRINT "     * * * ERROR: Database File Is EMPTY Or Contents Invalid - Aborting!!"
6670 CLOSE: PRINT: PRINT
6680 GOSUB 5740
6690 RESUME 1280
6700 GOTO 6780
6710 ' ELSE
6720 PRINT CLEARSCREEN$;BELL$
6730 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
6740 PRINT "      * * * ERROR:  An Unexpected Error Has Occurred - Halting Program!"
6750 CLOSE: PRINT
6760 PRINT "                         ERR =";ERR;"  AND   ERL =";ERL: PRINT
6770 STOP
6780 ' ENDIF
6790 ' ENDIF
6800 ' GETCHARS
6810 CHARCOUNT=ZERO
6820 DUMMY$=NLLSTR$ '
6830 ' REPEAT
6840 DUMMY1$=INKEY$
6850 IF NOT (LEN(DUMMY1$)=ONE) THEN 7020
6860 IF NOT (DUMMY1$=BACKSPACE$ AND CHARCOUNT>ZERO) THEN 6910
6870 CHARCOUNT=CHARCOUNT-ONE
6880 DUMMY$=LEFT$(DUMMY$,CHARCOUNT)
6890 PRINT BACKSPACE$+ONESPACE$+BACKSPACE$;
6900 GOTO 7010
6910 IF NOT (FNPR(ASC(DUMMY1$))) THEN 7000
6930 J=ASC(DUMMY1$)
6940 IF NOT (FNAL(J)) THEN 6960
6950 DUMMY1$=CHR$(J-OFFSET)
6960 ' ENDIF
6970 DUMMY$=DUMMY$+DUMMY1$
6980 CHARCOUNT=CHARCOUNT+ONE
6990 PRINT DUMMY1$;
7000 ' ENDIF
7010 ' ENDIF
7020 ' ENDIF
7040 IF NOT (DUMMY1$=CARRIAGERETURN$) THEN 6830
7050 RETURN
7060 ' GET_LAST_RECORD_NO
7070 ANSWER=ZERO
7080 FOR EXPONENT = 14 TO ZERO STEP -ONE
7090 GET #FILE, ANSWER+(2^EXPONENT)
7100 IF NOT (NOT (EOF(FILE))) THEN 7120
7110 ANSWER=ANSWER+(2^EXPONENT)
7120 ' ENDIF
7130 NEXT EXPONENT
7140 IF NOT (ANSWER=ZERO) THEN 7170
7150 NORECORDS=TRUE
7160 GOTO 7190
7170 ' ELSE
7180 NORECORDS=FALSE
7190 ' ENDIF
7200 RETURN
7210 ' GETNUM
7220 NUMCOUNT=ZERO
7230 DUMMY$=NLLSTR$
7240 ' REPEAT
7250 DUMMY1$=INKEY$
7260 IF NOT (LEN(DUMMY1$)=ONE) THEN 7380
7270 IF NOT (DUMMY1$=BACKSPACE$ AND NUMCOUNT>ZERO) THEN 7320
7280 NUMCOUNT=NUMCOUNT-ONE
7290 DUMMY$=LEFT$(DUMMY$,NUMCOUNT)
7300 PRINT BACKSPACE$;ONESPACE$;BACKSPACE$;
7310 GOTO 7370
7320 IF NOT (FNNU(ASC(DUMMY1$))) THEN 7360
7330 NUMCOUNT=NUMCOUNT+ONE
7340 DUMMY$=DUMMY$+DUMMY1$
7350 PRINT DUMMY1$;
7360 ' ENDIF
7370 ' ENDIF
7380 ' ENDIF
7400 IF NOT (DUMMY1$=CARRIAGERETURN$) THEN 7240
7410 RETURN
7420 END