293 lines
14 KiB
HTML
293 lines
14 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: Using keys with List Spooled Files API" />
|
||
|
|
<meta name="abstract" content="This example shows the steps necessary to process keyed output from an API." />
|
||
|
|
<meta name="description" content="This example shows the steps necessary to process keyed output from an API." />
|
||
|
|
<meta name="DC.Relation" scheme="URI" content="opmScenario.htm" />
|
||
|
|
<meta name="DC.Relation" scheme="URI" content="cmnKeysRPG.htm" />
|
||
|
|
<meta name="DC.Relation" scheme="URI" content="cmnKeysRPG.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="cmnKeysCOBOL" />
|
||
|
|
<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: Using keys with List Spooled Files API</title>
|
||
|
|
</head>
|
||
|
|
<body id="cmnKeysCOBOL"><a name="cmnKeysCOBOL"><!-- --></a>
|
||
|
|
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
|
||
|
|
<h1 class="topictitle1">Example in ILE COBOL: Using keys with List Spooled Files API</h1>
|
||
|
|
<div><p>This example shows the steps necessary to process
|
||
|
|
keyed output from an API.</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>
|
||
|
|
<p>Refer to Example in OPM RPG: Using keys with List
|
||
|
|
Spooled Files API for the original example. The following program also works
|
||
|
|
for OPM COBOL.</p>
|
||
|
|
<pre> IDENTIFICATION DIVISION.
|
||
|
|
***************************************************************
|
||
|
|
***************************************************************
|
||
|
|
*
|
||
|
|
* Program: List Spooled Files for Current User
|
||
|
|
*
|
||
|
|
* Language: ILE COBOL
|
||
|
|
*
|
||
|
|
* Description: This example shows the steps necessary to
|
||
|
|
* process keyed output from an API.
|
||
|
|
*
|
||
|
|
* APIs Used: QUSLSPL - List Spooled Files
|
||
|
|
* QUSCRTUS - Create User Space
|
||
|
|
* QUSPTRUS - Retrieve Pointer to User Space
|
||
|
|
*
|
||
|
|
***************************************************************
|
||
|
|
***************************************************************
|
||
|
|
*
|
||
|
|
PROGRAM-ID. LSTSPL.
|
||
|
|
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.
|
||
|
|
*
|
||
|
|
* Listing text
|
||
|
|
*
|
||
|
|
01 PRTLIN.
|
||
|
|
05 PRTFIL PIC X(10).
|
||
|
|
05 FILLER PIC X(05).
|
||
|
|
05 PAGES PIC S9(09).
|
||
|
|
05 FILLER PIC X(05).
|
||
|
|
05 OPNDAT PIC X(07).
|
||
|
|
01 LSTERR.
|
||
|
|
05 TEXT1 PIC X(22) VALUE "List data not valid".
|
||
|
|
01 HDRERR.
|
||
|
|
05 TEXT2 PIC X(22) VALUE "Unknown Generic Header".
|
||
|
|
*
|
||
|
|
01 MISC.
|
||
|
|
05 SPC-NAME PIC X(20) VALUE "SPCNAME QTEMP ".
|
||
|
|
05 SPC-SIZE PIC S9(09) VALUE 2000 BINARY. <span class="uicontrol">(2)</span>
|
||
|
|
05 SPC-INIT PIC X(01) VALUE X"00".
|
||
|
|
05 SPCPTR POINTER.
|
||
|
|
05 SPC-TYPE PIC X(10) VALUE "*USRSPC".
|
||
|
|
05 EXT-ATTR PIC X(10) VALUE "QUSLSPL ". <span class="uicontrol">(3)</span>
|
||
|
|
05 SPC-AUT PIC X(10) VALUE "*ALL".
|
||
|
|
05 SPC-TEXT PIC X(50).
|
||
|
|
05 SPC-REPLAC PIC X(10) VALUE "*YES".
|
||
|
|
05 SPC-DOMAIN PIC X(10) VALUE "*USER".
|
||
|
|
05 LST-FORMAT-NAME PIC X(08) VALUE "SPLF0200". <span class="uicontrol">(4)</span>
|
||
|
|
05 USR-PRF PIC X(10) VALUE "*CURRENT ".
|
||
|
|
05 OUTQ PIC X(20) VALUE "*ALL".
|
||
|
|
05 FORMTYP PIC X(10) VALUE "*ALL".
|
||
|
|
05 USRDTA PIC X(10) VALUE "*ALL".
|
||
|
|
05 JOBNAM PIC X(26).
|
||
|
|
01 KEYS. <span class="uicontrol">(7)</span>
|
||
|
|
05 KEY1 PIC S9(09) BINARY VALUE 201. <span class="uicontrol">(8)</span>
|
||
|
|
05 KEY2 PIC S9(09) BINARY VALUE 216.
|
||
|
|
05 KEY3 PIC S9(09) BINARY VALUE 211.
|
||
|
|
01 NUMBER-OF-KEYS PIC S9(09) BINARY VALUE 3.
|
||
|
|
01 MISC2.
|
||
|
|
05 PAGESA PIC X(04).
|
||
|
|
05 PAGESN REDEFINES PAGESA
|
||
|
|
PIC S9(09) BINARY.
|
||
|
|
*
|
||
|
|
LINKAGE SECTION.
|
||
|
|
*
|
||
|
|
* String to map User Space offsets into
|
||
|
|
*
|
||
|
|
01 STRING-SPACE PIC X(32000).
|
||
|
|
*
|
||
|
|
* User Space Generic Header include. These includes will be
|
||
|
|
* mapped over a User Space.
|
||
|
|
*
|
||
|
|
COPY QUSGEN OF QSYSINC-QLBLSRC. <span class="uicontrol">(11)</span>
|
||
|
|
*
|
||
|
|
* List Spool Files API include. These includes will be
|
||
|
|
* mapped over a User Space. The include is copied into the
|
||
|
|
* source so that we can define the variable length portion
|
||
|
|
* of QUS-LSPL-KEY-INFO.
|
||
|
|
*
|
||
|
|
01 QUS-LSPL-KEY-INFO.
|
||
|
|
05 LEN-FIELD-INFO-RETD PIC S9(00009) BINARY.
|
||
|
|
05 KEY-FIELD-FOR-FIELD-RETD PIC S9(00009) BINARY.
|
||
|
|
05 TYPE-OF-DATA PIC X(00001).
|
||
|
|
05 RESERV3 PIC X(00003).
|
||
|
|
05 DATA-LENGTH PIC S9(00009) BINARY.
|
||
|
|
05 DATA-FIELD PIC X(00100).
|
||
|
|
*
|
||
|
|
* Varying length
|
||
|
|
* 05 RESERVED PIC X(00001).
|
||
|
|
*
|
||
|
|
* Varying length
|
||
|
|
01 QUS-SPLF0200.
|
||
|
|
05 NUM-FIELDS-RETD PIC S9(00009) BINARY.
|
||
|
|
05 KEY-INFO.
|
||
|
|
09 LEN-FIELD-INFO-RETD PIC S9(00009) BINARY.
|
||
|
|
09 KEY-FIELD-FOR-FIELD-RETD PIC S9(00009) BINARY.
|
||
|
|
09 TYPE-OF-DATA PIC X(00001).
|
||
|
|
09 RESERV3 PIC X(00003).
|
||
|
|
09 DATA-LENGTH PIC S9(00009) BINARY.
|
||
|
|
09 DATA-FIELD PIC X(00001).
|
||
|
|
09 RESERVED PIC X(00001).
|
||
|
|
*
|
||
|
|
* Varying length
|
||
|
|
*
|
||
|
|
*
|
||
|
|
* Beginning of mainline
|
||
|
|
*
|
||
|
|
PROCEDURE DIVISION.
|
||
|
|
MAIN-LINE.
|
||
|
|
*
|
||
|
|
* Open LISTING file
|
||
|
|
*
|
||
|
|
OPEN OUTPUT LISTING.
|
||
|
|
*
|
||
|
|
* Set Error Code structure to use exceptions
|
||
|
|
*
|
||
|
|
MOVE 0 TO BYTES-PROVIDED OF QUS-EC. <span class="uicontrol">(1)</span>
|
||
|
|
*
|
||
|
|
* Create a User Space for the List generated by QUSLSPL
|
||
|
|
*
|
||
|
|
CALL "QUSCRTUS" USING SPC-NAME, EXT-ATTR, SPC-SIZE, <span class="uicontrol">(2)</span>
|
||
|
|
SPC-INIT, SPC-AUT, SPC-TEXT,
|
||
|
|
SPC-REPLAC, QUS-EC, SPC-DOMAIN
|
||
|
|
*
|
||
|
|
* Call QUSLSPL to get all spooled files for *CURRENT user
|
||
|
|
*
|
||
|
|
CALL "QUSLSPL" USING SPC-NAME, LST-FORMAT-NAME, USR-PRF, <span class="uicontrol">(3)</span> <span class="uicontrol">(4)</span>
|
||
|
|
OUTQ, FORMTYP, USRDTA, QUS-EC,
|
||
|
|
JOBNAM, KEYS, NUMBER-OF-KEYS. <span class="uicontrol">(5)</span> <span class="uicontrol">(6)</span>
|
||
|
|
*
|
||
|
|
* Get a resolved pointer to the User Space for performance
|
||
|
|
*
|
||
|
|
CALL "QUSPTRUS" USING SPC-NAME, SPCPTR, QUS-EC. <span class="uicontrol">(9)</span>
|
||
|
|
*
|
||
|
|
* If valid information was returned
|
||
|
|
*
|
||
|
|
SET ADDRESS OF QUS-GENERIC-HEADER-0100 TO SPCPTR.
|
||
|
|
|
||
|
|
IF STRUCTURE-RELEASE-LEVEL OF QUS-GENERIC-HEADER-0100 <span class="uicontrol">(12)</span>
|
||
|
|
NOT EQUAL "0100" WRITE LIST-LINE FROM HDRERR, <span class="uicontrol">(13)</span>
|
||
|
|
STOP RUN.
|
||
|
|
|
||
|
|
IF (INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100 = "C" <span class="uicontrol">(14)</span>
|
||
|
|
OR INFORMATION-STATUS OF QUS-GENERIC-HEADER-0100 = "P")
|
||
|
|
AND NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100 > 0 <span class="uicontrol">(16)</span>
|
||
|
|
*
|
||
|
|
* address current list entry
|
||
|
|
*
|
||
|
|
|
||
|
|
SET ADDRESS OF STRING-SPACE TO SPCPTR,
|
||
|
|
|
||
|
|
SET ADDRESS OF QUS-SPLF0200 TO
|
||
|
|
ADDRESS OF STRING-SPACE((OFFSET-LIST-DATA
|
||
|
|
OF QUS-GENERIC-HEADER-0100 + 1):1), <span class="uicontrol">(18)</span>
|
||
|
|
*
|
||
|
|
* and process all of the entries
|
||
|
|
*
|
||
|
|
PERFORM PROCES
|
||
|
|
NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100 TIMES, <span class="uicontrol">(20)</span>
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
WRITE LIST-LINE FROM LSTERR. <span class="uicontrol">(15)</span>
|
||
|
|
STOP RUN. <span class="uicontrol">(28)</span>
|
||
|
|
*****************************************************************
|
||
|
|
PROCES.
|
||
|
|
*
|
||
|
|
* address the first variable length record for this entry
|
||
|
|
*
|
||
|
|
SET ADDRESS OF QUS-LSPL-KEY-INFO TO ADDRESS OF
|
||
|
|
QUS-SPLF0200(5:).
|
||
|
|
*
|
||
|
|
* process all variable length records associated with this entry
|
||
|
|
*
|
||
|
|
PERFORM PROCES2 NUM-FIELDS-RETD TIMES. <span class="uicontrol">(22)</span> <span class="uicontrol">(23)</span>
|
||
|
|
|
||
|
|
WRITE LIST-LINE FROM PRTLIN. <span class="uicontrol">(26)</span>
|
||
|
|
*
|
||
|
|
* after each entry, increment to the next entry
|
||
|
|
*
|
||
|
|
SET ADDRESS OF STRING-SPACE TO ADDRESS OF QUS-SPLF0200. <span class="uicontrol">(27)</span>
|
||
|
|
|
||
|
|
SET ADDRESS OF QUS-SPLF0200 TO ADDRESS OF STRING-SPACE
|
||
|
|
((SIZE-EACH-ENTRY OF QUS-GENERIC-HEADER-0100 + 1):1).
|
||
|
|
*
|
||
|
|
* Process each variable length record based on key
|
||
|
|
*
|
||
|
|
PROCES2.
|
||
|
|
*
|
||
|
|
* extract spooled file name for report
|
||
|
|
*
|
||
|
|
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-LSPL-KEY-INFO = 201 <span class="uicontrol">(24)</span> <span class="uicontrol">(25)</span>
|
||
|
|
MOVE SPACES TO PRTFIL,
|
||
|
|
MOVE DATA-FIELD OF QUS-LSPL-KEY-INFO(
|
||
|
|
1:DATA-LENGTH OF QUS-LSPL-KEY-INFO)
|
||
|
|
TO PRTFIL.
|
||
|
|
*
|
||
|
|
* extract number of pages for report
|
||
|
|
*
|
||
|
|
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-LSPL-KEY-INFO = 211 <span class="uicontrol">(24)</span> <span class="uicontrol">(25)</span>
|
||
|
|
MOVE DATA-FIELD OF QUS-LSPL-KEY-INFO(
|
||
|
|
1:DATA-LENGTH OF QUS-LSPL-KEY-INFO)
|
||
|
|
TO PAGESA,
|
||
|
|
MOVE PAGESN TO PAGES.
|
||
|
|
*
|
||
|
|
* extract age of spooled file for report
|
||
|
|
*
|
||
|
|
IF KEY-FIELD-FOR-FIELD-RETD OF QUS-LSPL-KEY-INFO = 216 <span class="uicontrol">(24)</span> <span class="uicontrol">(25)</span>
|
||
|
|
MOVE SPACES TO OPNDAT,
|
||
|
|
MOVE DATA-FIELD OF QUS-LSPL-KEY-INFO(
|
||
|
|
1:DATA-LENGTH OF QUS-LSPL-KEY-INFO)
|
||
|
|
TO OPNDAT.
|
||
|
|
*
|
||
|
|
* address next variable length entry
|
||
|
|
*
|
||
|
|
SET ADDRESS OF STRING-SPACE TO ADDRESS OF QUS-LSPL-KEY-INFO.
|
||
|
|
|
||
|
|
SET ADDRESS OF QUS-LSPL-KEY-INFO TO ADDRESS OF
|
||
|
|
STRING-SPACE(
|
||
|
|
LEN-FIELD-INFO-RETD OF QUS-LSPL-KEY-INFO + 1:1).</pre>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
<div>
|
||
|
|
<div class="familylinks">
|
||
|
|
<div class="parentlink"><strong>Parent topic:</strong> <a href="opmScenario.htm" title="This scenario demonstrates the use of an original program model (OPM) API in several different programs.">Scenario: Original Program Model (OPM) API</a></div>
|
||
|
|
</div>
|
||
|
|
<div class="relref"><strong>Related reference</strong><br />
|
||
|
|
<div><a href="cmnKeysRPG.htm" title="This example shows the steps necessary to process keyed output from an API.">Example in OPM RPG: Using keys with List Spooled Files API</a></div>
|
||
|
|
</div>
|
||
|
|
</div>
|
||
|
|
</body>
|
||
|
|
</html>
|