'===========================================================================
' Subject: BINARY TO BASIC SCRIPT             Date: 07/92 (00:00)          
'  Author: Allan Zachary                      Code: QB, QBasic, PDS        
'  Origin: BINARY,BASIC,SCRIPT              Packet: BINARY.ABC
'===========================================================================
' .------------------------------------------------------.
' |    BIN2QB.BAS  by Allan Zachary Public Domain 7/92   |
' |  Converts binary files to echo-compatible text files |
' |  version 3.3 - replaces a fallible checksum in v3.1  |
' | < Bar Charts progress, Manual or Batch style input > |
' |     BATCH SYNTAX: BIN2QB infile.ext outfile.ext      |
' `------------------------------------------------------'
DEFINT A-Z
DECLARE FUNCTION Bin2Txt$ (ThreeBytes$) ' 3 binary bytes in returns
DIM SHARED XCk&                      ' 4 printable Text bytes out
Q$ = CHR$(34): MaxFileSz& = 32760
Bin$ = RTRIM$(COMMAND$) ' (QBASIC users put 'REM' before this line.)
Split = INSTR(Bin$, " ")
IF Split = 0 THEN
  INPUT "Filename of file to convert:", InFile$
  INPUT "Output filename:", OutFile$
ELSE
  InFile$ = LEFT$(Bin$, Split - 1)
  OutFile$ = RIGHT$(Bin$, LEN(Bin$) - Split)
END IF
COLOR 12, 0: Bin$ = ""
IF LEN(InFile$) THEN
  OPEN InFile$ FOR BINARY AS #2
  Size& = LOF(2): FSiz& = Size&
ELSE
  InFile$ = "File"
END IF
IF Size& > MaxFileSz& THEN
  PRINT "Aborted- File too large for Bin2Qb!"
  BEEP: COLOR 7, 0: END
END IF
IF Size& THEN
  ON ERROR GOTO DoIt
  OPEN OutFile$ FOR INPUT AS #1
  CLOSE #1: COLOR 12, 0: PRINT OutFile$; " already exists!!"
  BEEP: COLOR 7, 0: END
DoIt:
  CLOSE #1: CLS
  COLOR 11, 0: PRINT "BIN2QB 3.3 by Allan Zachary Creating "; OutFile$
  OPEN OutFile$ FOR OUTPUT AS #1
  PRINT #1, "DEFINT A-Z  ' Created by BIN2QB 3.3 freeware 7/92"
  PRINT #1, "f$="; Q$; InFile$; Q$; ":LSBs=3"
  PRINT #1, "CLS : PRINT "; Q$; "Creating "; Q$; ";f$"
  PRINT #1, "OPEN f$ FOR BINARY AS #1 :FSize&="; FSiz&
  PRINT #1, "ON ERROR GOTO Done:LOCATE 2,1:PRINT STRING$(78,176)"
  PRINT #1, "DO"
  PRINT #1, "  READ Lyne$:LynLen=LEN(Lyne$)"
  PRINT #1, "  FOR i=1 TO LynLen "
  PRINT #1, "    Power=((i-1)MOD 4)*6"
  PRINT #1, "    B&=(ASC(MID$(Lyne$,i,1))-59)*2^Power:C&=C&+B&"
  PRINT #1, "    IF i MOD 4=0 THEN"
  PRINT #1, "      Stored&=Stored&+3:XCk&=XCk& XOR C&:LOCATE 2,1"
  PRINT #1, "      PRINT STRING$(CINT(Stored&/FSize&*78),219);"
  PRINT #1, "      IF Stored&>FSize& THEN LSBs=3+(FSize&-Stored&)"
  PRINT #1, "      Bin$=LEFT$(MKL$(C&),LSBs):PUT #1,,Bin$:C&=0"
  PRINT #1, "    ENDIF"
  PRINT #1, "  NEXT i:LOOP"
  Lyne$ = "DATA "
  BufSz& = FRE(Buf$) - 1024
  IF BufSz& > Size& THEN BufSz& = Size&
  Buf$ = SPACE$(BufSz&)
  LOCATE 2, 1: PRINT STRING$(78, 176); : COLOR 10, 0
  DO
    GET #2, , Buf$
    FOR i = 1 TO LEN(Buf$)
      Done& = Done& + 1
      Ascii = ASC(MID$(Buf$, i, 1))
      Bin$ = Bin$ + CHR$(Ascii)
      IF LEN(Bin$) = 3 THEN
        IF LEN(Lyne$) >= 69 THEN 'save it, and start a new line...
          PRINT #1, Lyne$
          LOCATE 2, 1: PRINT STRING$(CINT(Done& / Size& * 78), 219)
          Lyne$ = "DATA " + Bin2Txt$(Bin$)
        ELSE 'keep building this line...
          Lyne$ = Lyne$ + Bin2Txt$(Bin$)
        END IF
        Bin$ = ""
      END IF
    NEXT i
    Size& = Size& - BufSz&
    IF BufSz& > Size& THEN BufSz& = Size&
    Buf$ = SPACE$(BufSz&)
  LOOP WHILE LEN(Buf$)    'Until the last character has been read.
  Size& = LEN(Bin$)
  IF Size& THEN Bin$ = Bin2Txt$(Bin$)
  IF LEN(Lyne$) >= 69 THEN
    PRINT #1, Lyne$
    IF Size& THEN PRINT #1, "DATA " + Bin$
  ELSE
    PRINT #1, Lyne$ + Bin$
  END IF
  LOCATE 2, 1: PRINT STRING$(CINT(Done& / FSiz& * 78), 219)
  PRINT #1, "Done:CLOSE #1: PRINT"
  PRINT #1, "IF XCk&<>"; XCk&; " THEN "
  PRINT #1, "  PRINT "; Q$; "DATA corrupt!  File deleted."; Q$
  PRINT #1, "  KILL f$"
  PRINT #1, "ELSE"
  PRINT #1, "  PRINT f$;"; Q$; " created."; Q$
  PRINT #1, "END IF:END"
  CLOSE
  COLOR 11, 0: PRINT "done."
ELSE
 PRINT InFile$; " doesn't exist, or has no length!"
 CLOSE
END IF
COLOR 7, 0: END

FUNCTION Bin2Txt$ (ThreeBytes$)
  L = LEN(ThreeBytes$)
  N& = CVL(ThreeBytes$ + STRING$(4 - L, 0))
  XCk& = XCk& XOR N&
  FourBytes$ = ""'             .---Offset into Character set
  FOR j = 1 TO 4 '             |
    Tmp$ = CHR$((N& AND 63) + 59)
    N& = N& \ 64
    FourBytes$ = FourBytes$ + Tmp$
  NEXT j
  Bin2Txt$ = FourBytes$
END FUNCTION