/*
    $VER: LHA-LZX REPACK V2.04b  Updated by Christer Bjarnemo (1995/12/17)
 */

TempDir		= 'HD1:TRASHCAN/'
Mode		= '3'
Priority	= -1
VirtualDisk	= 'FM0:'

/*************************************************/
/* I recommend you leave it alone from here. :-) */
/*************************************************/

Arg Dir arg1 arg2 arg3 arg4

forcelzx = 0
LZXStore = TempDir
TempDir = TempDir'_LZX_TEMP/'
If ~EXISTS(TempDir) then address COMMAND 'makedir 'left(TempDir,length(TempDir)-1)

PATTERN = '.LZH|.LHA|.ZIP|.ARJ|.ARC|.ZOO|.GZ|.Z'

say 
say 'LHA-LZX repacker 2.04b updated by Christer Bjarnemo 1995-12-17.'
say 'Original program by Mat Bettinson of the Plot Hatching Factory.'
say

if upper(arg1) = 'FORCELZX' | upper(arg2)='FORCELZX' | upper(arg3)='FORCELZX' | upper(arg4)='FORCELZX' then ForceLZX = 1
if upper(arg1) = 'KEEPOLD' | upper(arg2)='KEEPOLD' | upper(arg3)='KEEPOLD' | upper(arg4)='KEEPOLD' then KEEPOLD = 'YES'
if upper(arg1) = 'ONLYLHA' | upper(arg2)='ONLYLHA' | upper(arg3)='ONLYLHA' | upper(arg4)='ONLYLHA' then PATTERN = '.LZH|.LHA'
if upper(arg1) = 'DMS' | upper(arg2)='DMS' | upper(arg3)='DMS' | upper(arg4)='DMS' then PATTERN = PATTERN'|.DMS'

If Dir = '?' | Dir = '/?' | Dir = '-?' | Dir = '' then signal Usage

If dir = '22'x'22'x then do
	dir = '22'x'22'x
	address command 'assign CDIR: 'dir
	dir = 'CDIR:'
	end

If ~EXISTS(Dir) then signal Usage
say
Call Pragma('S',50000)
If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/'
Address COMMAND 'Assign REPACK: 'Tempdir
Call Pragma('D','REPACK:')
Address COMMAND 'List 'Dir' PAT #?('PATTERN') FILES LFORMAT "%n %c" >t:LHA-LZX.temp'
Call Open(list,'t:LHA-LZX.temp','R')
BSave = 0
DO forever
 Line = ReadLN(list)
 File = strip(word(line,1)) ; Comment = strip(word(line,2)) ; Comment = Strip(Comment,'B','"')
 IF EOF(list) then break
 NewFile = Left(File,Length(file)-length(ext(file)))'LZX'

 say 'Converting file: 'File
 Address COMMAND 'Delete >NIL: REPACK:#? ALL FORCE'
 Call Open(ts,Dir||file) ; Lhasize = Seek(ts,0,'E') ; Call Close(ts)

/* Now we are going to extract the archive */

if ext(file)='LHA' then Address COMMAND 'LHA -a -F -M -P'Priority' x 'Dir||File' #? REPACK:'
if ext(file)='LZH' then Address COMMAND 'LHA -a -F -M -P'Priority' x 'Dir||File' #? REPACK:'
if ext(file)='ZIP' then Address COMMAND 'UnZip 'Dir||File' -d REPACK:'

if ext(file)='DMS' then do
	Address command 'format >NIL: <NIL: drive 'VirtualDisk' name Empty quick noicons'
	Address COMMAND 'unDMS <NIL: write 'Dir||File' to 'VirtualDisk' NOPAUSE NOTEXT'
        Address COMMAND 'Copy >NIL: FM0:#? all to REPACK:'
	end

if ext(file)='ARJ' then Address COMMAND 'UnARJ x 'Dir||File' REPACK:'
if ext(file)='ARC' then do
	Pragma('D','REPACK:')
	Address COMMAND 'ARC x 'Dir||File
	end
if ext(file)='ZOO' then do
	Pragma('D','REPACK:')
	Address COMMAND 'ZOO eq/ 'Dir||File
	end
if ext(file)='GZ'  then Address COMMAND 'GZIP 'Dir||left(file,length(file)-1-length(ext(file)))' -cdN >REPACK:'left(file,length(file)-1-length(ext(file)))
if ext(file)='Z' then Address COMMAND 'uncompress 'Dir||left(file,length(file)-1-length(ext(file)))' -c >REPACK:'left(file,length(file)-1-length(ext(file)))

 if RC ~= 0 then do
	say ''
	say '[0;1mWARNING![0m Something went wrong while unpacking 'file'.'
	say 'The 'ext(file)' file could be corrupt, or (hopefully) there wasnt enough'
	say 'space left on your hd/ramdisk.'
	call writech(stdout,'Do you want to continue? (some files might be LOST forever) (y/[0;1mN[0m) ')
	parse pull choice
	if upper(choice) ~= 'Y' then do
		exit(20)
		end
	end

 Address COMMAND 'LZX -r -e -M5000 -'Mode' -P'Priority' -F a 'LZXStore||NewFile' REPACK:#?'

 if RC ~= 0 then do
	fel = 1
	say ''
	say '[0;1mWARNING![0m Something went wrong while packing 'LZXStore||newfile'.'
	call writech(stdout,'Do you want to continue? (keeps the 'ext(file)' file) (y/[0;1mN[0m) ')

	parse pull choice
	if upper(choice) ~= 'Y' then do
		Address COMMAND 'Delete >NIL: 'LZXStore||newfile
		say 'The original file 'file' is untouched :-)'
		exit(20)
		end
	end

if fel ~= 1 then do
 Call Open(ts,LZXStore||NewFile) ; Lzxsize = Seek(ts,0,'E') ; Call Close(ts)
 Diff = Lhasize - Lzxsize
 If Diff > 0 | ForceLZX then DO
  if KEEPOLD ~= 'YES' then Address COMMAND 'Delete >NIL: 'Dir||File
  If Comment ~= '' then Address COMMAND 'Filenote 'LZXStore||NewFile' "'Comment'"'
  Address COMMAND 'Copy 'LZXStore||newfile' to 'dir

 if RC ~= 0 then do
	say ''
	say '[0;1mWARNING![0m Something went wrong while copying 'newfile' to 'dir'.'
	call writech(stdout,'Do you want to continue? (the archive will be LOST forever) (y/[0;1mN[0m) ')
	parse pull choice
	if upper(choice) ~= 'Y' then do
		say 'You should copy the file 'LZXStore||newfile' to a SAFE place.'
		exit(20)
		end
	end

  Address COMMAND 'Delete >NIL: 'LZXStore||newfile
  say '* 'Diff' bytes saved on this archive!' ; say
  END
 ELSE DO
  Address COMMAND 'Delete >NIL: 'LZXStore||Newfile
    say '* 'ext(file)' file 'ABS(Diff)' bytes larger than LZX. Keeping 'ext(file)'...' ; say
  Diff = 0
  END
 BSave = BSave + Diff
end
else say '* Keeping 'ext(file)'...'
end

Call Close(list)
Address COMMAND 'Delete >NIL: REPACK:#? ALL FORCE'
Address COMMAND 'Assign REPACK: REMOVE'
Address COMMAND 'Assign CDIR: REMOVE'

say
say ' *** LHA-LZX Repacker finished. 'Bsave' bytes saved in this dir. ***'
say
EXIT

Usage:
say 'Usage: [0;1mLHA2LZX[0m <Directory> [options]'
say
say '  [0;1mForceLZX[0m  Allways keep the LZX file even if the LHA file is smaller'
say '  [0;1mKeepOLD[0m   Keep both LhA/ZIP and the LZX file'
say '  [0;1mOnlyLHA[0m   Only repack LHA files'
say '  [0;1mDMS[0m       Repack DMS archives'
say
say 'HINT: Replace <directory> with "" if you want to repack current dir.'
say
EXIT

ext: procedure
  arg filename
  do i=1 to length(filename)
     if upper(substr(filename,length(filename)-i,1)) = '.' then break
  end
     extension = upper(right(filename,i))
return(extension)
