From: sys_hjk@LIFRA.LIF.DE (Hans-Joachim Koch)
Newsgroups: comp.os.vms
Subject: Re: Non-privileged REPLY program?
Date: 10 Jan 93 19:40:18 GMT
Reply-To: koch@lifra.lif.de
Organization: Lahmeyer International GmbH, Frankfurt/Main, Germany

In <1993Jan8.231603.4631@ucselx.sdsu.edu> thompson@steer.sdsu.edu writes:
: Can anyone point me to a program that will allow individuals the ability
: to send a single line message to another user (without having to get into MAIL
: or PHONE).  We have a system that would benefit from allowing our clerical
: staff to send a message to another user (Same Group, if this matters)
: indicating that his/her scheduled appointment has arrived....

The following is a small program, which I wrote years ago...
There are three parts: Fortran, CLD-definition, build procedure.

If a user is not reachable (not present, broadcast disabled), the message
will be send as mail.

Have fun!
Hans.

C-----------------------------------------------------------------------
	PROGRAM TELL

! Send message to other user in system.

! HJK, 4-DEC-1987 08:50:56, remove quotes from message string
! HJK, 7-JUL-1988 20:50:00, /MAIL qualifier added

	IMPLICIT NONE
	INCLUDE '($SSDEF) /NOLIST'
	INCLUDE '($BRKDEF)/NOLIST'
	INCLUDE '($JPIDEF)/NOLIST'

	CHARACTER MESSAGE*255		! message string
	CHARACTER USER*12		! destination username
	CHARACTER MYNAME*12		! origin username
	CHARACTER BELL*1	/7/	! bell signal
	CHARACTER LF*1		/10/	! line feed
	CHARACTER CR*1		/13/	! carriage return

	INTEGER*4 GROUP			! group number
	INTEGER*4 L_MESSAGE		! length of message
	INTEGER*4 L_USER		! length of username
	INTEGER*4 L_MYNAME		! length of username
	INTEGER*4 CLI$PRESENT		! qualifier present
	INTEGER*4 CLI$GET_VALUE		! get qualifier value
	INTEGER*4 SYS$BRKTHRUW		! breakthrough system service
	INTEGER*4 LIB$DO_COMMAND	! execute dcl command
	INTEGER*4 LIB$GETJPI		! get process information
	INTEGER*4 LIB$SYS_FAO		! formatted ascii output
	INTEGER*4 LIB$PUT_OUTPUT	! write to output device
	INTEGER*4 LENGTH		! returns length of string
	INTEGER*4 STATUS		! return status code
	INTEGER*2 IOSB(4)		! i/o status block
	INTEGER*4 I			! loop counter
	INTEGER*4 J			! loop counter

	LOGICAL   IDENTIFY		! flag for /identify qualifier
	LOGICAL   MAIL			! flag for /mail qualifier

	EXTERNAL  CLI$_NEGATED


! Get qualifiers and parameters.

	IDENTIFY = CLI$PRESENT( 'IDENTIFY') .NE. %LOC( CLI$_NEGATED)
	MAIL = CLI$PRESENT( 'MAIL') .NE. %LOC( CLI$_NEGATED)
	STATUS   = CLI$GET_VALUE( 'P1', USER, L_USER)
	IF( .NOT. STATUS) CALL EXIT( STATUS)
	STATUS = CLI$GET_VALUE( 'P2', MESSAGE, L_MESSAGE)
	IF( .NOT. STATUS) CALL EXIT( STATUS)

! Get group number.

	STATUS = LIB$GETJPI( JPI$_GRP,,,GROUP)
	IF( .NOT. STATUS) CALL EXIT( STATUS)

! Remove quotes from message.

	IF( MESSAGE( 1: 1) .EQ. '"' .AND.
	1	MESSAGE( L_MESSAGE: L_MESSAGE) .EQ. '"') THEN
	   MESSAGE = MESSAGE( 2: L_MESSAGE-1)
	   L_MESSAGE = L_MESSAGE - 2
	ENDIF

! Remove control characters.

	IF( GROUP .GT. 8) THEN
	   IDENTIFY = .TRUE.
	   DO I= 1, L_MESSAGE
	      J = ICHAR( MESSAGE( I: I))
	      IF( IAND( J, 96) .EQ. 0 .OR. J. EQ. 127)
	1		MESSAGE( I: I) = '?'
	   ENDDO
	ENDIF

! Get origin username.

	STATUS = LIB$GETJPI( JPI$_USERNAME,,,,MYNAME)
	IF( .NOT. STATUS) CALL EXIT( STATUS)
	L_MYNAME = LENGTH( MYNAME)

! Send message.

	IF( IDENTIFY) THEN
	   STATUS = SYS$BRKTHRUW ( , CR // LF // BELL //
	1	'Message from ' // MYNAME( 1: L_MYNAME) // ': ' //
	2	MESSAGE( 1: L_MESSAGE) , USER( 1: L_USER),
	3	%VAL( BRK$C_USERNAME), IOSB,,,,,,)
	ELSE
	   STATUS = SYS$BRKTHRUW ( , 
	2	MESSAGE( 1: L_MESSAGE) , USER( 1: L_USER),
	3	%VAL( BRK$C_USERNAME), IOSB,,,,,,)
	ENDIF
	IF( .NOT. STATUS) CALL EXIT( STATUS)

! Build log line, if message delivered.

	IF( IOSB( 2) .GT. 0) THEN
	   STATUS = LIB$SYS_FAO( 'Message sent to !SW terminal!%S.',,
	1	MESSAGE, %VAL( IOSB( 2)))
	   IF( .NOT. STATUS) CALL EXIT( STATUS)
	   L_MESSAGE = LENGTH( MESSAGE)
	   STATUS = LIB$PUT_OUTPUT( MESSAGE( 1: L_MESSAGE))
	   CALL EXIT( STATUS)

! Send mail, if user not accessible.

	ELSE IF( MAIL) THEN
	   OPEN( UNIT=10, FILE='SYS$LOGIN:MAIL.TMP', FORM='FORMATTED',
	1	STATUS='NEW', CARRIAGECONTROL='LIST')
	   WRITE( UNIT=10, FMT='(A)') '$ SET NOON'
	   WRITE( UNIT=10, FMT='(A)')
	1	'$ MAIL/SUBJECT="Routed TELL message"' //
	2	' SYS$INPUT ' // USER( 1: L_USER)
	   WRITE( UNIT=10, FMT='(A)') MESSAGE( 1: L_MESSAGE)
	   WRITE( UNIT=10, FMT='(A)')
	1	'$ DELETE/NOLOG SYS$LOGIN:MAIL.TMP;0'
	   CLOSE( UNIT=10)
	   MESSAGE = 'User ' // USER( 1: L_USER) // ' not reachable' //
	1	', message routed as mail.'
	   L_MESSAGE = LENGTH( MESSAGE)
	   STATUS = LIB$PUT_OUTPUT( MESSAGE( 1: L_MESSAGE))
	   IF( .NOT. STATUS) CALL EXIT( STATUS)
	   STATUS = LIB$DO_COMMAND( '@SYS$LOGIN:MAIL.TMP')
	   CALL EXIT( STATUS)

! Notify user, if no tell or mail successful.

	ELSE
	   MESSAGE = 'User ' // USER( 1: L_USER) // ' not reachable' //
	1	', mail routing negated.'
	   L_MESSAGE = LENGTH( MESSAGE)
	   STATUS = LIB$PUT_OUTPUT( MESSAGE( 1: L_MESSAGE))
	   CALL EXIT( STATUS)
	ENDIF

	END
C-----------------------------------------------------------------------
! TELL UTILITY
! HJK, 25.06.86
! HJK, 3-NOV-1987 13:27:59, /IDENTIFY added
! HJK, 6-JUL-1988 20:42:00, /MAIL added
!
DEFINE	VERB	TELL
IMAGE		"LI$EXE:TELL"
QUALIFIER	IDENTIFY,DEFAULT,NEGATABLE
QUALIFIER	MAIL,DEFAULT,NEGATABLE
PARAMETER 	P1,PROMPT="Username",VALUE(REQUIRED)
PARAMETER 	P2,PROMPT="Message ",VALUE(REQUIRED,TYPE=$REST_OF_LINE)
!
! End of command language definition
C-----------------------------------------------------------------------
$ SET VERIFY
$ PURGE/LOG TELL.*
$ FORT/LIS/SHOW=NOSINGLE/NODEBUG TELL
$ PRINT/HEADER/DELETE TELL
$ LINK/NODEBUG/NOTRACEBACK/NOUSER_LIBRARY/EXE=LI$EXE:TELL.EXE -
  TELL,LI$SHR/LIB
$ DELETE/LOG TELL.OBJ;*
$ RUN SYS$SYSTEM:INSTALL
LI$EXE:TELL/REPLACE
$ SET PROTECTION=S:RWED/LOG LI$EXE:TELL.EXE;*
$ PURGE/LOG LI$EXE:TELL.*
$ SET PROTECTION=S:RW/LOG LI$EXE:TELL.EXE
$ SET NOVERIFY
C-----------------------------------------------------------------------

-- 
Hans-Joachim Koch, Computer department of Lahmeyer International
Lyoner Strasse 22, POB 71 06 51, D-6000 Frankfurt (Main) 71, Germany
Phone: +49 69 6677-642, Fax: +49 69 6677-571, Tx: 413478 li d
EUnet: koch@lifra.lif.de, AMPRnet: dk9om@db0lj.ampr.org