| 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: csq4tvd5.cob Sprache: CobolOriginal von: verschiedene© |
|
||||||
|
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
* ------------------------------------------------------------- * IDENTIFICATION DIVISION. * ------------------------------------------------------------- * PROGRAM-ID. CSQ4TVD5. *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 : CSQ4TVD5 * * * * Environment : MVS TSO/ISPF; COBOL II * * * * Function : This program provides nickname creation * * function for the mail manager sample. * * See IBM MQSeries for MVS/ESA * * Application Programming Reference, * * for further details. * * * * Description : This program will allow the user to define* * nicknames for users of the system * * that are commonly contacted. This program * * will put all requests on to the * * SYSTEM.COMMAND.INPUT queue to be processed* * by the command server. All replies will * * be returned on a temporary dynamic queue * * based on the model queue * * SYSTEM.DEFAULT.MODEL.QUEUE. * * * * ************************************************************* * * * * Program Logic * * ------------- * * * * Start (A-MAIN SECTION) * * ----- * * Define required variables to ISPF * * Display the create nickname panel (CSQ4VDP5) * * * * Do while return code form ISPF is zero * * Perform VALIDATE-USER-ENTRY * * If valid user entry * * Perform CREATE-NICKNAME * * End-if * * Update the message variables in the shared pool * * Display the create nickname panel * * End-do * * * * Return to ISPF * * * * * * VALIDATE-USER-ENTRY SECTION * * --------------------------- * * If no nickname has been entered * * Build 'enter valid nickname' message * * Else * * Check that nickname entered starts in the first * * position of the variable and contains no spaces * * If check fails * * Build 'enter valid nickname' message * * Else * * If no userid has been entered * * Build 'Enter valid userid' message * * Else * * Check that userid entered starts in the first * * position of the variable and contains no spaces* * If check fails * * Build 'enter valid userid' message * * End-if * * End-if * * End-if * * End-if * * * * Return to performing section * * * * * * SET-UP-NICKNAME-FIELDS SECTION * * ------------------------------ * * Put the information from ISPF variables * * into the program variables to be used for nickname * * checking and creation * * * * Return to performing section * * * * * * CHECK-NICKNAME SECTION * * ---------------------- * * Set the variables for the open call * * Open the nickname queue for inquire * * If the call is successful * * Build 'nickname already exists' message * * Else * * If reason for call failure is not unknown object name* * Build error message * * Else * * Set message to spaces * * End-if * * End-if * * * * Return to performing section * * * * * * CREATE-NICKNAME SECTION * * ----------------------- * * Perform SET-UP-NICKNAME-FIELDS * * Perform CHECK-NICKNAME * * Evaluate * * When message not spaces * * do nothing (because there is an error) * * When user has not entered a queue manager name * * Perform CREATE-ALIAS-QUEUE * * Otherwise * * If queue manager name is not local queue manager * * Perform CREATE-REMOTE-QUEUE * * Else * * Perform CREATE-ALIAS-QUEUE * * End-if * * End-evaluate * * * * Return to performing section * * * * * * CREATE-REMOTE-QUEUE SECTION * * --------------------------- * * Perform CREATE-TEMP-DYNAMIC-QUEUE * * If the queue is not created successfully * * Build an error message * * Go to CREATE-REMOTE-QUEUE-EXIT * * End-if * * * * Initialize the variables for the put1 call * * Put the define queue message on the system command queue* * If the open is not successful * * Build an error message * * Else * * Perform GET-COMMAND-SERVER-RESP * * End-if * * * * Perform CLOSE-TEMP-DYNAMIC-QUEUE * * * * CREATE-REMOTE-QUEUE-EXIT * * * * Return to performing section * * * * * * CREATE-ALIAS-QUEUE SECTION * * -------------------------- * * Perform CREATE-TEMP-DYNAMIC-QUEUE * * If the queue is not created successfully * * Build an error message * * Go to CREATE-ALIAS-QUEUE-EXIT * * End-if * * * * Initialize the variables for the put1 call * * Put the define queue message on the system command queue* * If the open is not successful * * Build an error message * * Else * * Perform GET-COMMAND-SERVER-RESP * * End-if * * * * Perform CLOSE-TEMP-DYNAMIC-QUEUE * * * * CREATE-ALIAS-QUEUE-EXIT * * * * Return to performing section * * * * * * CREATE-TEMP-DYNAMIC-QUEUE SECTION * * --------------------------------- * * Initialize the variables for the open call * * Create the temporary dynamic queue by opening the model * * queue * * * * Return to performing section * * * * * * GET-COMMAND-SERVER-RESPONSE SECTION * * ----------------------------------- * * Initialize the variables for the get call * * Do until expected response message received or get fails* * Get the message * * If compcode not ok * * If not no message available * * Build an error message * * End-if * * Else * * If expected message received * * If queue was created successfully * * Set create-worked to Y * * Else * * Set create-worked to N * * Perform GET-ERROR-DETAILS * * End-if * * End-if * * End-if * * End-do * * * * If create queue worked * * Set 'nickname created' message * * End-if * * * * Return to performing section * * * * * * CLOSE-TEMP-DYNAMIC-QUEUE SECTION * * -------------------------------- * * Close the queue * * * * Return to performing section * * * * * * GET-ERROR-DETAILS SECTION * * ------------------------- * * Initialize the variables for the get call * * Get the next message from the temporary queue * * Move the message received to the display message 2 line * * * * Initialize the variables for the get call * * Get the next message from the temporary queue * * Move the message received to the display message 3 line * * * * Return to performing section * * * * ************************************************************* * * ------------------------------------------------------------- * ENVIRONMENT DIVISION. * ------------------------------------------------------------- * DATA DIVISION. * ------------------------------------------------------------- * WORKING-STORAGE SECTION. * ------------------------------------------------------------- * * * W00 - General work fields * 01 W00-NICKNAME PIC X(08) VALUE SPACES. 01 W00-USERQ PIC X(08) VALUE SPACES. 01 W00-VALIDATE PIC X(01) VALUE SPACES. * 01 W00-QNAME PIC X(48) VALUE SPACES. 01 W00-Q-PREFIX PIC X(17) VALUE 'CSQ4SAMP.MAILMGR.'. 01 W00-SYSTEM-REPLY-MODEL PIC X(26) VALUE 'SYSTEM.DEFAULT.MODEL.QUEUE'. 01 W00-SYSTEM-COMMAND-QUEUE PIC X(20) VALUE 'SYSTEM.COMMAND.INPUT'. 01 W00-SYSTEM-REPLY-INITIAL PIC X(10) VALUE 'CSQ4SAMP.*'. * 01 W00-GET-WAIT-30SECS PIC S9(09) BINARY VALUE 30000. 01 W00-GET-WAIT-2SECS PIC S9(09) BINARY VALUE 2000. * 01 W00-DEFINE-ALIAS-COMMAND. 05 PIC X(14) VALUE 'DEFINE QALIAS('. 05 W00-ALIAS-QNAME PIC X(48). 05 PIC X(63) VALUE ') LIKE(CSQ4SAMP.MAILMGR.ALIAS.TEM - 'PLATE) TARGQ(CSQ4SAMP.MAILMGR.'. 05 W00-TARGQ-QNAME PIC X(08) VALUE SPACES. 05 PIC X VALUE ')'. 01 W00-DEFINE-REMOTE-COMMAND. 05 PIC X(16) VALUE 'DEFINE QREMOTE('. 05 W00-LOCAL-QNAME PIC X(48). 05 PIC X(63) VALUE ') PUT(ENABLED) DEFPRTY(2) DEFPSIS - 'T(YES) RNAME(CSQ4SAMP.MAILMGR.'. 05 W00-REMOTE-QNAME PIC X(08) VALUE SPACES. 05 PIC X(10) VALUE ') RQMNAME('. 05 W00-REMOTE-QMGR PIC X(48) VALUE SPACES. 05 PIC X(08) VALUE ') XMITQ('. 05 W00-XMIT-QNAME PIC X(48) VALUE SPACES. 05 PIC X VALUE ')'. 01 W00-DEFINE-ALIAS-LENGTH PIC S9(09) BINARY. 01 W00-DEFINE-REMOTE-LENGTH PIC S9(09) BINARY. 01 W00-REPLY-LENGTH PIC S9(09) BINARY VALUE 100. 01 W00-COMMAND-REPLY. 05 W00-REPLY-NUM PIC X(08). 05 PIC X(26). 05 W00-RETURN PIC X(08). 05 PIC X(09). 05 W00-REASON PIC X(08). 05 PIC X(41). 01 FILLER REDEFINES W00-COMMAND-REPLY. 05 PIC X(34). 05 W00-RETURN-NUM PIC 9(08). 05 PIC X(09). 05 W00-REASON-NUM PIC 9(08). 05 PIC X(41). 01 W00-CREATE-WORKED PIC X. 01 W00-DATA-LENGTH 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 W01-ALIAS PIC X(08) VALUE '(ALIAS)'. 01 W01-CMDMSG1 PIC X(09) VALUE '(CMDMSG1)'. 01 W01-CMDMSG2 PIC X(09) VALUE '(CMDMSG2)'. 01 W01-PANEL5 PIC X(08) VALUE 'CSQ4VDP5'. 01 W01-USERQ PIC X(08) VALUE '(USERQ)'. * * ISPF variable definitions used in this program * COPY CSQ4VD2. * 01 ALIAS PIC X(08) VALUE SPACES. 01 CMDMSG1 PIC X(79) VALUE SPACES. 01 CMDMSG2 PIC X(79) VALUE SPACES. 01 QMGR PIC X(48) VALUE SPACES. 01 USERQ PIC X(08) VALUE SPACES. * * W03 - API fields * 01 W03-OPTIONS PIC S9(9) BINARY VALUE ZERO. 01 W03-HOBJ PIC S9(9) BINARY VALUE ZERO. * * API control blocks * 01 MQM-OBJECT-DESCRIPTOR. COPY CMQODV SUPPRESS. 01 MQM-MESSAGE-DESCRIPTOR. COPY CMQMDV SUPPRESS. 01 MQM-PUT-MESSAGE-OPTIONS. COPY CMQPMOV SUPPRESS. 01 MQM-GET-MESSAGE-OPTIONS. COPY CMQGMOV SUPPRESS. * * 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 * ------------------------------------------------------------- * LINKAGE SECTION. * ------------------------------------------------------------- * EJECT * ------------------------------------------------------------- * PROCEDURE DIVISION. * ------------------------------------------------------------- * A-MAIN SECTION. * ------------------------------------------------------------- * * * * This section initializes the ISPF variables and then displays,* * in a loop, the create nickname panel. Once the user has * * entered data a check is made to validate that the nickname * * does not already exist. If it does not exist it * * will be created by sending a message to the system command * * server queue. * * * * Errors are reported to the user. The program terminates when * * a non-zero return code is returned by ISPF. * * * * ------------------------------------------------------------- * * * 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 W01-ALIAS ALIAS VD1-CHAR VD1-LENGTH8 . CALL 'ISPLINK' USING VD1-VDEFINE W01-CMDMSG1 CMDMSG1 VD1-CHAR VD1-LENGTH79 . CALL 'ISPLINK' USING VD1-VDEFINE W01-CMDMSG2 CMDMSG2 VD1-CHAR VD1-LENGTH79 . CALL 'ISPLINK' USING VD1-VDEFINE VD1-QMGR QMGR VD1-CHAR VD1-LENGTH48 . CALL 'ISPLINK' USING VD1-VDEFINE W01-USERQ USERQ VD1-CHAR VD1-LENGTH8 . * CALL 'ISPLINK' USING VD1-VDEFINE VD1-HCONN HCONN VD1-CHAR VD1-LENGTH4 VD1-COPY . CALL 'ISPLINK' USING VD1-VDEFINE VD1-HOBJ HOBJ VD1-CHAR VD1-LENGTH4 VD1-COPY . CALL 'ISPLINK' USING VD1-VDEFINE VD1-MSG MSG VD1-CHAR VD1-LENGTH60 VD1-COPY . CALL 'ISPLINK' USING VD1-VDEFINE VD1-SUBSYS SUBSYS VD1-CHAR VD1-LENGTH48 VD1-COPY . CALL 'ISPLINK' USING VD1-VDEFINE VD1-USERID USERID VD1-CHAR VD1-LENGTH8 VD1-COPY . * * Update the relevant screen fields. If an error occurred * it is recorded in MSG * MOVE SPACES TO MSG. MOVE SPACES TO CMDMSG1. MOVE SPACES TO CMDMSG2. * CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL5. * * 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 MOVE SPACES TO CMDMSG1 MOVE SPACES TO CMDMSG2 * PERFORM VALIDATE-USER-ENTRY IF MSG = SPACES THEN PERFORM CREATE-NICKNAME END-IF * CALL 'ISPLINK' USING VD1-VPUT VD1-MSG CALL 'ISPLINK' USING VD1-VPUT W01-CMDMSG1 CALL 'ISPLINK' USING VD1-VPUT W01-CMDMSG2 * CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL5 * END-PERFORM. * A-MAIN-EXIT. * * Return to ISPF * STOP RUN. EJECT * * ------------------------------------------------------------- * VALIDATE-USER-ENTRY SECTION. * ------------------------------------------------------------- * * * * This section validates that both alias and user mail queue * * names have been entered. * * * * ------------------------------------------------------------ * * IF ((ALIAS = SPACES) OR (ALIAS = LOW-VALUES)) THEN MOVE VD0-MESSAGE-10 TO MSG ELSE MOVE SPACES TO W00-NICKNAME W00-VALIDATE UNSTRING ALIAS DELIMITED BY ALL SPACE INTO W00-NICKNAME W00-VALIDATE IF ((W00-NICKNAME = SPACES) OR (W00-VALIDATE NOT = SPACE)) MOVE VD0-MESSAGE-10 TO MSG ELSE IF ((USERQ = SPACES) OR (USERQ = LOW-VALUES)) THEN MOVE VD0-MESSAGE-11 TO MSG ELSE MOVE SPACES TO W00-USERQ W00-VALIDATE UNSTRING USERQ DELIMITED BY ALL SPACE INTO W00-USERQ W00-VALIDATE IF ((W00-NICKNAME = SPACES) OR (W00-VALIDATE NOT = SPACE)) MOVE VD0-MESSAGE-11 TO MSG END-IF END-IF END-IF END-IF. * VALIDATE-USER-ENTRY-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * SET-UP-NICKNAME-FIELDS SECTION. * ------------------------------------------------------------- * * * * This section puts the information from ISPF variables * * into the program variables to be used for nickname * * checking and creation. * * * * ------------------------------------------------------------ * * MOVE USERQ TO W00-TARGQ-QNAME W00-REMOTE-QNAME. MOVE QMGR TO W00-REMOTE-QMGR W00-XMIT-QNAME. * MOVE SPACES TO W00-QNAME. STRING W00-Q-PREFIX USERID '.' ALIAS DELIMITED BY SPACES INTO W00-QNAME. * MOVE W00-QNAME TO W00-ALIAS-QNAME W00-LOCAL-QNAME. * * SET-UP-NICKNAME-FIELDS-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * CREATE-NICKNAME SECTION. * ------------------------------------------------------------- * * * * This section checks whether the nickname to be created * * already exists, if it does the program returns to the * * calling section. Otherwise a nickname will be created. * * * * If the target queue is on the local queue manager, an alias * * queue is created by performing CREATE-ALIAS-QUEUE. If the * * target queue is on another queue manager, a remote queue * * is created by performing CREATE-REMOTE-QUEUE. * * * * Error messages are set by performed sections and displayed * * by the performing section. * * * * ------------------------------------------------------------ * * PERFORM SET-UP-NICKNAME-FIELDS. * PERFORM CHECK-NICKNAME. * EVALUATE TRUE WHEN MSG NOT = SPACES * we have an error - so report it CONTINUE * we have no error - so lets do the processing WHEN QMGR = SPACES WHEN QMGR = LOW-VALUES PERFORM CREATE-ALIAS-QUEUE * WHEN OTHER IF (QMGR NOT = SUBSYS) PERFORM CREATE-REMOTE-QUEUE ELSE PERFORM CREATE-ALIAS-QUEUE END-IF * END-EVALUATE. * CREATE-NICKNAME-EXIT. * EXIT. EJECT * * ------------------------------------------------------------- * CHECK-NICKNAME SECTION. * ------------------------------------------------------------- * * * * This section checks whether a nickname exists by trying to * * open the queue corresponding to the nickname for inquiry. * * * * If the open fails for unknown object name the nickname does * * not exist (so no error message is set). If the open succeeds * * or fails for any other reason an error message is set for * * display to the user by the calling section. If the * * queue was opened it is closed. * * * * ------------------------------------------------------------ * * * Set up the MQSeries API control blocks. * Apart from the following values, all other values in the * control blocks will be set to their default values * MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE W00-QNAME TO MQOD-OBJECTNAME. * * W03-OPTIONS is set to open the queue for INQUIRE * NOTE: The open option is irrelevant to this * program. The open is only used to * validate if the nickname already * exists * MOVE MQOO-INQUIRE TO W03-OPTIONS. * * Open the queue * CALL 'MQOPEN' USING HCONN MQOD W03-OPTIONS W03-HOBJ COMPCODE REASON. * * Test the output of the open call. * * If the open succeeds, the queue already exists. Move an * error message to the panel, close the queue. * * If the open fails and the reason is not UNKNOWN-OBJECT-NAME * move an error message showing the completion and reason codes * to the panel. * * If the open fails with UNKNOWN-OBJECT-NAME, set the message * to blanks * IF COMPCODE = MQCC-OK THEN MOVE VD0-MESSAGE-12 TO MSG CALL 'MQCLOSE' USING HCONN W03-HOBJ MQCO-NONE COMPCODE REASON ELSE IF (REASON NOT = MQRC-UNKNOWN-OBJECT-NAME) THEN MOVE 'OPEN NICKQ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG ELSE MOVE SPACES TO MSG END-IF END-IF. * CHECK-NICKNAME-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * CREATE-REMOTE-QUEUE SECTION. * ------------------------------------------------------------- * * * * This section creates a remote queue by sending a command to * * the queue manager system command input queue. A temporary * * dynamic queue is created to receive the command server * * responses and these responses are checked to determine if * * the queue has been successfully created. * * Status and error messages are prepared for display by the * * calling section. * * * * ------------------------------------------------------------ * * PERFORM CREATE-TEMP-DYNAMIC-QUEUE. * * Test the output of the open call. If the call failed, * build an error message showing the completion code and * reason, and return to the performing section * to allow it to be displayed * 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-REMOTE-QUEUE-EXIT END-IF. * * Save the queue name and also place it in the REPLYTOQ field. * Use the REQUEST message type to ensure that the Command * Server sends back all reply messages. The define remote queue * message is then written to the SYSTEM-COMMAND-INPUT queue to * be processed * MOVE MQOD-OBJECTNAME TO MQMD-REPLYTOQ. MOVE MQMT-REQUEST TO MQMD-MSGTYPE. MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE. MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME. * MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS. * MOVE LENGTH OF W00-DEFINE-REMOTE-COMMAND TO W00-DEFINE-REMOTE-LENGTH. * * Put the define remote command * CALL 'MQPUT1' USING HCONN MQOD MQMD MQPMO W00-DEFINE-REMOTE-LENGTH W00-DEFINE-REMOTE-COMMAND COMPCODE REASON. * * If the compcode is not OK after the PUT1 request * display an error message and return * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'MQPUT1-R ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG ELSE PERFORM GET-COMMAND-SERVER-RESP * * The response messages are set in the function, no * testing is done after return * END-IF. * PERFORM CLOSE-TEMP-DYNAMIC-QUEUE. * CREATE-REMOTE-QUEUE-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * CREATE-ALIAS-QUEUE SECTION. * ------------------------------------------------------------- * * * * This section creates an alias queue by sending a command to * * the queue manager system command input queue. A temporary * * dynamic queue is created to receive the command server * * responses and these responses are checked to determine if * * the queue has been successfully created. * * Status and error messages are prepared for display by the * * performing section. * * * * ------------------------------------------------------------ * * PERFORM CREATE-TEMP-DYNAMIC-QUEUE. * * Test the output of the open call. If the call failed, * build an error message showing the completion code and * reason, and return to the performing section * to allow it to be displayed * 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-ALIAS-QUEUE-EXIT END-IF. * * Save the queue name and also place it in the REPLYTOQ field. * Use the REQUEST message type to ensure that the Command * Server sends back all reply messages. The define alias queue * message is then written to the SYSTEM-COMMAND-INPUT queue to * be processed * MOVE MQOD-OBJECTNAME TO MQMD-REPLYTOQ. MOVE MQMT-REQUEST TO MQMD-MSGTYPE. MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE. MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME. * MOVE MQPMO-NO-SYNCPOINT TO MQPMO-OPTIONS. * MOVE LENGTH OF W00-DEFINE-ALIAS-COMMAND TO W00-DEFINE-ALIAS-LENGTH. * * Put the define alias command * CALL 'MQPUT1' USING HCONN MQOD MQMD MQPMO W00-DEFINE-ALIAS-LENGTH W00-DEFINE-ALIAS-COMMAND COMPCODE REASON. * * If the compcode is not OK after the PUT1 request * display an error message and return * IF (COMPCODE NOT = MQCC-OK) THEN MOVE 'MQPUT1-A ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG ELSE PERFORM GET-COMMAND-SERVER-RESP * * The response messages are set in the function, no * testing is done after return * END-IF. * PERFORM CLOSE-TEMP-DYNAMIC-QUEUE. * CREATE-ALIAS-QUEUE-EXIT. * * Return to performing section * EXIT. EJECT * * ------------------------------------------------------------- * CREATE-TEMP-DYNAMIC-QUEUE SECTION. * ------------------------------------------------------------- * * This section creates a temporary dynamic queue using a * * model queue. * * * * ------------------------------------------------------------ * * * Initialize the Object Descriptor (MQOD) control block. * (The remaining fields are already initialized) * * OBJECTNAME - Contains the name of the model queue that is * to be used to create the temporary dynamic * queue name. * DYNAMICQNAME - Contains the characters that the queue name * is to begin with. * MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE W00-SYSTEM-REPLY-MODEL TO MQOD-OBJECTNAME. MOVE W00-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME. MOVE ZERO TO W03-HOBJ. MOVE MQOO-INPUT-AS-Q-DEF TO W03-OPTIONS. * * Open the queue and, therefore, create the queue * CALL 'MQOPEN' USING HCONN MQOD W03-OPTIONS W03-HOBJ COMPCODE REASON. * CREATE-TEMP-DYNAMIC-QUEUE-EXIT. * * Return to performing section * EXIT. * * ------------------------------------------------------------- * GET-COMMAND-SERVER-RESP SECTION. * ------------------------------------------------------------- * * * * This section gets the command server responses in a loop * * until the right message (CSQN205I) arrives or an error * * occurs. * * When the message is received it is checked to see if the * * queue creation was successful - if it was an appropriate * * message is prepared for display by the calling section, * * otherwise GET-ERROR-DETAILS is called to get the reasons * * for the error. * * If any errors occur, appropriate messages are prepared for * * display by the calling section. * * * * ------------------------------------------------------------ * * * Set up the options for the get-wait call * MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS. ADD MQGMO-WAIT TO MQGMO-OPTIONS. ADD MQGMO-NO-SYNCPOINT TO MQGMO-OPTIONS. * MOVE W00-GET-WAIT-30SECS TO MQGMO-WAITINTERVAL. * * Loop around until an error occurs or until the right * message arrives * MOVE SPACES TO W00-CREATE-WORKED PERFORM WITH TEST AFTER UNTIL ((COMPCODE NOT = MQCC-OK) OR (W00-CREATE-WORKED NOT = SPACES)) * MOVE MQMI-NONE TO MQMD-MSGID MOVE MQCI-NONE TO MQMD-CORRELID MOVE SPACES TO W00-COMMAND-REPLY * CALL 'MQGET' USING HCONN W03-HOBJ MQMD MQGMO W00-REPLY-LENGTH W00-COMMAND-REPLY W00-DATA-LENGTH COMPCODE REASON * * If the compcode is not OK after the get, and the reason * is not NO-MSG-AVAILABLE, build an error message. * If the reason is NO-MSG-AVAILABLE just exit the loop. * Otherwise each message is checked to locate the command * server reply (CSQN205I). When this is located the return * code is checked. Depending on the return code received * the create worked flag is set. If the create failed, * the error details are retrieved and built for display * IF (COMPCODE NOT = MQCC-OK) THEN IF (REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN MOVE 'MQGET ' TO VD0-MSG1-TYPE MOVE COMPCODE TO VD0-MSG1-COMPCODE MOVE REASON TO VD0-MSG1-REASON MOVE VD0-MESSAGE-1 TO MSG MOVE 'N' TO W00-CREATE-WORKED END-IF ELSE IF W00-REPLY-NUM = 'CSQN205I' THEN * Validate the response from the create queue section. * Move either a 'success' or 'fail' message to the panel * dependant on W00-CREATE-WORKED * IF W00-RETURN = '00000000' THEN MOVE 'Y' TO W00-CREATE-WORKED MOVE VD0-MESSAGE-14 TO MSG ELSE MOVE 'N' TO W00-CREATE-WORKED MOVE VD0-MESSAGE-13 TO MSG * * The next two messages should contain * details of the failure. GET-ERROR-DETAILS * puts them in the screen message fields * PERFORM GET-ERROR-DETAILS * END-IF END-IF END-IF * END-PERFORM. * IF W00-CREATE-WORKED = SPACES THEN MOVE VD0-MESSAGE-26 TO MSG END-IF. * GET-COMMAND-SERVER-RESP-EXIT. * * Return to performing section * EXIT. * * ------------------------------------------------------------- * CLOSE-TEMP-DYNAMIC-QUEUE SECTION. * ------------------------------------------------------------- * * * * This section closes, and thus deletes, the temporary * * dynamic queue. * * * * ------------------------------------------------------------ * * * * Close the reply queue and purge it * CALL 'MQCLOSE' USING HCONN W03-HOBJ MQCO-NONE COMPCODE REASON. * CLOSE-TEMP-DYNAMIC-QUEUE-EXIT. * * * Return to performing section * EXIT. * * ------------------------------------------------------------- * GET-ERROR-DETAILS SECTION. * ------------------------------------------------------------- * * * * This section get two messages from the queue and puts the * * message data into message fields for display by the calling * * section. If errors occur in getting these messages, no * * additional data will be available to the user. No error * * checking is done on the calls. * * * * ------------------------------------------------------------ * * * Get the next message on the queue which should * contain a displayable message of what went wrong * MOVE W00-GET-WAIT-2SECS TO MQGMO-WAITINTERVAL. MOVE MQMI-NONE TO MQMD-MSGID. MOVE MQCI-NONE TO MQMD-CORRELID. MOVE SPACES TO W00-COMMAND-REPLY. * CALL 'MQGET' USING HCONN W03-HOBJ MQMD MQGMO W00-REPLY-LENGTH W00-COMMAND-REPLY W00-DATA-LENGTH COMPCODE REASON. * MOVE W00-COMMAND-REPLY TO CMDMSG1. * * Get the next message on the queue which should * contain another displayable message of what went wrong * MOVE MQMI-NONE TO MQMD-MSGID. MOVE MQCI-NONE TO MQMD-CORRELID. MOVE SPACES TO W00-COMMAND-REPLY. * CALL 'MQGET' USING HCONN W03-HOBJ MQMD MQGMO W00-REPLY-LENGTH W00-COMMAND-REPLY W00-DATA-LENGTH COMPCODE REASON. * MOVE W00-COMMAND-REPLY TO CMDMSG2. * * GET-ERROR-DETAILS-EXIT. * * * Return to performing section * EXIT. * * --------------------------------------------------------------- * End of program * --------------------------------------------------------------- ¤ Dauer der Verarbeitung: 0.31 Sekunden (vorverarbeitet) ¤ |
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:Die farbliche Syntaxdarstellung ist noch experimentell.Bot Zugriff |
