Article 167039 of comp.os.vms:
> I discovered this list recently and I am really enjoying the
> wealth of information that I have read so far.

> Running under OpenVMS 6.1 (Vax and Alpha), is there an easy
> way to limit the number of logins per account?   Or, is
> this "not-so-hot-in-the-complex-DCL-writing" person, supposed
> to write a command procedure to do this?

> We are trying to cut down on the sharing of accounts.

> Thanks in advance for any responses!!!
> annette
> hearn_a@hccs.cc.tx.us
> System Administrator
> Houston Community College System

Attached is a command file and a fortran source file that someone once sent me 
to limit simultaneous use of an account.  I was able to to use the VEST
compiler to convert the executable to our Alpha.

-------------------------------------------------------------------------------
Alan Simon                                      simon@hslc.org  
Associate Director                              simon@shrsys.hslc.org
Health Sciences Libraries Consortium            VOICE: (215) 222-1532  
3600 Market Street, Suite 550                     FAX: (215) 222-0416
Philadelphia, PA  19104
-------------------------------------------------------------------------------

$! TWOLOG.COM
$! Program to check whether a user is already logged on.
$! 
$! Get the number of non-batch processes (including this one !).
$! TWOLOG result is in $STATUS - if error skip some login checks.
$  SET NOON
$  USERNAME == F$EDIT(F$GETJPI(0,"USERNAME"),"TRIM")
$  RUN SYS$MANAGER:TWOLOG          ! The Henry O'Keeffe TWOLOG.FOR routine.
$  IF $SEVERITY
$    THEN LOGON_CHECK = $STATUS/8
$    SET ON
$!   ! Issue reminder if user on more than once...
$    IF 
$    IF LOGON_CHECK .GT. 1
$      THEN BLEEP[0,8] = 7
$      WRITE SYS$OUTPUT ""
$      WRITE SYS$OUTPUT BLEEP,"*** You are ALREADY logged in! ***"
$      WRITE SYS$OUTPUT BLEEP,"*** You are not authorized to login more than once. ***"
$      WRITE SYS$OUTPUT BLEEP,"*** Please call xxx-xxx-xxxx for more information. ***"
$      WRITE SYS$OUTPUT ""
$      SHOW USER/FULL 'USERNAME'
$      ENDIF
$    ENDIF
$!  LOGOUT
$  EXIT

c   Routine to check if a user is already logged on .....

c  This program (installed with WORLD privilege ) checks
c  all processes in the system to find if any have the same
c  Username as the process which executes it . If a match is
c  found then that process is examined to see if it is has a
C  terminal associated with it .
c  the number of current jobs with the same username is
c  accumulated .

c  Uses SYSTEM SERVICES $GETJPI ands $WAITFR

        PROGRAM twolog

        integer*2 item_term,buffln_term,item_usrnm,buffln_usrnm
        integer*2 iosb(4),return_code,term_str_len
        integer*4 a_term,a_usrnm,pid_add,old_pid,old_usrnm
        integer*4 BATCH,success,result,no_logs
        character*8  term,trim_term
        character*12 usrnm,match_usrnm

        external ss$_nomoreproc

        equivalence (return_code,iosb(1))

c  get TEXT file for JPIDEF definitions

        include '($JPIDEF)'


c  generate contigous itemlists at BUFFLN for system service

        common buffln_term,item_term,a_term,ret_term,
     &         buffln_usrnm,item_usrnm,a_usrnm,ret_usrnm

        equivalence (buffln_term,item_list_term)
        equivalence (buffln_usrnm,item_list_usrnm)

c  set up standard itemlist contents

        data buffln_term/8/,ret_term/0/
        data buffln_usrnm/12/,ret_usrnm/0/

c set up for return from this image

        data success/1/,shift/8/
        no_more = %loc(ss$_nomoreproc)

c set up buffer addresses in item lists

        a_term = %loc(term)
        a_usrnm = %loc(usrnm)

c set up ITEMS for selction itemlist

        item_term = jpi$_terminal
        item_usrnm = jpi$_username

c set up process id longword for "wild card" search

        pid_add =  -1

c ***********                 *******************
c             program section
c ***********                 *******************

c       Get the USERNAME of the calling process (no wait required)

        call sys$getjpi(,,,item_list_usrnm,iosb,,)
        IF (.not. return_code)THEN
C          ERROR return
           call lib$stop(%val(return_code))

        ELSE
c          save this username
           match_usrnm = usrnm

c          loop through all processes on the system(wait for answer)

           NO_LOGS = 0
           DO WHILE(return_code .ne. no_more)
                old_pid = pid_add
                call sys$getjpi(1,pid_add,,item_list_usrnm,iosb,,)
                call sys$waitfr(1)
                IF(return_code)THEN
c                  check if the username is the same - ignore if not
                   IF(usrnm .eq. match_usrnm)THEN
c                       check for interactive job - backspace search
                        pid_add = old_pid
                        call sys$getjpi(1,pid_add,,item_list_term,iosb,,)
                        call sys$waitfr(1)
                        IF(.not.(return_code))call lib$stop(%val(return_code))
c                       accumulate if a terminal allocated
                        IF( term .gt. ' ')NO_LOGS
     &                          = NO_LOGS + 1
                   END IF
                ELSE
                   IF(return_code.ne.no_more)call lib$stop(%val(return_code))
                END IF
           END DO
           result = success +( shift * NO_LOGS )
           call exit(result)
        END IF
        end



