27.5.4　メッセージを受信するコーディングの例

'.\SampleQueue'というキューからメッセージを受信するコーディングの例を次に示します。

         :
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 CBLMQINF.
         02 MSMQ-ERRCD       PIC X(8)   VALUE SPACE.
         02 DETAIL-CD        PIC S9(9)  USAGE COMP
                                        VALUE ZERO.
         02 LOCATE-END       PIC X      VALUE SPACE.
         02 QUEUE-ACCESS     PIC X      VALUE SPACE.
         02 MQMSG-CLASS      PIC X(2)   VALUE SPACE.
         02 MQMSG-TIMEOUT    PIC S9(9)  USAGE COMP
                                        VALUE ZERO.
         02 MQMSG-PRIORITY   PIC 9(4)   USAGE COMP
                                        VALUE ZERO.
         02 MQMSG-DELIVERY   PIC X      VALUE SPACE.
         02 MQMSG-JOURNAL    PIC X      VALUE SPACE.
         02 MQMSG-DEADLETTER PIC X      VALUE SPACE.
         02 MSGDATA-CONV     PIC X      VALUE SPACE.
         02 CBLMQ-RESERVE    PIC X(102) VALUE LOW-VALUE.
       01 QUEUE-PARM.
         02 PATH-LEN  PIC S9(9)  USAGE COMP VALUE 13.
         02 PATH-NAME PIC X(256) VALUE '.\SampleQueue'.
       01 MESSAGE-PARM.
         02 LABEL-LEN PIC S9(9)  USAGE COMP.
         02 LABEL-DAT PIC X(512).
         02 BODY-LEN  PIC S9(9)  USAGE COMP.
         02 BODY-DAT  PIC X(512).
         :
       PROCEDURE DIVISION.
           :
           INITIALIZE CBLMQINF.
           MOVE LOW-VALUE TO CBLMQ-RESERVE OF CBLMQINF.
 
           MOVE '1' TO QUEUE-ACCESS OF CBLMQINF.
           CALL 'CBLMQOPEN' USING CBLMQINF QUEUE-PARM.
           IF ZERO NOT = RETURN-CODE THEN
             DISPLAY 'QUEUE OPEN ERROR'
             STOP RUN
           END-IF.
 
           MOVE 20000 TO MQMSG-TIMEOUT OF CBLMQINF.
           MOVE '0'   TO MSGDATA-CONV  OF CBLMQINF.
           COMPUTE BODY-LEN = FUNCTION LENGTH(BODY-DAT).
           CALL 'CBLMQRECEIVEMSG' USING CBLMQINF MESSAGE-PARM.
           EVALUATE RETURN-CODE
           WHEN ZERO
           WHEN 2
             IF 2 = RETURN-CODE THEN
               DISPLAY 'RECEIVE MESSAGE DATA ERROR'
             ELSE IF LOW-VALUE = MQMSG-CLASS OF CBLMQINF THEN
               DISPLAY 'NORMAL MESSAGE'
             ELSE
               DISPLAY 'NOT NORMAL MESSAGE'
             END-IF END-IF
             DISPLAY 'PRIORITY   :'
                      MQMSG-PRIORITY   OF CBLMQINF
             DISPLAY 'DELIVERY   :'
                      MQMSG-DELIVERY   OF CBLMQINF
             DISPLAY 'JOURNAL    :'
                      MQMSG-JOURNAL    OF CBLMQINF
             DISPLAY 'DEAD-LETTER:'
                      MQMSG-DEADLETTER OF CBLMQINF
             DISPLAY 'LABEL:' LABEL-DAT(1:LABEL-LEN)
             DISPLAY 'DATA :' BODY-DAT (1:BODY-LEN)
           WHEN 1
             DISPLAY 'RECEIVE MESSAGE BUFFER OVERFLOW:' BODY-LEN
           WHEN 100
             DISPLAY 'RECEIVE MESSAGE TIME-OUT'
           WHEN OTHER
             DISPLAY 'QUEUE RECEIVE MESSAGE ERROR'
           END-EVALUATE.
 
           CALL 'CBLMQCLOSE' USING CBLMQINF QUEUE-PARM.
           IF ZERO NOT = RETURN-CODE THEN
             DISPLAY 'QUEUE CLOSE ERROR'
             STOP RUN
           END-IF.
           :