333 lines
15 KiB
HTML
333 lines
15 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: Retrieve exit point and exit program information" />
|
||
|
|
<meta name="abstract" content="This program retrieves exit point and exit program information. After retrieving the exit point information, the program calls each exit program. The Retrieve Exit Information API returns a continuation handle when it has more information to return than what fits in the receiver variable." />
|
||
|
|
<meta name="description" content="This program retrieves exit point and exit program information. After retrieving the exit point information, the program calls each exit program. The Retrieve Exit Information API returns a continuation handle when it has more information to return than what fits in the receiver variable." />
|
||
|
|
<meta name="DC.Relation" scheme="URI" content="ileScenario.htm" />
|
||
|
|
<meta name="DC.Relation" scheme="URI" content="conContinuation.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="ileRetrieveILECOBOL" />
|
||
|
|
<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: Retrieve exit point and exit program information</title>
|
||
|
|
</head>
|
||
|
|
<body id="ileRetrieveILECOBOL"><a name="ileRetrieveILECOBOL"><!-- --></a>
|
||
|
|
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
|
||
|
|
<h1 class="topictitle1">Example in ILE COBOL: Retrieve exit point and exit program information</h1>
|
||
|
|
<div><p>This program retrieves exit point and exit program information.
|
||
|
|
After retrieving the exit point information, the program calls each exit
|
||
|
|
program. The Retrieve Exit Information API returns a continuation handle when
|
||
|
|
it has more information to return than what fits in the receiver variable.</p>
|
||
|
|
<div class="section"><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: Retrieve Exit Point and Exit Program Information
|
||
|
|
*
|
||
|
|
* Language: ILE COBOL
|
||
|
|
*
|
||
|
|
* Description: This program retrieves exit point and exit
|
||
|
|
* program information. After retrieving the
|
||
|
|
* exit point information, the program calls each
|
||
|
|
* exit program.
|
||
|
|
*
|
||
|
|
* APIs Used: QUSCRTUS - Create User Space
|
||
|
|
* QUSPTRUS - Retrieve Pointer to User Space
|
||
|
|
* QusRetrieveExitInformation - Retrieve Exit
|
||
|
|
* Information
|
||
|
|
*
|
||
|
|
***************************************************************
|
||
|
|
***************************************************************
|
||
|
|
*
|
||
|
|
PROGRAM-ID. REGFAC2.
|
||
|
|
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. As this sample program
|
||
|
|
* uses COPY to include the error code structure, only the first
|
||
|
|
* 16 bytes of the error code structure are available. If the
|
||
|
|
* application program needs to access the variable length
|
||
|
|
* exception data for the error, the developer should physically
|
||
|
|
* copy the QSYSINC include and modify the copied include to
|
||
|
|
* define additional storage for the exception data.
|
||
|
|
*
|
||
|
|
COPY QUSEC OF QSYSINC-QLBLSRC.
|
||
|
|
*
|
||
|
|
* Error message text
|
||
|
|
*
|
||
|
|
01 BAD-EXIT-POINT.
|
||
|
|
05 TEXT1 PIC X(40)
|
||
|
|
VALUE "Attempt to retrieve information failed: ".
|
||
|
|
05 EXCEPTION-ID PIC X(07).
|
||
|
|
01 BAD-EXIT-PGM.
|
||
|
|
05 TEXT1 PIC X(42)
|
||
|
|
VALUE "Attempt to retrieve Exit Programs failed: ".
|
||
|
|
05 EXCEPTION-ID PIC X(07).
|
||
|
|
01 BAD-CREATE.
|
||
|
|
05 TEXT1 PIC X(37)
|
||
|
|
VALUE "Allocation of RCVVAR storage failed: ".
|
||
|
|
05 EXCEPTION-ID PIC X(07).
|
||
|
|
*
|
||
|
|
* Miscellaneous elements
|
||
|
|
*
|
||
|
|
01 MISC.
|
||
|
|
05 EXIT-POINT-NAME PIC X(20) VALUE "EXAMPLE_EXIT_POINT".
|
||
|
|
05 EXIT-PGM-NBR PIC S9(09) VALUE -1 BINARY.
|
||
|
|
05 EXIT-PARAMETERS PIC X(10).
|
||
|
|
05 FORMAT-NAME PIC X(08) VALUE "EXTI0100".
|
||
|
|
05 FORMAT-NAME-1 PIC X(08) VALUE "EXTI0200".
|
||
|
|
05 FORMAT-NAME-2 PIC X(08) VALUE "EXMP0100".
|
||
|
|
05 NBR-OF-SELECT-CRITERIA PIC S9(09) VALUE 0 BINARY.
|
||
|
|
05 CONTINUATION-HDL PIC X(16).
|
||
|
|
05 BASE-POINTER POINTER.
|
||
|
|
05 INFO-POINTER POINTER.
|
||
|
|
05 SPACE-NAME PIC X(20) VALUE "RCVVAR QTEMP ".
|
||
|
|
05 SPACE-ATTR PIC X(10).
|
||
|
|
05 SPACE-SIZE PIC S9(09) VALUE 3500 BINARY.
|
||
|
|
05 SPACE-VALUE PIC X(01) VALUE X"00".
|
||
|
|
05 SPACE-AUTH PIC X(10) VALUE "*USE".
|
||
|
|
05 SPACE-TEXT PIC X(50).
|
||
|
|
05 SPACE-REPLACE PIC X(10) VALUE "*NO".
|
||
|
|
05 SPACE-DOMAIN PIC X(10) VALUE "*USER".
|
||
|
|
*
|
||
|
|
LINKAGE SECTION.
|
||
|
|
*
|
||
|
|
* Variable to hold results of QusRetrieveExitInformation. The
|
||
|
|
* storage for this variable will be allocated by way of a User
|
||
|
|
* Space.
|
||
|
|
*
|
||
|
|
01 RCVVAR PIC X(3500).
|
||
|
|
*
|
||
|
|
* Registration Facility API include. These includes will be
|
||
|
|
* mapped over the RCVVAR (User Space) previously defined.
|
||
|
|
*
|
||
|
|
COPY QUSREG OF QSYSINC-QLBLSRC.
|
||
|
|
*
|
||
|
|
* Beginning of mainline
|
||
|
|
*
|
||
|
|
PROCEDURE DIVISION.
|
||
|
|
MAIN-LINE.
|
||
|
|
*
|
||
|
|
* Retrieve the exit point information first. If the current
|
||
|
|
* number of exit programs is not zero, retrieve the exit
|
||
|
|
* programs. It is not necessary to call for the exit point
|
||
|
|
* information to determine if the exit point has any exit
|
||
|
|
* programs. It is done here for illustrative purposes only.
|
||
|
|
* You can make one call to the API for the exit program
|
||
|
|
* information and check the number of exit program entries
|
||
|
|
* returned field to see if there are any exit programs to call.
|
||
|
|
*
|
||
|
|
* Initialize the error code to inform the API that all
|
||
|
|
* exceptions should be returned through the error code parameter.
|
||
|
|
*
|
||
|
|
MOVE 16 TO BYTES-PROVIDED OF QUS-EC.
|
||
|
|
*
|
||
|
|
* Create a User Space for RCVVAR.
|
||
|
|
*
|
||
|
|
CALL "QUSCRTUS" USING SPACE-NAME, SPACE-ATTR, SPACE-SIZE,
|
||
|
|
SPACE-VALUE, SPACE-AUTH, SPACE-TEXT,
|
||
|
|
SPACE-REPLACE, QUS-EC, SPACE-DOMAIN.
|
||
|
|
*
|
||
|
|
* 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 OF QUS-EC > 0
|
||
|
|
IF EXCEPTION-ID OF QUS-EC = "CPF9870"
|
||
|
|
CONTINUE
|
||
|
|
ELSE
|
||
|
|
OPEN OUTPUT LISTING,
|
||
|
|
MOVE EXCEPTION-ID OF QUS-EC
|
||
|
|
TO EXCEPTION-ID OF BAD-CREATE,
|
||
|
|
WRITE LIST-LINE FROM BAD-CREATE,
|
||
|
|
STOP RUN.
|
||
|
|
*
|
||
|
|
* Assign BASE-POINTER to address RCVVAR
|
||
|
|
*
|
||
|
|
CALL "QUSPTRUS" USING SPACE-NAME, BASE-POINTER, 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 OF QUS-EC > 0
|
||
|
|
OPEN OUTPUT LISTING,
|
||
|
|
MOVE EXCEPTION-ID OF QUS-EC
|
||
|
|
TO EXCEPTION-ID OF BAD-CREATE,
|
||
|
|
WRITE LIST-LINE FROM BAD-CREATE,
|
||
|
|
STOP RUN.
|
||
|
|
*
|
||
|
|
SET ADDRESS OF RCVVAR TO BASE-POINTER.
|
||
|
|
*
|
||
|
|
* Blank out the continuation handle to let the API know that this
|
||
|
|
* is a first attempt at the retrieve operation.
|
||
|
|
*
|
||
|
|
MOVE SPACES TO CONTINUATION-HDL.
|
||
|
|
*
|
||
|
|
* Call the API to retrieve the exit programs
|
||
|
|
*
|
||
|
|
CALL PROCEDURE "QusRetrieveExitInformation" USING
|
||
|
|
CONTINUATION-HDL,
|
||
|
|
RCVVAR,
|
||
|
|
BY CONTENT LENGTH OF RCVVAR,
|
||
|
|
FORMAT-NAME OF MISC,
|
||
|
|
EXIT-POINT-NAME OF MISC,
|
||
|
|
FORMAT-NAME-2, EXIT-PGM-NBR,
|
||
|
|
NBR-OF-SELECT-CRITERIA, 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 OF QUS-EC > 0
|
||
|
|
OPEN OUTPUT LISTING,
|
||
|
|
MOVE EXCEPTION-ID OF QUS-EC
|
||
|
|
TO EXCEPTION-ID OF BAD-EXIT-POINT,
|
||
|
|
WRITE LIST-LINE FROM BAD-EXIT-POINT,
|
||
|
|
STOP RUN.
|
||
|
|
*
|
||
|
|
* If the call to retrieve exit point information is successful,
|
||
|
|
* check to see if there are any exit programs to call.
|
||
|
|
*
|
||
|
|
SET ADDRESS OF QUS-EXTI0100 TO BASE-POINTER.
|
||
|
|
SET ADDRESS OF QUS-EXTI0200 TO BASE-POINTER.
|
||
|
|
*
|
||
|
|
IF NUMBER-POINTS-RETURNED OF QUS-EXTI0100 > 0
|
||
|
|
SET ADDRESS OF QUS-EXTI0100-ENTRY TO
|
||
|
|
ADDRESS OF RCVVAR((OFFSET-EXIT-POINT-ENTRY OF
|
||
|
|
QUS-EXTI0100 + 1):)
|
||
|
|
ELSE STOP RUN.
|
||
|
|
*
|
||
|
|
IF NUMBER-EXIT-PROGRAMS OF QUS-EXTI0100-ENTRY > 0
|
||
|
|
*
|
||
|
|
* There are some exit programs to call. Blank out the continuation
|
||
|
|
* handle to let the API know that this is a first attempt at the
|
||
|
|
* retrieve operation.
|
||
|
|
*
|
||
|
|
MOVE SPACES TO CONTINUATION-HDL,
|
||
|
|
*
|
||
|
|
* Call the exit programs
|
||
|
|
*
|
||
|
|
PERFORM CALL-EXIT-PROGRAMS,
|
||
|
|
*
|
||
|
|
* If the continuation handle field in the receiver variable is
|
||
|
|
* not set to blanks, the API has more information to return than
|
||
|
|
* what could fit in the receiver variable. Call the API for
|
||
|
|
* more exit programs to call.
|
||
|
|
*
|
||
|
|
PERFORM UNTIL CONTINUE-HANDLE OF QUS-EXTI0200 = SPACES
|
||
|
|
MOVE CONTINUE-HANDLE OF QUS-EXTI0200
|
||
|
|
TO CONTINUATION-HDL,
|
||
|
|
PERFORM CALL-EXIT-PROGRAMS,
|
||
|
|
END-PERFORM.
|
||
|
|
*
|
||
|
|
STOP RUN.
|
||
|
|
*
|
||
|
|
* End of MAINLINE
|
||
|
|
*
|
||
|
|
*
|
||
|
|
* Process exit programs in receiver variable
|
||
|
|
*
|
||
|
|
CALL-EXIT-PROGRAMS.
|
||
|
|
*
|
||
|
|
* Call the API to retrieve the exit program information
|
||
|
|
*
|
||
|
|
CALL PROCEDURE "QusRetrieveExitInformation" USING
|
||
|
|
CONTINUATION-HDL, RCVVAR,
|
||
|
|
BY CONTENT LENGTH OF RCVVAR,
|
||
|
|
FORMAT-NAME-1,
|
||
|
|
EXIT-POINT-NAME OF MISC,
|
||
|
|
FORMAT-NAME-2, EXIT-PGM-NBR,
|
||
|
|
NBR-OF-SELECT-CRITERIA, 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 OF QUS-EC > 0
|
||
|
|
OPEN OUTPUT LISTING,
|
||
|
|
MOVE EXCEPTION-ID OF QUS-EC
|
||
|
|
TO EXCEPTION-ID OF BAD-EXIT-PGM,
|
||
|
|
WRITE LIST-LINE FROM BAD-EXIT-PGM,
|
||
|
|
STOP RUN.
|
||
|
|
*
|
||
|
|
* If the call to retrieve exit program information is successful,
|
||
|
|
* check to see if there are any exit programs to call.
|
||
|
|
*
|
||
|
|
* The receiver variable offers enough room for a minimum of one
|
||
|
|
* exit program entry because the receiver variable was declared
|
||
|
|
* as 3500 bytes. Therefore, this example only checks the
|
||
|
|
* number of exit programs returned field. If the receiver
|
||
|
|
* variable were not large enough to hold at least one entry,
|
||
|
|
* the bytes available field would need to be checked as well as
|
||
|
|
* the number of exit programs returned field. If the number of
|
||
|
|
* exit programs returned field is set to zero and the bytes
|
||
|
|
* available field is greater than the bytes returned field, the
|
||
|
|
* API had at least one exit program entry to return but was
|
||
|
|
* unable to because the receiver variable was too small.
|
||
|
|
*
|
||
|
|
SET ADDRESS OF QUS-EXTI0200-ENTRY
|
||
|
|
TO ADDRESS OF RCVVAR(OFFSET-PROGRAM-ENTRY
|
||
|
|
OF QUS-EXTI0200 + 1:).
|
||
|
|
PERFORM CALL-PGMS
|
||
|
|
NUMBER-PROGRAMS-RETURNED OF QUS-EXTI0200 TIMES.
|
||
|
|
*
|
||
|
|
CALL-PGMS.
|
||
|
|
*
|
||
|
|
* Call the exit program while ignoring failures on the call
|
||
|
|
*
|
||
|
|
CALL PROGRAM-NAME OF QUS-EXTI0200-ENTRY USING
|
||
|
|
EXIT-PARAMETERS
|
||
|
|
ON EXCEPTION CONTINUE.
|
||
|
|
*
|
||
|
|
* Address the next exit program entry
|
||
|
|
*
|
||
|
|
SET ADDRESS OF QUS-EXTI0200-ENTRY
|
||
|
|
TO ADDRESS OF RCVVAR(OFFSET-NEXT-ENTRY
|
||
|
|
OF QUS-EXTI0200-ENTRY + 1:).</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div>
|
||
|
|
<div class="familylinks">
|
||
|
|
<div class="parentlink"><strong>Parent topic:</strong> <a href="ileScenario.htm" title="The example APIs in this section represent two general functions of APIs--change and retrieve.">Scenario: Integrated Language Environment (ILE) APIs</a></div>
|
||
|
|
</div>
|
||
|
|
<div class="reltasks"><strong>Related tasks</strong><br />
|
||
|
|
<div><a href="conContinuation.htm" title="Some APIs that return information offer a continuation handle.">Continuation handle</a></div>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
</body>
|
||
|
|
</html>
|