LoCode 4/5

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

'
' UnLoc.BAS - By Brent Ashley
'
' for Allan Zachary
'
DECLARE SUB ProgressMeter (Row%, Col%, freq%)
DECLARE FUNCTION Decode$ (Byte4$)

DEFINT A-Z
DIM SHARED CharSet AS STRING * 64
DIM Byte3 AS STRING * 3
CharSet = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ()"

IF COMMAND$ = "" THEN
  PRINT "Syntax:  UNLOC Filename[.ext]"
  PRINT "                       (.LOC assumed)"
  PRINT "UnLOCoded file created with filename found within coded file."
  END
END IF

PRINT
PRINT "UnLoc - decodes low-order ASCII .LOC files to binary original"
PRINT "By Brent Ashley - released into Public Domain"

' parse filename
InFileName$ = RTRIM$(COMMAND$)
IF NOT INSTR(InFileName$, ".") THEN InFileName$ = InFileName$ + ".LOC"

' open input file
InFile = FREEFILE
ON ERROR GOTO ErrorTrap
OPEN InFileName$ FOR INPUT AS #InFile
' look for start signature
DO
  IF EOF(InFile) THEN
    PRINT "Start Signature not found."
    END
  END IF
  LINE INPUT #InFile, Temp$
  Temp$ = RTRIM$(Temp$)
LOOP UNTIL Temp$ = ")LOCODE("

' get output file name and open it
LINE INPUT #InFile, OutFileName$
PRINT "Creating "; OutFileName$; " ";
OutFile = FREEFILE
' truncate if present
OPEN OutFileName$ FOR OUTPUT AS #OutFile
CLOSE #OutFile
OPEN OutFileName$ FOR BINARY AS #OutFile
ON ERROR GOTO 0
Row = CSRLIN
Col = POS(0)

' get original file length
LINE INPUT #InFile, Temp$
FileLen& = VAL(Temp$)

' rebuild original file
DO
  ProgressMeter Row, Col, 1
  LINE INPUT #InFile, Temp$
  IF RTRIM$(Temp$) = ")LOCEND(" THEN GOTO EndFlag
  FOR j = 1 TO LEN(Temp$) - 3 STEP 4
    Byte3 = Decode(MID$(Temp$, j, 4))
    NumBytes& = NumBytes& + 3
    ' check for last chunk
    IF NumBytes& <= FileLen& THEN
      PUT #OutFile, , Byte3
    ELSE
      Temp$ = LEFT$(Byte3, 3 - (NumBytes& - FileLen&))
      PUT #OutFile, , Temp$
    END IF
  NEXT
LOOP UNTIL NumBytes& >= FileLen&
' check for end flag
LINE INPUT #InFile, Temp$
IF RTRIM$(Temp$) <> ")LOCEND(" THEN PRINT "End Flag not found"
PRINT "...Done"
PRINT
CLOSE
END


EndFlag:
  PRINT "Error - End flag found too soon"
  CLOSE
  END

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

FUNCTION Decode$ (Byte4$)
  ' decodes 4-byte low-ascii string into 3-byte string

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

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