COBOL2002 ユーザーズガイド

[目次][用語][索引][前へ][次へ]

29.5.5 キューのパス名を検索するコーディングの例

'Sample Queue'というラベルの付いた'user1\samplequeue'というパス名のキューがあるかどうかを検索し,なければ'Sample Queue'というラベルの付いたパブリックキューのパス名を一覧表示するコーディング例を次に示します。

 
         :
       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 LOCATE-PARM.
         02 PATH-LEN  PIC S9(9)  USAGE COMP.
         02 PATH-NAME PIC X(256).
         02 LABEL-LEN PIC S9(9)  USAGE COMP VALUE 12.
         02 LABEL-DAT PIC X(256) VALUE 'Sample Queue'.
         :
       PROCEDURE DIVISION.
           :
           INITIALIZE CBLMQINF.
           MOVE LOW-VALUE TO CBLMQ-RESERVE OF CBLMQINF.
 
           MOVE '0' TO LOCATE-END OF CBLMQINF.
           PERFORM WITH TEST AFTER
             UNTIL ( 1 NOT = RETURN-CODE ) AND
                   ( 2 NOT = RETURN-CODE )
             CALL 'CBLMQLOCATE' USING CBLMQINF LOCATE-PARM
             IF ( 1 = RETURN-CODE ) AND
                ( 'user1\samplequeue' = PATH-NAME ) THEN
               MOVE '1' TO LOCATE-END OF CBLMQINF
             END-IF
           END-PERFORM.
           EVALUATE RETURN-CODE
           WHEN 0
             DISPLAY 'FOUND !:' PATH-NAME(1:PATH-LEN)
             STOP RUN
           WHEN 100
             DISPLAY 'NOT FOUND PATH-NAME'
           WHEN OTHER
             DISPLAY 'QUEUE LOCATE ERROR'
             STOP RUN
           END-EVALUATE.
 
           MOVE '0'TO LOCATE-END OF CBLMQINF.
           PERFORM WITH TEST AFTER
             UNTIL ( 1 NOT = RETURN-CODE ) AND
                   ( 2 NOT = RETURN-CODE )
             CALL 'CBLMQLOCATE' USING CBLMQINF LOCATE-PARM
             EVALUATE RETURN-CODE
             WHEN 1
             WHEN 2
               IF 2 = RETURN-CODE THEN
                 DISPLAY 'QUEUE PATH-NAME DATA ERROR'
               END-IF
               DISPLAY 'QUEUE PATH-NAME[' PATH-LEN ']:'
                       PATH-NAME(1:FUNCTION MIN(PATH-LEN,256))
             END-EVALUATE
           END-PERFORM.
           IF ZERO > RETURN-CODE THEN
             DISPLAY 'QUEUE LOCATE ERROR'
           END-IF.
           :