| products/sources/formale Sprachen/Cobol/verschiedene-Autoren/MQ-Series/ |
|
Quellcode-Bibliothek© Kompilation durch diese Firma[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]Datei: Sprache: CobolOriginal von: verschiedene© |
|
||||||
|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- * IDENTIFICATION DIVISION. * ------------------------------------------------------------- * PROGRAM-ID. CSQ4TVD1. *REMARKS ***************************************************************** * @START_COPYRIGHT@ * * Statement: Licensed Materials - Property of IBM * * * * 5695-137 * * (C) Copyright IBM Corporation. 1993, 1997 * * * * Status: Version 1 Release 2 * * @END_COPYRIGHT@ * * ************************************************************* * * * * Product Number : 5695-137 * * * * Module Name : CSQ4TVD1 * * * * Environment : MVS TSO/ISPF; COBOL II * * * * Function : This program provides initiation and * * option menu for the mail manager sample. * * See IBM MQSeries for MVS/ESA * * Application Programming Reference, * * for further details. * * * * Description : This program opens a users mail queue, * * (creating it if it does not exist) * * It then displays panel CSQ4VDP1 and * * initiates the other programs in suite to * * perform the user selected function. * * * * ************************************************************* * * * * Program Logic * * ------------- * * * * Start (A-MAIN SECTION) * * ----- * * Define required variables to ISPF * * Connect to the queue manager * * If connect not successful * * Build error message and exit * * End-if * * Perform GET-QMGR-NAME * * If the queue manager name cannot be obtained * * Build error message and exit * * End-if * * Perform OPEN-USERS-MAIL-QUEUE * * If open not successful * * Build error message and exit * * End-if * * Perform FIND-MAIL-QUEUE-DEPTH * * Perform PUT-TO-SHARED-POOL * * * * Display the main menu panel (CSQ4VDP1) * * Do while return code from ISPF is zero * * Evaluate user request * * When '1' Perform FIND-MAIL-QUEUE-DEPTH * * If messages available * * Perform READ-MAIL * * Else * * Build message * * End-if * * When '2' Perform SEND-MAIL * * When '3' Perform CREATE-NICKNAME * * Otherwise build error message * * End-evaluate * * Perform FIND-MAIL-QUEUE-DEPTH * * Display the main menu panel * * End-do * * * * If return code does not indicate PF3 pressed * * Build an error message * * End-if * * Close the users mail queue * * If close not successful * * Build error message * * End-if * * Disconnect from the queue manager * * If unsuccessful * * Build error message * * End-if * * If there is an error message to display * * Display it using ISPF SETMSG * * End-if * * * * Return to ISPF * * * * * * GET-QMGR-NAME SECTION * * --------------------- * * Initialize the variables for the open call * * Open the queue manager for inquiry * * If open not successful * * Build an error message * * Else * * Initialize the variables for the inquire call * * If inquire not successful * * Build an error message * * Else * * Save the queue manager name * * End-if * * Close the queue manager * * End-if * * * * Return to performing section * * * * * * OPEN-USERS-MAIL-QUEUE SECTION * * ----------------------------- * * Initialize the variables for the open call * * Open the users mail queue * * If open not successful * * If the queue does not exist * * Perform CREATE-MAIL-QUEUE * * Set number of messages to zero * * If create queue was unsuccessful * * Build an error message * * End-if * * Else * * Build an error message * * End-if * * End-if * * * * Return to performing section * * * * * * CREATE-MAIL-QUEUE SECTION * * ------------------------- * * Initialize the variables for the open call * * Open the temporary queue * * If open not successful * * Build error message * * Go to CREATE-MAIL-QUEUE-EXIT * * End-if * * * * Initialize the variables for the put1 call * * Put1 the define queue message * * If put1 not successful * * Build error message * * Go to CREATE-MAIL-QUEUE-TEMPQ-CLOSE * * End-if * * * * Initialize the variables for the get call * * Do until expected response message received or get fails* * Get the message * * If compcode ok * * If expected message received * * If queue was created successfully * * Set create-worked to Y * * Else * * Set create-worked to N * * End-if * * End-if * * Else * * If no message available * * Set 'unable to create mail queue' message * * Else * * Build error message * * End-if * * End-if * * End-do * * * * CREATE-MAIL-QUEUE-TEMPQ-CLOSE * * Close the temporary queue * * * * If create-worked = Y * * Initialize the variables for the open call * * Open the users mail queue * * If the open is not successful * * Build an error message * * End-if * * End-if * * * * CREATE-MAIL-QUEUE-EXIT * * Return to performing section * * * * * * FIND-MAIL-QUEUE-DEPTH SECTION * * ----------------------------- * * Initialize the variables for the inquire call * * Inquire on the users mail queue depth * * If inquire not successful * * Build an error message * * Set number of messages to zero * * Else * * Set number of messages to queue depth * * End-if * * * * Return to performing section * * * * * * PUT-TO-SHARED-POOL SECTION * * -------------------------- * * Copy the ISPF variables required for display and * * the other programs to the shared pool * * * * Return to performing section * * * * * * READ-MAIL SECTION * * ----------------- * * Call ISPLINK to initiate the receive mail program * * * * Return to performing section * * * * * * SEND-MAIL SECTION * * ----------------- * * Call ISPLINK to initiate the send mail program * * * * Return to performing section * * * * * * CREATE-NICKNAME SECTION * * ----------------------- * * Call ISPLINK to initiate the create nickname program * * * * Return to performing section * * * * * * ************************************************************* * * ------------------------------------------------------------- * ENVIRONMENT DIVISION. * ------------------------------------------------------------- * * ------------------------------------------------------------- * DATA DIVISION. * ------------------------------------------------------------- * * ------------------------------------------------------------- * WORKING-STORAGE SECTION. * ------------------------------------------------------------- * * * W00 - General work fields * 01 W00-GET-WAIT-30SECS PIC S9(09) BINARY VALUE 30000. 01 W00-DATA-LENGTH PIC S9(09) BINARY. 01 W00-MESSAGE-DATA PIC X(80) VALUE SPACES. 01 W00-CREATE-WORKED PIC X. * * W01 - Queue name fields * 01 W01-REPLY-QNAME PIC X(48) VALUE SPACES. 01 W01-SYSTEM-REPLY-MODEL PIC X(26) VALUE 'SYSTEM.DEFAULT.MODEL.QUEUE'. 01 W01-SYSTEM-COMMAND-QUEUE PIC X(20) VALUE 'SYSTEM.COMMAND.INPUT'. 01 W01-SYSTEM-REPLY-INITIAL PIC X(10) VALUE 'CSQ4SAMP.*'. * * W02 - Command server query and response fields * 01 W02-DEFINE-COMMAND. 05 PIC X(14) VALUE 'DEFINE QLOCAL('. 05 MAILQ. 10 PIC X(17) VALUE 'CSQ4SAMP.MAILMGR.'. 10 MAILQ-USER PIC X(08) VALUE SPACES. 10 PIC X(23) VALUE SPACES. 05 PIC X(39) VALUE ') LIKE(CSQ4SAMP.MAILMGR.QUEUE.TEMPLATE)'. 01 W02-DEFINE-LENGTH PIC S9(09) BINARY. * 01 W02-COMMAND-REPLY. 05 W02-REPLY-NUM PIC X(08). 05 PIC X(26). 05 W02-RETURN-NUM PIC X(08). 05 PIC X(09). 05 W02-REASON-NUM PIC X(08). 05 PIC X(41). 01 W02-REPLY-LENGTH PIC S9(09) BINARY. * * W03 - MQM API fields * 01 W03-OPTIONS PIC S9(09) BINARY. 01 W03-SELECTORCOUNT PIC S9(09) BINARY VALUE 1. 01 W03-INTATTRCOUNT PIC S9(09) BINARY. 01 W03-CHARATTRLENGTH PIC S9(09) BINARY. 01 W03-CHARATTRS PIC X(48) VALUE LOW-VALUES. 01 W03-SELECTORS-TABLE. 05 W03-SELECTORS PIC S9(09) BINARY. 01 W03-INTATTRS-TABLE. 05 W03-INTATTRS PIC S9(09) BINARY. * * The following copy book contains messages that will be * displayed to the user * COPY CSQ4VD0. * * ISPF definitions used in this program * COPY CSQ4VD1. * 01 W04-CSQ4TVD2 PIC X(13) VALUE 'PGM(CSQ4TVD2)'. 01 W04-CSQ4TVD4 PIC X(13) VALUE 'PGM(CSQ4TVD4)'. 01 W04-CSQ4TVD5 PIC X(13) VALUE 'PGM(CSQ4TVD5)'. 01 W04-PANEL1 PIC X(15) VALUE 'CSQ4VDP1'. * * ISPF variable definitions used in this program * COPY CSQ4VD2. * 01 NUMMSG PIC ZZZ9 VALUE ZERO. 01 N PIC X VALUE ZERO. * * API control blocks * 01 MQM-OBJECT-DESCRIPTOR. COPY CMQODV. 01 MQM-MESSAGE-DESCRIPTOR. COPY CMQMDV. 01 MQM-GET-MESSAGE-OPTIONS. COPY CMQGMOV. 01 MQM-PUT-MESSAGE-OPTIONS. COPY CMQPMOV. * * Copy book of constants (for filling in the control blocks) * and return codes (for testing the result of a call) * 01 CMQV. COPY CMQV SUPPRESS. EJECT * ------------------------------------------------------------- * PROCEDURE DIVISION. * ------------------------------------------------------------- * A-MAIN SECTION. * ------------------------------------------------------------- * * * * This section receives the queue manager and userid. * * * * The section then displays the mail manager main menu screen * * in a loop and calls other programs to process the options * * entered by the user. The number of messages in the mail * * queue is updated within the loop. * * * * After exit from the loop the users mail queue is closed and * * control returned to the calling CLIST. * * * * ------------------------------------------------------------ * * * * Define the variables to ISPF * - this also copies current values into the program of * those variables already known to ISPF * CALL 'ISPLINK' USING VD1-VDEFINE VD1-HCONN HCONN VD1-CHAR VD1-LENGTH4 . CALL 'ISPLINK' USING VD1-VDEFINE VD1-HOBJ HOBJ VD1-CHAR VD1-LENGTH4 . CALL 'ISPLINK' USING VD1-VDEFINE VD1-MSG MSG VD1-CHAR VD1-LENGTH60 . CALL 'ISPLINK' USING VD1-VDEFINE VD1-N N VD1-CHAR VD1-LENGTH . CALL 'ISPLINK' USING VD1-VDEFINE VD1-NUMMSG NUMMSG VD1-CHAR VD1-LENGTH4 . * CALL 'ISPLINK' USING VD1-VDEFINE VD1-USERID USERID VD1-CHAR VD1-LENGTH8 VD1-COPY . CALL 'ISPLINK' USING VD1-VDEFINE VD1-SUBSYS SUBSYS VD1-CHAR VD1-LENGTH48 VD1-COPY . * * Initialize variables * MOVE LENGTH OF W02-DEFINE-COMMAND TO W02-DEFINE-LENGTH. MOVE LENGTH OF W02-COMMAND-REPLY TO W02-REPLY-LENGTH. MOVE ZERO TO HCONN. MOVE USERID TO MAILQ-USER. * * If the user has not tailored the JCL - use the default * IF SUBSYS = 'QMGR' THEN MOVE SPACES TO SUBSYS END-IF. * * Connect to the queue manager * CALL 'MQCONN' USING SUBSYS HCONN COMPCODE REASON. * * Test the output of the connect call. If the call failed, * set up an error message showing the completion code and * reason code and exit * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'MQCONN' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG GO TO A-MAIN-EXIT END-IF. * PERFORM GET-QMGR-NAME. * * If the queue manager name could not be read, exit * displaying the message set by GET-QMGR-NAME * IF (MSG NOT = SPACES) THEN GO TO A-MAIN-DISCONNECT END-IF. * * Open the users mail queue * PERFORM OPEN-USERS-MAIL-QUEUE. * * If the open was unsuccessful, exit * displaying the message set by OPEN-USERS-MAIL-QUEUE * IF (MSG NOT = SPACES) THEN GO TO A-MAIN-DISCONNECT END-IF. * PERFORM FIND-MAIL-QUEUE-DEPTH. * PERFORM PUT-TO-SHARED-POOL. * * Update the relevant screen fields. If an error occurred * it is recorded in MSG * MOVE SPACE TO N. * CALL 'ISPLINK' USING VD1-DISPLAY W04-PANEL1. * * Loop from here to END-PERFORM until the PF3 key is pressed * or until an ISPF error occurs * PERFORM WITH TEST BEFORE UNTIL RETURN-CODE NOT = ZERO * MOVE SPACES TO MSG * * Process depending on the action entered by the user * EVALUATE TRUE WHEN N = '1' PERFORM FIND-MAIL-QUEUE-DEPTH IF NUMMSG NOT = ' 0' THEN PERFORM READ-MAIL ELSE MOVE VD0-MESSAGE-17 TO MSG END-IF WHEN N = '2' PERFORM SEND-MAIL WHEN N = '3' PERFORM CREATE-NICKNAME WHEN OTHER MOVE VD0-MESSAGE-18 TO MSG END-EVALUATE * PERFORM FIND-MAIL-QUEUE-DEPTH * CALL 'ISPLINK' USING VD1-DISPLAY W04-PANEL1 * END-PERFORM. * * Check the return code after the loop ends, if it does * not correspond to PF3 having been pressed, build an * error message * IF RETURN-CODE NOT = 8 THEN MOVE VD1-DISPLAY TO VD0-MSG16-CALL MOVE RETURN-CODE TO VD0-MSG16-RETURN MOVE VD0-MESSAGE-16 TO MSG CALL 'ISPLINK' USING VD1-VPUT VD1-MSG CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1 MOVE SPACES TO MSG END-IF. * * Close the queue. * MOVE MQCO-NONE TO W03-OPTIONS. * CALL 'MQCLOSE' USING HCONN HOBJ W03-OPTIONS COMPCODE REASON. * * Test the output of the close call. If the call failed, * build an error message showing the completion code and * reason * IF (COMPCODE = MQCC-FAILED) THEN MOVE 'MQCLOSE' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG END-IF. * A-MAIN-DISCONNECT. * * Disconnect from the queue manager. * CALL 'MQDISC' USING HCONN COMPCODE REASON. * * Test the output of the disconnect call. If the call failed, * build an error message showing the completion code and * reason * IF (COMPCODE = MQCC-FAILED) THEN MOVE 'MQDISC' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG END-IF. * * A-MAIN-EXIT. * * If there is an error message display it to the user * IF MSG NOT = SPACES THEN CALL 'ISPLINK' USING VD1-VPUT VD1-MSG CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1 END-IF. * * Return to ISPF * STOP RUN. EJECT * * ------------------------------------------------------------- * GET-QMGR-NAME SECTION. * ------------------------------------------------------------- * * * * This section gets the name of the queue manager the * * system is attached to. * * * * ------------------------------------------------------------ * * * Initialize the Object Descriptor (MQOD) control block. * (The copy book initializes remaining fields) * MOVE MQOT-Q-MGR TO MQOD-OBJECTTYPE. MOVE SPACES TO MQOD-OBJECTNAME. MOVE SPACES TO MQOD-DYNAMICQNAME. MOVE ZERO TO HOBJ. * MOVE MQOO-INQUIRE TO W03-OPTIONS. * * Open the queue manager * CALL 'MQOPEN' USING HCONN MQOD W03-OPTIONS HOBJ COMPCODE REASON. * * Test the output of the open call. If the call failed, build * an error message showing the completion code and reason code * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'OPEN QMGR' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG GO TO GET-QMGR-NAME-EXIT END-IF. * * Set selectors to inquire on queue manager name * MOVE MQCA-Q-MGR-NAME TO W03-SELECTORS. MOVE ZERO TO W03-INTATTRCOUNT. MOVE MQ-Q-MGR-NAME-LENGTH TO W03-CHARATTRLENGTH. * * Inquire on the attributes * CALL 'MQINQ' USING HCONN HOBJ W03-SELECTORCOUNT W03-SELECTORS W03-INTATTRCOUNT W03-INTATTRS W03-CHARATTRLENGTH W03-CHARATTRS COMPCODE REASON. * * Test the output from the inquiry: * * - If the completion code is not ok, display an error * message showing the completion and reason codes * * - Otherwise, store the queue manager name * IF COMPCODE NOT = MQCC-OK MOVE 'MQINQ QMGR' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG MOVE SPACES TO SUBSYS ELSE MOVE SPACES TO MSG MOVE W03-CHARATTRS TO SUBSYS END-IF. * CALL 'MQCLOSE' USING HCONN HOBJ MQCO-NONE COMPCODE REASON. * GET-QMGR-NAME-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * OPEN-USERS-MAIL-QUEUE SECTION. * ------------------------------------------------------------- * * * * This section opens the user's mail queue - if this queue * * does not exist the section calls CREATE-MAIL-QUEUE to * * create the queue. * * If the open fails a message is built indicating the reason. * * * * ------------------------------------------------------------ * * MOVE SPACES TO MSG * * Initialize the Object Descriptor (MQOD) control block. * (The remaining fields are already initialized) * MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE MAILQ TO MQOD-OBJECTNAME. * MOVE MQOO-INQUIRE TO W03-OPTIONS. ADD MQOO-BROWSE TO W03-OPTIONS. ADD MQOO-INPUT-SHARED TO W03-OPTIONS. ADD MQOO-OUTPUT TO W03-OPTIONS. MOVE ZERO TO HOBJ. * * Open the mail queue * CALL 'MQOPEN' USING HCONN MQOD W03-OPTIONS HOBJ COMPCODE REASON. * * Test the output of the open call. * If the call failed for unknown object name - create * the queue * Else build an error message showing the completion * code and reason * IF (COMPCODE NOT = MQCC-OK) THEN IF (REASON = MQRC-UNKNOWN-OBJECT-NAME) THEN * Queue doesn't exist - create it PERFORM CREATE-MAIL-QUEUE MOVE ZERO TO NUMMSG IF W00-CREATE-WORKED = 'N' THEN * Couldn't create it - report it MOVE VD0-MESSAGE-2 TO MSG END-IF ELSE * Something else is wrong - report it MOVE 'OPEN MAILQ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG END-IF END-IF. * OPEN-USERS-MAIL-QUEUE-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * CREATE-MAIL-QUEUE SECTION. * ------------------------------------------------------------- * * * * This section creates the users mail queue. If the create * * fails, a message is built indicating the reason. * * * * ------------------------------------------------------------ * * MOVE SPACE TO W00-CREATE-WORKED. * * Initialize the Object Descriptor (MQOD) control block. * (The remaining fields are already initialized) * MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE W01-SYSTEM-REPLY-MODEL TO MQOD-OBJECTNAME. MOVE W01-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME. MOVE ZERO TO HOBJ. * MOVE MQOO-INPUT-AS-Q-DEF TO W03-OPTIONS. * * Open the temporary queue * CALL 'MQOPEN' USING HCONN MQOD W03-OPTIONS HOBJ COMPCODE REASON. * * Test the output of the open call. If the call failed, build * an error message showing the completion code and reason * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'OPEN TEMPQ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG GO TO CREATE-MAIL-QUEUE-EXIT END-IF. * * Send a 'define queue' message to the system command * input queue * MOVE MQOD-OBJECTNAME TO W01-REPLY-QNAME MQMD-REPLYTOQ. MOVE MQMT-REQUEST TO MQMD-MSGTYPE. MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE. MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE W01-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME. MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS. * CALL 'MQPUT1' USING HCONN MQOD MQMD MQPMO W02-DEFINE-LENGTH W02-DEFINE-COMMAND COMPCODE REASON. * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'DEFINE PUT' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG GO TO CREATE-MAIL-QUEUE-TEMPQ-CLOSE END-IF. * MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS. ADD MQGMO-WAIT TO MQGMO-OPTIONS. MOVE W00-GET-WAIT-30SECS TO MQGMO-WAITINTERVAL. * PERFORM WITH TEST AFTER UNTIL ( (COMPCODE NOT = MQCC-OK) OR (W00-CREATE-WORKED NOT = SPACE) ) * MOVE MQMI-NONE TO MQMD-MSGID MOVE MQCI-NONE TO MQMD-CORRELID MOVE SPACES TO W02-COMMAND-REPLY * CALL 'MQGET' USING HCONN HOBJ MQMD MQGMO W02-REPLY-LENGTH W02-COMMAND-REPLY W00-DATA-LENGTH COMPCODE REASON * IF (COMPCODE = MQCC-OK) THEN IF W02-REPLY-NUM = 'CSQN205I' THEN IF W02-RETURN-NUM = '00000000' THEN MOVE 'Y' TO W00-CREATE-WORKED ELSE MOVE 'N' TO W00-CREATE-WORKED END-IF * else * Do nothing with this message END-IF ELSE IF (REASON = MQRC-NO-MSG-AVAILABLE) THEN MOVE VD0-MESSAGE-2 TO MSG ELSE MOVE 'DEFINE GET' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG END-IF END-IF * END-PERFORM. * CREATE-MAIL-QUEUE-TEMPQ-CLOSE. * * Close, and thus delete, the temporary queue * CALL 'MQCLOSE' USING HCONN HOBJ MQCO-NONE COMPCODE REASON. * * If the mail queue was created, open it * IF W00-CREATE-WORKED = 'Y' THEN * * Initialize the Object Descriptor (MQOD) control block * (The remaining fields are already initialized) * MOVE MQOT-Q TO MQOD-OBJECTTYPE MOVE MAILQ TO MQOD-OBJECTNAME * * Initialize the working storage fields required to open * the queue * MOVE MQOO-INQUIRE TO W03-OPTIONS ADD MQOO-BROWSE TO W03-OPTIONS ADD MQOO-INPUT-SHARED TO W03-OPTIONS ADD MQOO-OUTPUT TO W03-OPTIONS ADD MQOO-SAVE-ALL-CONTEXT TO W03-OPTIONS * * Open the queue * CALL 'MQOPEN' USING HCONN MQOD W03-OPTIONS HOBJ COMPCODE REASON * * Test the output of the open call. If the call failed * build an error message showing the completion code * and reason * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'OPEN MAILQ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG END-IF * END-IF. * CREATE-MAIL-QUEUE-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * FIND-MAIL-QUEUE-DEPTH SECTION. * ------------------------------------------------------------- * * * * This section inquires on the users mail queue to find the * * number of messages on the queue. * * It updates NUMMSG with this number * * * * ------------------------------------------------------------ * * * Initialize the variables for the inquire call * MOVE MQIA-CURRENT-Q-DEPTH TO W03-SELECTORS. MOVE 1 TO W03-SELECTORCOUNT. MOVE 1 TO W03-INTATTRCOUNT. MOVE ZERO TO W03-CHARATTRLENGTH. * * Inquire on the attributes * CALL 'MQINQ' USING HCONN HOBJ W03-SELECTORCOUNT W03-SELECTORS-TABLE W03-INTATTRCOUNT W03-INTATTRS-TABLE W03-CHARATTRLENGTH W03-CHARATTRS COMPCODE REASON. * * Test the output * - If the completion code is not OK, build an error * message showing the completion and reason codes * - Otherwise, update the number of messages * IF COMPCODE NOT = MQCC-OK THEN MOVE 'INQ DEPTH' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG MOVE ZERO TO NUMMSG ELSE MOVE W03-INTATTRS TO NUMMSG END-IF. * FIND-MAIL-QUEUE-DEPTH-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * PUT-TO-SHARED-POOL SECTION. * ------------------------------------------------------------- * * * * This section copies the variables to the ISPF shared pool * * * * ------------------------------------------------------------ * * CALL 'ISPLINK' USING VD1-VPUT VD1-USERID VD1-SHARED. CALL 'ISPLINK' USING VD1-VPUT VD1-SUBSYS VD1-SHARED. CALL 'ISPLINK' USING VD1-VPUT VD1-MSG VD1-SHARED. CALL 'ISPLINK' USING VD1-VPUT VD1-NUMMSG VD1-SHARED. CALL 'ISPLINK' USING VD1-VPUT VD1-N VD1-SHARED. CALL 'ISPLINK' USING VD1-VPUT VD1-HCONN VD1-SHARED. CALL 'ISPLINK' USING VD1-VPUT VD1-HOBJ VD1-SHARED. * PUT-TO-SHARED-POOL-EXIT. * * Return to performing section * EXIT. * * ------------------------------------------------------------- * READ-MAIL SECTION. * ------------------------------------------------------------- * * * * This section calls the program which allows the user to * * handle incoming mail * * * * ------------------------------------------------------------ * * CALL 'ISPLINK' USING VD1-SELECT VD1-SELECT-LENGTH W04-CSQ4TVD2. * * READ-MAIL-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * SEND-MAIL SECTION. * ------------------------------------------------------------- * * * * This section calls the program which sends mail * * * * ------------------------------------------------------------ * * CALL 'ISPLINK' USING VD1-SELECT VD1-SELECT-LENGTH W04-CSQ4TVD4. * * SEND-MAIL-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * CREATE-NICKNAME SECTION. * ------------------------------------------------------------- * * * * This section calls the program which controls nickname * * creation * * * * ------------------------------------------------------------ * * CALL 'ISPLINK' USING VD1-SELECT VD1-SELECT-LENGTH W04-CSQ4TVD5. * * CREATE-NICKNAME-EXIT. * * Return to performing section * EXIT. EJECT * * --------------------------------------------------------------- * End of program * --------------------------------------------------------------- ¤ Dauer der Verarbeitung: 0.66 Sekunden (vorverarbeitet) ¤ |
Laden
Fehler beim Verzeichnis:
in der Quellcodebibliothek suchenDie farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
