'===========================================================================
' Subject: BRIAN'S FILE PACKER               Date: 07-03-97 (17:48)       
' Author:  Brian Bacon                       Code: QB, PDS                
' Origin:  kyberteknik@geocities.com       Packet: MISC.ABC
'===========================================================================
'Ok, here is what I made this for: I needed a way to store files
'(compressed preferably) so I can unstore them with an installation
'program. Well, PKWare wants like hundreds of dollars to use their
'compression routines and they are even the same ones used in PKZIP
'so, I found a LZW compressor written by Rich Geldreich, but it only
'compresses one file at a time.  I needed a way to make lots of files
'into one file.  So I made this program.  All it does is store lots
'of files in one bigger file (it adds like 20 bytes per file, but
'I think that is ok if your gonna compress the output anyways).
'So, I used this to make a bunch of files into one, then compressed
'it with Rich's program, then made an uninstall program that uses
'Rich's decompressor and my unpacker together, (changed the way the
'output looks on both programs (just edited some print statements)
'give credit where it is due, and I had a nice install program for
'a game I am working on.  You can do it to! :)
'
'This program is written in the most part by Brian Bacon
'DIR.BAS is by Dave Cleary, ErrorMsgs was written by someone
'(sorry I forgot the name), and ComLine is one of QuickBASIC's
'exmaple programs.
'
'Note - This program does NO compression
'
DEFINT A-Z
DECLARE FUNCTION DIR$ (FileSpec$)
DECLARE SUB ComLine (N, A$())
DECLARE SUB ErrorMsgs ()

'$INCLUDE: 'QB.BI'

ON ERROR GOTO ErrHandler

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

PRINT "BPAK - Brian's file PAcKing 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)
		ELSE
		   InFiles$(Outf) = Argv$(I)
		   IF DIR$(Argv$(I)) = "" THEN ERROR 255
		END IF
		Outf = Outf + 1
    END SELECT
NEXT I

PRINT "Output file: " + OutFile$
OPEN OutFile$ FOR BINARY AS #1
IF LOF(1) THEN ERROR 254
CurFil = 1
DO UNTIL InFiles$(CurFil - 1) = "!!" AND InFile$(CurFil) = ""
   InFile$ = DIR$(InFiles$(CurFil))
   IF InFile$ <> "" THEN
      InFiles$(CurFil) = ""
      InFile$ = LEFT$(InFile$, LEN(InFile$) - 1)
      OPEN InFile$ FOR BINARY AS #2
	   PRINT "(  0%) - " + InFile$;
	   InFile$ = InFile$ + SPACE$(12 - LEN(InFile$))
	   PUT #1, , InFile$
	   flof& = LOF(2)
	   PUT #1, , flof&
	   W$ = SPACE$(100)
	   FOR I = 1 TO flof& \ 100
	       LOCATE , 2: PRINT USING "###"; 100 * (LOC(2) / LOF(2));
	       GET #2, , W$
	       PUT #1, , W$
	   NEXT I
	   W$ = SPACE$(flof& MOD 100)
	   GET #2, , W$
	   PUT #1, , W$
	   LOCATE , 2: PRINT USING "###"; 100 * (LOC(2) / LOF(2))
      CLOSE 2
   ELSE
      InFiles$(CurFil) = "!!"
      CurFil = CurFil + 1
   END IF
LOOP
CLOSE 1
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

FUNCTION DIR$ (FileSpec$) STATIC
   DIM DTA AS STRING * 44, Regs AS RegTypeX
   Null$ = CHR$(0)
   Regs.AX = &H1A00
   Regs.DX = VARPTR(DTA)
   Regs.DS = -1
   InterruptX &H21, Regs, Regs
   IF LEN(FileSpec$) THEN
	 FileSpecZ$ = FileSpec$ + Null$
	 Regs.AX = &H4E00
	 Regs.CX = 0
	 Regs.DX = SADD(FileSpecZ$)
	 Regs.DS = -1
   ELSE
	 Regs.AX = &H4F00
   END IF
   InterruptX &H21, Regs, Regs
   IF Regs.Flags AND 1 THEN
	 DIR$ = ""
   ELSE
	 Null = INSTR(31, DTA, Null$)
	 DIR$ = MID$(DTA, 31, Null - 30)
   END IF
END FUNCTION

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 254: VErr$ = "Output file already exists"
	CASE 255: VErr$ = "Input file not found"

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