home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 1 / Mecomp-CD.iso / amiga / tools / opus / opus-tools5.x / arcdir / arexx / newarc.dopus5 < prev   
Text File  |  1997-06-27  |  1KB  |  52 lines
  1. /*
  2.   $VER: NewArc.dopus5 1.1 (6.6.97)
  3.   Written by Edmund Vermeulen <edmundv@xs4all.nl>.
  4.  
  5.   ARexx script for Directory Opus 5 to create a new (empty) archive.
  6.   The archive may be of the LhA or LZX type. Default is LhA.
  7.  
  8.   Function : ARexx      DOpus5:ARexx/NewArc.dopus5 {Qp}
  9. */
  10.  
  11. parse arg portname .
  12.  
  13. if portname='' then  /* in case they forgot */
  14.    portname='DOPUS.1'
  15. address value portname
  16.  
  17. options results
  18. options failat 21
  19.  
  20. lister query source
  21. if rc>0 then
  22.    exit
  23. parse var result handle .  /* only need first source */
  24.  
  25. lister set handle busy on
  26.  
  27. dopus getstring '"Enter archive name to create." 31 "" Create|Cancel'
  28. arcname=result
  29. if arcname=='' | arcname='RESULT' then do
  30.    lister set handle busy off
  31.    exit
  32.    end
  33.  
  34. lister query handle path
  35. winpath=result
  36. arcname=winpath||arcname
  37.  
  38. ext=upper(right(arcname,4))
  39. if ext='.LZX' then
  40.    address command 'LZX a "'arcname'" %'
  41. else do
  42.    if ext~='.LHA' then
  43.       arcname=arcname'.lha'
  44.    call open('emptyarchive',arcname,'w') then do
  45.    call writech('emptyarchive','0'x)
  46.    call close('emptyarchive')
  47.    end
  48.  
  49. command protect 'NAME "'arcname'" CLEAR e'
  50. lister set handle busy off
  51. lister read handle '"'winpath'"' force
  52.