'===========================================================================
' Subject: HEX ENCODER/DECODER               Date: 09-05-97 (19:51)       
' Author:  Sami Kyostila                     Code: QB, QBasic, PDS        
' Origin:  hiteck@mail.freenet.hut.fi      Packet: ALGOR.ABC
'===========================================================================
CONST ColLimit = 60        'Chars per line

'-------------------------
'       Hex Encoder
'-------------------------
'FREEWARE by Sami Kyostila
'-------------------------
'  hiteck@freenet.hut.fi
'-------------------------

'  This prog converts binary files into emailable ones
'I tried to keep the line lenght under 60 chars, so
'you can send this file via email.
'It also has a very simple checksum algorithm, but it
'is (almost) fully error proof.
'  To use, Encode the file you wish to send (NOTE:
'ZIP YOUR FILE FIRST!, so it will be a LOT smaller)
'and paste the file to an EMail message, and simply
'send it. To extract a file from an EMail message,
'save the message into a file and decode that file.
'NOTE: This program searches for an "Hex-" string that
'indicates the start of file data. However if your
'email message contains this string, then the extraction
'will fail, so make sure that there aren't any such
'strings in the file. Also make sure that the last 2
'bytes in the file are "XX", which indicate the end
'of the file data.

TYPE Header                  'File header
  Verify AS STRING * 4
  Filename AS STRING * 12
END TYPE


DIM Byte AS STRING * 1       '1 byte
DIM Hex AS STRING * 2        '2 bytes
DIM Hdr AS Header            'Header
DIM SeekS AS STRING * 4      'Seek buffer

CLS
COLOR 15, 4
PRINT "                    ";
PRINT "Hex Encoder/Decoder for QBasic - Sami Ky";
PRINT CHR$(148); "stil";
PRINT CHR$(132);
PRINT "              "

VIEW PRINT 2 TO 25
PRINT
COLOR 10, 0
PRINT "          1 - Encode"
PRINT "          2 - Decode"
COLOR 2
PRINT
PRINT " Choose one: ";
k$ = INPUT$(1)
COLOR 9

IF k$ = "1" THEN PRINT "Encode": GOTO Encode
IF k$ = "2" THEN PRINT "Decode": GOTO Decode
PRINT "Quit"
END


Encode:
COLOR 7, 0
PRINT
INPUT "  Input file: ", Inp$
IF Inp$ = "" THEN END
INPUT " Output file: ", Out$
IF Out$ = "" THEN END

OPEN Inp$ FOR BINARY AS #1
OPEN Out$ FOR OUTPUT AS #2

FOR i = LEN(Inp$) TO 1 STEP -1        'Remove path
  IF MID$(Inp$, i, 1) = "Ö" THEN
    Inp$ = MID$(Inp$, i + 1, 255)
  END IF
NEXT

Inp$ = UCASE$(Inp$)
Inp$ = LEFT$(Inp$, 12)
Inp$ = Inp$ + STRING$(12 - LEN(Inp$), "<")

PRINT " Encoding..."
PRINT " - Writing header..."
Hdr.Verify = "Hex-"                  'Write header
Hdr.Filename = Inp$

PRINT #2, Hdr.Verify;
PRINT #2, Hdr.Filename

PRINT " - Encoding"; LOF(1); "bytes..."
Col = 0                              'Encode
Avg& = 0
lines& = 0
FOR i& = 1 TO LOF(1)
  GET #1, , Byte
  Avg& = Avg& + ASC(Byte)
  Hx$ = HEX$(ASC(Byte))

  IF LEN(Hx$) = 1 THEN Hx$ = "0" + Hx$
  PRINT #2, Hx$;
  Col = Col + 2
  IF Col = ColLimit THEN
    Col = 0
    Chk$ = HEX$(Avg& MOD 255)
    IF LEN(Chk$) = 1 THEN Chk$ = "0" + Chk$
    PRINT #2, "::"; Chk$
    lines& = lines& + 1
    Avg& = 0
  END IF
NEXT
PRINT #2, "XX"


PRINT " - Output file size: "; LOF(2); "bytes -";
PRINT lines&; "lines"

CLOSE #1
CLOSE #2
END


Decode:
COLOR 7, 0
PRINT
INPUT "  Input file: ", Inp$
IF Inp$ = "" THEN END

PRINT " Decoding..."
PRINT " - Seeking..."

OPEN Inp$ FOR BINARY AS #1
IF LOF(1) = 0 THEN                   'Check if file
  PRINT " File not found!"           'exists
  CLOSE
  KILL Inp$
  END
END IF

Start& = -1
FOR i& = 1 TO LOF(1)                 'Seek start of
  GET #1, i&, SeekS                  'file data
  IF SeekS = "Hex-" THEN
    Start& = i&
    EXIT FOR
  END IF
NEXT
IF Start& = -1 THEN
  PRINT " - File data not found!"
  END
END IF
                                     'Read header
PRINT " - Reading header..."
SEEK #1, Start&

GET #1, , Hdr
IF Hdr.Verify <> "Hex-" THEN
  PRINT " First 4 bytes must be 'Hex-'"
  CLOSE
  END
END IF

Out$ = LEFT$(Hdr.Filename, INSTR(Hdr.Filename, "<") - 1)
OPEN Out$ FOR BINARY AS #2
PRINT " - Writing output file "; Out$; "..."

IF LOF(2) > 0 THEN
  PRINT " Output file exists!"
  CLOSE
  END
END IF

Col = 0                              'Decode
Avg& = 0
FOR i& = 1 TO LOF(1)
  DO
    GET #1, , Hex
    IF Hex = "XX" THEN EXIT FOR
    IF Hex = "::" THEN
      GET #1, , Hex
      IF VAL("&H" + Hex) <> Avg& MOD 255 THEN
        COLOR 12
        PRINT " Checksum error at"; SEEK(1)
        PRINT VAL("&H" + Hex); "<>"; Avg& MOD 255
        COLOR 7
        CLOSE
        END
      END IF
      Avg& = 0
      Hex = CHR$(13) + CHR$(0)
    END IF
  LOOP UNTIL INSTR(Hex, CHR$(13)) = 0
  Byte = CHR$(VAL("&H" + Hex))
  Avg& = Avg& + ASC(Byte)
  PUT #2, , Byte
NEXT


PRINT " - Input file size: ", LOF(1)
PRINT " - Output file size: ", LOF(2)

CLOSE #1
CLOSE #2

END