COBOL2002 ユーザーズガイド
'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.
:
All Rights Reserved. Copyright (C) 2013, 2016, Hitachi, Ltd.
All Rights Reserved. Copyright (C) 2002, 2011, Microsoft Corporation.