home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / FileMover / Dopus5 / tradecfg.lha / arexx / DelBBSAds.dopus next >
Encoding:
Text File  |  1994-07-14  |  9.4 KB  |  391 lines
  1. /*
  2.   $VER: DelBBSAds.dopus 4.8 (14.7.94)
  3.   Copyright © 1993-1994 EAV Productions International
  4.  
  5.   ARexx script for Directory Opus to delete BBS ads from LhA archives.
  6.  
  7.   Requires: LhA, Directory Opus, MultiView, ReqTools.library and
  8.   RexxReqTools.library
  9.  
  10.   DelBBSAds.dopus will also use locale.library to adapt to different
  11.   languages, provided there is a catalog.
  12. */
  13.  
  14. maxads=60            /* maximum number of ads in the config */
  15. configname='S:BBSAds.list'    /* name of the config file to use */
  16.  
  17.  
  18. busy on            /* switch busy mouse pointer on */
  19.  
  20. signal on syntax    /* intercept syntax errors */
  21. options results        /* need results from DOpus */
  22. options failat 21    /* external commands are allowed returncode 20 */
  23.  
  24. lf='a'x            /* ascii code for linefeed */
  25. flag=0            /* something deleted? flag */
  26.  
  27. call initlocale        /* initialize local strings */
  28.  
  29. viewer='AmigaGuide'
  30. if open('ksenv','ENV:Kickstart','r') then do
  31.    version=readln('ksenv')
  32.    if version>=39 then
  33.       viewer='MultiView'
  34.    call close('ksenv')
  35.    end
  36.  
  37. now=date('I')
  38. if now<6035 then
  39.    call quitit msg.21
  40. nads=0
  41. totremoved=0
  42. totdate=0
  43.  
  44. if open('configfile',configname,'r') then do
  45.    thisline=readln('configfile')
  46.    do until eof('configfile')
  47.       nads=nads+1
  48.       if nads>maxads then
  49.      leave
  50.       parse var thisline removed.nads date.nads adname.nads
  51.       parse var adname.nads ' ' adname.nads
  52.       totremoved=totremoved+removed.nads
  53.       totdate=totdate+date.nads
  54.       thisline=readln('configfile')
  55.       end
  56.    call close ('configfile')
  57.    end
  58.  
  59. compare=''
  60. do i=1 to nads
  61.    compare=compare i':'adname.i
  62.    end
  63.  
  64. query updateflags
  65. follow=bittst(d2c(result),1)    /* scroll window to follow operations? */
  66. query font 8            /* which font should requesters use? */
  67. fonttag='rt_font='result
  68.  
  69. remember            /* remember config settings */
  70. busy on
  71. modify deleteflags 8        /* don't ask when deleting internal */
  72.  
  73. query screenname
  74. if result=0 then        /* for compatibility with old DOpus */
  75.    screenname=address()
  76. else
  77.    screenname=result
  78.  
  79. status 3            /* get active window */
  80. window=result
  81. status 9 window            /* get number of selected entries */
  82. entries=result
  83.  
  84. if entries=0 then
  85.    call quitit msg.1
  86.  
  87. if ~show('l','rexxreqtools.library') then
  88.    call addlib('rexxreqtools.library',0,-30,0)
  89. eztags='rt_reqpos=reqpos_centerscr rt_pubscrname='screenname 'rtez_flags=ezreqf_centertext' fonttag
  90.  
  91. /* Let the user choose between interactive and automatic. */
  92. call rtezrequest(msg.2,msg.3,,eztags)
  93. if rtresult=0 then
  94.    call quitit msg.4
  95. automatic=(rtresult=2)
  96.  
  97. checkabort            /* reset abort flag */
  98. status 13 window        /* get directory name */
  99. drawer=result
  100.  
  101. do entries
  102.  
  103.    getnextselected
  104.    filename=result
  105.    if follow then
  106.       scrolltoshow '"'filename'"'
  107.    call insstr(filename,msg.5)
  108.    toptext msgstring
  109.    ext=upper(right(filename,4))
  110.    arcfile=ext='.LHA'|ext='.LZH'|ext='.RUN'
  111.    fileinfo '"'filename'" /'
  112.    parse var result . '/' . '/' . '/' filetype '/'
  113.  
  114.    if filetype>0|~arcfile then
  115.       call skipask msg.6
  116.    else do  /* list the archive's contents */
  117.       address command 'LhA >T:DelBBSAds.temp vq -N -Qw -Qo "'drawer||filename'"'
  118.       if rc>0 then
  119.      call skipask msg.8
  120.       else do
  121.      call open('tempfile','T:DelBBSAds.temp','r')
  122.      nfiles=0
  123.      do until eof('tempfile')
  124.         nfiles=nfiles+1
  125.         name.nfiles=readln('tempfile')
  126.         end
  127.      nfiles=nfiles-1
  128.      call close('tempfile')
  129.  
  130.      delthese=''
  131.      delcount=0
  132.      nomore=0
  133.      call open('actionfile','T:actionfile','w')
  134.  
  135.      do i=nfiles to 1 by -1
  136.         cuthere=pos(':'name.i' ',compare' ')
  137.         select
  138.            when upper(name.i)=='FILE_ID.DIZ' then
  139.           nop
  140.            when right(upper(name.i),10)=='.DISPLAYME' then
  141.           call markfordel
  142.            when cuthere>0 then
  143.           call markfordel
  144.            when automatic|nomore then
  145.           nop
  146.            otherwise do /* check by hand */
  147.           call insstr(name.i,msg.9)
  148.           call rtezrequest(msgstring,msg.10,,eztags)
  149.           select
  150.              when rtresult=0 then
  151.             call stopit
  152.              when rtresult=1 then
  153.             nop
  154.              when rtresult=2 then do
  155.                toptext msg.11
  156.                address command 'LhA e -q -x2 -a -C0 -Qo "'patchname(drawer||filename)'" T: "'patchname(name.i)'"'
  157.                if rc>0 then do
  158.                   call skipask msg.12
  159.                   delcount=0
  160.                   leave  /* a short way out of here */
  161.                   end
  162.                temp=reverse(name.i)
  163.                parse var temp thisfile '/'
  164.                thisfile='"T:'reverse(thisfile)'"'
  165.  
  166.                address command viewer 'PUBSCREEN' screenname thisfile
  167.                if rc>0 then do
  168.                   beep
  169.                   busy on
  170.                   call insstr(viewer,msg.13)
  171.                   call rtezrequest(msgstring,,,eztags)
  172.                   end
  173.  
  174.                delete thisfile  /* delete temp file */
  175.                busy on
  176.  
  177.                call insstr(name.i,msg.14)
  178.                call rtezrequest(msgstring,msg.15,,eztags)
  179.                if ~result then
  180.                   nomore=1
  181.                end
  182.              otherwise nomore=1
  183.              end
  184.  
  185.           if ~nomore then do
  186.              nads=nads+1
  187.              adname.nads=name.i
  188.              date.nads=now
  189.              removed.nads=1
  190.              compare=compare nads':'name.i
  191.              call markfordel
  192.              end
  193.           end
  194.            end
  195.         end
  196.      busy on
  197.      call close('actionfile')
  198.  
  199.      if delcount>0 then do
  200.         toptext msg.16 delcount'x'delthese
  201.         flag=1
  202.         address command 'LhA d -q -Qp -Qo "'patchname(drawer||filename)'" @T:actionfile'
  203.         if rc>0 then
  204.            call skipask msg.17
  205.         delete 'T:actionfile'
  206.         busy on
  207.         end
  208.      end
  209.       end
  210.    selectfile filename 0 1    /* deselect the processed file */
  211.    checkabort            /* did the user press both mouse buttons? */
  212.    if result then
  213.       call stopit msg.4
  214.    end                /* on to the next file */
  215.  
  216. call stopit
  217.  
  218.  
  219. skipask:
  220.  
  221.    parse arg reason
  222.    beep
  223.    busy on
  224.    call rtezrequest(reason||lf||msg.18,msg.19,,eztags)
  225.    if ~rtresult then
  226.       call stopit
  227.    return
  228.  
  229.  
  230. initlocale:
  231.  
  232.    /* These are the English default strings. */
  233.    msg.1="Nothing selected!"
  234.    msg.2="How do you want to delete the\n.Displayme's and BBS ads?"
  235.    msg.3="_Interactive|_Automatic|A_bort"
  236.    msg.4="Aborted..."
  237.    msg.5="Processing '%s'..."
  238.    msg.6="Sorry, I can only process LhA archives!"
  239.    msg.7="ERROR"
  240.    msg.8="Error while listing archive."
  241.    msg.9="Do you want to delete the file\n%s\nfrom the archive?"
  242.    msg.10="_Yes|_View|_No|_Stop"
  243.    msg.11="Extracting file..."
  244.    msg.12="Error while extracting."
  245.    msg.13="Sorry, %s cannot\nview this file."
  246.    msg.14="Well, do you want to delete the file\n%s\nfrom the archive?"
  247.    msg.15="_Yes|_No"
  248.    msg.16="Deleting:"
  249.    msg.17="Error while deleting from archive."
  250.    msg.18="Do you wish to skip this file?"
  251.    msg.19="_Skip|S_top"
  252.    msg.20="Syntax Error %s, %s in line %s."
  253.    msg.21="Error, system time not set right!"
  254.    msg.22="Saving config..."
  255.    msgno=22  /* number of locale strings */
  256.  
  257.    ok=show(l,'locale.library')
  258.    if ~ok then
  259.       ok=addlib('locale.library',0,-30)
  260.    if ok then do
  261.       catalog=opencatalog('DelBBSAds.catalog','',0)
  262.       if catalog~=0 then
  263.      do i=1 to msgno
  264.         msg.i=getcatalogstr(catalog,i,msg.i)
  265.         end
  266.       call closecatalog(catalog);
  267.       end
  268.  
  269.    /* Convert \n into real linefeeds. */
  270.    do i=1 to msgno
  271.       if pos('\n',msg.i)>0 then do
  272.      parse var msg.i fore '\n' aft
  273.      msg.i=fore||'a'x||aft
  274.      i=i-1
  275.      end
  276.       end
  277.    return
  278.  
  279.  
  280. insstr:
  281.  
  282.    parse arg replace,msgstring
  283.    if pos('%s',msgstring)>0 then do
  284.       parse var msgstring fore '%s' aft
  285.       msgstring=fore||replace||aft
  286.       end
  287.    return
  288.  
  289.  
  290. markfordel:
  291.  
  292.    totremoved=totremoved+1
  293.    delcount=delcount+1
  294.    delthese=delthese "'"name.i"'"
  295.    call writeln('actionfile','"'patchname(name.i)'"')
  296.    if cuthere>0 then do
  297.       cutagain=lastpos(' ',compare,cuthere-1)+1
  298.       fileno=substr(compare,cutagain,cuthere-cutagain)
  299.       removed.fileno=removed.fileno+1
  300.       totdate=totdate-date.fileno+now
  301.       date.fileno=now
  302.       end
  303.    return
  304.  
  305.  
  306. stopit:  /* sort and save config */
  307.  
  308.    parse arg topline
  309.    if flag then do  /* some ads deleted */
  310.       toptext msg.22
  311.       call open('configfile',configname,'w')
  312.       if automatic then
  313.      do i= 1 to nads
  314.         call writeln('configfile',removed.i date.i adname.i)
  315.         end
  316.       else do  /* calculate the points rewarded to each entry */
  317.      avgremoved=totremoved/nads
  318.      avgdays=now-totdate/nads+1
  319.      do i=1 to nads
  320.         points.i=3.5*removed.i/avgremoved-(now-date.i)/avgdays
  321.         end
  322.      do i= 1 to nads
  323.         if i>maxads then
  324.            leave
  325.         next=i
  326.         itspoints=points.i
  327.         do j=i+1 to nads
  328.            if points.j>itspoints then do
  329.           next=j
  330.           itspoints=points.j
  331.           end
  332.            end
  333.         call writeln('configfile',removed.next date.next adname.next)
  334.         removed.next=removed.i
  335.         date.next=date.i
  336.         adname.next=adname.i
  337.         points.next= points.i
  338.         end
  339.      end
  340.       call close('configfile')
  341.       end
  342.    call quitit topline
  343.  
  344.  
  345. patchname:  /* patch filenames containing pattern matching tokens */
  346.  
  347.    parse arg patched
  348.    pos=1
  349.    do forever
  350.       here=verify(substr(patched,pos),"#?|%()[]~'",'m')
  351.       if here=0 then
  352.      leave
  353.       pos=pos+here+1
  354.       patched=insert("'",patched,pos-3)
  355.       end
  356.    do forever
  357.       here=verify(substr(patched,pos),'*@','m')
  358.       if here=0 then
  359.      leave
  360.       pos=pos+here+1
  361.       patched=insert("*",patched,pos-3)
  362.       end
  363.    patched=translate(patched,'?','"')
  364.    return patched
  365.  
  366.  
  367. syntax:
  368.  
  369.  
  370.    call quitit "Syntax Error" rc"," errortext(rc) "in line" sigl"."
  371.  
  372.  
  373. quitit:
  374.  
  375.    parse arg topline
  376.    if flag then
  377.       rescan    /* files should be shorter! */
  378.    if exists('T:DelBBSAds.temp') then
  379.       delete 'T:DelBBSAds.temp'
  380.    if exists('T:actionfile') then do
  381.       call close('actionfile')
  382.       delete 'T:actionfile'
  383.       end
  384.    if topline~=="" then
  385.       toptext topline
  386.    if pos(msg.7,upper(topline))>0 then
  387.       beep    /* an error occurred */
  388.    restore    /* restore config settings */
  389.    busy off    /* switch to normal pointer */
  390.    exit        /* stop script here */
  391.