Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: csq4bvj1.cob Sprache: Cobol

Original von: verschiedene^©

CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
      *                                                               *
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4BVJ1.
      *REMARKS
      *****************************************************************
      * @START_COPYRIGHT@                                             *
      *   Statement:     Licensed Materials - Property of IBM         *
      *                                                               *
      *                  5695-137                                     *
      *                  (C) Copyright IBM Corporation. 1996, 1997    *
      *                                                               *
      *   Status:        Version 1 Release 2                          *
      * @END_COPYRIGHT@                                               *
      *                                                               *
      *  Module Name      : CSQ4BVJ1                                  *
      *                                                               *
      *  Environment      : MVS Batch; COBOL II                       *
      *                                                               *
      *  Description : Sample program to get a number of messages     *
      *                from a queue.                                  *
      *                                                               *
      *  Notes       : The maximum message length is 65536. Messages  *
      *                greater than this will not cause an error but  *
      *                will be truncated.                             *
      *                The syncpoint option is ignored when browsing. *
      *                                                               *
      *****************************************************************
      *                                                               *
      *                       Program  Logic                          *
      *                       --------------                          *
      *                                                               *
      *                                                               *
      *  main                                                         *
      *  ----                                                         *
      *                                                               *
      *   Move parameters into corresponding variables.               *
      *   If parameters are invalid then                              *
      *            Call USAGE-ERROR and exit.                         *
      *                                                               *
      *   Display the parameters passed to the program.               *
      *                                                               *
      *   Connect to the queue manager.                               *
      *   If connection failed then                                   *
      *            Call DISPLAY-ERROR-MESSAGE and exit                *
      *                                                               *
      *   Open the specified message queue (MQOPEN).                  *
      *   If open failed then                                         *
      *            Disconnect from queue manager                      *
      *            Call DISPLAY-ERROR-MESSAGE and exit                *
      *   Endif.                                                      *
      *                                                               *
      *   Set the get message options.                                *
      *   Loop while the messages are received                        *
      *            Get message from queue (MQGET)                     *
      *            If get failed                                      *
      *                     Call DISPLAY-ERROR-MESSAGE                *
      *                     Break from loop                           *
      *            Else                                               *
      *                     Display the message received              *
      *            Endif                                              *
      *   Endloop.                                                    *
      *   Display number of messages got from queue.                  *
      *                                                               *
      *   If syncpoint variable set then                              *
      *            Execute syncpoint.                                 *
      *                                                               *
      *   Close the message queue.                                    *
      *   If close failed then                                        *
      *            Call DISPLAY-ERROR-MESSAGE.                        *
      *                                                               *
      *   Disconnect from the queue manager.                          *
      *   If disconnect failed then                                   *
      *            Call DISPLAY-ERROR-MESSAGE.                        *
      *                                                               *
      *   Exit program.                                               *
      *                                                               *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      *  USAGE-ERROR                                                  *
      *  -----------                                                  *
      *                                                               *
      *   Print message showing correct usage for program.            *
      *                                                               *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      *  DISPLAY-ERROR-MESSAGE                                        *
      *  ---------------------                                        *
      *                                                               *
      *   Create error message and display.                           *
      *                                                               *
      *                                                               *
      *****************************************************************
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       FILE SECTION.
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-RETURN-CODE             PIC S9(4) BINARY VALUE ZERO.
       01  W00-LOOP                    PIC S9(9) BINARY VALUE 0.
       01  W00-NUMGETS                 PIC S9(9) BINARY VALUE 0.
       01  W00-ERROR-MESSAGE           PIC X(48) VALUE SPACES.
       01  W00-MSGBUFFER.
         02  W00-MSGBUFFER-ARRAY         PIC X(1) OCCURS 65536 TIMES.
       01  W00-MSGLENGTH               PIC S9(9) BINARY VALUE 65536.
       01  W00-DATALENGTH              PIC S9(9) BINARY VALUE 0.
      *
      *    Parameter variables
      *
       01  W00-QMGR                    PIC X(48).
       01  W00-QNAME                   PIC X(48).
       01  W00-NUMMSGS-CHAR            PIC X(4) VALUE SPACES.
       01  W00-NUMMSGS                 PIC S9(9) BINARY VALUE 1.
       01  W00-BROWSE-GET              PIC X(1) VALUE 'D'.
           88 BROWSE-GET      VALUE 'B'.
           88 DESTRUCTIVE-GET VALUE 'D'.
       01  W00-SYNCPOINT               PIC X(1) VALUE 'N'.
           88 SYNCPOINT       VALUE 'S'.
           88 NO-SYNCPOINT    VALUE 'N'.
      *
      *    W03 - API fields
      *
       01  W03-HCONN                   PIC S9(9) BINARY VALUE 0.
       01  W03-HOBJ                    PIC S9(9) BINARY VALUE 0.
       01  W03-OPENOPTIONS             PIC S9(9) BINARY.
       01  W03-COMPCODE                PIC S9(9) BINARY.
       01  W03-REASON                  PIC S9(9) BINARY.
      *
      *    API control blocks
      *
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV.
       01  MQM-GET-MESSAGE-OPTIONS.
           COPY CMQGMOV.
      *
      *    MQV contains constants (for filling in the control blocks)
      *    and return codes (for testing the result of a call)
      *
       01  MQM-CONSTANTS.
           COPY CMQV SUPPRESS.
      *
      *
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
      * ------------------------------------------------------------- *
       01  PARMDATA.
           05  PARM-LEN                PIC S9(03) BINARY.
           05  PARM-STRING             PIC X(100).
      *
           EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION USING PARMDATA.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *
      *    If no parameters passed to program then display
      *    error message and exit
      *
           IF PARM-LEN = 0 THEN
              PERFORM USAGE-ERROR
              MOVE 8 TO W00-RETURN-CODE
              GO TO A-MAIN-END
           END-IF.
      *
      *    Move parameters into corresponding variables
      *
           UNSTRING PARM-STRING DELIMITED BY ALL ','
                        INTO W00-QMGR
                             W00-QNAME
                             W00-NUMMSGS-CHAR
                             W00-BROWSE-GET
                             W00-SYNCPOINT.
           MOVE W00-NUMMSGS-CHAR   TO W00-NUMMSGS.
      *
      *    Display parameters to be used in the program
      *
           DISPLAY '==========================================='.
           DISPLAY 'PARAMETERS PASSED :'.
           DISPLAY ' QMGR - ', W00-QMGR.
           DISPLAY ' QNAME - ', W00-QNAME.
           DISPLAY ' NUMMSGS - ', W00-NUMMSGS.
           DISPLAY ' GET - ', W00-BROWSE-GET.
           DISPLAY ' SYNCPOINT - ', W00-SYNCPOINT.
           DISPLAY '==========================================='.
      *
      *
      *
      *    Connect to the queue manager
      *
           CALL 'MQCONN' USING W00-QMGR
                               W03-HCONN
                               W03-COMPCODE
                               W03-REASON.
      *
      *    If connection failed then display error message and exit
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'MQCONN'   TO W00-ERROR-MESSAGE
              PERFORM DISPLAY-ERROR-MESSAGE
              MOVE W03-REASON TO W00-RETURN-CODE
              GO TO A-MAIN-END
           END-IF.
           DISPLAY 'MQCONN SUCCESSFUL'.
      *
      *
      *    Open the queue for input shared and browse
      *
           COMPUTE W03-OPENOPTIONS = MQOO-INPUT-SHARED +
                                     MQOO-BROWSE.
           MOVE W00-QNAME   TO MQOD-OBJECTNAME.
      *
           CALL 'MQOPEN' USING W03-HCONN
                               MQOD
                               W03-OPENOPTIONS
                               W03-HOBJ
                               W03-COMPCODE
                               W03-REASON.
      *
      *    If open failed display error message and exit
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'MQOPEN'   TO W00-ERROR-MESSAGE
              PERFORM DISPLAY-ERROR-MESSAGE
              MOVE W03-REASON TO W00-RETURN-CODE
              GO TO A-MAIN-DISCONNECT
           END-IF.
           DISPLAY 'MQOPEN SUCCESSFUL'.
      *
      *
      *    Setup MQGMO-OPTIONS depending on parameters passed
      *    into program
      *
           COMPUTE MQGMO-OPTIONS = MQGMO-NO-WAIT +
                                   MQGMO-ACCEPT-TRUNCATED-MSG.
           IF SYNCPOINT AND DESTRUCTIVE-GET THEN
              ADD MQGMO-SYNCPOINT    TO MQGMO-OPTIONS
           ELSE
              ADD MQGMO-NO-SYNCPOINT TO MQGMO-OPTIONS
           END-IF.
      *
           IF BROWSE-GET THEN
              ADD MQGMO-BROWSE-FIRST TO MQGMO-OPTIONS
           END-IF.
      *
      *    Loop getting the messages
      *    MSGID and CORRELID are reset before each MQGET
      *
           PERFORM WITH TEST BEFORE VARYING W00-LOOP FROM 0 BY 1
               UNTIL (W00-LOOP >= W00-NUMMSGS)
      *
               MOVE MQMI-NONE TO MQMD-MSGID
               MOVE MQCI-NONE TO MQMD-CORRELID
      *
               CALL 'MQGET' USING W03-HCONN
                                  W03-HOBJ
                                  MQMD
                                  MQGMO
                                  W00-MSGLENGTH
                                  W00-MSGBUFFER
                                  W00-DATALENGTH
                                  W03-COMPCODE
                                  W03-REASON
      *
      *    If get failed then display error message and
      *    break out of the loop.
      *    Otherwise display the message received
      *
               IF (W03-COMPCODE NOT = MQCC-OK) AND
                  (W03-REASON NOT = MQRC-TRUNCATED-MSG-ACCEPTED) THEN
                  MOVE 'MQGET'     TO W00-ERROR-MESSAGE
                  PERFORM DISPLAY-ERROR-MESSAGE
                  MOVE W00-NUMMSGS TO W00-LOOP
                  MOVE W03-REASON  TO W00-RETURN-CODE
               ELSE
                  IF W03-REASON = MQRC-TRUNCATED-MSG-ACCEPTED THEN
                     DISPLAY W00-LOOP, ' : ', W00-DATALENGTH, ' : ',
                             'Truncated to ', W00-MSGLENGTH, ' : ',
                             W00-MSGBUFFER(1:W00-MSGLENGTH)
                  ELSE
                     DISPLAY W00-LOOP, ' : ', W00-DATALENGTH, ' : ',
                             W00-MSGBUFFER(1:W00-DATALENGTH)
                  END-IF
                  ADD 1 TO W00-NUMGETS
               END-IF
      *
      *    If browsing the queue then change the
      *    MQGMO browse options
      *
               IF (W00-LOOP = 0) AND BROWSE-GET THEN
                  SUBTRACT MQGMO-BROWSE-FIRST FROM MQGMO-OPTIONS
                  ADD      MQGMO-BROWSE-NEXT  TO   MQGMO-OPTIONS
               END-IF
      *
           END-PERFORM.
      *
      *    Display the number of messages successfully got
      *    from the queue.
      *
           DISPLAY W00-NUMGETS, ' MESSAGES GOT FROM QUEUE'.
      *
      *
      *    If program started with syncpoint and destructive get
      *    selected then execute syncpoint
      *
           IF SYNCPOINT AND DESTRUCTIVE-GET THEN
              CALL 'MQCMIT' USING W03-HCONN
                                  W03-COMPCODE
                                  W03-REASON
              IF (W03-COMPCODE NOT = MQCC-OK) THEN
                 MOVE 'MQCMIT'   TO W00-ERROR-MESSAGE
                 PERFORM DISPLAY-ERROR-MESSAGE
                 MOVE W03-REASON TO W00-RETURN-CODE
              ELSE
                 DISPLAY 'MQCMIT SUCCESSFUL'
              END-IF
           END-IF.
      *
      *
      *    Close the queue
      *
           CALL 'MQCLOSE' USING W03-HCONN
                                W03-HOBJ
                                MQCO-NONE
                                W03-COMPCODE
                                W03-REASON.
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'MQCLOSE'  TO W00-ERROR-MESSAGE
              PERFORM DISPLAY-ERROR-MESSAGE
              MOVE W03-REASON TO W00-RETURN-CODE
           ELSE
              DISPLAY 'MQCLOSE SUCCESSFUL'
           END-IF.
      *
      *
      *
       A-MAIN-DISCONNECT.
      *
      *    Disconnect from the queue manager
      *
           CALL 'MQDISC' USING W03-HCONN
                               W03-COMPCODE
                               W03-REASON.
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'MQDISC'   TO W00-ERROR-MESSAGE
              PERFORM DISPLAY-ERROR-MESSAGE
              MOVE W03-REASON TO W00-RETURN-CODE
           ELSE
              DISPLAY 'MQDISC SUCCESSFUL'
           END-IF.
      *
       A-MAIN-END.
      *
      *
           MOVE W00-RETURN-CODE TO RETURN-CODE
           STOP RUN.
      *
      * ------------------------------------------------------------- *
       USAGE-ERROR SECTION.
      * ------------------------------------------------------------- *
      *
           DISPLAY '=================================================='
           DISPLAY 'PARAMETERS FOR PROGRAM :'.
           DISPLAY ' QMGR - QUEUE MANGER'.
           DISPLAY ' QNAME - QUEUE NAME'.
           DISPLAY ' NUMMSGS - NUMBER OF MESSAGES'.
           DISPLAY ' GET - (B)ROWSE / (D)ESTRUCTIVE GET'.
           DISPLAY ' SYNCPOINT - (N)O / (S)YNCPOINT'.
           DISPLAY '=================================================='.
      *
       USAGE-ERROR-END.
      *
      *    RETURN TO PERFORMING FUNCTION
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       DISPLAY-ERROR-MESSAGE SECTION.
      * ------------------------------------------------------------- *
      *
           DISPLAY '************************************************'.
           DISPLAY '* ', W00-ERROR-MESSAGE.
           DISPLAY '* COMPLETION CODE : ', W03-COMPCODE.
           DISPLAY '* REASON CODE : ', W03-REASON.
           DISPLAY '************************************************'.
      *
       DISPLAY-ERROR-MESSAGE-END.
      *
      *    RETURN TO PERFORMING FUNCTION
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
      *                        END OF PROGRAM
      * ------------------------------------------------------------- *

¤ Dauer der Verarbeitung: 0.0 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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.