home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga Shareware Floppies / ma26.dms / ma26.adf / LhaDir / LhADir.dopus < prev    next >
Text File  |  2021-01-22  |  17KB  |  731 lines
  1. /*
  2.   $VER: LhADir.dopus 1.7 (6.5.94)
  3.   Copyright © 1993-1994 by EAV Productions International
  4.   Placed in the public domain. No restrictions on distribution or usage.
  5.  
  6.   This ARexx script for Directory Opus allows you to show the contents
  7.   (files and directories) of LhA archive files in a DOpus window and operate
  8.   on them as with a normal directory.
  9.  
  10.   Possible arguments (not case sensitive) for LhADir.dopus:
  11.  
  12.    GETDIR, BROWSE, PARENT, ROOT, DELETE, COPY, MOVE, MAKEDIR, GETSIZES,
  13.    READ, ANSIREAD, HEXREAD, SHOW, PLAY, LOOPPLAY, PRINT, ICONINFO, RUN,
  14.    VERSION, MULTIVIEW, AMIGAGUIDE, VIEWTEK, RETINADISPLAY.
  15. */
  16.  
  17.  
  18. signal on syntax    /* intercept syntax errors */
  19. options results        /* need results */
  20. options failat 21    /* external commands are allowed return code 20 */
  21. numeric digits 10    /* needed for convertdate routine */
  22. lf='a'x            /* ascii code for linefeed */
  23.  
  24. parse arg command portname . '"' selected '"'
  25. upper command
  26. if portname~=='' then
  27.    address(portname)
  28. else
  29.    portname=address()
  30. parse var portname '.' port  /* port number */
  31.  
  32. busy on            /* busy mouse pointer on */
  33. status 3        /* get active window */
  34. win=result
  35. status 9 win        /* get number of selected entries */
  36. entries=result
  37. checkabort        /* reset abort flag */
  38.  
  39. call checkconfig
  40. call checklhadir(win)
  41.  
  42. if selected~=='' then do
  43.    filetype=-1
  44.    entries=1
  45.    end
  46. else
  47.    if entries>0 then
  48.       call getnextone
  49.  
  50. topline=""
  51. listlha=0
  52. notmove=command~='MOVE'
  53. if pos('|'command'|','|GETDIR|BROWSE|PARENT|ROOT|DELETE|COPY|MOVE|MAKEDIR|GETSIZES|')>0 then
  54.    interpret 'call do'command
  55. else do
  56.    n=entries
  57.    async=pos('|'command'|','|READ|ANSIREAD|HEXREAD|')>0
  58.    internal=async|pos('|'command'|','|SHOW|PLAY|LOOPPLAY|PRINT|ICONINFO|RUN|')>0
  59.    if entries=0|async|(internal&~(lhadir&entries>0))|command='VERSION' then
  60.       n=1
  61.  
  62.    do n
  63.       checkabort  /* did the user press both mouse buttons? */
  64.       if result then
  65.      call quitit "Aborted..."
  66.  
  67.       if entries>0 then do
  68.      call getnextone
  69.      if lhadir then do
  70.         if filetype>0 then
  71.            call quitit "Error, cannot view directories."
  72.         address command 'LhA e -q -x2 -Qo "'patch(lhafile)'" T: "'patch(lhasubdir||selected)'"'
  73.         if rc>0 then
  74.            call quitit "Error while extracting file."
  75.         thisfile='"T:'selected'"'
  76.         end
  77.      else
  78.         if internal then
  79.            thisfile=''
  80.         else
  81.            thisfile='"'selected'"'
  82.      end
  83.  
  84.       if internal then do
  85.      interpret "'"command thisfile"'"
  86.      abort=result~=0
  87.      end
  88.       else do
  89.      if ~lhadir&entries>0 then
  90.         thisfile='"'winpath||selected'"'
  91.      query screenname
  92.      if result=0 then
  93.         screenname=portname  /* for compatibility */
  94.      else
  95.         screenname=result
  96.  
  97.      select  /* external commands */
  98.         when command='VERSION' then
  99.            call doversion
  100.         when command='MULTIVIEW' then
  101.            address command 'MultiView' thisfile 'PUBSCREEN' screenname
  102.         when command='AMIGAGUIDE' then
  103.            address command 'AmigaGuide' thisfile 'PUBSCREEN' screenname
  104.         when command='VIEWTEK' then
  105.            address command 'Work:OtherTools/VT >NIL:' thisfile
  106.         when command='RETINADISPLAY' then
  107.            address command 'Work:RetinaTools/RetinaDisplay' thisfile
  108.         otherwise
  109.            call quitit "Error, LhADir.dopus does not support the command '"command"'."
  110.         end
  111.      abort=0
  112.      end
  113.  
  114.       busy on
  115.       if lhadir&entries>0 then do
  116.      if async then do
  117.         if ~show('l','rexxsupport.library') then
  118.            call addlib('rexxsupport.library',0,-30)  /* needed for delay() */
  119.         call delay(75)  /* wait a bit before deleting */
  120.         end
  121.      delete '"T:'selected'"'
  122.      busy on
  123.      end
  124.       if thisfile~=='' then do
  125.      selectfile '"'selected'" 0 1'  /* deselect item */
  126.      if topline=="" then
  127.         topline="OK"
  128.      end
  129.       if abort then
  130.      call quitit
  131.       end
  132.    end
  133.  
  134. call quitit topline  /* finished */
  135.  
  136.  
  137. dobrowse:
  138. dogetdir:
  139.  
  140.    if entries>0 then
  141.       if filetype>0 then  /* list a new dir */
  142.      if lhadir then
  143.         lhasubdir=lhasubdir||selected'/'
  144.      else
  145.         winpath=winpath||selected'/'
  146.       else do  /* list an archive file */
  147.      if pos('|'upper(right(selected,4)'|'),'|.LHA|.LZH|.RUN|')=0 then
  148.         call quitit "Error, LhADir.dopus can only list LhA archives."
  149.      if lhadir then do
  150.         request "This is an archive in an archive."lf"Extract it to 'T:' and then list it?"
  151.         uset=result
  152.         if uset then
  153.            destpath='T:'
  154.         else do
  155.            busy on
  156.            status 13 1-win  /* get window path */
  157.            destpath=result
  158.            if result=='' then
  159.           call quitit "Aborted..."
  160.            request "Use the current destination window"lf"'"destpath"' instead?"
  161.            if ~result then
  162.           call quitit "Aborted..."
  163.            end
  164.         busy on
  165.         toptext "Extracting from archive..."
  166.         address command 'LhA e -q -x2 -a -C0 -Qo "'patch(lhafile)'" "'destpath'" "'patch(lhasubdir||selected)'"'
  167.         if rc>0 then
  168.            call quitit "Error while extracting from archive."
  169.         if ~uset&command='GETDIR' then
  170.            rescan 1-win
  171.         lhafile=destpath||selected
  172.         end
  173.      else
  174.         lhafile=winpath||selected
  175.      lhadir=1
  176.      lhasubdir=''
  177.      listlha=1
  178.      end
  179.    else  /* rescan current dir */
  180.       if lhadir then do
  181.      status 6  /* get number of entries */
  182.      listlha=result>0
  183.      end
  184.  
  185.    if command='BROWSE' then do
  186.       selectfile '"'selected'" 0 1'
  187.       call swapactive
  188.       end
  189.    if lhadir then do
  190.       call showlhadir
  191.       topline="OK"
  192.       end
  193.    else
  194.       status 13 win set '"'winpath'"'
  195.    return
  196.  
  197.  
  198. doparent:
  199.  
  200.    if lhadir&lhasubdir~=='' then do
  201.       cuthere=lastpos('/',lhasubdir,length(lhasubdir)-1)
  202.       lhasubdir=left(lhasubdir,cuthere)
  203.       call showlhadir
  204.       topline="OK"
  205.       end
  206.    else
  207.       parent
  208.    return
  209.  
  210.  
  211. doroot:
  212.  
  213.    if lhadir&lhasubdir~=='' then do
  214.       lhasubdir=''
  215.       call showlhadir
  216.       topline="OK"
  217.       end
  218.    else
  219.       root
  220.    return
  221.  
  222.  
  223. dodelete:
  224.  
  225.    if lhadir then do
  226.       if entries=0 then
  227.      call quitit
  228.       if notmove then do
  229.      if askdelete then do
  230.         request "Do you really wish to delete selected entries"lf"from archive?"
  231.         if ~result then
  232.            call quitit "Aborted..."
  233.         busy on
  234.         end
  235.      call getall
  236.      end
  237.       call open('actionfile','T:actionfile'port,'w')
  238.       do i=1 to entries
  239.      if type.i>0 then
  240.         wild='/#?'
  241.      else
  242.         wild=''
  243.      call writeln('actionfile','"'patch(lhasubdir||name.i)||wild'"')
  244.      removefile '"'name.i'" 0'
  245.      end
  246.       call close('actionfile')
  247.       toptext "Deleting from archive..."
  248.       address command 'LhA d -q -Qp -Qo "'patch(lhafile)'" @T:actionfile'port
  249.       if rc>0 then do
  250.      topline="Error while deleting from archive."
  251.      listlha=1
  252.      call showlhadir
  253.      end
  254.       else do
  255.      topline="OK"
  256.      displaydir
  257.      end
  258.       delete 'T:actionfile'port
  259.       delete 'T:LhADir.list'port  /* archive contents has changed */
  260.       busy on
  261.       end
  262.    else do
  263.       if notmove then
  264.      restore
  265.       delete
  266.       end
  267.    return
  268.  
  269.  
  270. domove:
  271. docopy:
  272.  
  273.    if entries=0 then
  274.       call quitit
  275.    problem=0
  276.    source=winpath
  277.    s_lhadir=lhadir
  278.    s_lhafile=lhafile
  279.    s_lhasubdir=lhasubdir
  280.    call checklhadir(1-win)
  281.  
  282.    if s_lhadir then do
  283.       if winpath=='' then do
  284.      errortext="No destination directory selected!"
  285.      toptext errortext
  286.      notify errortext
  287.      call quitit
  288.      end
  289.       if lhadir then
  290.      winpath='T:LhADir'port'/'lhasubdir
  291.       call getall
  292.       call lhaextract
  293.       if lhadir then do
  294.      source=winpath
  295.      call lhaadd
  296.      end
  297.       else
  298.      rescan 1-win
  299.       end
  300.    else
  301.       if lhadir then do
  302.      call getall
  303.      call lhaadd
  304.      end
  305.       else do  /* normal copy/move */
  306.      restore
  307.      if notmove then
  308.         copy
  309.      else
  310.         move
  311.      end
  312.  
  313.    if (s_lhadir|lhadir)&~notmove&~problem then do
  314.       lhadir=s_lhadir
  315.       lhafile=s_lhafile
  316.       lhasubdir=s_lhasubdir
  317.       call dodelete
  318.       end
  319.    return
  320.  
  321.  
  322. domakedir:
  323.  
  324.    result=''
  325.    getstring '"Enter directory name or archive name.lha"'
  326.    dirtomake=result
  327.    if dirtomake=='' then
  328.       call quitit
  329.    now=date('i')*86400+time('s')
  330.    if lhadir then do  /* create empty dir in archive */
  331.       call createdirs dirtomake'/'
  332.       address command 'LhA a -q -e -r -Qo "'patch(lhafile)'" T:LhADir'port'/' '"'patch(lhasubdir||dirtomake)'"'
  333.       if rc>0 then
  334.      topline="Error while adding to archive."
  335.       else do
  336.      topline="Directory created."
  337.      addfile '"'dirtomake'" 0 1' now '"" ----RWED 0 1'
  338.      end
  339.       delete 'T:LhADir'port
  340.       delete 'T:LhADir.list'port
  341.       busy on
  342.       end
  343.    else do
  344.       if upper(right(dirtomake,4))=='.LHA' then  /* create new archive */
  345.      if open('emptyarchive',winpath||dirtomake,'w') then do
  346.         call writech('emptyarchive','0'x)
  347.         call close('emptyarchive')
  348.         topline="Empty archive created."
  349.         addfile '"'dirtomake'" 1 -1' now '"" ----RWED 0 1'
  350.         end
  351.      else
  352.         topline="Error creating archive."
  353.       else do  /* normal makedir */
  354.      restore
  355.      makedir '"'dirtomake'"'
  356.      end
  357.       end
  358.    return
  359.  
  360.  
  361. dogetsizes:
  362.  
  363.    if lhadir then do
  364.       status 6 win  /* get total number of entries */
  365.       all=result
  366.       status 8 win  /* get number of dirs selected */
  367.       seldirs=result
  368.       n=1
  369.       do i=1 to all
  370.      getentry i
  371.      dirname.n=result
  372.      fileinfo '"'result'" /'
  373.      parse var result '/' filesize '/' '/' type '/' select '/'
  374.      if type>0&select&filesize=0 then
  375.         n=n+1
  376.      end
  377.       dirsize.=0
  378.       dirsecs.=0
  379.       ndirs=n-1
  380.       call readlist(0)
  381.       end
  382.    getsizes
  383.    return
  384.  
  385.  
  386. doversion:
  387.  
  388.    if entries=0 then
  389.       thisfile='REXX:LhADir.dopus'
  390.    toptext "Searching for version string..."
  391.    address command 'Version >T:Version.temp' thisfile 'FILE FULL'
  392.    call open('tempfile','T:Version.temp','r')
  393.    topline=readln('tempfile')
  394.    call close ('tempfile')
  395.    delete 'T:Version.temp'
  396.    return
  397.  
  398.  
  399. checklhadir:
  400.  
  401.    arg checkwindow
  402.    status 13 checkwindow  /* get window path */
  403.    winpath=result
  404.    test=upper(winpath)
  405.    cuthere=pos('.LHA/',test)
  406.    if cuthere=0 then
  407.       cuthere=pos('.LZH/',test)
  408.    if cuthere=0 then
  409.       cuthere=pos('.RUN/',test)
  410.    lhadir=cuthere>0
  411.    if lhadir then do
  412.       lhafile=left(winpath,cuthere+3)
  413.       lhasubdir=substr(winpath,cuthere+5)
  414.       end
  415.    return
  416.  
  417.  
  418. lhaextract:
  419.  
  420.    status 8 win  /* get number of dirs selected */
  421.    anydirs=result>0
  422.    mustmove=anydirs&s_lhasubdir~==''
  423.    if mustmove then
  424.       destpath=winpath'LhADir'port'/'
  425.    else
  426.       destpath=winpath
  427.  
  428.    call open('actionfile','T:actionfile'port,'w')
  429.    do i=1 to entries
  430.       if type.i>0 then
  431.      wild='/#?'
  432.       else
  433.      wild=''
  434.       call writeln('actionfile','"'patch(s_lhasubdir||name.i)||wild'"')
  435.       end
  436.    call close('actionfile')
  437.  
  438.    if anydirs then
  439.       lhacmd='x'
  440.    else
  441.       lhacmd='e -x2'
  442.    toptext "Extracting from archive..."
  443.    address command 'LhA' lhacmd '-q -a -C0 -Qo "'patch(s_lhafile)'" "'destpath'" @T:actionfile'port
  444.    problem=rc>0
  445.    if problem then
  446.       topline="Error while extracting from archive."
  447.    else do
  448.       topline="OK"
  449.       if notmove then
  450.      none
  451.       end
  452.  
  453.    if mustmove then do
  454.       do i=1 to entries
  455.      move '"'winpath'LhADir'port'/'s_lhasubdir||name.i'" "'winpath'"'
  456.      end
  457.       delete '"'winpath'LhADir'port'"'
  458.       end
  459.    delete 'T:actionfile'port
  460.    busy on
  461.    return
  462.  
  463.  
  464. lhaadd:
  465.  
  466.    mustcopy=upper(right(source,length(lhasubdir)))~==upper(lhasubdir)
  467.    if mustcopy then do  /* all files must be copied to T: before they can be added */
  468.       homedir='T:LhADir'port'/'
  469.       call createdirs
  470.       end
  471.    else
  472.       homedir=left(source,length(source)-length(lhasubdir))
  473.    call open('actionfile','T:actionfile'port,'w')
  474.    call writeln('actionfile','"'patch(homedir)'"')
  475.  
  476.    if s_lhadir then
  477.       call writeln('actionfile','#?')
  478.    else do
  479.       do i=1 to entries
  480.      call writeln('actionfile','"'patch(lhasubdir||name.i)'"')
  481.      if mustcopy then do
  482.         copy '"'source||name.i'" "T:LhADir'port'/'lhasubdir'"'
  483.         busy on
  484.         end
  485.      end
  486.       end
  487.    call close('actionfile')
  488.  
  489.    toptext "Adding to archive..."
  490.    address command 'LhA r -q -e -r -Qo "'patch(lhafile)'" @T:actionfile'port
  491.    problem=rc>0
  492.    if problem then
  493.       topline="Error while adding to archive."
  494.    else do
  495.       topline="OK"
  496.       if notmove then
  497.      none
  498.       end
  499.    delete 'T:actionfile'port
  500.    if mustcopy|s_lhadir then
  501.       delete 'T:LhADir'port
  502.    busy on
  503.    call swapactive
  504.    listlha=1
  505.    call showlhadir
  506.    call swapactive
  507.    return
  508.  
  509.  
  510. lhalist:
  511.  
  512.    address command 'LhA >T:LhADir.list'port 'vv -N -Qw -Qo "'lhafile'"'
  513.    if rc>0 then do
  514.       setwintitle '"<Directory not available>"'
  515.       call quitit "Error while listing archive."
  516.       end
  517.    return
  518.  
  519.  
  520. getnextone:
  521.  
  522.    getnextselected
  523.    selected=result
  524.    if follow then
  525.       scrolltoshow '"'selected'"'
  526.    fileinfo '"'selected'" /'
  527.    parse var result '/' '/' '/' filetype '/'
  528.    return
  529.  
  530.  
  531. getall:
  532.  
  533.    status 6 win  /* get total number of entries */
  534.    all=result
  535.    n=1
  536.    do i=1 to all
  537.       getentry i
  538.       name.n=result
  539.       fileinfo '"'result'" /'
  540.       parse var result '/' '/' '/' type.n '/' select '/'
  541.       if select then
  542.      n=n+1
  543.       if n>entries then
  544.      leave
  545.       end
  546.    return
  547.  
  548.  
  549. createdirs:
  550.  
  551.    parse arg subdir
  552.    dirstocreate='T:LhADir'port'/'lhasubdir||subdir
  553.    here=0
  554.    do forever
  555.       here=pos('/',dirstocreate,here+1)
  556.       if here=0 then
  557.      leave
  558.       makedir '"'left(dirstocreate,here-1)'"'
  559.       end
  560.    busy on
  561.    return
  562.  
  563.  
  564. swapactive:
  565.  
  566.    otherwindow
  567.    win=1-win
  568.    return
  569.  
  570.  
  571. showlhadir:
  572.  
  573.    status 13 win set '"'lhafile'/'lhasubdir'"'
  574.    toptext "Listing archive..."  /* toptext obscures error message */
  575.    setwintitle '"LhADir listed archive"'
  576.    now=date('i')*86400+time('s')
  577.    ndirs=0
  578.    call readlist(1)
  579.    return
  580.  
  581.  
  582. readlist:
  583.  
  584.    arg show  /* showdir or getsizes? */
  585.    if listlha|~exists('T:LhADir.list'port) then
  586.       call lhalist
  587.    call open('tempfile','T:LhADir.list'port,'r')
  588.    nextline=readln('tempfile')
  589.    parse var nextline 21 whicharc "':"
  590.    if upper(whicharc)~==upper(lhafile) then do  /* it's another archive's list */
  591.       call close('tempfile')
  592.       call lhalist
  593.       call open('tempfile','T:LhADir.list'port,'r')
  594.       call readln('tempfile')
  595.       end
  596.    do 2
  597.       call readln('tempfile')  /* waste these 2 lines */
  598.       end
  599.  
  600.    compstr=upper(lhasubdir)
  601.    complen=length(compstr)
  602.    nextline=readln('tempfile')
  603.  
  604.    do forever
  605.  
  606.       name=nextline
  607.       infoline=readln('tempfile')
  608.       do while substr(infoline,22,1)~=='%'
  609.      name=infoline
  610.      infoline=readln('tempfile')
  611.      end
  612.       if name=='-------- ------- ----- --------- --------' then
  613.      leave
  614.       nextline=readln('tempfile')
  615.       if left(nextline,1)==':' then do
  616.      parse var nextline 3 comment
  617.      nextline=readln('tempfile')
  618.      end
  619.       else
  620.      comment=''
  621.  
  622.       if upper(left(name,complen))==compstr then do
  623.      name=substr(name,complen+1)
  624.      if name~==''&pos('"',name)=0 then do
  625.         if pos('/',name)>0 then do  /* it's a dir */
  626.            parse var name dirname '/'
  627.            olddir=0
  628.            do i=ndirs to 1 by -1
  629.           if upper(dirname)==upper(dirname.i) then do
  630.              olddir=1
  631.              if ~show then do
  632.             toptext winpath||name
  633.             parse var infoline size . 24 datestamp 42
  634.             dirsize.i=dirsize.i+size
  635.             seconds=convertdate(datestamp)
  636.             if seconds>dirsecs.i then
  637.                dirsecs.i=seconds
  638.             end
  639.              leave
  640.              end
  641.           end
  642.            if show&~olddir then do  /* a new dir */
  643.           ndirs=ndirs+1
  644.           dirname.ndirs=dirname
  645.           addfile '"'dirname'" 0 1' now '"" ----RWED 0 0'
  646.           end
  647.            end
  648.         else  /* it's a file */
  649.            if show then do
  650.           parse var infoline size . 24 datestamp 42 43 atts .
  651.           seconds=convertdate(datestamp)
  652.           addfile '"'name'"' size '-1' seconds '"'comment'"' atts '0 0'
  653.           end
  654.         end
  655.      end
  656.       end
  657.    call close('tempfile')
  658.    if ~show then
  659.       do i=1 to ndirs
  660.      addfile '"'dirname.i'"' dirsize.i '1' dirsecs.i '"" ----RWED 0 0'
  661.      selectfile '"'dirname.i'"'
  662.      end
  663.    displaydir
  664.    return
  665.  
  666.  
  667. convertdate:  /* convert a file's date stamp to seconds past 01-Jan-78 */
  668.  
  669.    parse arg day '-' month '-' year ' ' hours ':' minutes ':' seconds
  670.    century=19+(year<78)
  671.    month=pos(month,'  JanFebMarAprMayJunJulAugSepOctNovDec')/3
  672.    month=right(month,2,'0')
  673.    return seconds+minutes*60+hours*3600+date('i',century||year||month||day,'s')*86400
  674.  
  675.  
  676. patch:  /* patch filenames containing pattern matching tokens */
  677.  
  678.    parse arg patched
  679.    pos=1
  680.    do forever
  681.       here=verify(substr(patched,pos),'#?|%()[]~*','m')
  682.       if here=0 then
  683.      leave
  684.       pos=pos+here+1
  685.       patched=insert("'",patched,pos-3)
  686.       end
  687.    return patched
  688.  
  689.  
  690. syntax:
  691.  
  692.    call quitit "Syntax Error" rc"," errortext(rc) "in line" sigl"."
  693.  
  694.  
  695. checkconfig:
  696.  
  697.    query dirflags
  698.    olddirflags=result
  699.    if olddirflags<0 then  /* bug in DOpus? */
  700.       olddirflags=256+olddirflags
  701.    if bittst(d2c(olddirflags),5) then do
  702.       request "The config setting 'Re-read changed buffers'"lf"must be switched off. Shall I do this for you?"
  703.       if ~result then do
  704.      remember  /* something to restore */
  705.      call quitit "Error, config setting 'Re-read changed buffers' must be switched off."
  706.      end
  707.       modify dirflags olddirflags-32
  708.       end
  709.  
  710.    remember                /* remember user settings */
  711.    busy on
  712.    query updateflags
  713.    follow=bittst(d2c(result),1)        /* scroll window to follow operations? */
  714.    modify updateflags 0            /* no progress indicator */
  715.    query deleteflags
  716.    askdelete=bittst(d2c(result),0)    /* ask before deleting? */
  717.    modify deleteflags 8            /* don't ask when deleting internal */
  718.    modify iconflags 0            /* no icons please */
  719.    return
  720.  
  721.  
  722. quitit:
  723.  
  724.    parse arg topline
  725.    restore                   /* restore user settings */
  726.    if topline~=="" then
  727.       toptext topline            /* display final message */
  728.    if pos("Error",topline)>0 then beep    /* an error occurred */
  729.    busy off                /* busy mouse pointer off */
  730.    exit                    /* stop script here */
  731.