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.