! B R O A D C A S T . B A S ! ! This following is an example program that illustrates the trapping ! of broadcast messages and sending to a DECForms application. This ! example utilizes a mailbox and an AST that is activated by data waiting ! in the mailbox. The AST routine reads the mailbox and sends the message ! to the form...to be displayed on the message line. ! ! Special thanks to DSN for contributing to the setup of the mailbox ! using QIO's! ! ! Martin D. Lucas ! Allied Electronics, Inc. ! 7410 Pebble Drive ! Fort Worth, TX 76118 ! (817) 595-3500 ! ! This code is provided as is and may be distributed freely. This ! software is not intended for sale. Distribution is permitted - providing ! that this header remains attached. ! %TITLE "Broadcast Trapping Example" %IDENT "MDL 07/91" PROGRAM Broadcast ! *********************************************************************** ! Directives ! *********************************************************************** OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER SET NO PROMPT ! *********************************************************************** ! Include Files ! *********************************************************************** %INCLUDE "SYS$LIBRARY:FORMS$BAS_DEFINITIONS" %INCLUDE "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" ! *********************************************************************** ! DECForms Specific Declarations ! *********************************************************************** DECLARE STRING CONSTANT Form_File = "Broadcast", & Device_Name = "TT:", & AST_Form_File = "Broadcast" ! *********************************************************************** ! Application Specific Declarations ! *********************************************************************** RECORD Message_Record STRING Message_Text=78 END RECORD ! Device characteristics structure RECORD Dev_Char_Record BYTE Dev_Class BYTE Dev_Type WORD Page_Width VARIANT CASE LONG Basic_Dev_Char CASE BYTE Unused(2) BYTE Page_Length END VARIANT LONG Extended_Dev_Char END RECORD ! *********************************************************************** ! Map Statements ! *********************************************************************** ! Double mapping here allows the same data to be referenced as a byte ! or a word MAP (Brdcst_Message) & BYTE Mbx_Msg_Byte(200) MAP (Brdcst_Message) & WORD Mbx_Msg_Word(100) MAP (Brdcst_Common) & WORD Mbx_Channel, & WORD Terminal_Channel, & STRING Session_ID = 16, & STRING AST_Session_ID = 16, & STRING Message=78, & Dev_Char_Record Dev_Char_Default, & Dev_Char_Record Dev_Char MAP (Dates) & STRING Current_Date=9, & STRING Current_Time=8 MAP (Dates) & STRING Date_Time_String=17 ! *********************************************************************** ! Constants ! *********************************************************************** DECLARE LONG CONSTANT TRUE = -1, & FALSE = 0, & EOF = 11, & Dev_Char_Buflen = 12 ! *********************************************************************** ! Program Data Declarations ! *********************************************************************** ! IO status block DECLARE WORD IOSB(4) ! Misc variables DECLARE LONG Loop, & Return_Status, & AST_Return_Status ! External functions EXTERNAL LONG FUNCTION SYS$ASSIGN, & SYS$CREMBX, & SYS$DASSGN, & SYS$HIBER, & SYS$QIOW ! *********************************************************************** ! Main Program ! *********************************************************************** ! Initialize and enable the form ! Two sessions will be used. ! (1) Main program usage ! (2) AST usage to report broadcast messages Return_Status = Forms$Enable( Forms$Ar_Form_Table, & Device_Name, & Session_Id, & Form_File, & ,,,,,,,) CALL Check_Status_L(Return_Status) AST_Return_Status = Forms$Enable(Forms$Ar_Form_Table, & Device_Name, & AST_Session_Id, & AST_Form_File, & ,,,,,,,) CALL Check_Status_L(AST_Return_Status) ! Set up for broadcast trapping CALL Broadcast_Trapping_Enable ! Actual main program loop starts here. FOR Loop = 1 to 3 ! Send the date and time to the form using session 1. Current_Date = Date$(0) Current_Time = Time$(0) Return_Status = Forms$Send( Session_Id, & "Date_Rec", & 1%, & , & , & , & , & , & , & , & Date_Time_String, & ) CALL Check_Status_L(Return_Status) SLEEP 30 ! If you make any calls to escape routines or other routines that may ! modify terminal attributes, you may wish to restore them before ! returning to DECForms. Although in this example, no escape routines ! are called, an example of how to reset the attributes is provided. CALL Refresh_Term_Characteristics NEXT Loop All_Done: ! Return terminal characteristics back to what they originally were Return_Status = SYS$Qiow( , & Terminal_Channel BY VALUE, & IO$_SETMODE BY VALUE, & IOSB() BY REF, & , & , & Dev_Char_Default BY REF, & 12% BY VALUE, & , & , & , & ,) ! Disable the two sessions Return_Status = FORMS$Disable(Session_Id) Return_Status = FORMS$Disable(AST_Session_Id) CLOSE 21 END ! *********************************************************************** ! Internal Subroutines ! *********************************************************************** ! Check a word size status SUB Check_Status_W(WORD Temp_Status) OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER IF (Temp_Status AND 1%) = 0 ! IF error occurred THEN CALL LIB$STOP(Temp_Status by value) END IF END SUB ! END SUB Check_Status ! Check a lonword size status SUB Check_Status_L(LONG Temp_Status) OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER IF (Temp_Status AND 1%) = 0 ! IF error occurred THEN CALL LIB$STOP(Temp_Status by value) END IF END SUB ! END SUB Check_Status SUB AST_Routine(LONG Astarg,LONG R0,LONG R1,LONG PC,LONG PSL) OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER %INCLUDE "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" %INCLUDE "$MSGDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" %INCLUDE "SYS$LIBRARY:FORMS$BAS_DEFINITIONS" ! Device characteristics RECORD Dev_Char_Record BYTE Dev_Class BYTE Dev_Type WORD Page_Width VARIANT CASE LONG Basic_Dev_Char CASE BYTE Unused(2) BYTE Page_Length END VARIANT LONG Extended_Dev_Char END RECORD ! Broadcast message mapped as byte, word, string MAP (Brdcst_Message) & BYTE Mbx_Msg_Byte(200) MAP (Brdcst_Message) & WORD Mbx_Msg_Word(100) MAP (Brdcst_Message) & STRING Mbx_Msg_STRING=200 MAP (Brdcst_Common) & WORD Mbx_Channel, & WORD Terminal_Channel, & STRING Session_ID = 16, & STRING AST_Session_ID = 16, & STRING Message=78, & Dev_Char_Record Dev_Char_Default, & Dev_Char_Record Dev_Char DECLARE LONG AST_Return_Status, & x, & y DECLARE LONG RETURN_STATUS, & Msg_Len, & I DECLARE WORD IOSB(4) DECLARE STRING Temp_Msg, & Msg EXTERNAL LONG FUNCTION SYS$QIOW, & STR$COPY_R MAP (Forms_Records) & STRING Record_Name, & LONG Record_Count ! Begin ! Get from the mailbox Return_Status = SYS$Qiow ( , & Mbx_Channel BY VALUE, & IO$_READVBLK BY VALUE, & IOSB() BY REF, & , & , & MBX_Msg_Byte() BY REF, & 200% BY VALUE, & , & , & , & , ) CALL Check_Status_L(Return_Status) ! Check the I/O status block CALL Check_Status_W(IOSB(0)) ! Do we have a broadcast message? IF (MBX_Msg_Word(0) = MSG$_TRMBRDCST) THEN Msg = SEG$(Mbx_Msg_String,22, 22 + Mbx_Msg_Word(10)) Temp_Msg = "" ! Determine the message length Msg_Len = LEN(Msg) ! Filter out any non printables FOR I = 1 TO Msg_Len IF ASCII(SEG$(MSG,I,I)) < 32 AND & ASCII(SEG$(MSG,i,i)) < 127 THEN Temp_Msg = Temp_Msg + " " ELSE Temp_Msg = Temp_Msg + SEG$(MSG,I,I) END IF NEXT I ! Get rid of duplicate spaces and such Temp_Msg = EDIT$(Temp_Msg,156%) ! With a single message line on the application, reply and shutdown ! messages are a bit of a problem...since they span multiple lines. ! By picking out only the important parts of the message, the message ! will be shortened to conserve space while maintaining readability. ! IF POS(Temp_Msg,"Reply",1) <> 0 OR & POS(Temp_Msg,"SHUTDOWN",1) <> 0 OR & POS(Temp_Msg,"URGENT",1) <> 0 THEN IF POS(Temp_Msg,"SHUTDOWN",1) <> 0 THEN Msg = Bel + Bel + Bel + "*SHUTDOWN* " ELSE IF POS(Temp_Msg,"URGENT",1) <> 0 THEN Msg = Bel + Bel + "*URGENT* " ELSE Msg = Bel END IF END IF x = POS(Temp_Msg,"on ",1) y = POS(Temp_Msg," from",1) Msg = Msg + SEG$(Temp_Msg,x+3,y-1) + "::" x = POS(Temp_Msg,"user ",1) y = POS(Temp_Msg," at",1) Msg = TRM$(Msg) + SEG$(Temp_Msg,x+5,y-1) x = POS(Temp_Msg,": ",1) Msg = TRM$(Msg) + "(" + SEG$(Temp_Msg,x+2,x+2+7) + ")" Msg = TRM$(Msg) + " " + SEG$(Temp_Msg,x+11,LEN(Temp_Msg)) Temp_Msg = Msg END IF MESSAGE = SEG$(Temp_Msg,1,78) ! *** NOTE *** ! Literal strings within the Forms$ calls will not function and will ! result in a 'successfully queued' return status. This is only true ! when located within an AST. A mapped variable declaration or ! equivalent must be used. Decforms may not complete the request until ! after the AST has completed in which literals have been disposed of by ! memory management. Record_Name = "Message_Record" Record_Count = 1 AST_Return_Status = Forms$Send( AST_Session_Id, & Record_Name, & Record_Count, & , & , & , & , & , & , & , & Message, & ) CALL Check_Status_L(AST_Return_Status) END IF ! All desired processing has been completed. Now re-queue the AST CALL Enable_AST_Routine END SUB SUB Broadcast_Trapping_Enable OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER %INCLUDE "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" %INCLUDE "$TTDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" %INCLUDE "$TT2DEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" RECORD Dev_Char_Record BYTE Dev_Class BYTE Dev_Type WORD Page_Width VARIANT CASE LONG Basic_Dev_Char CASE BYTE Unused(2) BYTE Page_Length END VARIANT LONG Extended_Dev_Char END RECORD MAP (Brdcst_Message) & BYTE Mbx_Msg_Byte(200) MAP (Brdcst_Message) & WORD Mbx_Msg_Word(100) MAP (Brdcst_Common) & WORD Mbx_Channel, & WORD Terminal_Channel, & STRING Session_ID = 16, & STRING AST_Session_ID = 16, & STRING Message=78, & Dev_Char_Record Dev_Char_Default, & Dev_Char_Record Dev_Char DECLARE LONG Io_Function, & Stat DECLARE WORD IOSB(4) EXTERNAL LONG FUNCTION SYS$ASSIGN, & SYS$CREMBX, & SYS$DASSGN, & SYS$HIBER, & SYS$QIOW ! Begin ! Create a mailbox Stat = Sys$Crembx( , & Mbx_Channel, & 500% by value, & , & , & , & 'TEMPMBX') CALL Check_Status_L(Stat) ! Assign it to this terminal Stat = Sys$Assign( 'TT', & Terminal_Channel, & , & 'TEMPMBX') CALL Check_Status_L(Stat) ! Get the current device characteristics Stat = Sys$Qiow( , & Terminal_Channel BY VALUE, & IO$_Sensemode BY VALUE, & IOSB() BY REF, & , & , & Dev_Char_Default BY REF, & 12 BY VALUE, & , & , & , & , ) CALL Check_Status_L(Stat) CALL Check_Status_W(IOSB(0)) Dev_Char = Dev_Char_Default ! IF terminal is set not to receive broadcast messages, then we don't ! want to turn them on. Only trap messages if broadcast was already ! enabled. IF (Dev_Char::Basic_Dev_Char AND TT$M_NOBRDCST) <> TT$M_NOBRDCST THEN Dev_Char::Basic_Dev_Char = Dev_Char::Basic_Dev_Char OR TT$M_NOBRDCST Dev_Char::Extended_Dev_Char = Dev_Char::Extended_Dev_Char OR TT2$M_BRDCSTMBX END IF ! Turn autowrap off for the decforms session IF (Dev_Char::Basic_Dev_Char AND TT$M_WRAP) = TT$M_WRAP THEN Dev_Char::Basic_Dev_Char = Dev_Char::Basic_Dev_Char XOR TT$M_WRAP END IF ! Set the new terminal characteristics Stat = Sys$Qiow( , & Terminal_Channel BY VALUE, & IO$_Setmode BY VALUE, & IOSB() BY REF, & , & , & Dev_Char BY REF, & 12 BY VALUE, & , & , & , & , ) CALL Check_Status_L(Stat) CALL Check_Status_W(IOSB(0)) ! Only enable the AST routine if we're trapping messages IF (Dev_Char::Extended_Dev_Char AND TT2$M_BRDCSTMBX) = TT2$M_BRDCSTMBX THEN CALL Enable_AST_Routine END IF END SUB SUB Enable_AST_Routine OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER %INCLUDE "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" RECORD Dev_Char_Record BYTE Dev_Class BYTE Dev_Type WORD Page_Width VARIANT CASE LONG Basic_Dev_Char CASE BYTE Unused(2) BYTE Page_Length END VARIANT LONG Extended_Dev_Char END RECORD MAP (Brdcst_Message) & BYTE Mbx_Msg_Byte(200) MAP (Brdcst_Message) & WORD Mbx_Msg_Word(100) MAP (Brdcst_Common) & WORD Mbx_Channel, & WORD Terminal_Channel, & STRING Session_ID = 16, & STRING AST_Session_ID = 16, & STRING Message=78, & Dev_Char_Record Dev_Char_Default, & Dev_Char_Record Dev_Char DECLARE LONG Io_Function, & Stat DECLARE WORD IOSB(4) EXTERNAL LONG AST_ROUTINE EXTERNAL LONG FUNCTION SYS$QIOW ! We will set the mailbox for write attention with AST_Routine as the handler Io_Function = IO$_SETMODE OR IO$M_WRTATTN Stat = Sys$Qiow( , & Mbx_Channel BY VALUE, & IO_Function BY VALUE, & IOSB() BY REF, & , & , & Ast_Routine, & , & , & , & , & , ) CALL Check_Status_L(Stat) CALL Check_Status_W(IOSB(0)) END SUB SUB Refresh_Term_Characteristics OPTION TYPE = EXPLICIT, & SIZE = (REAL DOUBLE,INTEGER LONG), & CONSTANT TYPE = INTEGER %INCLUDE "$IODEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET" RECORD Dev_Char_Record BYTE Dev_Class BYTE Dev_Type WORD Page_Width VARIANT CASE LONG Basic_Dev_Char CASE BYTE Unused(2) BYTE Page_Length END VARIANT LONG Extended_Dev_Char END RECORD MAP (Brdcst_Message) & BYTE Mbx_Msg_Byte(200) MAP (Brdcst_Message) & WORD Mbx_Msg_Word(100) MAP (Brdcst_Common) & WORD Mbx_Channel, & WORD Terminal_Channel, & STRING Session_ID = 16, & STRING AST_Session_ID = 16, & STRING Message=78, & Dev_Char_Record Dev_Char_Default, & Dev_Char_Record Dev_Char EXTERNAL LONG FUNCTION SYS$QIOW DECLARE LONG Stat DECLARE WORD IOSB(4) ! Set terminal characteristics for decforms Stat = Sys$Qiow( , & Terminal_Channel BY VALUE, & IO$_Setmode BY VALUE, & IOSB() BY REF, & , & , & Dev_Char BY REF, & 12 BY VALUE, & , & , & , & , ) CALL Check_Status_L(Stat) CALL Check_Status_W(IOSB(0)) END SUB