232 lines
9.8 KiB
HTML
232 lines
9.8 KiB
HTML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE html
|
|
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|
<html lang="en-us" xml:lang="en-us">
|
|
<head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
|
<meta name="security" content="public" />
|
|
<meta name="Robots" content="index,follow" />
|
|
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
|
|
<meta name="DC.Type" content="reference" />
|
|
<meta name="DC.Title" content="Example in ILE COBOL: Data queue" />
|
|
<meta name="abstract" content="This program illustrates how to use APIs to create and manipulate a *DTAQ. The following program also works with OPM COBOL." />
|
|
<meta name="description" content="This program illustrates how to use APIs to create and manipulate a *DTAQ. The following program also works with OPM COBOL." />
|
|
<meta name="DC.Relation" scheme="URI" content="ExTaskDataque.htm" />
|
|
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
|
|
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1998, 2006" />
|
|
<meta name="DC.Format" content="XHTML" />
|
|
<meta name="DC.Identifier" content="exdqilecobol" />
|
|
<meta name="DC.Language" content="en-us" />
|
|
<!-- All rights reserved. Licensed Materials Property of IBM -->
|
|
<!-- US Government Users Restricted Rights -->
|
|
<!-- Use, duplication or disclosure restricted by -->
|
|
<!-- GSA ADP Schedule Contract with IBM Corp. -->
|
|
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
|
|
<link rel="stylesheet" type="text/css" href="./ic.css" />
|
|
<title>Example in ILE COBOL: Data queue</title>
|
|
</head>
|
|
<body id="exdqilecobol"><a name="exdqilecobol"><!-- --></a>
|
|
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
|
|
<h1 class="topictitle1">Example in ILE COBOL: Data queue</h1>
|
|
<div><p>This program illustrates how to use APIs to create and manipulate
|
|
a *DTAQ. The following program also works with OPM COBOL.</p>
|
|
<div class="section" id="exdqilecobol__HDRDQ1"><a name="exdqilecobol__HDRDQ1"><!-- --></a><p>Refer to <a href="exdqilec.htm">Example in ILE C: Data queue</a> for
|
|
the original example.</p>
|
|
<div class="note"><span class="notetitle">Note:</span> Read the <a href="codedisclaimer.htm">Code license and disclaimer information</a> for
|
|
important legal information.</div>
|
|
<pre> IDENTIFICATION DIVISION.
|
|
***************************************************************
|
|
***************************************************************
|
|
*
|
|
* Program Name: DQUEUEX
|
|
*
|
|
* Programming Language: COBOL
|
|
*
|
|
* Description: This program illustrates how to use APIs to
|
|
* create and manipulate a *DTAQ.
|
|
*
|
|
* Header Files Included: QUSEC - Error Code Parameter
|
|
* QCAPCMD - Process Command API
|
|
*
|
|
***************************************************************
|
|
*
|
|
***************************************************************
|
|
PROGRAM-ID. DQUEUEX.
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
SOURCE-COMPUTER. IBM-AS400.
|
|
OBJECT-COMPUTER. IBM-AS400.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT LISTING ASSIGN TO PRINTER-QPRINT
|
|
ORGANIZATION IS SEQUENTIAL.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD LISTING RECORD CONTAINS 132 CHARACTERS
|
|
LABEL RECORDS ARE STANDARD
|
|
DATA RECORD IS LIST-LINE.
|
|
01 LIST-LINE PIC X(132).
|
|
WORKING-STORAGE SECTION.
|
|
*
|
|
* Error Code parameter include
|
|
*
|
|
COPY QUSEC OF QSYSINC-QLBLSRC.
|
|
*
|
|
* Process Command API Include
|
|
*
|
|
COPY QCAPCMD OF QSYSINC-QLBLSRC.
|
|
*
|
|
* Command strings
|
|
*
|
|
01 CRTLIB PIC X(50) VALUE "CRTLIB QUEUELIB".
|
|
01 DLTLIB PIC X(50) VALUE "DLTLIB QUEUELIB".
|
|
01 CRTDQ PIC X(50)
|
|
VALUE "CRTDTAQ QUEUELIB/EXAMPLEQ MAXLEN(10)".
|
|
01 DLTDQ PIC X(50) VALUE "DLTDTAQ QUEUELIB/EXAMPLEQ".
|
|
*
|
|
* Error message text
|
|
*
|
|
01 BAD-NEWS.
|
|
05 TEXT1 PIC X(14) VALUE "Failed in API ".
|
|
05 API-NAME PIC X(10) VALUE "QCAPCMD".
|
|
05 TEXT2 PIC X(11) VALUE "with error ".
|
|
05 EXCEPTION-ID PIC X(07).
|
|
*
|
|
* Miscellaneous elements
|
|
*
|
|
01 COMMAND-LENGTH PIC S9(09) VALUE 50 BINARY.
|
|
01 RECEIVER PIC X(01).
|
|
01 RECEIVER-LENGTH PIC S9(09) VALUE 0 BINARY.
|
|
01 OPTIONS-SIZE PIC S9(09) VALUE 20 BINARY.
|
|
01 FORMAT-NAME PIC X(08) VALUE "CPOP0100".
|
|
01 FIRST-ERROR PIC X(01) VALUE "0".
|
|
01 NAME-OF-QUEUE PIC X(10) VALUE "EXAMPLEQ".
|
|
01 NAME-OF-LIBRARY PIC X(10) VALUE "QUEUELIB".
|
|
01 SIZE-OF-MSG PIC S9(05) VALUE 10 PACKED-DECIMAL.
|
|
01 WAIT-TIME PIC S9(05) VALUE 0 PACKED-DECIMAL.
|
|
01 MSG PIC X(10) VALUE "EXAMPLE".
|
|
01 MSG-BACK PIC X(10).
|
|
*
|
|
* Beginning of mainline
|
|
*
|
|
PROCEDURE DIVISION.
|
|
MAIN-LINE.
|
|
*
|
|
* Initialize the error code parameter. To signal exceptions to
|
|
* this program by the API, you need to set the bytes provided
|
|
* field of the error code to zero. Because this program has
|
|
* exceptions sent back through the error code parameter, it sets
|
|
* the bytes provided field to the number of bytes it gives the
|
|
* API for the parameter.
|
|
*
|
|
MOVE 16 TO BYTES-PROVIDED.
|
|
*
|
|
* Initialize QCAPCMD options control block for CL processing
|
|
*
|
|
MOVE 0 TO COMMAND-PROCESS-TYPE.
|
|
MOVE "0" TO DBCS-DATA-HANDLING.
|
|
MOVE "0" TO PROMPTER-ACTION.
|
|
MOVE "0" TO COMMAND-STRING-SYNTAX.
|
|
MOVE SPACES TO MESSAGE-KEY.
|
|
MOVE LOW-VALUES TO RESERVED OF QCA-PCMD-CPOP0100.
|
|
*
|
|
* Create library QUEUELIB
|
|
*
|
|
CALL QCAPCMD USING CRTLIB, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
|
|
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
|
|
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
|
|
*
|
|
* If an exception occurs, the API returns the exception in the
|
|
* error code parameter. The bytes available field is set to
|
|
* zero if no exception occurs and greater than zero if an
|
|
* exception does occur.
|
|
*
|
|
*
|
|
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
|
|
*
|
|
* Create a data queue called EXAMPLEQ in library QUEUELIB. The
|
|
* queue will have a maximum entry length set at 10, and will be
|
|
* FIFO (first-in first-out).
|
|
*
|
|
CALL QCAPCMD USING CRTDQ, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
|
|
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
|
|
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
|
|
*
|
|
* If an exception occurs, the API returns the exception in the
|
|
* error code parameter. The bytes available field is set to
|
|
* zero if no exception occurs and greater than zero if an
|
|
* exception does occur.
|
|
*
|
|
*
|
|
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
|
|
*
|
|
* Send information to the data queue.
|
|
*
|
|
CALL "QSNDDTAQ" USING NAME-OF-QUEUE, NAME-OF-LIBRARY,
|
|
SIZE-OF-MSG, MSG.
|
|
*
|
|
* Retrieve information from the data queue.
|
|
*
|
|
CALL "QRCVDTAQ" USING NAME-OF-QUEUE, NAME-OF-LIBRARY,
|
|
SIZE-OF-MSG, MSG-BACK, WAIT-TIME.
|
|
*
|
|
* Display the returned message
|
|
*
|
|
DISPLAY MSG-BACK.
|
|
*
|
|
* Delete the data queue
|
|
*
|
|
CALL QCAPCMD USING DLTDQ, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
|
|
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
|
|
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
|
|
*
|
|
* If an exception occurs, the API returns the exception in the
|
|
* error code parameter. The bytes available field is set to
|
|
* zero if no exception occurs and greater than zero if an
|
|
* exception does occur.
|
|
*
|
|
*
|
|
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
|
|
*
|
|
* Delete the library
|
|
*
|
|
CALL QCAPCMD USING DLTLIB, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
|
|
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
|
|
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
|
|
*
|
|
* If an exception occurs, the API returns the exception in the
|
|
* error code parameter. The bytes available field is set to
|
|
* zero if no exception occurs and greater than zero if an
|
|
* exception does occur.
|
|
*
|
|
*
|
|
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
|
|
*
|
|
STOP RUN.
|
|
*
|
|
* End of MAINLINE
|
|
*
|
|
*****************************************************************
|
|
*
|
|
ERROR-FOUND.
|
|
*
|
|
* Process errors returned from the API.
|
|
*
|
|
* If first error found, then open QPRINT *PRTF
|
|
*
|
|
IF FIRST-ERROR = "0" OPEN OUTPUT LISTING,
|
|
MOVE "1" TO FIRST-ERROR.
|
|
*
|
|
* Print the error and the API that received the error
|
|
*
|
|
MOVE EXCEPTION-ID OF QUS-EC TO EXCEPTION-ID OF BAD-NEWS.
|
|
WRITE LIST-LINE FROM BAD-NEWS.</pre>
|
|
</div>
|
|
</div>
|
|
<div>
|
|
<div class="familylinks">
|
|
<div class="parentlink"><strong>Parent topic:</strong> <a href="ExTaskDataque.htm" title="Data queues and user queues both provide a means for one or more processes to communicate asynchronously. The queues can be processed FIFO (first-in first-out), LIFO (last-in first-out), or by key.">Examples: Using data queues or user queues</a></div>
|
|
</div>
|
|
</div>
|
|
</body>
|
|
</html> |