'===========================================================================
' Subject: (DE)COMPRESS QB FILES              Date: 07-01-97 (00:00)       
'  Author: The ABC Programmer                 Code: QB, QBasic, PDS        
'  Origin: voxel@freenet.edmonton.ab.ca     Packet: ALGOR.ABC
'===========================================================================
'(De)compress QB/QBasic/PDS/VBDOS files  Programmed by William Yu (07-01-97)

DECLARE SUB DeCompressQBFile (InFile$, OutFile$)
DECLARE SUB CompressQBFile (InFile$, OutFile$)
DEFINT A-Z

CONST ID = 255        ' Identifier

TYPE Reference
  Text AS STRING * 20
  Symbol AS INTEGER
END TYPE

DIM SHARED RefData(1 TO 510) AS Reference  ' 510 is the maximum I allow.
DIM SHARED NumRef

READ NumRef
FOR I = 1 TO NumRef
  READ RefData(I).Text
  READ RefData(I).Symbol
NEXT I

 InFile$ = "COMPQB.BAS"
OutFile$ = "COMPQB.CQB"

CLS
CompressQBFile InFile$, OutFile$

 InFile$ = "COMPQB.CQB"
OutFile$ = "SAMPLE.BAS"

DeCompressQBFile InFile$, OutFile$

' Here's a short list of the many statements/functions in a typical QB program.
' For maximal compression, use them all! <g>
' Fully customizable table w/simple compression and decompression algorithms.
' After using COMPQB.BAS, PKZIP compresses the output a little better!

' Try not to exceed 255, as anything over that will use up 3 bytes instead
' of only 2 bytes.

' Data DOES NOT have to be in numerical order, but it helps to speed up the
' decompression process if it is.

DATA 100
DATA DECLARE SUB,1
DATA DECLARE FUNCTION,2
DATA END SUB,3
DATA END FUNCTION,4
DATA FOR INPUT AS,5
DATA FOR OUTPUT AS,6
DATA FOR BINARY AS,7
DATA FOR APPEND AS,8
DATA SELECT CASE,9
DATA END SELECT,10
DATA END TYPE,11
DATA LOOP UNTIL,12
DATA END IF,13
DATA ELSE IF,14
DATA DIM SHARED,15
DATA PRINT USING,16
DATA COMMON SHARED,17
DATA RANDOMIZE TIMER,18
DATA AS INTEGER,19
DATA AS STRING,20
DATA AS DOUBLE,21
DATA AS SINGLE,22
DATA AS ANY,23
DATA AS LONG,24
DATA EXIT SUB,25
DATA DEFINT A-Z,26
DATA DEF SEG,27
DATA GOSUB,28
DATA COLOR,29
DATA LOCATE,30
DATA CIRCLE,31
DATA PRINT ",32
DATA ABS,33
DATA PAINT,34
DATA CASE,35
DATA CONST,36
DATA TYPE,37
DATA FUNCTION,38
DATA ELSE,39
DATA THEN,40
DATA RETURN,41
DATA GOTO,42
DATA DIM,43
DATA NEXT,44
DATA EXIT,45
DATA INKEY$,46
DATA WHILE,47
DATA OPEN,48
DATA CLOSE,49
DATA FREEFILE,50
DATA LINE INPUT,51
DATA PRINT,52
DATA WRITE,53
DATA XOR,54
DATA COMMAND$,55
DATA STEP,56
DATA READ,57
DATA POKE,58
DATA WEND,59
DATA "DATA",60
DATA FOR,61
DATA CLS,62
DATA LOF(,63
DATA EOF(,64
DATA PSET,65
DATA POINT,66
DATA SUB,67
DATA GET,68
DATA PUT,69
DATA LINE,70
DATA VARPTR$(,71
DATA VARPTR(,72
DATA VARSTR(,73
DATA PEEK,74
DATA SADD,75
DATA RTRIM$(,76
DATA LTRIM$(,77
DATA LEFT$(,78
DATA MID$(,79
DATA RIGHT$(,80
DATA LEN(,81
DATA CHR$(,82
DATA ASC(,83
DATA INSTR,84
DATA BLOAD,85
DATA BSAVE,86
DATA SCREEN,87
DATA ON ERROR,88
DATA ON KEY,89
DATA WIDTH,90
DATA PLAY,91
DATA SLEEP,92
DATA AND,93
DATA SPACE$(,94
DATA MOD,95

' These demonstrate customizable compression

DATA CompressQBFile,96
DATA Ref,97
DATA InFile,98
DATA OutFile,99
DATA Text,100

SUB CompressQBFile (InFile$, OutFile$)

PRINT " Compressing: "; InFile$
PRINT "Outputing to: "; OutFile$

InFile = FREEFILE
OPEN InFile$ FOR INPUT AS InFile
OutFile = FREEFILE
OPEN OutFile$ FOR OUTPUT AS OutFile

FileBytes& = LOF(InFile)

DO
  LINE INPUT #InFile, Text$
  FOR I = 1 TO NumRef
    A = INSTR(Text$, RTRIM$(RefData(I).Text))
    WHILE A
      IF A THEN
        B = B + 1
        IF A > 1 THEN FText$ = LEFT$(Text$, A - 1) ELSE FText$ = ""
        IF RefData(I).Symbol > 255 THEN
          Symbol$ = CHR$(0) + CHR$(RefData(I).Symbol MOD 255)
                   '    ^^^ You can make this go up to 255 if you wish.
                   '  So you can keep up to 255*255 references!
        ELSE
          Symbol$ = CHR$(RefData(I).Symbol)
        END IF
        Text$ = FText$ + CHR$(ID) + Symbol$ + MID$(Text$, A + LEN(RTRIM$(RefData(I).Text)), LEN(Text$))
        OrigText& = OrigText& + LEN(RTRIM$(RefData(I).Text))
      END IF
      A = INSTR(Text$, RTRIM$(RefData(I).Text))
    WEND
  NEXT I
  PRINT #OutFile, Text$
  LOCATE 4, 1
  PRINT USING "Saved: ##,### bytes!"; OrigText& - (B * 2)
  PRINT USING "Compressed: ##.#% of file"; (OrigText& - (B * 2)) / FileBytes& * 100;
LOOP UNTIL EOF(InFile)
CLOSE InFile
CLOSE OutFile

END SUB

SUB DeCompressQBFile (InFile$, OutFile$)

' Test on several different source codes, works about 99% of the time
' Seems to choke on badly written code though :)

PRINT
PRINT
PRINT "Decompressing: "; InFile$
PRINT " Outputing to: "; OutFile$

InFile = FREEFILE
OPEN InFile$ FOR BINARY AS InFile       ' Must watch for CHR$(13)
OutFile = FREEFILE
OPEN OutFile$ FOR OUTPUT AS OutFile

FileBytes& = LOF(InFile)

Pointer& = 1
CrLf$ = CHR$(13) + CHR$(10)
DO
  Text$ = SPACE$(256)                   ' Don't encode code with long lines
  GET #InFile, Pointer&, Text$
  Text$ = MID$(Text$, 1, INSTR(Text$, CrLf$) - 1)
  Pointer& = Pointer& + LEN(Text$) + 2
  FText$ = ""
  I = 1
  WHILE I < LEN(Text$)
    IF MID$(Text$, I, 1) = CHR$(ID) THEN
      Sym = ASC(MID$(Text$, I + 1, 1))
      IF Sym = 0 THEN Sym = 255 + ASC(MID$(Text$, I + 2, 1))
      X = Sym
      IF RefData(X).Symbol <> Sym THEN     ' In case you mess up the
        FOR X = 1 TO NumRef                ' reference chart.
          IF RefData(X).Symbol = Sym THEN EXIT FOR
        NEXT X
      END IF
      IF Sym > 255 THEN
        I = I + 2
      ELSE
        I = I + 1
      END IF
      FText$ = FText$ + RTRIM$(RefData(X).Text)
    ELSE
      FText$ = FText$ + MID$(Text$, I, 1)
    END IF
    I = I + 1
  WEND
  IF I = LEN(Text$) THEN FText$ = FText$ + MID$(Text$, I, 1)
  PRINT #OutFile, FText$
LOOP UNTIL Pointer& >= LOF(InFile)
CLOSE InFile
CLOSE OutFile

END SUB