Chinaunix
标题:
谁会用Cobol调用MQSeries
[打印本页]
作者:
ck2000
时间:
2005-07-11 17:24
提示:
作者被禁止或删除 内容自动屏蔽
作者:
xuguopeng
时间:
2005-07-12 09:16
标题:
谁会用Cobol调用MQSeries
你想要哪方面的?? GET 还是PUT?[/code]
作者:
ck2000
时间:
2005-07-12 11:36
提示:
作者被禁止或删除 内容自动屏蔽
作者:
zzzddd
时间:
2005-07-12 13:48
标题:
谁会用Cobol调用MQSeries
这个几句话说不清的,需要培训一下!
作者:
ck2000
时间:
2005-07-12 15:05
提示:
作者被禁止或删除 内容自动屏蔽
作者:
xuguopeng
时间:
2005-07-12 15:09
标题:
谁会用Cobol调用MQSeries
PROCESS GRAPHIC.
IDENTIFICATION DIVISION.
PROGRAM-ID. GETMQINF.
*****************************************************
EJECT
*****************************************************
ENVIRONMENT DIVISION.
*****************************************************
DATA DIVISION.
*****************************************************
*****************************************************
WORKING-STORAGE SECTION.
*****************************************************
* RETURN CODE
01 RETCD PIC X(7).
01 MKPARM.
* 作业别代码
03 MKJOBID PIC X(13).
* MQ-MGR
03 MKQMGR PIC X(10).
* MQ-名称
03 MKQNAME PIC X(48).
*01 REPLY PIC X(1).
*****************************************************
LINKAGE SECTION.
*****************************************************
* 作业别代码 (INPUT PARM)
01 LINK-JOBID PIC X(13).
01 LINK-OUT-RETCD PIC X(7).
01 LINK-OUT-PARM.
* 作业别代码
03 OUT-JOBID PIC X(13).
* MQ-MGR
03 OUT-QMGR PIC X(10).
* MQ-名称
03 OUT-QNAME PIC X(48).
*****************************************************
PROCEDURE DIVISION USING LINK-JOBID
LINK-OUT-RETCD
LINK-OUT-PARM.
*****************************************************
MOVE SPACE TO MKPARM
LINK-OUT-RETCD
LINK-OUT-PARM.
MOVE LINK-JOBID TO MKJOBID.
CALL "DCCDXFK" USING RETCD
MKPARM.
MOVE RETCD TO LINK-OUT-RETCD.
MOVE MKPARM TO LINK-OUT-PARM.
* 返回码
* DISPLAY LINK-OUT-RETCD.
* 作业别代码
* DISPLAY OUT-JOBID.
* MQ-MGR
* DISPLAY OUT-QMGR.
* MQ-名称
* DISPLAY OUT-QNAME.
* ACCEPT REPLY.
复制代码
作者:
ck2000
时间:
2005-07-19 11:51
提示:
作者被禁止或删除 内容自动屏蔽
作者:
xuguopeng
时间:
2005-07-19 17:15
标题:
谁会用Cobol调用MQSeries
0001.00 IDENTIFICATION DIVISION.
0002.00 ****************************************************************
0003.00 * Program name: MQPUT001 *
0004.00 * *
0005.00 * Description: COBOL SUB PROGRAM THAT PUT MESSAGE TO A MESSAGE *
0006.00 * QUEUE. *
0007.00 *
0008.00 * WRITE BY JASON 1999/08/09 *
0008.01 * CHANGED 1: 2002/01/20 修改档案架构 DCAOCPP *
0009.00 * *
0010.00 ****************************************************************
0011.00 * *
0012.00 * Function: *
0013.00 * *
0014.00 * Program logic: *
0015.00 * 1.MQOPEN target queue for OUTPUT *
0016.00 * 2.MQPUT message with text to target queue *
0017.00 * 3.MQCLOSE target queue *
0018.00 * *
0019.00 ****************************************************************
0020.00 * AMQ0PUT4 has 3 parameter *
0021.00 * 1.NAME OF TARGET QUEUE(I) *
0022.00 * 2.BUFFER STARE THE DATA TO BE PUT INTO QUEUE(I) *
0023.00 * 3.DATA-LENGTH(I) LENGTH OF THE MESSAGE TO BE PUT *
0024.00 * 4.RETURN CODE *
0025.00 * --->;"Y":PUT MESSAGE OK.
0026.00 * --->;"N":PUT MESSAGE ERROR.
0027.00 *
0028.00 *****************************************************************
0029.00 * 使用说明
0030.00 * 将作业别写到 JOD-ID OF MSG-HEAD IN LK-BUFFER
0031.00 * 资料内容在MSG-BODY中
0032.00 * 资料长度放在 LK-DATA-LENGTH 中(不包括 MESSAGE HEAD)
0033.00 * 程序根据作业别自动获取使用的 MESSAGE QUEUE 名称,
0034.00 * 把相关信息自动写入 MESSAGE HEAD
0035.00 * 并将该 MESSAGE PUT 到对应的 MESSAGE QUEUE 中
0036.00 ****************************************************************
0037.00 PROGRAM-ID. MQPUT001.
0038.00
0039.00 ****************************************************************
0040.00 DATA DIVISION.
0041.00 ****************************************************************
0042.00 WORKING-STORAGE SECTION.
0043.00 ****************************************************************
0044.00 *
0045.00 ** Declare MQI structures needed
0046.00 * MQI named constants
0047.00 01 MY-MQ-CONSTANTS.
0048.00 COPY CMQV.
0049.00 * Object Descriptor
0050.00 01 OBJECT-DESCRIPTOR.
0051.00 COPY CMQODV.
0052.00 * Message Descriptor
0053.00 01 MESSAGE-DESCRIPTOR.
0054.00 COPY CMQMDV.
0055.00 * Put message options
0056.00 01 PMOPTIONS.
0057.00 COPY CMQPMOV.
0058.00 ** note, sample uses defaults where it can
0059.00 01 HCONN PIC S9(9) BINARY.
0060.00 01 Q-HANDLE PIC S9(9) BINARY.
0061.00 01 OPTIONS PIC S9(9) BINARY.
0062.00 01 COMPLETION-CODE PIC S9(9) BINARY.
0063.00 01 OPEN-CODE PIC S9(9) BINARY.
0064.00 01 REASON PIC S9(9) BINARY.
0065.00 01 WK-PGM-ID PIC X(10) VALUE "MQPUT001".
0066.00 01 WK-MSG-HEAD-LEN PIC S9(9) BINARY VALUE 256.
0067.00 01 WK-MSG-LENGTH PIC S9(9) BINARY.
0068.00
0069.00 * FOR GET QUEUE NAME BY JOB-ID
0070.00 01 WK-JOBID PIC X(13).
0071.00 01 WK-OUT-RETCD PIC X(7).
0072.00 01 WK-OUT-PARM.
0073.00 * 作业别代码
0074.00 03 OUT-JOBID PIC X(13).
0077.00 * MQ-MGR
0078.00 03 OUT-QMGR PIC X(10).
0079.00 * MQ-名称
0080.00 03 OUT-QNAME PIC X(48).
0093.00
0094.00 ****************************************************************
0095.00 LINKAGE SECTION.
0096.00 ****************************************************************
0098.00 01 LK-BUFFER PIC X(4096).
0099.00 01 LK-BUFFER-DETAIL REDEFINES LK-BUFFER.
0100.00 03 MSG-HEAD PIC X(256).
0101.00 03 MSG-HEAD-DETAIL REDEFINES MSG-HEAD.
0101.01 *CHANGED
0102.00 COPY MQCPY001 OF FURCOPY.
0103.00 03 MSG-BODY PIC X(3840).
0104.00
0105.00 01 LK-DATA-LENGTH PIC S9(9) BINARY.
0106.00 01 LK-RTNCD PIC X(1).
0107.00
0108.00 ****************************************************************
0109.00 PROCEDURE DIVISION USING
0110.00 LK-BUFFER
0111.00 LK-DATA-LENGTH
0112.00 LK-RTNCD.
0113.00
0114.00 M010-INIT.
0115.00 MOVE "Y" TO LK-RTNCD.
0116.00 PERFORM S-040-GET-MQ-INFO THRU S-040-EXIT.
0117.00 PERFORM S-010-OPEN THRU S-010-EXIT.
0118.00 M020-MAIN.
0119.00 PERFORM S-020-PUT THRU S-020-EXIT.
0120.00 M030-FINISH.
0121.00 PERFORM S-030-CLOSE THRU S-030-EXIT.
0122.00 M040-EXIT.
0123.00 EXIT PROGRAM.
0124.00 STOP RUN.
0125.00
0126.00 ****************************************************************
0127.00 * OPEN QMGR AND QUEUE *
0128.00 ****************************************************************
0129.00 S-010-OPEN.
0130.00 ****************************************************************
0131.00 * MQCONN is implicit on OS/400; use the default *
0132.00 * connection handle for all MQI calls *
0133.00 ****************************************************************
0134.00 MOVE MQHC-DEF-HCONN to HCONN.
0135.00 ****************************************************************
0136.00 * Open the target message queue for output (and fail if *
0137.00 * MQM is quiescing) *
0138.00 ****************************************************************
0139.00 MOVE MESSAGE-QUEUE OF MSG-HEAD-DETAIL TO MQOD-OBJECTNAME.
0140.00 ADD MQOO-OUTPUT MQOO-FAIL-IF-QUIESCING
0141.00 GIVING OPTIONS.
0142.00 CALL "MQOPEN" USING
0143.00 HCONN, OBJECT-DESCRIPTOR,
0144.00 OPTIONS, Q-HANDLE,
0145.00 OPEN-CODE, REASON.
0146.00
0147.00 * report reason, if any; stop if failed
0148.00 IF REASON IS NOT EQUAL TO MQRC-NONE
0149.00 DISPLAY "MQOPEN ended with reason code " REASON
0150.00 DISPLAY "QNAME-->;" MQOD-OBJECTNAME
0151.00 DISPLAY "LK-BUFFER-->;" LK-BUFFER
0152.00 END-IF.
0153.00
0154.00 IF OPEN-CODE IS EQUAL TO MQCC-FAILED
0155.00 MOVE "E" TO LK-RTNCD
0156.00 DISPLAY "unable to open server queue for output"
0157.00 DISPLAY "QNAME-->;" MQOD-OBJECTNAME
0158.00 DISPLAY "LK-BUFFER-->;" LK-BUFFER
0159.00 GO TO M040-EXIT
0160.00 END-IF.
0161.00 S-010-EXIT.
0162.00
0163.00 *****************************************************************
0164.00 * PUT MESSAGE TO QUEUE *
0165.00 *****************************************************************
0166.00 S-020-PUT.
0167.00 MOVE LK-DATA-LENGTH TO WK-MSG-LENGTH.
0168.00 ADD WK-MSG-HEAD-LEN TO WK-MSG-LENGTH.
0169.00 * CALL "ZYMDSYS" USING SEND-DATE
0170.00 * WK-PGM-ID.
0171.00 * ACCEPT SEND-TIME FROM TIME.
0172.00 MOVE OPEN-CODE TO COMPLETION-CODE.
0173.00 * Set format to string so that the msg can be converted
0174.00 MOVE MQFMT-NONE to MQMD-FORMAT
0175.00 CALL "MQPUT" USING
0176.00 HCONN, Q-HANDLE,
0177.00 MESSAGE-DESCRIPTOR, PMOPTIONS,
0178.00 WK-MSG-LENGTH, LK-BUFFER,
0179.00 COMPLETION-CODE, REASON.
0180.00 * report reason, if any
0181.00 IF REASON IS NOT EQUAL TO MQRC-NONE
0182.00 DISPLAY "MQPUT ended with reason code " REASON
0183.00 MOVE "E" TO LK-RTNCD
0184.00 END-IF.
0185.00
0186.00 S-020-EXIT.
0187.00
0188.00 *****************************************************************
0189.00 * CLOSE QUEUE *
0190.00 *****************************************************************
0191.00 S-030-CLOSE.
0192.00 MOVE MQCO-NONE TO OPTIONS.
0193.00 CALL "MQCLOSE" USING
0194.00 HCONN, Q-HANDLE, OPTIONS,
0195.00 COMPLETION-CODE, REASON.
0196.00
0197.00 IF REASON IS NOT EQUAL TO MQRC-NONE
0198.00 DISPLAY "MQCLOSE ended with reason code " REASON
0199.00 END-IF.
0200.00 S-030-EXIT.
0201.00 *****************************************************************
0202.00 * 以作业别获取MQ资料,并写入MESSAGE HEAD
0203.00 *****************************************************************
0204.00 S-040-GET-MQ-INFO.
0205.00 * 作业别代码
0206.00 MOVE JOB-ID OF MSG-HEAD-DETAIL TO WK-JOBID.
0207.00 * 以作业别获取 MESSAGE QUEUE 信息
0207.01 *CHANGED
0208.00 CALL "GETMQINF" USING WK-JOBID
0209.00 WK-OUT-RETCD
0210.00 WK-OUT-PARM.
0211.00 CANCEL "GETMQINF".
0211.01 * CALL "GETMQINF1" USING WK-JOBID
0211.02 * WK-OUT-RETCD
0211.03 * WK-OUT-PARM.
0211.04 * CANCEL "GETMQINF1".
0212.00 IF NOT WK-OUT-RETCD = SPACES
0213.00 DISPLAY " 以作业别获取 MESSAGE QUEUE 信息失败 "
0214.00 MOVE "E" TO LK-RTNCD
0215.00 GO TO M040-EXIT
0216.00 END-IF.
0217.00 * 将MQ信息写入MESSAGE HEAD
0218.00 * 作业别代码
0219.00 MOVE OUT-JOBID TO JOB-ID OF MSG-HEAD-DETAIL.
0222.00 * MQ-MGR
0223.00 MOVE OUT-QMGR TO SOURCE-QMGR OF MSG-HEAD-DETAIL.
0224.00 * MQ-名称
0225.00 MOVE OUT-QNAME TO MESSAGE-QUEUE OF MSG-HEAD-DETAIL.
0238.00 S-040-EXIT.
复制代码
作者:
zzzddd
时间:
2005-07-19 17:43
标题:
谁会用Cobol调用MQSeries
其实应该看看SAMPLE程序,国鹏的干扰部分太多,容易混淆视听!
作者:
xuguopeng
时间:
2005-07-19 17:58
标题:
谁会用Cobol调用MQSeries
恩 如果装了SAMPLE LIB的话可以看看里面的SRC
在QMQMSAMP下
作者:
ck2000
时间:
2005-07-25 14:57
提示:
作者被禁止或删除 内容自动屏蔽
作者:
xuguopeng
时间:
2005-07-25 17:26
标题:
谁会用Cobol调用MQSeries
没用过OS390。。。
作者:
ck2000
时间:
2005-07-26 10:23
提示:
作者被禁止或删除 内容自动屏蔽
作者:
ck2000
时间:
2005-07-26 10:29
提示:
作者被禁止或删除 内容自动屏蔽
作者:
zzzddd
时间:
2005-07-26 10:34
标题:
谁会用Cobol调用MQSeries
其实有许多东西都是格式化的,如果采用多个option的话,就是把option代表的值相加!
欢迎光临 Chinaunix (http://bbs.chinaunix.net/)
Powered by Discuz! X3.2