10 '	DBINDENT.BAS Version 1.00 (c) Copyright 1985 by Merlin R. Null
20 '	To pretty print dBASE II command files saved in ASCII.
30 '	This program may not be sold separately or as part of any collection
40 '	of programs without the written permission of the author:
50 '	Merlin R. Null, P.O. Box 9422, N. Hollywood, CA 91609, (818)762-1429
60 DEFINT A-Z
70 WIDTH LPRINT 255
80 ON ERROR GOTO 1970	'Used mostly to detect incorrect filename
90 BL$=CHR$(7)
100 OPEN "I",#1,"CLS.DAT"
110 WHILE NOT EOF(1)
120   LINE INPUT #1, A$
130   A=VAL(A$)
140   CLS$=CLS$+CHR$(A)
150 WEND
160 CLOSE #1
170 PRINT CLS$
180 PRINT TAB(10)"DBINDENT Version 1.00   2-19-85"
190 PRINT
200 PRINT"To modify the indentation of dBASE II command files."
210 PRINT:PRINT
220 PRINT"Options:	P		Send output to Printer"
230 PRINT"		F		Send output to File"
240 PRINT"		N		No console output"
250 PRINT"		1-9		Value to indent (default=2)"
260 PRINT"		0		Remove all indenting"
270 PRINT:PRINT
280 PRINT"Examples:	B:FOO.SRC PN4	Printer output only, indent 4 spaces"
290 PRINT"		FOO.SRC F3	Output to file and console indent 3"
300 PRINT"		FOO.SRC		Console output only indent 2 spaces"
310 PRINT"		A:		Displays directory of A:"
320 PRINT"		?		View the Help file"
330 PRINT"		<RET>		Redisplay this screen"
340 PRINT:PRINT		'return here after directory call or error
350 LINE INPUT"Filename.SRC/.CMD or Drive:? ";NF$
360 IF NF$="" THEN 170			'Redisplay start screen
370 NFLEN=0:OPTFLAG=0:INDFLAG=0:LINEPRINT=0:FILE=0:CONOFF=0:ERASEBAK=0
380 FULLNAME$=""
390 IF NF$="?" THEN OPEN "I",#1,"DBINDENT.HLP" ELSE 520
400   PRINT CLS$
410   FOR LINES=1 TO 20
420     IF EOF(1) THEN 470 ELSE LINE INPUT #1,HELP$
430     PRINT HELP$
440   NEXT LINES
450   PRINT
460   PRINT TAB(7)"<Press any key to continue reading help file>"
470   PRINT TAB(12)"Press <ESC> to return to DBINDENT ";
480   FINISHED$=INPUT$(1)
490   IF FINISHED$<>CHR$(27) THEN 400
500   CLOSE #1
510   GOTO 170
520 FOR I=1 TO LEN(NF$)		'Convert lower to upper case & detect options
530   BYTE$=MID$(NF$,I,1)
540   IF ASC(BYTE$)>96 AND ASC(BYTE$)<123 THEN BYTE$=CHR$(ASC(BYTE$)-32)
550   FULLNAME$=FULLNAME$+BYTE$
560   IF BYTE$=" " THEN OPTFLAG=-1			'Flag start of options
570   IF NOT OPTFLAG THEN 630
580   IF BYTE$="P" THEN LINEPRINT=-1			'Detect print option
590   IF BYTE$="F" THEN FILE=-1				'Detect file option
600   IF BYTE$="N" THEN CONOFF=-1			'Detect console off
610   IF INDFLAG THEN 630
620   IF ASC(BYTE$)>47 AND ASC(BYTE$)<58 THEN INDENT=ASC(BYTE$)-48:INDFLAG=-1
630   IF NFLEN THEN 650
640   IF BYTE$="." THEN NFLEN=I+3			'Find filename length
650 NEXT I
660 IF NOT INDFLAG THEN INDENT=2		'Set default indent value
670 IF CONOFF AND NOT LINEPRINT AND NOT FILE THEN PRINT BL$; ELSE 720
680   PRINT CLS$;STRING$(5,10)
690   PRINT"The N option may not be selected alone.  It is used with"
700   PRINT"the print and file options as FN or PN.  -  try again.";BL$
710   GOTO 340
720 IF NFLEN>3 THEN FULLNAME$=LEFT$(FULLNAME$,NFLEN)'Drop options from filename
730 IF MID$(FULLNAME$,2,1)=";" THEN MID$(FULLNAME$,2,1)=":" 'ZCPR like (A;)
740 IF LEN(FULLNAME$)=2 AND MID$(FULLNAME$,2,1)=":" THEN PRINT CLS$ ELSE 790
750   DIR$=FULLNAME$+"*.*"
760   PRINT"Directory of drive ";FULLNAME$
770   FILES DIR$
780   GOTO 340
790 IF RIGHT$(FULLNAME$,3)="COM" OR RIGHT$(FULLNAME$,3)="OBJ" THEN PRINT CLS$;

    BL$ ELSE 840
800   PRINT CLS$;STRING$(5,10)
810   PRINT"Please don't do that to me.  I only work on dBASE II command";BL$
820   PRINT"files.  ";CHR$(34);FULLNAME$;CHR$(34);" is not my kind of program."

      ;BL$
830   GOTO 340
840 IF RIGHT$(FULLNAME$,4)<>".SRC" AND RIGHT$(FULLNAME$,4)<>".CMD" THEN

    PRINT CLS$ ELSE 890
850   PRINT STRING$(5,10)
860   PRINT BL$;CHR$(34);LEFT$(FULLNAME$,15);CHR$(34);" must have a .SRC or";
870   PRINT" .CMD extension  -  try again"
880   GOTO 340
890 FILENAME$=LEFT$(FULLNAME$,NFLEN-3)
900 IF NOT FILE THEN 1050
910 TMPNAME$=FILENAME$+"TMP"
920 BAKNAME$=FILENAME$+"BAK"
930 OPEN "I",#1,BAKNAME$	'See if <filename>.BAK exists
940 CLOSE #1			'Close, if found.  Else error trap gets it
950 PRINT CLS$;STRING$(8,10)
960 PRINT TAB(20)"[]=========[]"
970 PRINT TAB(20)"[] WARNING []"
980 PRINT TAB(20)"[]=========[]"
990 PRINT
1000 PRINT TAB(14) BAKNAME$;" already exists!"
1010 PRINT:PRINT:PRINT"Do you wish to continue and overwrite ";BAKNAME$;
1020 INPUT OVERWRITE$
1030 IF LEFT$(OVERWRITE$,1)<>"Y" AND LEFT$(OVERWRITE$,1)<>"y" THEN 1630
1040 ERASEBAK=-1
1050 OPEN "I",#2,FULLNAME$
1060 IF FILE THEN OPEN "O",#3,TMPNAME$
1070 PRINT CLS$;TAB(20)"^S to pause  -  ^C to abort"
1080 PRINT
1090 WHILE NOT EOF(2)
1100   START=0:BLANK=0
1110   LINE INPUT #2,TXT$
1120   PRN$=""
1130   IF LEN(TXT$)=0 THEN 1380
1140   LINENUM=LINENUM+1
1150   TEMP$=TXT$
1160   FOR BYTE=1 TO LEN(TEMP$)
1170     CHAR=ASC(MID$(TEMP$,BYTE,1))
1180     IF CHAR>127 THEN 1740
1190     IF CHAR>96 AND CHAR<123 THEN MID$(TEMP$,BYTE,1)=CHR$(CHAR-32)
1200     IF BYTE-BLANK>3 THEN BYTE=LEN(TEMP$)
1210     IF START THEN 1230
1220     IF CHAR=32 OR CHAR=9 THEN BLANK=BLANK+1 ELSE START=BYTE
1230   NEXT BYTE
1240   IF MID$(TEMP$,BLANK+1,4)="ENDT" THEN TEXTFLAG=0
1250   IF TEXTFLAG THEN PRN$=TXT$:GOTO 1380
1260   IF MID$(TEMP$,BLANK+1,4)="TEXT" THEN TEXTFLAG=-1
1270   IF MID$(TEMP$,BLANK+1,4)="ENDI" THEN IFNUM=IFNUM-1
1280   IF MID$(TEMP$,BLANK+1,4)="ENDD" THEN DOWHILENUM=DOWHILENUM-1
1290   IF MID$(TEMP$,BLANK+1,4)="ENDC" THEN DOCASENUM=DOCASENUM-1
1300   IF MID$(TEMP$,BLANK+1,4)="ELSE" OR MID$(TEMP$,BLANK+1,4)="OTHE"

       THEN BACKUP=1 ELSE BACKUP=0
1310   INDLEVEL=IFNUM+DOWHILENUM+DOCASENUM-BACKUP
1320   IF INDLEVEL<0 THEN 1850
1330   PRN$=PRN$+STRING$(INDENT*INDLEVEL,32)
1340   IF MID$(TEMP$,BLANK+1,2)="IF" THEN IFNUM=IFNUM+1
1350   IF MID$(TEMP$,BLANK+1,4)="DO W" THEN DOWHILENUM=DOWHILENUM+1
1360   IF MID$(TEMP$,BLANK+1,4)="DO C" THEN DOCASENUM=DOCASENUM+1
1370   PRN$=PRN$+MID$(TXT$,BLANK+1)
1380   IF NOT CONOFF THEN PRINT PRN$
1390   IF LINEPRINT THEN LPRINT PRN$
1400   IF FILE THEN PRINT #3, PRN$
1410   QUIT$=INKEY$
1420   IF QUIT$<>"" THEN GOSUB 1680
1430 WEND
1440 CLOSE
1450 IF IFNUM=0 AND DOWHILENUM=0 AND DOCASENUM=0 THEN 1550
1460 PRINT BL$;"*** WARNING ***  This file has the following errors:";BL$
1470 IF IFNUM>0 THEN PRINT TAB(17) IFNUM;"- IF without ENDIF"
1480 IF DOWHILENUM>0 THEN PRINT TAB(17) DOWHILENUM;"- DO WHILE without ENDDO"
1490 IF DOCASENUM>0 THEN PRINT TAB(17) DOCASENUM;"- DO CASE without ENDCASE"
1500 IF IFNUM<0 THEN PRINT TAB(17) IFNUM;"- ENDIF without IF"
1510 IF DOWHILENUM<0 THEN PRINT TAB(17) DOWHILENUM;"- ENDDO without DO WHILE"
1520 IF DOCASENUM<0 THEN PRINT TAB(17) DOCASENUM;"- ENDCASE without DO CASE"
1530 IF FILE THEN KILL TMPNAME$:PRINT"No files changed."
1540 GOTO 1660
1550 IF NOT FILE THEN 1630
1560 PRINT
1570 IF ERASEBAK THEN KILL BAKNAME$ ELSE 1590
1580   PRINT"Erasing ";BAKNAME$
1590 PRINT"Changing ";FULLNAME$;" to ";BAKNAME$
1600 NAME FULLNAME$ AS BAKNAME$
1610 PRINT"Changing ";TMPNAME$;" to ";FULLNAME$
1620 NAME TMPNAME$ AS FULLNAME$
1630 PRINT
1640 INPUT"Are you finished";ANS$
1650 IF LEFT$(ANS$,1)<>"Y" AND LEFT$(ANS$,1)<>"y" THEN 170
1660 END
1670		'The Quit routine only works with BASCOM
1680 IF QUIT$=CHR$(3) THEN CLOSE ELSE 1720
1690   IF FILE THEN KILL TMPNAME$
1700   PRINT"*** ABORTING *** ^C entered from keyboard, no files changed."
1710   GOTO 1640
1720 IF QUIT$=CHR$(19) THEN WHILE INKEY$="":WEND	'If ^S then hold
1730 RETURN
1740 CLOSE
1750 PRINT BL$
1760 PRINT"*** ABORTING ***  This file contains bytes with the 8th bit set!";BL$
1770 PRINT"		  If this file has the extension .CMD, check to"
1780 PRINT"		  see if it is an encoded file.  Otherwise,"
1790 PRINT"		  filter the file to set the 8th bit low."
1800 PRINT"		  The error was on line";LINENUM;"of file ";FULLNAME$
1810 PRINT"		  Which reads:"
1820 PRINT:PRINT TXT$
1830 IF FILE THEN KILL TMPNAME$
1840 GOTO 1630
1850 PRINT BL$
1860 PRINT"*** ABORTING ***  One too many end statements were found.";BL$
1870 IF IFNUM<0 THEN PRINT TAB(19)"ENDIF without IF"
1880 IF DOWHILENUM<0 THEN PRINT TAB(19)"ENDDO without DO WHILE"
1890 IF DOCASENUM<0 THEN PRINT TAB(19)"ENDCASE without DO CASE"
1900 PRINT"                  Error was on line";LINENUM;"of file ";FULLNAME$;
1910 PRINT" Which reads:"
1920 PRINT
1930 PRINT TXT$
1940 IF FILE THEN KILL TMPNAME$
1950 PRINT
1960 GOTO 1660
1970 IF ERR=53 AND ERL=930 THEN CLOSE #1 ELSE 1990
1980   RESUME 1050
1990 IF ERR=53 AND ERL=100 THEN CLOSE #1 ELSE 2230
2000   PRINT STRING$(20,10)
2010   PRINT BL$;"CLS.DAT not found."
2020   PRINT"Please enter your your clear screen sequence"
2030   PRINT"one byte at a time in Decimal numbers.  End your"
2040   PRINT"entries with a <RETURN> to generate CLS.DAT"
2050   PRINT
2060   FOR I=1 TO 9
2070     PRINT"Clear Screen character";I;
2080     LINE INPUT C$
2090     IF C$="" AND I>1 THEN 2180
2100     IF C$="" THEN 2070
2110     IF LEN(C$)>3 THEN 2070
2120     FOR J=1 TO LEN(C$)
2130       IF ASC(MID$(C$,J,1))<48 OR ASC(MID$(C$,J,1))>57 THEN PRINT BL$;

           "Whole decimal numbers only.":GOTO 2070
2140     NEXT J
2150     IF I>1 THEN CLR$=CLR$+CHR$(13)+CHR$(10)
2160     CLR$=CLR$+C$
2170   NEXT I
2180   PRINT"Writing CLS.DAT";
2190   OPEN "O",#1,"CLS.DAT"
2200   PRINT #1,CLR$
2210   CLOSE #1
2220   RESUME 100
2230 IF ERR=53 AND ERL=390 THEN CLOSE #1 ELSE 2270
2240   PRINT CLS$;STRING$(5,10)
2250   PRINT BL$;"DBINDENT.HLP not found on this disk."
2260   RESUME 340
2270 IF ERR=64 THEN CLOSE ELSE 2310
2280   PRINT CLS$;STRING$(5,10)
2290   PRINT BL$;CHR$(34);FULLNAME$;CHR$(34);" is a bad file name - try again."
2300   RESUME 340
2310 IF ERR=53 AND ERL=1050 THEN CLOSE #2 ELSE 2350
2320   PRINT CLS$;STRING$(5,10)
2330   PRINT BL$;CHR$(34);FULLNAME$;CHR$(34);" not found - try again."
2340   RESUME 340
2350 ON ERROR GOTO 0
TRING$(5,10)
2330   PRINT BL$;CHR$(34);FU