'
'  Program Type ............ QBASIC 1.1 SOURCE CODE
'  Program Name ............ GWB2TXT
'  Program Version ......... 1.0
'  License ................. FREEWARE
'  Description ............. This BASIC program converts
'  GW-BASIC .BAS files from binary format to plain ASCII text.
'  It can convert protected .BAS files as well.
'  Written by Zsolt N. Perry (zsnp@juno.com) in June 2023.
'
'  NOTE: This program has not been thoroughly tested. It was
'  tested with some programs, and no errors have been found yet.
'  It was tested with QBASIC 1.1 and QBASIC 4.5 running on
'  Windows XP SP2. It ran without errors.
'
'  In order to write this program, I studied the following pages:
'
'   https://slions.net/threads/deciphering-gw-basic-basica-protected-programs.50/
'   http://justsolve.archiveteam.org/wiki/GW-BASIC_tokenized_file
'   http://www.chebucto.ns.ca/~af380/GW-BASIC-tokens.html
'
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

DEFINT A-Z
DECLARE SUB DECRYPT (INFILE$, OUTFILE$)
DECLARE SUB DECODE (INFILE$, OUTFILE$, FORMAT$)
DECLARE FUNCTION FGETC (FileHandle)
DECLARE FUNCTION FGETSTR$ (FileHandle, Length)
DECLARE FUNCTION TRIM$ (S$)
DECLARE FUNCTION GETWORD (FH)
DECLARE FUNCTION LOOKUP$ (C, WORDS$)
DECLARE FUNCTION ONLYFROM (S$, CS$)

CONST WORKDIR$ = "D:\DESKTOP"
DIM SHARED FP&
DIM SHARED PROTECTED
DIM SHARED FILESIZE&
DIM C AS STRING * 1

' Find all BAS files in the current directory and save the list
' of BAS file names in a file called BASFILEZ.TXT. The program
' then reads this file line by line and opens each BAS file...
SHELL "MD " + WORKDIR$ + "\OUTPUT"
CLS
SHELL "DIR " + WORKDIR$ + "\*.BAS /B > " + WORKDIR$ + "\BASFILEZ.TXT"
OPEN WORKDIR$ + "\BASFILEZ.TXT" FOR INPUT AS #1
DO UNTIL EOF(1)
    LINE INPUT #1, F$
    PRINT WORKDIR$ + "\" + F$,
    FORMAT$ = "A"
    OPEN WORKDIR$ + "\" + F$ FOR BINARY AS #2
    IF LOF(2) > 0 THEN GET #2, 1, FORMAT$
    CLOSE #2
    FF = ASC(FORMAT$)
    PROTECTED = 0
    IF FF = 10 OR FF = 13 OR (FF > 31 AND FF < 127) THEN
        PRINT "- ASCII text file. Skipped."
    ELSEIF FF = 255 THEN
        FORMAT$ = "Non-protected"
        PRINT "- "; FORMAT$; " GW-BASIC file, converting..."
        DECODE WORKDIR$ + "\" + F$, WORKDIR$ + "\OUTPUT\" + F$, FORMAT$
    ELSEIF FF = 254 THEN
        PROTECTED = 1
        FORMAT$ = "Protected"
        PRINT "- "; FORMAT$; " GW-BASIC file, converting..."
        DECRYPT WORKDIR$ + "\" + F$, WORKDIR$ + "\OUTPUT\_DEC0DED.BAS"
        DECODE WORKDIR$ + "\OUTPUT\_DEC0DED.BAS", WORKDIR$ + "\OUTPUT\" + F$, FORMAT$
        KILL "OUTPUT\_DEC0DED.BAS"
    ELSE
        PRINT "- Unknown format"
    END IF
LOOP
CLOSE #1
KILL WORKDIR$ + "\" + "BASFILEZ.TXT"
END

' This function converts an unprotected GW-BASIC binary file
' to plain text ASCII format.
SUB DECODE (INFILE$, OUTFILE$, FORMAT$)

    OPEN INFILE$ FOR BINARY AS #2
    FILESIZE& = LOF(2)
    IF FILESIZE& < 10 THEN
        PRINT "File too small!"
        EXIT SUB
    END IF

    OPEN OUTFILE$ FOR OUTPUT AS #3

    ' Skip first byte, because we have already processed that before coming here.
    FP& = 2
    WHILE FP& < LOF(2)

        ' Process new line:
        LINE$ = ""
        HEXCODES$ = ""
        OFFSET = GETWORD(2)

        ' Calculate line number
        LINENO& = GETWORD(2)
        LINE$ = TRIM$(STR$(LINENO&)) + " "

        ' Process line data:
        DO
            A$ = ""
            C = FGETC(2)
            IF C > 15 THEN H$ = HEX$(C) ELSE H$ = "0" + HEX$(C)
            HEXCODES$ = RIGHT$(HEXCODES$, 4) + H$
            IF C > 16 AND C < 28 THEN        ' INSERT LITERAL NUMBERS 0-10
                A$ = TRIM$(STR$(C - 17))
            ELSEIF C > 31 AND C < 126 THEN   ' INSERT LITERAL CHARACTERS
                A$ = CHR$(C)
            ELSEIF C > 128 AND C < 245 THEN
                A$ = LOOKUP$(C, " 81=END 82=FOR 83=NEXT 84=DATA 85=INPUT 86=DIM 87=READ 88=LET 89=GOTO 8A=RUN 8B=IF 8C=RESTORE 8D=GOSUB 8E=RETURN 8F=REM 90=STOP 91=PRINT 92=CLEAR 93=LIST 94=NEW 95=ON 96=WAIT 97=DEF 98=POKE 99=CONT 9C=OUT 9D=LPRINT 9E=LLIST A0=WIDTH A1=ELSE A2=TRON A3=TROFF A4=SWAP A5=ERASE A6=EDIT A7=ERROR A8=RESUME A9=DELETE AA=AUTO AB=RENUM AC=DEFSTR AD=DEFINT AE=DEFSNG AF=DEFDBL B0=LINE B1=WHILE B2=WEND B3=CALL B7=WRITE B8=OPTION B9=RANDOMIZE BA=OPEN BB=CLOSE BC=LOAD BD=MERGE BE=SAVE BF=COLOR C0=CLS C1=MOTOR C2=BSAVE C3=BLOAD C4=SOUND C5=BEEP C6=PSET C7=PRESET C8=SCREEN C9=KEY CA=LOCATE CC=TO CD=THEN CE=TAB( CF=STEP D0=USR D1=FN D2=SPC( D3=NOT D4=ERL D5=ERR D6=STRING$ D7=USING D8=INSTR D9=' DA=VARPTR DB=CSRLIN DC=POINT DD=OFF DE=INKEY$ E6=> E7== E8=< E9=+ EA=- EB=* EC=/ ED=^ EE=AND EF=OR F0=XOR F1=EQV F2=IMP F3=MOD F4=\ ")
            ELSE
                SELECT CASE C
                    CASE 0: EXIT DO                         ' END OF LINE
                    CASE 11: A$ = "&O" + OCT$(GETWORD(2))   ' OCTAL VALUE
                    CASE 12: A$ = "&H" + HEX$(GETWORD(2))   ' HEXADECIMAL VALUE
                    CASE 13: FP& = FP& + 2                  ' FILE POINTER FOR GOTO STATEMENT (NOT USED HERE)
                    CASE 14: A$ = TRIM$(STR$(GETWORD(2)))   ' LINE NUMBER USED AFTER GOTO OR GOSUB
                    CASE 15: A$ = TRIM$(STR$(FGETC(2)))     ' INTEGER CONSTANT 11-255 (1 BYTE)
                    CASE 28: A$ = TRIM$(STR$(CVI(FGETSTR$(2, 2))))     ' INTEGER CONSTANT (2 BYTES)
                    CASE 29: A$ = TRIM$(STR$(CVSMBF(FGETSTR$(2, 4))))  ' FLOAT VALUE (4 BYTES)
                    CASE 31: A$ = TRIM$(STR$(CVDMBF(FGETSTR$(2, 8))))  ' DOUBLE VALUE (8 BYTES)
                    CASE 126: A$ = " "                                 ' SPACE
                    CASE 253: A$ = LOOKUP$(FGETC(2), " 81=CVI 82=CVS 83=CVD 84=MKI$ 85=MKS$ 86=MKD$ 8B=EXTERR ")
                    CASE 254: A$ = LOOKUP$(FGETC(2), " 81=FILES 82=FIELD 83=SYSTEM 84=NAME 85=LSET 86=RSET 87=KILL 88=PUT 89=GET 8A=RESET 8B=COMMON 8C=CHAIN 8D=DATE$ 8E=TIME$ 8F=PAINT 90=COM 91=CIRCLE 92=DRAW 93=PLAY 94=TIMER 95=ERDEV 96=IOCTL 97=CHDIR 98=MKDIR 99=RMDIR 9A=SHELL 9B=ENVIRON 9C=VIEW 9D=WINDOW 9E=PMAP 9F=PALETTE A0=LCOPY A1=CALLS  A4=NOISE A5=PCOPY A6=TERM A7=LOCK A8=UNLOCK ")
                    CASE 255: A$ = LOOKUP$(FGETC(2), " 81=LEFT$ 82=RIGHT$ 83=MID$ 84=SGN 85=INT 86=ABS 87=SQR 88=RND 89=SIN 8A=LOG 8B=EXP 8C=COS 8D=TAN 8E=ATN 8F=FRE 90=INP 91=POS 92=LEN 93=STR$ 94=VAL 95=ASC 96=CHR$ 97=PEEK 98=SPACE$ 99=OCT$ 9A=HEX$ 9B=LPOS 9C=CINT 9D=CSNG 9E=CDBL 9F=FIX A0=PEN A1=STICK A2=STRIG A3=EOF A4=LOC A5=LOF ")
                END SELECT
            END IF

            ' The WHILE statement is stored with an invisible '+' sign after it
            ' which we need to skip.
            IF A$ = "WHILE" THEN FP& = FP& + 1

            ' When a single quote functions as a comment marker, it is encoded
            ' as three bytes 3A 8F D9 which would translate to :REM'
            ' In this case, we remove ":REM" from the end of LINE$
            IF A$ = "'" AND HEXCODES$ = "3A8FD9" THEN LINE$ = MID$(LINE$, 1, LEN(LINE$) - 4)

            LINE$ = LINE$ + A$
        LOOP
        IF NOT ONLYFROM(LINE$, " 0123456789") THEN PRINT #3, RTRIM$(LINE$)
    WEND
    CLOSE #3
    CLOSE #2

END SUB

' This function converts a protected GW-BASIC binary
' file to unprotected GW-BASIC binary format.
' I ported this algorithm from a C source code.
SUB DECRYPT (INFILE$, OUTFILE$)

    KEY1$ = "A9848DCD75834363248319F79A"
    KEY2$ = "1E1DC4772697E07459887C"
    INDEX = 0

    OPEN INFILE$ FOR BINARY AS #2
    OPEN OUTFILE$ FOR BINARY AS #3
    C$ = CHR$(255)
    PUT #3, 1, C$   ' Unprotected GW-BASIC files begin with CHR$(255)
    FOR P& = 2 TO LOF(2)
        GET #2, P&, C$     ' Read one byte
        K1 = VAL("&H" + MID$(KEY1$, (INDEX MOD 13) * 2 + 1, 2))
        K2 = VAL("&H" + MID$(KEY2$, (INDEX MOD 11) * 2 + 1, 2))
        CC = ASC(C$) - (11 - (INDEX MOD 11))
        CC = ((CC AND 255) XOR K1) AND 255
        CC = (CC XOR K2) AND 255
        CC = CC + 13 - (INDEX MOD 13)
        INDEX = (INDEX + 1) MOD 143
        C$ = CHR$(CC AND 255)
        PUT #3, P&, C$     ' Write one byte
    NEXT P&
    CLOSE #3
    CLOSE #2
END SUB

' This function returns the next byte from a file.
' Returns zero if the end of file is reached.
FUNCTION FGETC (FileHandle)
    C$ = CHR$(0)
    IF FP& <= LOF(FileHandle) THEN
        GET FileHandle, FP&, C$
        FP& = FP& + 1
    END IF
    FGETC = ASC(C$)
END FUNCTION

' This function reads a string from a file and increments the file pointer.
' Returns a null padded string if the end of file is reached.
FUNCTION FGETSTR$ (FileHandle, Length)
    C$ = CHR$(0)
    S$ = STRING$(Length, 0)
    FOR I = 1 TO Length
        IF FP& > LOF(FileHandle) THEN EXIT FOR
        GET FileHandle, FP&, C$
        MID$(S$, I, 1) = C$
        FP& = FP& + 1
    NEXT I
    FGETSTR$ = S$
END FUNCTION

FUNCTION GETWORD (FH)
    GETWORD = CVI(FGETSTR$(FH, 2))
END FUNCTION

' This function takes a character and returns a word that is associated with it.
' Word associations are to be provided in WORDS$ in the following format:
' "XX=WORD1 XX=WORD2 XX=WORD3 ..." where XX is a hexadecimal value.
FUNCTION LOOKUP$ (C, WORDS$)
    H$ = HEX$(C AND 255)
    P = INSTR(WORDS$, " " + H$ + "=")
    IF P = 0 THEN
        LOOKUP$ = ""
        EXIT FUNCTION
    END IF
    P = P + LEN(H$) + 2
    S = INSTR(P, WORDS$, " ")
    LOOKUP$ = MID$(WORDS$, P, S - P)
END FUNCTION

' This function returns 1 if string S$ only consists
' of characters listed in string CS$. Returns zero if any other
' character is found in S$
FUNCTION ONLYFROM (S$, CS$)
    FOR I = 1 TO LEN(S$)
        IF INSTR(CS$, MID$(S$, I, 1)) < 1 THEN
            ONLYFROM = 0
            EXIT FUNCTION
        END IF
    NEXT I
    ONLYFROM = -1
END FUNCTION

FUNCTION TRIM$ (S$)
    TRIM$ = LTRIM$(RTRIM$(S$))
END FUNCTION