program newsdis ******************************************************************************** * * N E W S (Disable User Image) * * This program set the max message to 999 for a specified user * effectively disabling that user from the news system ******************************************************************************** integer cli$present integer set_usermax,stat integer*2 usermax character*10 username*12 stat = cli$get_value('DISABLE',username) if (.TRUE.) then call set_usermax(999,username) print *, 1 'User '//username//' disabled from NEWS.' call exit else call lib$stop(%val(stat)) endif end subroutine set_usermax(lastitem,username) ******************************************************************************** * * This routine updates the NEWSUSERS file to contain the new 'highest number * read' for the current user (for the user specified). * ******************************************************************************** parameter NEWSUSERS='NEWS$DIR:NEWSUSERS' parameter NEWSUNIT=101 parameter JPI$_USERNAME='202'X, PRV$M_SYSPRV='10000000'X parameter RESOURCE='RIT_NEWSUSERS_LCK' include 'lckdef.inc' integer lksb(2), lksb1(2) integer*2 lastitem, itemcode character*12 username external msg_panic * We need to enqueue on the user file for access to the user record. * Start out the enqueue on the whole file while obtaining info about the * user. call sys$enq(,%val(LCK$K_CRMODE),LKSB,%val(LCK$M_SYSTEM),RESOURCE, * ,,,,,) call sys$enqw(,%val(LCK$K_PWMODE),LKSB1,%val(LCK$M_SYSTEM), * username,%val(lksb(2)),,,,,) open (unit=NEWSUNIT, file=NEWSUSERS, status='old', form='formatted', * access='keyed', key=(1:12:character), recordtype='variable', * carriagecontrol='none', recl=20, organization='indexed', shared, * err=10000) * Write or rewrite the record (whichever is necessary!) read (NEWSUNIT,10,err=20,key=username) username rewrite (NEWSUNIT,10) username, lastitem 10 format (a12,i4) goto 30 20 write (NEWSUNIT,10) username, lastitem goto 30 * Clean up by closing the file and dequeueing. 30 close (unit=NEWSUNIT) call sys$deq(%val(lksb1(2)),,,) call sys$deq(%val(lksb(2)),,,) return 10000 call lib$stop(msg_panic) end