home *** CD-ROM | disk | FTP | other *** search
- /* UnARK.rexx */
-
- /*
- Format
-
- UnARK [FILE] <file> [TO <dir>]
-
- Extracts files from ARC, ZOO, PAK, ZIP, or LHARC format.
- TO argument specifies destination directory.
-
- */
-
- signal on failure; signal off error; signal on syntax; signal on break_c
- options failat 10
- call addlib 'rexxextra.library',-20,-30,0
-
- facility = 'UnARK'
- retcode = 0
- slog = facility||pragma('ID')||'Sorc:'
- dlog = facility||pragma('ID')||'Dest:'
- cmd. = 'BAD'
- cmd.ARC = 'c:arc x'
- cmd.ZOO = 'c:zoo xO//'
- cmd.PAK = ''
- cmd.LZH = 'c:lharc -a -r -P-1 -m x'
- cmd.ZIP = 'c:UnZip'
- types = 'ZOO ARC PAK ZIP LZH BAD'
-
- dtemplate = 'FILE/A,TO/K'
- ttemplate = 'TO/K,FILE/A'
- args.=''
-
- parse arg g_c
- do while g_c='?'
- options prompt dtemplate': ' /* this template is */
- parse pull g_c /* displayed to the user */
- if g_c='?' then do
- g_s=sourceline(3)
- if pos('/*',g_s)=0 then break; if pos('*/',g_s)>0 then break
- say
- g_s=sourceline(4)
- do i=5 while pos('*/',g_s)=0; say g_s; g_s=sourceline(i); end
- say
- end
- end
- interpret Cparse(g_c,ttemplate,'args')
- if args.ERRCODE > 1 then do; say facility'-E-BADARGS,' args.ERRTEXT; exit 5; end
-
- /*
- Body of code
- */
-
- 'assign' slog '""'
- if ~exists(args.TO) then 'Makedir' args.TO
- 'assign' dlog '"'args.TO'"'
- 'pushcd 'dlog
-
- sfile = Fparse(slog,args.FILE)
- ftype = upper(right(sfile,3))
- doit = cmd.ftype
- if doit = 'BAD' then do
- do i = 1 for words(types) until exists(sfile'.'ans)
- ans = word(types,i)
- end
- if ans = 'BAD' then do
- say facility'-E-NOTFOUND, Could not locate archive file:' sfile
- retcode = 5
- signal GetOut
- end
- doit = cmd.ans
- sfile = sfile'.'ans
- end
- say facility'-S-CMD,' doit sfile
- ''doit sfile
- retcode = rc
-
- GetOut:
- 'popcd'
- 'Assign' slog
- 'Assign' dlog
- exit retcode
-
- /* E N D */
-
- /* Error labels follow */
-
- break_c:
- break_d:
- break_e:
- break_f:
- say facility'-E-BREAK, Control-C interrupt'; retcode = 20; signal GetOut
- failure:
- say facility'-E-FAIL, Line:' sigl', Error:' rc; retcode = rc; signal GetOut
- syntax:
- say facility'-E-SYNTAX, Line:' sigl', Error:' rc; retcode = rc; signal GetOut
- error:
- say facility'-E-ERROR, Line:' sigl', Error:' rc; retcode = rc; signal GetOut
-
-