'===========================================================================
' Subject: BRIAN'S FILE UNPACKER             Date: 07-03-97 (17:48)       
' Author:  Brian Bacon                       Code: QB, PDS                
' Origin:  kyberteknik@geocities.com       Packet: MISC.ABC
'===========================================================================
'This program is written in the most part by Brian Bacon
'but ComLine is one of QuickBASIC's exmaple programs.
'
DEFINT A-Z
DECLARE SUB ComLine (N, A$())
DECLARE SUB ErrorMsgs ()

ON ERROR GOTO ErrHandler

DIM Argv$(30), InFiles$(30)
DIM SHARED EFlag%, VErr$

PRINT "BUNPAK - Brian's file UNPAcKing utility v1.0"
ComLine Argc, Argv$()

Outf = 0
FOR I = 1 TO Argc
    SELECT CASE LEFT$(UCASE$(Argv$(I)), 2)
	   CASE "-H", "-?", "/H", "/?": 'GOTO Usage
	   CASE ELSE
		IF Outf = 0 THEN
		   OutFile$ = Argv$(I)
		   Outf = 1
		ELSE
		   ERROR 255
		END IF
    END SELECT
NEXT I

PRINT "Input file: " + OutFile$
OPEN OutFile$ FOR BINARY AS #1
IF LOF(1) = 0 THEN ERROR 53
DO UNTIL LOF(1) = LOC(1)
   InFile$ = SPACE$(12)
   GET #1, , InFile$
   GET #1, , FileLen&
   InFile$ = RTRIM$(InFile$)
   OPEN InFile$ FOR BINARY AS #2
	PRINT "(  0%) - " + InFile$;
	IF LOF(2) THEN ERROR 58
	W$ = SPACE$(100)
	FOR I = 1 TO FileLen& \ 100
	    LOCATE , 2: PRINT USING "###"; 100 * (LOC(2) / FileLen&);
	    GET #1, , W$
	    PUT #2, , W$
	NEXT I
	W$ = SPACE$(FileLen& MOD 100)
	GET #1, , W$
	PUT #2, , W$
	LOCATE , 2: PRINT USING "###"; 100 * (LOC(2) / FileLen&)
   CLOSE 2
LOOP
END

ErrHandler:
CLOSE
EFlag% = ERR
CALL ErrorMsgs
PRINT VErr$: PRINT
END

SUB ComLine (NumArgs, Args$()) STATIC
  CONST TRUE = -1, FALSE = 0
  IF Init = FALSE THEN MaxArgs = UBOUND(Args$): Init = TRUE
  NumArgs = 0: In = FALSE
   Cl$ = COMMAND$
   L = LEN(Cl$)
   FOR I = 1 TO L
      c$ = MID$(Cl$, I, 1)
      IF (c$ <> " " AND c$ <> CHR$(9)) THEN
	 IF NOT In THEN
	    IF NumArgs = MaxArgs THEN EXIT FOR
	    NumArgs = NumArgs + 1
	    In = TRUE
	 END IF
	 Args$(NumArgs) = Args$(NumArgs) + c$
      ELSE
	 In = FALSE
      END IF
   NEXT I
END SUB

SUB ErrorMsgs
IF EFlag% = 0 THEN EXIT SUB
SELECT CASE EFlag%
	CASE 1:  VErr$ = "SHARE not active"
	CASE 2:  VErr$ = "Syntax Error"
	CASE 3:  VErr$ = "Return w/o gosub"
	CASE 4:  VErr$ = "Out of Data"
	CASE 5:  VErr$ = "Illegal Function Call"
	CASE 6:  VErr$ = "Overflow"
	CASE 7:  VErr$ = "Out of Memory"
	CASE 8:  VErr$ = "Label not defined"
	CASE 9:  VErr$ = "Subscript out of range"
	CASE 10: VErr$ = "Duplicate Definition"
	CASE 11: VErr$ = "Division by Zero"
	CASE 12: VErr$ = "Illegal in direct mode"
	CASE 13: VErr$ = "Type Mismatch"
	CASE 14: VErr$ = "Out of string space"
	CASE 15: VErr$ = "Fossil not available"
	CASE 16: VErr$ = "String formula too complex"
	CASE 17: VErr$ = "Carrier Dropped!"
	CASE 18: VErr$ = "Function not defined"
	CASE 19: VErr$ = "No RESUME"
	CASE 20: VErr$ = "RESUME w/o error"
	CASE 24: VErr$ = "Modem or Device Timeout"
	CASE 25: VErr$ = "Modem or Device fault"
	CASE 26: VErr$ = "FOR w/o NEXT"
	CASE 27: VErr$ = "Out of paper"
	CASE 29: VErr$ = "WHILE w/o WEND"
	CASE 30: VErr$ = "WEND w/o WHILE"
	CASE 33: VErr$ = "Duplicate Label"
	CASE 35: VErr$ = "Subprogram not defined"
	CASE 37: VErr$ = "Aurgument-count mismatch"
	CASE 38: VErr$ = "Array not defined"
	CASE 39: VErr$ = "CASE ELSE expected"
	CASE 40: VErr$ = "Variable Required"
	CASE 50: VErr$ = "Buffer or Field overflow"
	CASE 51: VErr$ = "System error"
	CASE 52: VErr$ = "Bad file name or number"
	CASE 53: VErr$ = "File not found"
	CASE 54: VErr$ = "Bad file mode"
	CASE 55: VErr$ = "File already open"
	CASE 56: VErr$ = "Field statement active"
	CASE 57: VErr$ = "Modem or Device I/O error"
	CASE 58: VErr$ = "File already exists"
	CASE 59: VErr$ = "Bad record length"
	CASE 61: VErr$ = "Disk full"
	CASE 62: VErr$ = "Input past end of file"
	CASE 63: VErr$ = "Bad record number"
	CASE 64: VErr$ = "Invalid filename"
	CASE 67: VErr$ = "Too many files"
	CASE 68: VErr$ = "Drive/Device Unavailable"
	CASE 69: VErr$ = "Comm buffer overflow"
	CASE 70: VErr$ = "Permission denied"
	CASE 71: VErr$ = "Disk/Printer not ready"
	CASE 72: VErr$ = "Disk media error"
	CASE 73: VErr$ = "Feature not available"
	CASE 74: VErr$ = "Rename across disks"
	CASE 75: VErr$ = "Path/File access error"
	CASE 76: VErr$ = "Path not found"
	CASE 255: VErr$ = "Invalid command line parameter"

	CASE ELSE: VErr$ = "UNIDENTIFIED ERROR"
END SELECT
VErr$ = VErr$ + "!"
END SUB