10 REM	   DBSQUASH.BAS   Version 1.1     10/17/83
20 ' COPYRIGHT (C) 1983 BY GREGORY C. DAHL
30 ' THIS PROGRAM REDUCES THE SIZE OF A dBASE II (tm)
40 ' PROGRAM BY REMOVING ALL LEADING BLANKS AND MOST
50 ' UNNECESSARY BLANKS NOT WITHIN QUOTES, BY
60 ' SHORTENING THE MOST COMMON COMMANDS, AND BY
70 ' DELETING ALL COMMENTS AND BLANK LINES.
73 '
75 ' DETAILED INSTRUCTIONS ARE GIVEN IN DBSQUASH.DOC
77 '
90 DEFINT A-Z
100 COMP =  0 ' FLAG FOR COMPILED VERSION
210 IF COMP THEN N=350 ELSE N= 80 ' BLINK SPEED
220 WIDTH 52:PRINT CHR$(&H1A);
230 PRINT TAB(16)"DBSQUASH (ver. 1.1)":PRINT
240 PRINT TAB(7)"COPYRIGHT (C) 1983 BY GREGORY C. DAHL
250 IF COMP THEN PRINT TAB(6)CHR$(&H1B)CHR$(&H29)"PORTIONS COPYRIGHTED BY MICROSOFT, 1981"CHR$(&H1B)CHR$(&H28) ELSE PRINT
260 PRINT" This program is "CHR$(&H1B)CHR$(&H6C)"USER SUPPORTED SOFTWARE."CHR$(&H1B)CHR$(&H6D)"  If you
270 PRINT" find it useful and wish to encourage the develop-
280 PRINT" ment of new programs, you are invited to send a
290 PRINT" contribution to the author:
300 PRINT TAB(17) "Gregory C. Dahl
310 PRINT TAB(17)"4050 Arroyo Trail
320 PRINT TAB(17)"Carmel, CA  93923
330 PRINT" All contributors sending $10 or more will receive 
340 PRINT" a diskette with the latest version of this program 
350 PRINT" and its documentation, as well as other programs 
360 PRINT" by the same author.  Contribute as much as you feel
370 PRINT" the program is worth to you, and send your comments
380 PRINT" too!  Be sure to specify double or single density
390 PRINT" and the name of the program you want.
398 PRINT CHR$(&H1B)CHR$(&H29)"      (Offer subject to change without notice)" CHR$(&H1B)CHR$(&H28)
410 PRINT" This program is copyrighted and may not be sold 
420 PRINT" for profit without written permission from the
430 PRINT" author.  However, free copies may be made and 
440 PRINT" distributed without limitation.  Pass it around!
450 PRINT "           Press any key to continue...";
460 FOR I=1 TO N:A$=INKEY$:IF A$<>""THEN 500 ELSE NEXT I
470 PRINT CHR$(13)"                                       "CHR$(13);
480 FOR I=1 TO N:A$=INKEY$:IF A$<>""THEN 500 ELSE NEXT I
490 GOTO 450
500 PRINT CHR$(&H1A):PRINT:PRINT
503 IF COMP THEN PRINT  ELSE PRINT TAB(8)CHR$(&H1B)CHR$(&H29)"ALSO AVAILABLE IN A COMPILED VERSION":PRINT TAB(10)"WHICH RUNS ABOUT 2 TIMES FASTER"CHR$(&H1B)CHR$(&H28)
506 PRINT
510 PRINT:PRINT"  DRIVE B: IS ASSUMED UNLESS OTHERWISE SPECIFIED
520 PRINT CHR$(&H22)+"WRITE"+CHR$(&H22)+" FILE IS ASSUMED TYPE .CMD UNLESS SPECIFIED
530 PRINT:PRINT
540 LINE INPUT "      FILE TO READ FROM:  ";F1$
550 PRINT:PRINT
560 LINE INPUT "      FILE TO WRITE TO:   ";F2$
570 FOR I=1 TO LEN(F1$):IF ASC(MID$(F1$,I))>&H60 THEN MID$(F1$,I,1)=CHR$(ASC(MID$(F1$,I))-&H20)
580 NEXT I
590 FOR I=1 TO LEN(F2$):IF ASC(MID$(F2$,I))>&H60 THEN MID$(F2$,I,1)=CHR$(ASC(MID$(F2$,I))-&H20)
600 NEXT I
610 IF INSTR(1,F1$,":")=0 THEN F1$="B:"+F1$
620 IF INSTR(1,F2$,":")=0 THEN F2$="B:"+F2$
630 IF INSTR(1,F2$,".")=0 THEN F2$=F2$+".CMD"
640 IF F1$=F2$ THEN PRINT:PRINT"WAKE UP!  WRITE FILE MUST BE DIFFERENT":PRINT"  FROM READ FILE.":STOP
650 N1=0:N2=0
660 WIDTH 51 'SET SCREEN DISPLAY WIDTH
670 DATA "PICTURE","PICT","STORE","STOR"
680 DATA "SELECT PRIMARY", "SELE PRIM"
690 DATA "SELECT SECONDARY","SELE SECO"
700 DATA "SET INTENSITY","SET INTE"
710 DATA "SET CONSOLE", "SET CONS"
720 DATA "RELEASE","RELE"
730 DATA "APPEND","APPE","DO WHILE","DO WHIL"
740 DATA "STRUCTURE","STRU"
750 DATA " .NOT.",".NOT.",".NOT. ",".NOT."
760 DATA " .AND.",".AND.",".AND. ",".AND."
770 DATA " .OR.",".OR.",".OR. ",".OR."
780 DATA "DISPLAY","DISP","CONTINUE","CONT"
790 DATA "LOCATE","LOCA","REPLACE","REPL"
800 DATA "RESTORE","REST","RETURN","RETU"
810 DATA "SET ALTERNATE","SET ALTE"
820 NSUB=23 'NUMBER OF SUBSTITUTIONS
830 DIM SUB1$(25),SUB2$(25),SUB3(25)
840 FOR J=1 TO NSUB: READ SUB1$(J),SUB2$(J): SUB3(J)=LEN(SUB1$(J))-LEN(SUB2$(J)): NEXT J
850 OPEN "I",1,F1$
860 OPEN "O",2,F2$
870 PRINT CHR$(&H1A);
880 LINE INPUT#1, S$
890 N1=N1+LEN(S$)+2 'COMMULATIVE FILE LENGTH (INCLUDING CR LF AFTER EACH LINE)
900 PRINT CHR$(27)"="CHR$(34)CHR$(33)"LINE BEING PROCESSED IS:":PRINT:PRINT:PRINT S$+STRING$(255-LEN(S$)," ") 'RESET CURSOR POSITION AND DISPLAY LINE BEING PROCESSED
910 IF LEN(S$)=0 THEN 1330
920 FOR N = 1 TO LEN(S$) : IF MID$(S$,N,1)<>" " THEN 1070 ELSE NEXT N
930 GOTO 1330 'blank line
940 '

	SUBROUTINE FOR DELETING BLANKS


950 IF MID$(S$,B,1)=" " THEN S$=LEFT$(S$,B-1)+RIGHT$(S$,LEN(S$)-B):E=E-1:GOTO 950 'DELETE LEADING BLANKS
960 IF E<=B THEN RETURN
970 IF MID$(S$,E,1)=" " THEN S$=LEFT$(S$,E-1)+RIGHT$(S$,LEN(S$)-E):E=E-1:GOTO 970 'DELETE TRAILING BLANKS
980 M=INSTR(B,S$,C$) :IF M=0 OR M>=E THEN RETURN
990 ' TAKE OUT BLANKS BEFORE AND AFTER CHARACTER
1000 IF M=1 THEN 1020
1010 IF MID$(S$,M-1,1)=" " THEN S$=LEFT$(S$,M-2)+RIGHT$(S$,LEN(S$)-M+1):M=M-1:E=E-1:GOTO 1010
1020 IF M=LEN(S$) THEN RETURN
1030 IF MID$(S$,M+1,1)=" " THEN S$=LEFT$(S$,M)+RIGHT$(S$,LEN(S$)-M-1):E=E-1:GOTO 1030
1040 M=INSTR(M+1,S$,C$) :IF M<>0 AND M<=E THEN 1010
1050 RETURN
1060 '



1070 IF MID$(S$,N,1)="*" THEN 1330 ' COMMENT LINE
1080 S$=RIGHT$(S$,LEN(S$)-N+1)
1090 B=1 'BEGINNING POINTER FOR DELETIONS
1100 QUOTE=0 'FLAG FOR PRESENCE OF " (=1) OR ' (=2)
1110 Q=INSTR(B,S$,CHR$(&H22)):IF Q=0 THEN E=LEN(S$) ELSE E=Q-1 : QUOTE=1 'ENDING POINTER FOR DELETIONS BEFORE " OR END OF LINE
1120 SQ=INSTR(B,S$,"'"):IF SQ<>0 THEN IF E>SQ-1 THEN E=SQ-1 : QUOTE=2 'SET ENDING POINTER AT SINGLE QUOTE LESS ONE
1130 RM = INSTR(B,S$,"NOTE"):IF RM<>0 THEN IF E>RM-1 THEN E=RM-1 'SET ENDING POINTER BEFORE NOTE
1140 IF E<=B THEN 1260
1150 IF INSTR(1,S$,"ENDIF")=1 THEN S$="ENDI":GOTO 1310
1160 IF INSTR(1,S$,"ENDDO")=1 THEN S$="ENDD":GOTO 1310
1170 IF INSTR(1,S$,"ENDCASE")=1 THEN S$="ENDC":GOTO 1310
1180 C$="=":GOSUB 950:C$=",":GOSUB 980:C$="+":GOSUB 980:C$="-":GOSUB 980:C$="*":GOSUB 980:C$="/":GOSUB 980:C$="(":GOSUB 980:C$=")":GOSUB 980:C$="<":GOSUB 980:C$=">":GOSUB 980 'DELETE BLANKS BEFORE AND AFTER = : , + - / * ( ) < >
1190 ' SHORTEN COMMANDS
1200 FOR J=1 TO NSUB
1210 M=INSTR(B,S$,SUB1$(J)):IF M>0 AND (M+LEN(SUB1$(J))-1)<=E THEN S$=LEFT$(S$,M-1)+SUB2$(J)+MID$(S$,M+LEN(SUB1$(J))):E=E-SUB3(J):IF E<=B THEN 1240 ELSE GOTO 1210
1220 NEXT J
1230 ' CORRECT ERROR IN dBASE WHICH REQUIRES SPACE BEFORE "TO" IN INPUT COMMAND AFTER '
1240 IF INSTR(1,S$,"INPUT")>0 THEN M=INSTR(B,S$,"TO"): IF M>0 AND M<E THEN S$=LEFT$(S$,M-1)+" TO"+MID$(S$,M+2)
1250 ' FIND CLOSE QUOTE, SET NEW BEGINNING AND ENDING POINTERS
1260 IF QUOTE=0 OR E>=LEN(S$)-3 THEN 1310
1270 IF QUOTE=1 THEN QUOTE$=CHR$(&H22) ELSE QUOTE$="'"
1280 CLOSEQ=INSTR(E+2,S$,QUOTE$)
1290 IF CLOSEQ=0 THEN 1310 'NO CLOSING QUOTE
1300 B=CLOSEQ+1:GOTO 1100
1310 PRINT#2, S$
1320 N2=N2+LEN(S$)+2 'COMMULATIVE FILE LENGTH AFTER COMPRESSION
1330 PRINT CHR$(27)"="CHR$(45)CHR$(35); 'SET CURSOR POSITION
1340 PRINT TAB(10)"FILE LENGTH BEFORE:  "N1"  CHARACTERS


1350 PRINT TAB(10)"FILE LENGTH AFTER:   "N2"  CHARACTERS


1360 PRINT TAB(10) "SAVINGS              "N1-N2"  CHARACTERS
1370 IF EOF(1) THEN 1380 ELSE 880
1380 CLOSE
1390 PRINT "


	 A "(1-N2/N1)*100" PERCENT SAVING
 