Locode 2/5

 BBS: Inland Empire Archive
Date: 01-04-56 (01:04)             Number: 1467
From: BRENT ASHLEY                 Refer#: NONE
  To: ALLAN ZACHARY                 Recvd: NO  
Subj: Locode 2/5                     Conf: (2) Quik_Bas

'
' LOCODE.BAS - by Brent Ashley
'
' for Allan Zachary
'
DECLARE SUB ProgressMeter (Row%, Col%, freq%)
DECLARE FUNCTION Encode$ (Byte3$)

DEFINT A-Z
DIM Byte3 AS STRING * 3, Byte4 AS STRING * 4, CRLF AS STRING * 2
DIM SHARED CharSet AS STRING * 64

CharSet = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ()"
CRLF = CHR$(13) + CHR$(10)

IF COMMAND$ = "" THEN
  PRINT "Syntax:  LOCODE Filename.ext"
  PRINT "LoCoded file will be created as Filename.LOC"
  END
END IF

' parse filenames
InFileName$ = RTRIM$(COMMAND$)
OutFileName$ = InFileName$
DotPos = INSTR(OutFileName$, ".")
IF DotPos THEN
  OutFileName$ = LEFT$(InFileName$, DotPos - 1)
END IF
OutFileName$ = OutFileName$ + ".LOC"

' open files
ON ERROR GOTO ErrorTrap
InFile = FREEFILE
OPEN InFileName$ FOR BINARY AS #InFile
OutFile = FREEFILE
' truncate to 0 if found
OPEN OutFileName$ FOR OUTPUT AS #OutFile
CLOSE #OutFile
OPEN OutFileName$ FOR BINARY AS #OutFile
ON ERROR GOTO 0

PRINT
PRINT "LOCode - encodes binary files to low-order ASCII"
PRINT "By Brent Ashley - released into Public Domain"

IF LOF(InFile) THEN
  ' start signature
  Temp$ = ")LOCODE(" + CRLF
  ' filename
  PUT #OutFile, , Temp$
  Temp$ = InFileName$ + CRLF
  PUT #OutFile, , Temp$
  ' byte count
  Temp$ = LTRIM$(STR$(LOF(InFile))) + CRLF
  PUT #OutFile, , Temp$

  PRINT "Processing "; InFileName$; " ";
  Row = CSRLIN
  Col = POS(0)
  LinePos = 0
  DO WHILE NOT EOF(InFile)
    ProgressMeter Row, Col, 5
    GET #InFile, , Byte3
    Byte4 = Encode(Byte3)
    PUT #OutFile, , Byte4
    LinePos = LinePos + 4
    IF LinePos = 64 THEN
      PUT #OutFile, , CRLF
      LinePos = 0
    END IF
  LOOP
  Temp$ = CRLF + ")LOCEND(" + CRLF
  PUT #OutFile, , Temp$
  PRINT " ...Done"
  PRINT
END IF
CLOSE
END

ErrorTrap:
  PRINT "Error opening "; InFileName$; " or "; OutFileName$
  CLOSE
  END

FUNCTION Encode$ (Byte3$)
  ' Encodes 3-byte string into 4-byte low-ascii string
  Temp$ = SPACE$(4)

  ' extract three input bytes
  i = ASC(MID$(Byte3$, 3, 1))
  j = ASC(MID$(Byte3$, 2, 1))
  k = ASC(MID$(Byte3$, 1, 1))

  ' build four output bytes
  MID$(Temp$, 4, 1) = MID$(CharSet, (i AND &H3F) + 1, 1)
  MID$(Temp$, 3, 1) = MID$(CharSet, (j AND &HF) * 4 + (i \ &H40) + 1, 1)

(Continued in the next message)
___
 X DeLuxe2 1.12 #10383 X

--- Maximus 2.00
 * Origin: Durham Systems (ONLINE!) (1:229/110)