home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 1 / Mecomp-CD.iso / amiga / tools / opus / opus-tools5.x / arcdir / arexx / arcdir.dopus5 next >
Text File  |  1997-06-27  |  24KB  |  851 lines
  1. /*
  2.   $VER: ArcDir.dopus5 1.1 (6.6.97)
  3.   Written by Edmund Vermeulen <edmundv@xs4all.nl>.
  4.  
  5.   ARexx script for Directory Opus 5 to show the contents of an LhA or LZX
  6.   archive in an Opus lister and operate on the files and directories inside
  7.   the archive as if it is a normal directory.
  8.  
  9.   Function : ARexx      DOpus5:ARexx/ArcDir.dopus5 Browse {Qp} {f} {Ql}
  10.   Flags : Run asynchronously
  11. */
  12.  
  13. parse arg cmd ' ' portname ' "' arcfile '" ' handle ' ' arcsubdir
  14.  
  15. address value portname
  16. options results
  17. options failat 21
  18. signal on syntax
  19. signal on halt
  20. signal on break_c
  21. lf='0a'x
  22.  
  23. dopus getfiletype '"'arcfile'"' id
  24. arctype=result
  25. if arctype~='LHA' & arctype~='LZX' then
  26.    exit
  27.  
  28. if ~show('l','rexxsupport.library') then
  29.    call addlib('rexxsupport.library',0,-30)
  30.  
  31. if exists('LIBS:locale.library') then do
  32.    if ~show(l,'locale.library') then
  33.       call addlib('locale.library',0,-30)
  34.    catalog=opencatalog('ArcDir.catalog','english',0)
  35.    end
  36. else
  37.    catalog=0
  38.  
  39. dopus version
  40. newopus=result~='RESULT' & translate(result,'.',' ')>=5.1215
  41.  
  42. if upper(cmd)='BROWSE' | handle=0 then do
  43.    lister new
  44.    handle=result
  45.    lister set handle source
  46.    end
  47. else
  48.    lister empty handle
  49.  
  50. call arclist
  51.  
  52.  
  53. /* Attach a handler to the lister and wait for an event to happen. */
  54.  
  55. handlername='ArcDir'handle
  56. lister set handle handler handlername quotes
  57. call openport(handlername)
  58.  
  59. viewcommands='Read HexRead Show Play'  /* you may add other Opus commands if you wish */
  60. notsupported='CopyAs Move MoveAs Rename Comment Protect'
  61. traps='Copy Delete MakeDir Parent Root ScanDir' viewcommands notsupported
  62. do while traps~=''
  63.    parse var traps trapcommand traps
  64.    dopus addtrap trapcommand handlername
  65.    end
  66.  
  67. thishandle=handle
  68. lister set handle busy off
  69.  
  70. do until event='inactive'
  71.    if waitpkt(handlername) then do
  72.  
  73.       packet=getpkt(handlername)
  74.       if packet~='00000000'x then do
  75.  
  76.          event=getarg(packet,0)
  77.          handle=getarg(packet,1)
  78.          namestr=getarg(packet,2)
  79.          user=getarg(packet,3)
  80.          pathstr=getarg(packet,4)
  81.          qualifier=getarg(packet,6)
  82.          deststr=getarg(packet,7)
  83.  
  84.          if newopus then
  85.             lister wait thishandle quick
  86.          else do
  87.             lister query thishandle busy
  88.             if result=1 then
  89.                call delay(10)
  90.             end
  91.  
  92.          select
  93.             when event='doubleclick' then do
  94.                if left(namestr,1)='"' then
  95.                   parse var namestr '"' namestr '"'
  96.                if namestr='' then
  97.                   fileinfo.type=1
  98.                else
  99.                   lister query handle entry '"'namestr'"' stem fileinfo.
  100.                if fileinfo.type>0 then do  /* it's a dir */
  101.                   if qualifier='shift' then do
  102.                      lister new
  103.                      newhandle=result
  104.                      address command 'Copy >NIL: T:ArcDir.list'handle 'T:ArcDir.list'newhandle
  105.                      lister set newhandle source
  106.                      address command 'Run >NIL: <NIL: RX DOpus5:ARexx/ArcDir.dopus5 GETDIR' portname '"'arcfile'"' newhandle arcsubdir||namestr'/'
  107.                      end
  108.                   else do
  109.                      arcsubdir=arcsubdir||namestr'/'
  110.                      call arclist
  111.                      end
  112.                   end
  113.                else
  114.                   call viewsingle
  115.                end
  116.  
  117.             when event='reread' | event='ScanDir' then do
  118.                call delete('T:ArcDir.list'handle)
  119.                call arclist
  120.                end
  121.  
  122.             when event='path' then
  123.                call dopath
  124.  
  125.             when event='drop' then do
  126.                parse var namestr '"' droppath '"'
  127.                if pos(right(droppath,1),'/:')>0 then  /* disk or left-out drawer */
  128.                   lister read handle '"'droppath'"' force
  129.                else do
  130.                   parse var namestr '"' dropfile '"'
  131.                   if pos(':',dropfile)=0 then do
  132.                      lister query user path
  133.                      dropfile=result||dropfile
  134.                      end
  135.                   dopus getfiletype '"'dropfile'"' id
  136.                   if result='LHA' | result='LZX' then do
  137.                      arctype=result
  138.                      arcfile=dropfile
  139.                      arcsubdir=''
  140.                      call delete('T:ArcDir.list'handle)
  141.                      call arclist
  142.                      end
  143.                   else do
  144.                      allents=namestr
  145.                      call getall
  146.                      otherhandle=user
  147.                      call arcadd
  148.                      end
  149.                   end
  150.                end
  151.  
  152.             when event='dropfrom' then
  153.                if qualifier='shift' then do
  154.                   parse var namestr '"' namestr '"'
  155.                   lister query handle entry '"'namestr'"' stem fileinfo.
  156.                   if fileinfo.type>0 then do
  157.                      address command 'Copy >NIL: T:ArcDir.list'handle 'T:ArcDir.list'user
  158.                      address command 'Run >NIL: <NIL: RX DOpus5:ARexx/ArcDir.dopus5 GETDIR' portname '"'arcfile'"' user arcsubdir||namestr'/'
  159.                      end
  160.                   end
  161.                else do
  162.                   allents=namestr
  163.                   call getall
  164.                   otherhandle=user
  165.                   call arcextract
  166.                   end
  167.  
  168.             when upper(event)='PARENT' | upper(event)='ROOT' then
  169.                call doparentroot
  170.  
  171.             when event='Delete' then
  172.                call dodelete
  173.  
  174.             when event='MakeDir' then
  175.                call domakedir
  176.  
  177.             when event='Copy' then do
  178.                lister query handle selentries
  179.                allents=result
  180.                call getall
  181.                if handle=thishandle then do
  182.                   otherhandle=user
  183.                   call arcextract
  184.                   end
  185.                else do
  186.                   otherhandle=handle
  187.                   handle=user
  188.                   call arcadd
  189.                   end
  190.                end   
  191.  
  192.             when pos(event,viewcommands)>0 then do
  193.                lister query handle firstsel
  194.                parse var result '"' namestr '"'
  195.                lister select handle '"'namestr'"' off
  196.                lister refresh handle
  197.                call viewsingle
  198.                end
  199.  
  200.             when pos(event,notsupported)>0 then do
  201.                lister set handle busy on
  202.                call displayerror(getcatstr(23,'Command not supported in ArcDir.'))
  203.                lister set handle busy off
  204.                end
  205.  
  206.             otherwise
  207.                nop
  208.             end
  209.  
  210.          lister set handle busy off
  211.          call reply(packet,0)
  212.          end
  213.       end
  214.    end
  215.  
  216. call delete('T:ArcDir.list'handle)
  217. call closeport(handlername)
  218. if catalog~=0 then
  219.    call closecatalog(catalog)
  220. exit
  221.  
  222.  
  223. doparentroot:
  224.  
  225.    if arcsubdir='' then do
  226.       cuthere=lastpos('/',arcfile)
  227.       if cuthere=0 | upper(event)='ROOT' then
  228.          cuthere=pos(':',arcfile)
  229.       normaldir=left(arcfile,cuthere)
  230.       if qualifier='shift' then do
  231.          lister new normaldir
  232.          newhandle=result
  233.          lister wait newhandle
  234.          lister set newhandle source
  235.          end
  236.       else do
  237.          lister set handle title
  238.          lister read handle normaldir
  239.          end
  240.       end
  241.    else do
  242.       if upper(event)='ROOT' then
  243.          newsubdir=''
  244.       else do
  245.          cuthere=lastpos('/',left(arcsubdir,length(arcsubdir)-1))
  246.          newsubdir=left(arcsubdir,cuthere)
  247.          end
  248.       if qualifier='shift' then do
  249.          lister new
  250.          newhandle=result
  251.          address command 'Copy >NIL: T:ArcDir.list'handle 'T:ArcDir.list'newhandle
  252.          lister set newhandle source
  253.          address command 'Run >NIL: <NIL: RX DOpus5:ARexx/ArcDir.dopus5 GETDIR' portname '"'arcfile'"' newhandle newsubdir
  254.          end
  255.       else do
  256.          arcsubdir=newsubdir
  257.          call arclist
  258.          end
  259.       end
  260.    return
  261.  
  262.  
  263. dopath:
  264.  
  265.    if pos(right(namestr,1),'/:')=0 then
  266.       namestr=namestr'/'
  267.    if left(namestr,length(arcfile))=arcfile then do
  268.       if namestr=arcfile'/'arcsubdir then
  269.          call delete('T:ArcDir.list'handle)
  270.       else
  271.          arcsubdir=substr(namestr,length(arcfile)+2)
  272.       call arclist
  273.       end
  274.    else do
  275.       cuthere=pos('.LHA/',upper(namestr))
  276.       if cuthere=0 then
  277.          cuthere=pos('.LZH/',upper(namestr))
  278.       if cuthere>0 then
  279.          arctype='LHA'
  280.       else do
  281.          cuthere=pos('.LZX/',upper(namestr))
  282.          if cuthere>0 then
  283.             arctype='LZX'
  284.          end
  285.       if cuthere>0 then do
  286.          call delete('T:ArcDir.list'handle)
  287.          arcfile=left(namestr,cuthere+3)
  288.          arcsubdir=substr(namestr,cuthere+5)
  289.          call arclist
  290.          end
  291.       else
  292.          lister read handle '"'namestr'"' force
  293.       end
  294.    return
  295.  
  296.  
  297. dodelete:
  298.  
  299.    lister set handle busy on
  300.    lister query handle selentries
  301.    allents=result
  302.    call getall
  303.    if entries=0 then
  304.       return
  305.  
  306.    lister query handle numselfiles
  307.    nfiles=result
  308.    lister query handle numseldirs
  309.    ndirs=result
  310.    call dorequest('"'getcatstr(5,'Warning: you cannot get back'lf||,
  311.       'what you delete! OK to delete:'lf||lf'%s file(s) and'lf||,
  312.       '%s drawer(s) (and their contents)?',nfiles,ndirs)'"',
  313.       getcatstr(6,'Proceed|Cancel'))
  314.    if ~rc then
  315.       return
  316.  
  317.    lister set handle title getcatstr(7,'Deleting from archive...')
  318.    lister refresh handle full
  319.  
  320.    select 
  321.       when arctype='LHA' then do
  322.          call open('actionfile','T:actionfile'handle,'w')
  323.          do i=1 to entries
  324.             if type.i>0 then
  325.                wild='/#?'
  326.             else
  327.                wild=''
  328.             call writeln('actionfile','"'patch(arcsubdir||name.i,"'")||wild'"')
  329.             end
  330.          call close('actionfile')
  331.          address command 'LhA d -q -X -Qp -Qo "'patch(arcfile)'" @T:actionfile'handle
  332.          problem=rc>0
  333.          address command 'Delete >NIL: T:LhA_ArcWork.#? QUIET'
  334.          problem=problem | rc=0
  335.          call delete('T:actionfile'handle)
  336.          end
  337.       when arctype='LZX' then do
  338.          lzxcmd='LZX d -q -X0 --' lzxkludge(patch(arcfile))
  339.          linelen=0
  340.          n=0
  341.          do i=1 to entries
  342.             if type.i>0 then
  343.                dothis=lzxkludge(patch(arcsubdir||name.i,'[')'/#?')
  344.             else
  345.                dothis=lzxkludge(patch(arcsubdir||name.i))
  346.             linelen=linelen+length(dothis)+1
  347.             if i=1 | linelen>255 then do
  348.                n=n+1
  349.                dothese.n=dothis
  350.                linelen=length(lzxcmd)+length(dothis)+1
  351.                end
  352.             else
  353.                dothese.n=dothese.n dothis
  354.             end
  355.          do i=1 to n
  356.             address command lzxcmd dothese.i
  357.             problem=rc>0
  358.             if problem then
  359.                leave
  360.             end
  361.          end
  362.       end
  363.  
  364.    if problem then
  365.       call displayerror(getcatstr(8,'Error while deleting from archive.'))
  366.    else do
  367.       call delete('T:ArcDir.list'handle)
  368.       do i=1 to entries
  369.          if name.i='' then do
  370.             lister query handle separate
  371.             if result='filesfirst' then do
  372.                lister query handle numfiles
  373.                entryno=result
  374.                end
  375.             else
  376.                entryno=0
  377.             lister remove handle '#'entryno
  378.             end
  379.          else
  380.             lister remove handle '"'name.i'"'
  381.          end
  382.       end
  383.  
  384.    lister set handle title 'ArcDir:' arcname
  385.    lister refresh handle full
  386.    return
  387.  
  388.  
  389. domakedir:
  390.  
  391.    lister set handle busy on
  392.    dopus getstring '"'getcatstr(15,'Enter directory name')'" 31 ""' getcatstr(16,'OK|Cancel')
  393.    dirtomake=result
  394.    if dirtomake=='' | dirtomake='RESULT' then
  395.       return
  396.  
  397.    now=date('i')*86400+time('s')
  398.    call createdirs(dirtomake'/')
  399.  
  400.    select
  401.       when arctype='LHA' then
  402.          address command 'LhA a -q -e -r -X -Qo "'patch(arcfile)'" T:ArcDir'handle'/' '"'patch(arcsubdir||dirtomake,"'")'"'
  403.       when arctype='LZX' then do
  404.          oldcurrent=pragma('d')
  405.          call pragma('d','T:ArcDir'handle)
  406.          address command 'LZX a -q -e -r -X0 --' lzxkludge(patch(arcfile)) lzxkludge(patch(arcsubdir||dirtomake))
  407.          call pragma('d',oldcurrent)
  408.          end
  409.       end
  410.  
  411.    if rc>0 then
  412.       call displayerror(getcatstr(13,'Error while adding to archive.'))
  413.    else do
  414.       lister add handle '"'dirtomake'" -1 1' now '----rwed'
  415.       lister refresh handle
  416.       end
  417.  
  418.    address command 'Delete >NIL: T:ArcDir'handle 'ALL QUIET'
  419.    call delete('T:ArcDir.list'handle)
  420.    return
  421.  
  422.  
  423. createdirs:
  424.  
  425.    parse arg subdir
  426.    dirstocreate='T:ArcDir'handle'/'arcsubdir||subdir
  427.    here=0
  428.    do until here=0
  429.       here=pos('/',dirstocreate,here+1)
  430.       if here>0 then
  431.          call makedir(left(dirstocreate,here-1))
  432.       end
  433.    return
  434.  
  435.  
  436. arclist:
  437.  
  438.    lister set handle busy on
  439.    lister clear handle
  440.    lister set handle title getcatstr(1,'Listing archive...')
  441.    lister set handle path arcfile'/'arcsubdir
  442.    lister refresh handle full
  443.  
  444.    if ~exists(arcfile) then do
  445.       call displayerror(getcatstr(22,'Error: archive not found'))
  446.       return
  447.       end
  448.  
  449.    if ~exists('T:ArcDir.list'handle) then do
  450.       select
  451.          when arctype='LHA' then do
  452.             address command 'LhAQuickList >T:ArcDir.list'handle '"'arcfile'"'
  453.             if rc>0 then
  454.                address command 'LhA >T:ArcDir.list'handle 'vv -N -X -Qw -Qo "'arcfile'"'
  455.             end
  456.          when arctype='LZX' then
  457.             address command 'LZX >T:ArcDir.list'handle 'v -X0 --' lzxkludge(patch(arcfile))
  458.          end
  459.       if rc>0 then
  460.          call displayerror(getcatstr(2,'Error while listing archive.'))
  461.       end
  462.  
  463.    oldcurrent=pragma('d')
  464.    call pragma('d','DOpus5:C')
  465.    address command 'ArcDirList >T:ArcDir.list'handle'@ T:ArcDir.list'handle '"'patchstar(arcsubdir)'"'
  466.    call pragma('d',oldcurrent)
  467.  
  468.    if ~open('tempfile','T:ArcDir.list'handle'@','r') then do
  469.       call displayerror(getcatstr(24,'ArcDirList not found!'))
  470.       return
  471.       end
  472.    thisline=readln('tempfile')
  473.    do while thisline~=''
  474.       lister add handle thisline
  475.       thisline=readln('tempfile')
  476.       end
  477.    call close('tempfile')
  478.    call delete('T:ArcDir.list'handle'@')
  479.  
  480.    cuthere=lastpos('/',arcfile)
  481.    if cuthere=0 then
  482.       cuthere=lastpos(':',arcfile)
  483.    arcname=substr(arcfile,cuthere+1)
  484.    lister set handle title 'ArcDir:' arcname
  485.    lister refresh handle full
  486.    return
  487.  
  488.  
  489. arcextract:
  490.  
  491.    lister set handle busy on
  492.    if otherhandle=0 then
  493.       if newopus then
  494.          winpath=deststr
  495.       else do
  496.          call displayerror(getcatstr(9,'No destination selected!'))
  497.          return
  498.          end
  499.    else do
  500.       if checkhandler() then
  501.          return
  502.       lister set otherhandle busy on
  503.       lister query otherhandle path
  504.       winpath=result
  505.       end
  506.  
  507.    lister query handle numdirs
  508.    anydirs=result>0
  509.    mustmove=anydirs & arcsubdir~==''
  510.    if mustmove then do
  511.       destpath=winpath'ArcDir'handle
  512.       call makedir(destpath)
  513.       destpath=destpath'/'
  514.       end
  515.    else
  516.       destpath=winpath
  517.  
  518.    lister set handle title getcatstr(10,'Extracting from archive...')
  519.    lister refresh handle full
  520.  
  521.    select
  522.       when arctype='LHA' then do
  523.          call open('actionfile','T:actionfile'handle,'w')
  524.          do i=1 to entries
  525.             if type.i>0 then
  526.                wild='/#?'
  527.             else
  528.                wild=''
  529.             call writeln('actionfile','"'patch(arcsubdir||name.i,"'")||wild'"')
  530.             end
  531.          call close('actionfile')
  532.  
  533.          if anydirs then
  534.             cmd='x'
  535.          else
  536.             cmd='e -x2'
  537.          address command 'LhA' cmd '-q -a -C0 -X -Qo "'patch(arcfile)'" "'destpath'" @T:actionfile'handle
  538.          problem=rc>0
  539.          call delete('T:actionfile'handle)
  540.          end
  541.       when arctype='LZX' then do
  542.          if anydirs then
  543.             cmd='x'
  544.          else
  545.             cmd='e'
  546.          lzxcmd='LZX' cmd '-q -a -C0 -X0 --' lzxkludge(patch(arcfile))
  547.  
  548.          linelen=0
  549.          n=0
  550.          do i=1 to entries
  551.             if type.i>0 then
  552.                dothis=lzxkludge(patch(arcsubdir||name.i,'[')'/#?')
  553.             else
  554.                dothis=lzxkludge(patch(arcsubdir||name.i))
  555.             linelen=linelen+length(dothis)+1
  556.             if i=1 | linelen>255 then do
  557.                n=n+1
  558.                dothese.n=dothis
  559.                linelen=length(lzxcmd)+length(dothis)+1
  560.                end
  561.             else
  562.                dothese.n=dothese.n dothis
  563.             end
  564.  
  565.          oldcurrent=pragma('d')
  566.          call pragma('d',destpath)
  567.          do i=1 to n
  568.             address command lzxcmd dothese.i
  569.             problem=rc>0
  570.             if problem>0 then
  571.                leave
  572.             end
  573.          call pragma('d',oldcurrent)
  574.          end
  575.       end
  576.  
  577.    if problem then
  578.       call displayerror(getcatstr(11,'Error while extracting from archive.'))
  579.    else
  580.       do i=1 to entries
  581.          lister select handle '"'name.i'"' off
  582.          end
  583.  
  584.    lister set handle title 'ArcDir:' arcname
  585.    lister refresh handle full
  586.  
  587.    if mustmove then do
  588.       address command 'DOpus5:C/Move >NIL: "'destpath||arcsubdir'#?" "'winpath'"'
  589.       address command 'Delete >NIL: "'winpath'ArcDir'handle'" ALL QUIET'
  590.       end
  591.  
  592.    if otherhandle~=0 then do
  593.       lister set otherhandle busy off
  594.       lister read otherhandle '"'winpath'"' force
  595.       end
  596.    return
  597.  
  598.  
  599. arcadd:
  600.  
  601.    if checkhandler() then
  602.       return
  603.    lister set handle busy on
  604.    lister set otherhandle busy on
  605.    lister query otherhandle path
  606.    frompath=result
  607.  
  608.    mustcopy=upper(right(src,length(arcsubdir)))~==upper(arcsubdir)
  609.    if mustcopy then do
  610.       homedir='T:ArcDir'handle'/'
  611.       call createdirs
  612.       end
  613.    else
  614.       homedir=left(frompath,length(frompath)-length(arcsubdir))
  615.  
  616.    if mustcopy then
  617.       do i=1 to entries
  618.          lister query otherhandle entry '"'name.i'"' stem fileinfo.
  619.          if fileinfo.type>0 then
  620.             address command 'Copy "'frompath||name.i'" "T:ArcDir'handle'/'arcsubdir||name.i'" ALL CLONE QUIET'
  621.          else
  622.             address command 'Copy "'frompath||name.i'" "T:ArcDir'handle'/'arcsubdir'" CLONE QUIET'
  623.          end
  624.  
  625.    lister set handle title getcatstr(12,'Adding to archive...')
  626.    lister refresh handle full
  627.  
  628.    select
  629.       when arctype='LHA' then do
  630.          call open('actionfile','T:actionfile'handle,'w')
  631.          call writeln('actionfile','"'patch(homedir)'"')
  632.          do i=1 to entries
  633.             call writeln('actionfile','"'patch(arcsubdir||name.i)'"')
  634.             end
  635.          call close('actionfile')
  636.  
  637.          if pos('.LZH/',test)>0 then
  638.             method='-0'
  639.          else
  640.             method=''
  641.          address command 'LhA r' method '-q -e -r -X -Qo "'patch(arcfile)'" @T:actionfile'handle
  642.          problem=rc>0
  643.          call delete('T:actionfile'handle)
  644.          end
  645.       when arctype='LZX' then do
  646.          lzxcmd='LZX u -q -a -e -r -X0 --' lzxkludge(patch(arcfile))
  647.          linelen=0
  648.          n=0
  649.          do i=1 to entries
  650.             if type.i>0 then
  651.                dothis=lzxkludge(patch(arcsubdir||name.i,'[')'/#?')
  652.             else
  653.                dothis=lzxkludge(patch(arcsubdir||name.i))
  654.             linelen=linelen+length(dothis)+1
  655.             if i=1 | linelen>255 then do
  656.                n=n+1
  657.                dothese.n=dothis
  658.                linelen=length(lzxcmd)+length(dothis)+1
  659.                end
  660.             else
  661.                dothese.n=dothese.n dothis
  662.             end
  663.  
  664.          oldcurrent=pragma('d')
  665.          call pragma('d',homedir)
  666.          do i=1 to n
  667.             address command lzxcmd dothese.i
  668.             problem=rc>0
  669.             if problem then
  670.                leave
  671.             end
  672.          call pragma('d',oldcurrent)
  673.          end
  674.       end
  675.  
  676.    if mustcopy then
  677.       address command 'Delete >NIL: T:ArcDir'handle 'ALL QUIET'
  678.  
  679.    if problem then do
  680.       call displayerror(getcatstr(13,'Error while adding to archive.'))
  681.       lister set otherhandle busy off
  682.       end
  683.    else do
  684.       do i=1 to entries
  685.          lister select otherhandle '"'name.i'"' off
  686.          end
  687.       lister refresh otherhandle
  688.       lister set otherhandle busy off
  689.       call delete('T:ArcDir.list'handle)
  690.       call arclist
  691.       end
  692.  
  693.    return
  694.  
  695.  
  696. viewsingle:
  697.  
  698.    lister set handle busy on
  699.    lister set handle title getcatstr(10,'Extracting from archive...')
  700.    lister refresh handle full
  701.  
  702.    select
  703.       when arctype='LHA' then
  704.          address command 'LhA e -q -x2 -X -Qo "'patch(arcfile)'" T: "'patch(arcsubdir||namestr,"'")'"'
  705.       when arctype='LZX' then
  706.          address command 'LZX e -q -X0 --' lzxkludge(patch(arcfile)) 'T:' lzxkludge(patch(arcsubdir||namestr))
  707.       end
  708.  
  709.    if rc>0 then
  710.       call displayerror(getcatstr(11,'Error while extracting from archive.'))
  711.  
  712.    thisfile='T:'namestr
  713.    commandline='address' portname'; command' event '""'thisfile'"";'
  714.  
  715.    dopus getfiletype '"'thisfile'"' id
  716.    if ~(event='doubleclick' & (result='LHA' | result='LZX')) then
  717.       commandline=commandline,
  718.          'command wait protect name ""'thisfile'"" set RWED;',
  719.          'do until ~exists('''thisfile''') | delete('''thisfile''');',
  720.             'call delay(200);',
  721.             'end'
  722.  
  723.    address command 'Run >NIL: <NIL: RX "'commandline'"'
  724.  
  725.    lister set handle title 'ArcDir:' arcname
  726.    lister refresh handle full
  727.    return
  728.  
  729.  
  730. getall:
  731.  
  732.    entries=0
  733.    do while allents~=''
  734.       entries=entries+1
  735.       parse var allents '"' name.entries '"' allents
  736.       if name.entries='' then
  737.          type.entries=1
  738.       else do
  739.          lister query handle entry '"'name.entries'"' stem fileinfo.
  740.          type.entries=fileinfo.type
  741.          end
  742.       end
  743.    return
  744.  
  745.  
  746. patch:  /* patch filenames containing strange characters */
  747.  
  748.    parse arg patched,extra
  749.    strange='*#?|%()~'extra
  750.    if arctype='LHA' then
  751.       strange=strange'[]'
  752.    pos=1
  753.    do until here=0
  754.       here=verify(substr(patched,pos),strange,'m')
  755.       if here>0 then do
  756.          pos=pos+here+1
  757.          patched=insert("'",patched,pos-3)
  758.          end
  759.       end
  760.    if arctype='LHA' & left(patched,1)='@' then
  761.       patched='%'patched
  762.    if arctype='LZX' then
  763.       if length(patched)-lastpos('/',patched)>=30 then
  764.          patched=patched'#?'
  765.    return patched
  766.  
  767.  
  768. patchstar:
  769.  
  770.    parse arg remain
  771.    patched=''
  772.    do until remain=''
  773.       parse var remain before '*' remain
  774.       patched=patched||before
  775.       if remain~=='' then
  776.          patched=patched'**'
  777.       end
  778.    return patched
  779.  
  780.  
  781. lzxkludge:
  782.  
  783.    parse arg string
  784.    if pos(' ',string)>0 then
  785.       do while pos("'*",string)>0
  786.          parse var string fore "'*" aft
  787.          string=fore'?'aft
  788.          end
  789.    if pos('*',string)=0 then
  790.       string='"'string'"'
  791.    return string
  792.  
  793.  
  794. getcatstr:
  795.  
  796.    parse arg msgno,msgstring
  797.    if catalog~=0 then
  798.       msgstring=getcatalogstr(catalog,msgno,msgstring)
  799.    do i=3 to arg()
  800.       parse var msgstring fore '%s' aft
  801.       msgstring=fore||arg(i)||aft
  802.       end
  803.    return msgstring
  804.  
  805.  
  806. checkhandler:
  807.  
  808.    lister query otherhandle handler
  809.    return ~(result='RESULT' | result='')
  810.  
  811.  
  812. syntax:
  813.  
  814.    call displayerror('Syntax Error' rc',' errortext(rc) 'in line' sigl'.')
  815.    lister set thishandle busy off
  816.    lister set otherhandle busy off
  817.    exit
  818.  
  819.  
  820. halt:
  821. break_c:
  822.  
  823.    lister set thishandle handler
  824.    lister clear thishandle
  825.    lister set thishandle path
  826.    lister set thishandle title 'ArcDir.dopus5 halted.'
  827.    lister refresh thishandle full
  828.    lister set thishandle title
  829.    exit
  830.  
  831.  
  832. displayerror:
  833.  
  834.    parse arg message
  835.    lister set handle title message
  836.    lister refresh handle full
  837.    command flash
  838.    call dorequest('"'message'"' getcatstr(4,'OK'))
  839.    lister set handle title 'ArcDir:' arcname
  840.    return
  841.  
  842.  
  843. dorequest:
  844.  
  845.    parse arg reqargs
  846.    if newopus then
  847.       lister request handle reqargs
  848.    else
  849.       dopus request reqargs
  850.    return
  851.