This is a program we wrote to control the maximum number of minutes any one user could spend on our system in any given week. We have a need to control this since our users are coming in via TYMNET at our expense. Since this is written fully in DCL, it is very easily modified for your own needs. Comments to the author are welcome :-). Harrison M. Spain III ... Voice: (714) 952-6114 McDonnell Douglas M&E ... Internet: spain@mdcbbs.com 5701 Katella Avenue ... UUCP: {uunet,decwrl,att}!mdcbbs.com!spain Cypress, CA 90630 ... PSI: PSI%31060099980019::SPAIN $! ................... Cut between dotted lines and save. ................... $!........................................................................... $! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989. $! $! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from $! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au). $! $! To unpack, simply save, concatinate all parts into one file and $! execute (@) that file. $! $! This archive was created by user SPAIN $! on 16-FEB-1991 18:15:41.36. $! $! ATTENTION: To keep each article below 31 blocks (15872 bytes), this $! program has been transmitted in 2 parts. You should $! concatenate ALL parts to ONE file and execute (@) that file. $! $! It contains the following 2 files: $! RATION.COM $! RATION_MONITOR.COM $! $!============================================================================ $ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL ) $ VERSION = F$GETSYI( "VERSION" ) $ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK $ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", - "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher." $ EXIT 44 ! SS$_ABORT $VERSION_OK: $ GOTO START $! $UNPACK_FILE: $ WRITE SYS$OUTPUT "Creating ''FILE_IS'" $ DEFINE/USER_MODE SYS$OUTPUT NL: $ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION - VMS_SHARE_DUMMY.DUMMY b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) ) ; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE , b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors := 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN & "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION ( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail & LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP ; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK ( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ) ; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF ; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ) ; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ) ; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF ; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE ; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1 ; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF ; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors := i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT ( "The following line could not be unpacked properly:" ); SPLIT_LINE ; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL ( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH ( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 ); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP ; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION ( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO ( "The following !UL errors were detected while unpacking !AS", i_errors , s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" ) ; ENDIF; EXIT; $ DELETE VMS_SHARE_DUMMY.DUMMY;* $ CHECKSUM 'FILE_IS $ WRITE SYS$OUTPUT " CHECKSUM ", - F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." ) $ RETURN $! $START: $ FILE_IS = "RATION.COM" $ CHECKSUM_IS = 2054396810 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X$!'f$verify(0) X$ set noon X$ set nocontrol=y X$ say := write sys$output X$! V$!--------------------------------------------------------------------------- X--- X$! Edit these values if you like X$! X$ default_time_template = "0024000000" ! default time limit of 240 minutes X$ default_ration_location = "BBS$ROOT:[RATION]" ! default location V$!--------------------------------------------------------------------------- X--- X$! X$ if f$parse("''default_ration_location'") .eqs. "" X$ then X$ `009default_ration_location = f$environment("procedure") V$ `009default_ration_location = f$extract(0,f$locate("]",default_ration_locat Xion)+1,default_ration_location) X$ endif X$! V$!--------------------------------------------------------------------------- X--- X$! RATION.COM designed to restrict elapsed time usage on a system over an X$! extended period of time. You must be running the RATION_MONITOR process X$! to use this procedure (invoking RATION_MONITOR is all that is necessary). X$! X$! Place the following in your SYSTARTUP_V5.COM: X$! X$! $ @disk:[directory]RATION_MONITOR X$! X$! Place the following into your SYS$SYLOGIN file: X$! X$! $ @disk:[directory]RATION CHECK_RATION X$! V$! You will want to refresh the RATION.DAT file (weekly if you want to contro Xl V$! the default number of minutes on a weekly basis). You can change the numb Xer X$! of default minutes by editing the default_time_template above (it is X$! currently set to 240 minutes). X$! X$! $ @disk:[directory]RATION CREATE_RATION X$! X$! Place the following in your menu (if you want): X$! X$! $ @disk:[directory]RATION SHOW_RATION X$! X$! You can control RATION by simply invoking this file and using the commands X$! built in (type HELP to display the commands). X$! X$! $ @disk:[directory]RATION X$! X$! Author: Harrison Spain X$! Date: February 15th, 1991 X$! Version: V1.1 V$!--------------------------------------------------------------------------- X--- X$! X$ user = f$getjpi("","username") X$ close /nolog ration_file X$ open /share/read/write ration_file 'default_ration_location'ration.dat X$! X$ if p1 .eqs. "" then goto command_entry X$ if p1 .eqs. "CREATE_RATION" then goto 'p1' ! (no param) X$ if p1 .eqs. "CHECK_RATION" then goto 'p1' ! (no param) X$ if p1 .eqs. "SHOW_RATION" then goto 'p1' ! (p1 - username) X$ if p1 .eqs. "MODIFY_RATION" then goto 'p1' ! (p1 - username) X$! (p2 - authorized minutes) X$! (p3 - used minutes) X$ if p1 .eqs. "DELETE_RATION" then goto 'p1' ! (p1 - username) X$! X$ say "" X$ say "%RATION-E-NOP1, The (''p1') parameter is not recognized." X$ say "" X$ say "You must specify one of the following P1 Parameters:" X$ say "" V$ say "CREATE_RATION - (create RATION.DAT weekly; system managem Xent)" X$ say "CHECK_RATION - (called during login from SYS$SYLOGIN)" V$ say "SHOW_RATION [username] - (for use in a menu or from DCL; system ma Xnagement)" V$ say "MODIFY_RATION [username] [authorized min] `123used min`125 - (system m Xanagement)" X$ say "DELETE_RATION [username] - (system management)" X$ say "" X$ goto cleanup X$! X$create_ration: X$ if .not. f$priv("sysprv") then - X`009say "%RATION-F-NOPRIV, You do not have privilege to run this procedure!" X$ if .not. f$priv("sysprv") then goto cleanup X$ old_file = f$search("''default_ration_location'ration.dat") X$ create /fdl=sys$input 'default_ration_location'ration.dat XIDENT`009"RATION.DAT to restrict the interactive use of the BBS" X XSYSTEM X`009SOURCE`009`009`009VAX/VMS X XFILE X`009ORGANIZATION`009`009indexed X XRECORD X`009CARRIAGE_CONTROL`009carriage_return X`009FORMAT`009`009`009variable X`009SIZE`009`009`00922 X XAREA 0 X`009ALLOCATION`009`0091 X`009BEST_TRY_CONTIGUOUS`009yes X`009BUCKET_SIZE`009`0091 X`009EXTENSION`009`0091 X XAREA 1 X`009ALLOCATION`009`0091 X`009BEST_TRY_CONTIGUOUS`009yes X`009BUCKET_SIZE`009`0091 X`009EXTENSION`009`0091 X XAREA 2 X`009ALLOCATION`009`0091 X`009BEST_TRY_CONTIGUOUS`009yes X`009BUCKET_SIZE`009`0091 X`009EXTENSION`009`0091 X XAREA 3 X`009ALLOCATION`009`0091 X`009BEST_TRY_CONTIGUOUS`009yes X`009BUCKET_SIZE`009`0091 X`009EXTENSION`009`0091 X XKEY 0 X`009CHANGES`009`009`009no X`009DATA_AREA`009`0090 X`009DATA_FILL`009`009100 X`009DATA_KEY_COMPRESSION`009yes X`009DATA_RECORD_COMPRESSION`009yes X`009DUPLICATES`009`009yes X`009INDEX_AREA`009`0091 X`009INDEX_COMPRESSION`009yes X`009INDEX_FILL`009`009100 X`009LEVEL1_INDEX_AREA`0091 X`009PROLOG`009`009`0093 X`009SEG0_LENGTH`009`00912 X`009SEG0_POSITION`009`0090 X`009TYPE`009`009`009string X XKEY 1 X`009CHANGES`009`009`009yes X`009DATA_AREA`009`0092 X`009DATA_FILL`009`009100 X`009DATA_KEY_COMPRESSION`009yes X`009DUPLICATES`009`009yes X`009INDEX_AREA`009`0092 X`009INDEX_COMPRESSION`009yes X`009INDEX_FILL`009`009100 X`009LEVEL1_INDEX_AREA`0092 X`009SEG0_LENGTH`009`0095 X`009SEG0_POSITION`009`00912 X`009TYPE`009`009`009string X XKEY 2 X`009CHANGES`009`009`009yes X`009DATA_AREA`009`0092 X`009DATA_FILL`009`009100 X`009DATA_KEY_COMPRESSION`009yes X`009DUPLICATES`009`009yes X`009INDEX_AREA`009`0093 X`009INDEX_COMPRESSION`009yes X`009INDEX_FILL`009`009100 X`009LEVEL1_INDEX_AREA`0093 X`009SEG0_LENGTH`009`0095 X`009SEG0_POSITION`009`00917 X`009TYPE`009`009`009string X$ if old_file .eqs. "" X$ then V$ `009set file /prot=(s:rwed,o:rwed,g:rwe,w) 'default_ration_location'ration. Xdat X$ `009purge /log /keep=2 'default_ration_location'ration.dat X$ else X$ `009close /nolog old_ration_file X$ `009open /share/read/write old_ration_file 'old_file' X$ `009close /nolog ration_file X$ `009open /share/read/write ration_file 'default_ration_location'ration.dat X$move_records: X$ `009read /end=end_move_records old_ration_file old_ration_line X$ `009if f$extract(12,5,old_ration_line) .nes. - X`009f$extract(0,5,default_time_template) then - V`009write ration_file f$extract(0,12,old_ration_line),f$extract(12,5,old_rati Xon_line),"00000" X$ `009goto move_records X$end_move_records: X$ `009close /nolog old_ration_file X$ endif X$ goto cleanup X$check_ration: X$ gosub check_for_new_ration X$ read /index=0 /key="''user'" ration_file ration_line X$ used = f$extract(17,5,ration_line) X$ used = f$int(used) X$ auth = f$extract(12,5,ration_line) X$ auth = f$int(auth) X$ if auth .gt. used then goto cleanup X$ say "%BBS-F-NOACCESS, BBS/TYMNET time limit (''auth' minutes) exceeded!" X$ say "" V$ say "You have exceeded your TYMNET time limit on the BBS for the current we Xek." X$ say "Please try again later." X$ say "" X$ wait 00:00:02 X$ if f$edit(f$getjpi("","username"),"trim") .eqs. "SPAIN" then - X`009goto cleanup X$ close /nolog ration_file X$ logout := logout X$ logout /hangup X$show_ration: X$ if p2 .nes. "" X$ then X$ `009usr = p2 X$ `009if f$length(usr) .eq. 1 then user = "''p2' " X$ `009if f$length(usr) .eq. 2 then user = "''p2' " X$ `009if f$length(usr) .eq. 3 then user = "''p2' " X$ `009if f$length(usr) .eq. 4 then user = "''p2' " X$ `009if f$length(usr) .eq. 5 then user = "''p2' " X$ `009if f$length(usr) .eq. 6 then user = "''p2' " X$ `009if f$length(usr) .eq. 7 then user = "''p2' " X$ `009if f$length(usr) .eq. 8 then user = "''p2' " X$ `009if f$length(usr) .eq. 9 then user = "''p2' " X$ `009if f$length(usr) .eq. 10 then user = "''p2' " X$ `009if f$length(usr) .eq. 11 then user = "''p2' " X$ `009if f$length(usr) .eq. 12 then user = "''p2'" X$ endif X$ gosub check_for_new_ration X$ read /index=0 /key="''user'" ration_file ration_line X$ if p2 .eqs. "" X$ then X$ `009un = f$edit(f$getjpi("","username"),"trim") X$ else X$`009un = f$edit(p2,"trim") X$ endif X$ used = f$extract(17,5,ration_line) X$ used = f$int(used) X$ auth = f$extract(12,5,ration_line) X$ auth = f$int(auth) X$ avail = auth - used X$ if avail .ge. 0 X$ then X$ `009diag1 = "minutes" X$ `009if used .eq. 1 then diag1 = "minute" X$ `009diag2 = "minutes" X$ `009if auth .eq. 1 then diag2 = "minute" X$`009say "" X$ `009say " User [''un'] has ''used' ''diag1' used, ''avail' available," X$ `009say " of ''auth' ''diag2' authorized for the current week on BBS" X$ else X$ `009over = used - auth X$ `009diag1 = "minutes" X$ `009if used .eq. 1 then diag1 = "minute" X$ `009diag2 = "minutes" X$ `009if auth .eq. 1 then diag2 = "minute" X$`009say "" X$ `009say " User [''un'] has ''used' ''diag1' used, ''over' OVERDRAWN," X$ `009say " of ''auth' ''diag2' authorized for the current week on BBS" X$ endif X$ goto cleanup X$modify_ration: X$ if .not. f$priv("sysprv") then - X`009say "%RATION-F-NOPRIV, You do not have privilege to run this procedure!" X$ if .not. f$priv("sysprv") then goto cleanup X$ if p2 .eqs. "" then say "%RATION-E-NOUSER, You must specify a username!" X$ if p2 .eqs. "" then goto cleanup ! User V$ if p3 .eqs. "" then say "%RATION-E-NOAUTH, You must specify the number of a Xuthorized minutes!" X$ if p3 .eqs. "" then goto cleanup ! New Auth X$ if p4 .eqs. "" then p4 = "00000" ! New Used X$ if f$type(p3) .nes. "INTEGER" then goto cleanup X$ if f$type(p4) .nes. "INTEGER" then goto cleanup X$ open /share/read/write ration_file 'default_ration_location'ration.dat X$! X$ if f$length(p2) .eq. 1 then user = "''p2' " X$ if f$length(p2) .eq. 2 then user = "''p2' " X$ if f$length(p2) .eq. 3 then user = "''p2' " X$ if f$length(p2) .eq. 4 then user = "''p2' " X$ if f$length(p2) .eq. 5 then user = "''p2' " X$ if f$length(p2) .eq. 6 then user = "''p2' " X$ if f$length(p2) .eq. 7 then user = "''p2' " X$ if f$length(p2) .eq. 8 then user = "''p2' " X$ if f$length(p2) .eq. 9 then user = "''p2' " X$ if f$length(p2) .eq. 10 then user = "''p2' " X$ if f$length(p2) .eq. 11 then user = "''p2' " X$ if f$length(p2) .eq. 12 then user = "''p2'" X$ if f$length(p3) .eq. 5 then auth = "''p3'" X$ if f$length(p3) .eq. 4 then auth = "0''p3'" X$ if f$length(p3) .eq. 3 then auth = "00''p3'" X$ if f$length(p3) .eq. 2 then auth = "000''p3'" X$ if f$length(p3) .eq. 1 then auth = "0000''p3'" X$ if f$length(p4) .eq. 5 then used = "''p4'" X$ if f$length(p4) .eq. 4 then used = "0''p4'" X$ if f$length(p4) .eq. 3 then used = "00''p4'" X$ if f$length(p4) .eq. 2 then used = "000''p4'" X$ if f$length(p4) .eq. 1 then used = "0000''p4'" X$! X$ gosub check_for_new_ration X$! X$ read /index=0 /key="''user'" ration_file ration_line X$ if p4 .eqs. "00000" X$ then X$ `009usd = f$extract(17,5,ration_line) X$ `009write /update ration_file "''user'''auth'''usd'" X$ else X$ `009write /update ration_file "''user'''auth'''used'" X$ endif X$ goto cleanup X$delete_ration: X$ if .not. f$priv("sysprv") then - X`009say "%RATION-F-NOPRIV, You do not have privilege to run this procedure!" X$ if .not. f$priv("sysprv") then goto cleanup X$ if p2 .eqs. "" then - X`009say "%RATION-E-NOUSER, You must specify a username to delete!" X$ if p2 .eqs. "" then goto cleanup X$! X$ if f$length(p2) .eq. 1 then user = "''p2' " X$ if f$length(p2) .eq. 2 then user = "''p2' " X$ if f$length(p2) .eq. 3 then user = "''p2' " -+-+-+-+-+ End of part 1 +-+-+-+-+- -- Harrison M. Spain III ... Voice: (714) 952-6114 McDonnell Douglas M&E ... Internet: spain@mdcbbs.com 5701 Katella Avenue ... UUCP: {uunet,decwrl,att}!mdcbbs.com!spain Cypress, CA 90630 ... PSI: PSI%31060099980019::SPAIN