'===========================================================================
' Subject: MUNCH BINARY SCRIPT ENCODER 1.2   Date: 04-29-99 (23:32)       
' Author:  Jonathan Gilbert                  Code: QB, PDS                
' Origin:  logic@phayze.com                Packet: BINARY.ABC
'===========================================================================
'--
'Written in QB71, but should work in QB45/PB if you comment out lines #52,
'#54, #59, #186, and #301 (all of which call DIR$).
'--
'This program works similarly to PostIt, except that it has slightly
'different goals and limits:
'            PostIt          |  Munch
' ---------------------------|-------------------
' target:   7-bit line-based | 8-bit line-based
'                            |
' method:   base-86 encoding | base-128 encoding
'                            |
' output:   single source    | multiple source
'           file split into  | files, non-split
'           multiple non-    |
'           executable files |
'                            |
' maximum                    |
' input                      |
' size:     roughly 150K     | no maximum
'                            |
' error                      |
' checking: 8-bit checksum   | 9-bit modified crc
' -----------------------------------------------
'
'To anyone well-acquanted with messaging systems and PostIt, it should be
'obvious that Munch is not PostIt. PostIt was designed for message systems
'which stripped bit 7 from messages passing through, while Munch was
'designed for 8-bit line-based systems which can't directly process binary
'data, ABC being a such example. As Munch uses a higher per-character data
'density, its output files are significantly smaller than PostIt's. Try it!
'--
'<legalese>
'Copyright (C) 1999 by Jonathan Gilbert, aka logiclrd, of Delta Q Development
'This source code is released to the public domain with a limited
'distribution license. You, the user, may distribute this code without
'restrictions, provided that it is not modified from its original form.
'If you do not agree with this license, then you may not legally modify,
'distribute or make use of this program. Also, any damaged caused by this
'or by its use is not the responsibility or the liability of Delta Q
'Development or any of its affiliates. This software package is provided
'"as-is", without warrantee or guarantee of any kind. Use at your own risk.
'</legalese>
'--
CONST maxout& = 10240, maxsubs% = 12
CONST version$ = "1.2"
charset$ = "#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ กขฃ"
freeletters$ = "BEFGHJKLMNPQRUVWX"
PRINT "Munch v" + version$ + " by logiclrd of Delta Q Development"
PRINT "(sorry for the icky interface =P)"
PRINT
IF DIR$("*.zip") <> "" THEN FILES "*.zip"
LINE INPUT "Input file: ", infile$
IF DIR$(infile$) = "" THEN PRINT "Input file does not exist!": END
OPEN infile$ FOR BINARY AS #1
LINE INPUT "Output file prefix (max 6 chars): ", outfile$
oif$ = infile$
LINE INPUT "Target file: ", infile$
IF DIR$(outfile$ + "00.BAS") <> "" THEN
 PRINT "Output file already exists!"
 PRINT "Overwrite (y/A)?"
 DO
  a$ = UCASE$(INPUT$(1))
  IF (a$ = CHR$(13)) OR (a$ = CHR$(27)) THEN a$ = "A"
 LOOP UNTIL INSTR("YA", a$)
 IF a$ = "A" THEN PRINT "Aborted...": END
END IF
OPEN outfile$ + "00.BAS" FOR OUTPUT AS #2
outfile$ = UCASE$(outfile$)
IF infile$ = "" THEN
 infile$ = oif$
 x% = INSTR(infile$, "\")
 DO WHILE x%
  infile$ = MID$(infile$, x% + 1)
  x% = INSTR(infile$, "\")
 LOOP
END IF
infile$ = UCASE$(infile$)
PRINT #2, "DEFINT A-Z:OPEN" + CHR$(34) + "O" + CHR$(34) + ",1," + CHR$(34) + infile$
PRINT #2, "CLOSE 1:OPEN" + CHR$(34) + "B" + CHR$(34) + ",1," + CHR$(34) + infile$ + CHR$(34) + "'Munch " + version$
PRINT #2, "?STRING$(60,176);:LOCATE,1"
PRINT #2, "SUB " + LEFT$(freeletters$, 1)
PRINT "Writing " + outfile$ + "00.BAS ..."
o$ = "D" + CHR$(34)
file% = 1
thissub% = 1
lastsize& = 0
lastpercent% = 0
DO
 a$ = INPUT$(7, 1)
 l% = LEN(a$)
 a$ = a$ + STRING$(7 - LEN(a$), 0)
 s% = 0
 FOR i% = 1 TO 7
  c% = ASC(MID$(a$, i%, 1))
  s% = (s% * 2) OR (c% \ 128)
  MID$(a$, i%, 1) = CHR$(c% AND 127)
 NEXT i%
 o$ = o$ + MID$(charset$, s% + 1, 1)
 IF LEN(o$) = 76 THEN
  PRINT #2, o$
  outbytes& = outbytes& + LEN(o$) + 2
  IF outbytes& > maxout& THEN
   thissub% = thissub% + 1
   IF LOC(1) = LOF(1) THEN
    newpercent% = (LOC(1) - 1) * 60 \ LOF(1)
    extra% = newpercent% - lastpercent%
    IF newpercent% = 60 THEN
     SELECT CASE extra%
      CASE 1 TO 16: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + " " + CHR$(34) + ";";
      CASE IS > 16: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178)+" + CHR$(34) + " " + CHR$(34) + ";";
     END SELECT
    ELSE
     SELECT CASE extra%
      CASE 1 TO 13: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + CHR$(34) + ";";
      CASE IS > 13: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178);";
     END SELECT
    END IF
    lastpercent% = newpercent%
    PRINT #2, ":END SUB"
    IF lastsize& THEN PRINT #2, "IF LOF(1)<>" + LTRIM$(RTRIM$(STR$(lastsize&))) + "THEN?" + CHR$(34) + "Bad =(" + CHR$(34) + ":CLOSE 1:END"
    PRINT #2, "Y:";
    FOR i% = 2 TO thissub%
     PRINT #2, MID$(freeletters$, i% - 1, 1) + ":";
    NEXT i%
    PRINT #2, "D" + CHR$(34);
    FOR i% = 1 TO l%
     c% = ASC(MID$(a$, i%, 1))
     PRINT #2, MID$(charset$, c%, 1);
     s% = s% * 2
     crc% = (crc% * 2 + (c% OR (s% AND 128)) XOR i%) AND 511 XOR crc% \ 256
    NEXT i%
    PRINT #2, CHR$(34) + ":CLOSE 1:IF c=" + LTRIM$(RTRIM$(STR$(crc%))) + "THEN?" + CHR$(34) + "Ok =}" + CHR$(34) + "ELSE?" + CHR$(34) + "Bad =("
    PRINT #2, "?" + CHR$(34) + "Encoded with Munch " + version$ + " by logiclrd/DQD"
    PRINT #2, "SUB d(a$):STATIC o,s,z AS STRING*1:SHARED c:FOR i=1TO LEN(a$)"
    PRINT #2, "IF o=0THEN"
    PRINT #2, "s=ASC(MID$(a$,i))-35:s=s+(s>92):o=1"
    PRINT #2, "ELSE:o=7AND(o+1):t=ASC(MID$(a$,i))-35:s=s*2:t=t+(t>92)+(128AND s)"
    PRINT #2, "z=CHR$(t):PUT#1,,z:c=511AND(c*2+t XOR i)XOR c\256"
    PRINT #2, "ENDIF:NEXT:END SUB"
    CLOSE #2
    handled% = -1
    EXIT DO
   ELSE
    n$ = "D" + CHR$(34)
    FOR i% = 1 TO l%
     c% = ASC(MID$(a$, i%, 1))
     n$ = n$ + MID$(charset$, c%, 1)
     s% = s% * 2
     crc% = (crc% * 2 + (c% OR (s% AND 128)) XOR i%) AND 511 XOR crc% \ 256
    NEXT i%
    PRINT #2, n$; CHR$(34)
    newpercent% = (LOC(1) - 1) * 60 \ LOF(1)
    extra% = newpercent% - lastpercent%
    IF newpercent% = 60 THEN
     SELECT CASE extra%
      CASE 1 TO 16: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + " " + CHR$(34) + ";";
      CASE IS > 16: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178)+" + CHR$(34) + " " + CHR$(34) + ";";
     END SELECT
    ELSE
     SELECT CASE extra%
      CASE 1 TO 13: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + CHR$(34) + ";";
      CASE IS > 13: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178);";
     END SELECT
    END IF
    lastpercent% = newpercent%
    PRINT #2, ":END SUB"
    outbytes& = 0
    IF thissub% <= maxsubs% THEN
     PRINT #2, "SUB " + MID$(freeletters$, thissub%, 1)
    ELSE
     IF lastsize& THEN PRINT #2, "IF LOF(1)<>" + LTRIM$(RTRIM$(STR$(lastsize&))) + "THEN?" + CHR$(34) + "Bad =(" + CHR$(34) + ":CLOSE 1:END"
     PRINT #2, "Y:";
     FOR i% = 1 TO maxsubs%
      PRINT #2, MID$(freeletters$, i%, 1) + ":";
     NEXT i%
     PRINT #2, "CLOSE 1:IF c=" + LTRIM$(RTRIM$(STR$(crc%))) + "THEN CHAIN" + CHR$(34) + outfile$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(file%))), 2) + ".BAS" + CHR$(34) + "ELSE?" + CHR$(34) + "Bad =("
     PRINT #2, "SUB d(a$):STATIC o,s,z AS STRING*1:SHARED c:FOR i=1TO LEN(a$)"
     PRINT #2, "IF o=0THEN"
     PRINT #2, "s=ASC(MID$(a$,i))-35:s=s+(s>92):o=1"
     PRINT #2, "ELSE:o=7AND(o+1):t=ASC(MID$(a$,i))-35:s=s*2:t=t+(t>92)+(128AND s)"
     PRINT #2, "z=CHR$(t):PUT#1,,z:c=511AND(c*2+t XOR i)XOR c\256"
     PRINT #2, "ENDIF:NEXT:END SUB"
     CLOSE #2
     thisfile$ = outfile$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(file%))), 2) + ".BAS"
     IF DIR$(thisfile$) <> "" THEN
      PRINT "Output file "; thisfile$; "already exists!"
      PRINT "Overwrite (y/A)?"
      DO
       a$ = UCASE$(INPUT$(1))
       IF (a$ = CHR$(13)) OR (a$ = CHR$(27)) THEN a$ = "A"
      LOOP UNTIL INSTR("YA", a$)
      IF a$ = "A" THEN PRINT "Aborted...": END
     END IF
     OPEN thisfile$ FOR OUTPUT AS #2
     PRINT #2, "DEFINT A-Z:OPEN" + CHR$(34) + "B" + CHR$(34) + ",1," + CHR$(34) + infile$ + CHR$(34) + ":SEEK 1,LOF(1)+1:c=" + LTRIM$(RTRIM$(STR$(crc%)))
     PRINT #2, "SUB " + LEFT$(freeletters$, 1)
     PRINT "Writing " + thisfile$ + " ..."
     lastsize& = LOC(1)
     thissub% = 1
     file% = file% + 1
     l% = 0
    END IF
   END IF
  END IF
  o$ = "D" + CHR$(34)
 END IF
 FOR i% = 1 TO l%
  c% = ASC(MID$(a$, i%, 1))
  o$ = o$ + MID$(charset$, c% + 1, 1)
  s% = s% * 2
  crc% = (crc% * 2 + (c% OR (s% AND 128)) XOR (LEN(o$) - 2)) AND 511 XOR crc% \ 256
  IF LEN(o$) = 76 THEN
   PRINT #2, o$
   outbytes& = outbytes& + LEN(o$) + 2
   IF outbytes& > maxout& THEN
    thissub% = thissub% + 1
    IF LOC(1) = LOF(1) THEN
     newpercent% = (LOC(1) - 1) * 60 \ LOF(1)
     extra% = newpercent% - lastpercent%
     IF newpercent% = 60 THEN
      SELECT CASE extra%
       CASE 1 TO 16: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + " " + CHR$(34) + ";";
       CASE IS > 16: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178)+" + CHR$(34) + " " + CHR$(34) + ";";
      END SELECT
     ELSE
      SELECT CASE extra%
       CASE 1 TO 13: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + CHR$(34) + ";";
       CASE IS > 13: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178);";
      END SELECT
     END IF
     lastpercent% = newpercent%
     PRINT #2, ":END SUB"
     IF lastsize& THEN PRINT #2, "IF LOF(1)<>" + LTRIM$(RTRIM$(STR$(lastsize&))) + "THEN?" + CHR$(34) + "Bad =(" + CHR$(34) + ":CLOSE 1:END"
     PRINT #2, "Y:";
     FOR j% = 2 TO thissub%
      PRINT #2, MID$(freeletters$, j% - 1, 1) + ":";
     NEXT j%
     PRINT #2, "D" + CHR$(34);
     FOR j% = i% + 1 TO l%
      c% = ASC(MID$(a$, j%, 1))
      PRINT #2, MID$(charset$, c%, 1);
      s% = s% * 2
      crc% = (crc% * 2 + (c% OR (s% AND 128)) XOR i%) AND 511 XOR crc% \ 256
     NEXT j%
     PRINT #2, CHR$(34) + ":CLOSE 1:IF c=" + LTRIM$(RTRIM$(STR$(crc%))) + "THEN?" + CHR$(34) + "Ok =}" + CHR$(34) + "ELSE?" + CHR$(34) + "Bad =("
     PRINT #2, "?" + CHR$(34) + "Encoded with Munch " + version$ + " by logiclrd/DQD"
     PRINT #2, "SUB d(a$):STATIC o,s,z AS STRING*1:SHARED c:FOR i=1TO LEN(a$)"
     PRINT #2, "IF o=0THEN"
     PRINT #2, "s=ASC(MID$(a$,i))-35:s=s+(s>92):o=1"
     PRINT #2, "ELSE:o=7AND(o+1):t=ASC(MID$(a$,i))-35:s=s*2:t=t+(t>92)+(128AND s)"
     PRINT #2, "z=CHR$(t):PUT#1,,z:c=511AND(c*2+t XOR i)XOR c\256"
     PRINT #2, "ENDIF:NEXT:END SUB"
     CLOSE #2
     handled% = -1
     EXIT DO
    ELSE
     IF i% <> l% THEN
      n$ = "D" + CHR$(34)
      FOR j% = i% + 1 TO l%
       c% = ASC(MID$(a$, i%, 1))
       n$ = n$ + MID$(charset$, c%, 1)
       s% = s% * 2
       crc% = (crc% * 2 + (c% OR (s% AND 128)) XOR i%) AND 511 XOR crc% \ 256
      NEXT j%
      PRINT #2, n$; CHR$(34)
     END IF
     newpercent% = (LOC(1) - 1) * 60 \ LOF(1)
     extra% = newpercent% - lastpercent%
     IF newpercent% = 60 THEN
      SELECT CASE extra%
       CASE 1 TO 16: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + " " + CHR$(34) + ";";
       CASE IS > 16: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178)+" + CHR$(34) + " " + CHR$(34) + ";";
      END SELECT
     ELSE
      SELECT CASE extra%
       CASE 1 TO 13: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + CHR$(34) + ";";
       CASE IS > 13: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178);";
      END SELECT
     END IF
     lastpercent% = newpercent%
     PRINT #2, ":END SUB"
     outbytes& = 0
     IF thissub% <= maxsubs% THEN
      PRINT #2, "SUB " + MID$(freeletters$, thissub%, 1)
     ELSE
      IF lastsize& THEN PRINT #2, "IF LOF(1)<>" + LTRIM$(RTRIM$(STR$(lastsize&))) + "THEN?" + CHR$(34) + "Bad =(" + CHR$(34) + ":CLOSE 1:END"
      PRINT #2, "Y:";
      FOR j% = 1 TO maxsubs%
       PRINT #2, MID$(freeletters$, j%, 1) + ":";
      NEXT j%
      PRINT #2, "CLOSE 1:IF c=" + LTRIM$(RTRIM$(STR$(crc%))) + "THEN CHAIN" + CHR$(34) + outfile$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(file%))), 2) + ".BAS" + CHR$(34) + "ELSE?" + CHR$(34) + "Bad =("
      PRINT #2, "SUB d(a$):STATIC o,s,z AS STRING*1:SHARED c:FOR i=1TO LEN(a$)"
      PRINT #2, "IF o=0THEN"
      PRINT #2, "s=ASC(MID$(a$,i))-35:s=s+(s>92):o=1"
      PRINT #2, "ELSE:o=7AND(o+1):t=ASC(MID$(a$,i))-35:s=s*2:t=t+(t>92)+(128AND s)"
      PRINT #2, "z=CHR$(t):PUT#1,,z:c=511AND(c*2+t XOR i)XOR c\256"
      PRINT #2, "ENDIF:NEXT:END SUB"
      CLOSE #2
      thisfile$ = outfile$ + RIGHT$("0" + LTRIM$(RTRIM$(STR$(file%))), 2) + ".BAS"
      IF DIR$(thisfile$) <> "" THEN
       PRINT "Output file "; thisfile$; "already exists!"
       PRINT "Overwrite (y/A)?"
       DO
        a$ = UCASE$(INPUT$(1))
        IF (a$ = CHR$(13)) OR (a$ = CHR$(27)) THEN a$ = "A"
       LOOP UNTIL INSTR("YA", a$)
       IF a$ = "A" THEN PRINT "Aborted...": END
      END IF
      OPEN thisfile$ FOR OUTPUT AS #2
      PRINT #2, "DEFINT A-Z:OPEN" + CHR$(34) + "B" + CHR$(34) + ",1," + CHR$(34) + infile$ + CHR$(34) + ":SEEK 1,LOF(1)+1:c=" + LTRIM$(RTRIM$(STR$(crc%)))
      PRINT #2, "SUB " + LEFT$(freeletters$, 1)
      PRINT "Writing " + thisfile$ + " ..."
      lastsize& = LOC(1)
      thissub% = 1
      file% = file% + 1
     END IF
    END IF
    o$ = "D" + CHR$(34)
    EXIT FOR
   END IF
   o$ = "D" + CHR$(34)
  END IF
 NEXT i%
LOOP UNTIL LOC(1) = LOF(1)
CLOSE #1
IF NOT handled% THEN
 PRINT #2, o$
 extra% = 60 - lastpercent%
 SELECT CASE extra%
  CASE 1 TO 16: PRINT #2, "?" + CHR$(34) + STRING$(extra%, 178) + " " + CHR$(34) + ";";
  CASE IS > 16: PRINT #2, "?STRING$(" + LTRIM$(RTRIM$(STR$(extra%))) + ",178)+" + CHR$(34) + " " + CHR$(34) + ";";
 END SELECT
 PRINT #2, ":END SUB"
 IF lastsize& THEN PRINT #2, "IF LOF(1)<>" + LTRIM$(RTRIM$(STR$(lastsize&))) + "THEN?" + CHR$(34) + "Bad =(" + CHR$(34) + ":CLOSE 1:END"
 PRINT #2, "Y:";
 FOR i% = 1 TO thissub%
  PRINT #2, MID$(freeletters$, i%, 1) + ":";
 NEXT i%
 PRINT #2, "CLOSE 1:IF c=" + LTRIM$(RTRIM$(STR$(crc%))) + "THEN?" + CHR$(34) + "Ok =}" + CHR$(34) + "ELSE?" + CHR$(34) + "Bad =("
 PRINT #2, "?" + CHR$(34) + "Encoded with Munch " + version$ + " by logiclrd/DQD"
 PRINT #2, "SUB d(a$):STATIC o,s,z AS STRING*1:SHARED c:FOR i=1TO LEN(a$)"
 PRINT #2, "IF o=0THEN"
 PRINT #2, "s=ASC(MID$(a$,i))-35:s=s+(s>92):o=1"
 PRINT #2, "ELSE:o=7AND(o+1):t=ASC(MID$(a$,i))-35:s=s*2:t=t+(t>92)+(128AND s)"
 PRINT #2, "z=CHR$(t):PUT#1,,z:c=511AND(c*2+t XOR i)XOR c\256"
 PRINT #2, "ENDIF:NEXT:END SUB"
 CLOSE #2
END IF