From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 12-JUN-1989 15:31
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Another option for sys$announce/sys$welcome

Message-Id:  <8906121645.AA01646@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 12 JUN 89 07:37:10 PDT
Received: from mis.arizona.edu (misvax.mis.arizona.edu) by KL.SRI.COM with TCP; Sun, 11 Jun 89 15:17:50 PDT
Date: Sun, 11 Jun 89 13:23 MST
From: "Quick, VT-180, to the VAXmobile." <JMS@mis.arizona.edu>
Subject: Another option for sys$announce/sys$welcome
To: info-vax@kl.sri.com
X-Vms-To: IN%"info-vax@kl.sri.com"

There's been some discussion on info-vax about sys$announce/sys$welcome
recently, and I thought it might be useful to dredge up this old
(but very useful) message.  I don't know if the author is still around,
or even at the address given below.

jms

Joel M Snyder, U Arizona MIS Dep't, Tucson, AZ, 85721  Phone: 602.621.2748
BITNET: jms@arizmis  Internet: jms@mis.arizona.edu  SPAN: 47541::uamis::jms   
SM-1700 -  A VAX that's *all* VAX (except it's made in the USSR)

-----------------------------------------

I have been surprised that no-one has suggested the possibility of
having a dynamic Sys$xxx display, automatically generated whenever a
user logs-in. The following (Fortran) code provides that possibility.
To use it, compile and link in the normal way, run it /detached (so that
it lurks somewhere in your system), and then re-define Sys$Announce as
follows :-
     
    $ Define /System Sys$Announce "@''f$logical(""Sys$Announce_Mbx"")'"
     
Of course, you'll want to modify the actual text it produces.  ** Phil.
     
Philip Taylor (Royal Holloway & Bedford New College;  University of London; U.K)
chaa006@vaxb.rhbnc.ac.uk 
     
============================== C U T   H E R E ==============================
     
    program sys$announce
C
C --- Creates & services a mailbox, defined as the translation of Sys$Announce
C
    implicit none
    integer * 2 channel
    integer sys$crembx, sys$hiber
    call function (
     &        sys$crembx
     &            (%val (1),
     &                channel, , ,
     &                    %val ('1131'X), ,
     &                        'SYS$ANNOUNCE_MBX'))
    call enable (channel)
    call function (sys$hiber ())
    end
     
    subroutine enable (channel)
C
C --- Enables routine AST to deal with ASTs on CHANNEL
C
    implicit none
    include '($iodef)'
    integer * 2 channel
    integer ast, sys$qiow
    external ast
    call function (sys$qiow
     &        (, %val (channel),%val (io$_setmode .or. io$m_readattn),
     &            , , , ast, channel, , , ,))
    return
    end
     
    subroutine ast (channel)
C
C --- Gets a few useful things, and writes them to the mailbox;
C --- also re-declares itself as AST handler
C
    implicit none
    include '($iodef)'
    include '($syidef)'
    integer * 2 channel
    integer max, n, lib$day_of_week
    integer sys$asctim, lib$getsyi, str$trim, sys$qiow
    character cr, lf
    character * 6 nodename
    character * 23 datime
    character * 132 buffer
    character * (9) days (7)
    integer length
    data days /'Monday', 'Tuesday', 'Wednesday', 'Thursday',
     &            'Friday', 'Saturday', 'Sunday'/
    cr = char (13)
    lf = char (10)
    call function (lib$day_of_week (, n))
    call function (sys$asctim (, datime, , ))
    call function (lib$getsyi (syi$_nodename, ,nodename, length))
    write (buffer, 9000) nodename (1:length),
     &            days (n), datime, cr, lf
    call function (str$trim (buffer, buffer, length))
    call function (sys$qiow
     &        (, %val (channel),%val (io$_writevblk),
     &            , , , %ref (buffer), %val (length) , , , ,))
    call function (sys$qiow
     &        (, %val (channel),%val (io$_writeof .or. io$m_now),
     &            , , , , , , , ,))
    call enable (channel)
    return
C
C --- Change the following line as necessary !!! SYSDEP !!!
C
 9000    format ('    RHBNC VAX-Cluster on node ',
     &            A, ' at ', A, X, A, A, A)
    end
     
    subroutine function (status)
C
C --- Signals errors if they occur
C
    implicit none
    integer status
    if (.not. status) call lib$signal (%val (status))
    return
    end