Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!uunet!husc6!bloom-beacon!oberon!cit-vax!ucla-cs!zen!ucbvax!RSBS0.anu.OZ.AU!STRASSER From: STRASSER@RSBS0.anu.OZ.AU Newsgroups: comp.os.vms Subject: DO & NOTIFY utilities (2 of 2) Message-ID: <8709251340.AA16233@uunet.UU.NET> Date: Mon, 21-Sep-87 16:05:27 EDT Article-I.D.: uunet.8709251340.AA16233 Posted: Mon Sep 21 16:05:27 1987 Date-Received: Sun, 27-Sep-87 10:42:42 EDT Sender: daemon@ucbvax.BERKELEY.EDU Distribution: world Organization: The ARPA Internet Lines: 224 Herewith, the SHAR'd source of my utility NOTIFY in Pascal. This utility sends a message to all terminals logged in with the current username as specified in the command, using the $BRKTHRU system service. It is used by DO, and could be used in command procedures as well. NOTIFY is documented in its header, but note that it must be set up as a foreign command. The procedure RemoveLoneQuotes was written because LIB$GET_FOREIGN returns the entire command line with quotes intact, when they were put there to prevent DCL converting characters to uppercase. (This seems a bit silly to me.) I couldn't be bothered working out how to use LIB$TPARSE or whether CLI$xxx is suitable: someone out there may know how to do this, and can improve on this. Please send me copies of any improvements/alterations you make to the code. I hope these are useful to someone. Enjoy! ------------------------------------------------------------------------------- Mike Strasser Research School of Biological Sciences Australian National University ACSnet, CSnet : strasser@rsbs0.anu.oz INTERNET : strasser%rsbs0.anu.oz@uunet.uu.net UUCP : {uunet,hplabs,ubc-vision,nttlab,mcvax,ukc}!munnari !rsbs0.anu.oz!strasser ------------------------------------------------------------------------------- ....................... Cut between dotted lines and save ...................... $!............................................................................. $! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987 $! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au) $! To unpack, simply save and execute (@) this file. $! $! This archive was created by STRASSER $! on Monday 14-SEP-1987 15:08:53.51 $! $! It contains the following 1 file: $! NOTIFY.PAS $!============================================================================= $ Set Symbol/Scope=(NoLocal,NoGlobal) $ Version=F$GetSYI("VERSION") ! See what VMS version we have here: $ If Version.ges."V4.4" then goto Version_OK $ Write SYS$Output "Sorry, you are running VMS ",Version, - ", but this procedure requires V4.4 or higher." $ Exit 44 $Version_OK: CR[0,8]=13 $ Pass_or_Failed="failed!,passed." $ Goto Start $Convert_File: $ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd $No_Error1: Define/User_Mode SYS$Output NL: $ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' - VMS_SHAR_DUMMY.DUMMY f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f); o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o); Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V"; Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal (-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b) EndLoop;Exit; $ Delete VMS_SHAR_DUMMY.DUMMY;* $ Checksum 'File_is $ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR $ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd $No_Error2: Return $Start: $ File_is="NOTIFY.PAS" $ Check_Sum_is=862926229 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY V{============================================================================== X} V{ NOTIFY X} V{ X} V{ (c) Copyright Mike Strasser 1987 X} V{ X} V{ This software is granted to the public domain. It may be distributed X} V{ freely provided that no payment is taken, and that this message remains X} V{ intact. X} V{ X} V{============================================================================== X} V{ X} V{ A utility to send messages to terminals logged in with the current X} V{ username (this requires no priviledge). It must be set up as a foreign X} V{ command, and sends the remainder of the command line. It was written X} V{ primarily for use with the DO utility. Example of use: X} V{ X} V{ $ NOTIFY "Today is the first day of the rest of your life" X} V{ X} V{ Quotes are necessary to preserve case, otherwise DCL converts everything X} V{ to uppercase. The message is sent using $BRKTHRU, and preceded by two X} V{ BEL (CTRL-G) characters. X} V{ X} V{============================================================================== X} X X[INHERIT( 'SYS$LIBRARY:STARLET' )] XPROGRAM Notify; X XTYPE X String = VARYING [256] OF CHAR; X SignedWord = [WORD] -32768..32767; X UnsignedWord = [WORD] 0..65535; X StatusBlock = RECORD X Status, X TransferCount : UnsignedWord; X Dummy : INTEGER; X END; X CondCode = UNSIGNED; X XVAR X MessageString : String; X Username : VARYING [12] OF CHAR; X Status : CondCode; X IOStatusBlock : StatusBlock; X V{============================================================================== X} X X FUNCTION LIB$GET_FOREIGN( X %DESCR GetStr : VARYING [U1] OF CHAR; X %DESCR UserPrompt : [TRUNCATE] VARYING [U2] OF CHAR := %IMMED 0; X %REF OutLen : [TRUNCATE] UnsignedWord := %IMMED 0; X %REF ForcePrompt : [TRUNCATE] INTEGER := %IMMED 0 X ) : CondCode; EXTERNAL; X X FUNCTION LIB$GETJPI( X %REF ItemCode : INTEGER; X %REF ProcessID : [TRUNCATE] UNSIGNED := %IMMED 0; X %DESCR ProcessName : [TRUNCATE] VARYING [U1] OF CHAR := %IMMED 0; X %REF OutValue : [TRUNCATE] INTEGER := %IMMED 0; X %DESCR OutString : [TRUNCATE] VARYING [U2] OF CHAR := %IMMED 0; X %REF OutLen : [TRUNCATE] SignedWord := %IMMED 0 X ) : CondCode; EXTERNAL; X X PROCEDURE LIB$SIGNAL( ConditionValue : CondCode ); EXTERNAL; X V{============================================================================== X} X X (* This procedure removes lone quotation marks from a string. Thus, the X string >"Hello there"< becomes >Hello there<, but >"""Hello there"""< X becomes >"Hello there"<. *) X PROCEDURE RemoveLoneQuotes( VAR Str : String ); X X VAR X Pos : INTEGER; X NewStr : String; X X BEGIN (* RemoveLoneQuotes *) X Pos := INDEX( Str, '"' ); X IF Pos <> 0 THEN X BEGIN X IF Pos = Str.LENGTH THEN X Str := SUBSTR( Str, 1, Pos - 1 ) X ELSE X BEGIN X Str := SUBSTR( Str, 1, Pos - 1 ) + X SUBSTR( Str, Pos + 1, Str.LENGTH - Pos ); X IF Pos < Str.LENGTH THEN X BEGIN X NewStr := SUBSTR( Str, Pos + 1, Str.LENGTH - Pos ); X RemoveLoneQuotes( NewStr ); X Str := SUBSTR( Str, 1, Pos ) + NewStr; X END; X END; X END; X END; (* RemoveLoneQuotes *) X V{------------------------------------------------------------------------------ X} X XBEGIN (* Notify *) X X (* Get remainder of command line to send *) X Status := LIB$GET_FOREIGN( GetStr := MessageString ); X IF NOT ODD( Status ) THEN X LIB$SIGNAL( Status ); X X (* Remove lone quotes from string. This is necessary because LIB$GET_FOREIGN X returns the command line with the quotes intact. *) X RemoveLoneQuotes( MessageString ); X X (* Start message with 2 x BEL *) X MessageString := ''(7) + ''(7) + MessageString; X X (* Get current username *) X Status := LIB$GETJPI( ItemCode := JPI$_USERNAME, OutString := Username ); X IF NOT ODD( Status ) THEN X LIB$SIGNAL( Status ); X X (* Send to current username *) X Status := $BRKTHRUW( MSGBUF := MessageString, X SENDTO := Username, X SNDTYP := BRK$C_USERNAME, X IOSB := IOStatusBlock ); X IF NOT ODD( Status ) THEN X LIB$SIGNAL( Status ) X ELSE X IF NOT ODD( IOStatusBlock.Status ) THEN X LIB$SIGNAL( IOStatusBlock.Status ); X XEND. (* Notify *) $ GoSub Convert_File $ Exit