259 lines
15 KiB
HTML
259 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 CL: List Object API" />
|
|
<meta name="abstract" content="The example program prints a report that shows all objects that adopt owner authority." />
|
|
<meta name="description" content="The example program prints a report that shows all objects that adopt owner authority." />
|
|
<meta name="DC.Relation" scheme="URI" content="listOverview.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="listILECL" />
|
|
<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 CL: List Object API</title>
|
|
</head>
|
|
<body id="listILECL"><a name="listILECL"><!-- --></a>
|
|
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
|
|
<h1 class="topictitle1">Example in ILE CL: List Object API</h1>
|
|
<div><p>The example program prints a report that shows all objects that
|
|
adopt owner authority.</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 RPG: List Object API for the
|
|
original example.</p>
|
|
<pre>/********************************************************************/
|
|
/* */
|
|
/* Program: List objects which adopt owner authority */
|
|
/* */
|
|
/* Language: ILE CL */
|
|
/* */
|
|
/* Description: This program displays all objects that adopt */
|
|
/* owner authority. The two parameters passed to */
|
|
/* the program are the profile to be checked and */
|
|
/* the type of objects to be listed. The parameter */
|
|
/* values are the same as those accepted by the */
|
|
/* QSYLOBJP API */
|
|
/* */
|
|
/* APIs Used: QSYLOBJP - List Objects that Adopt Owner Authority */
|
|
/* QUSCRTUS - Create User Space */
|
|
/* QUSPTRUS - Retrieve Pointer to User Space */
|
|
/* QUSROBJD - Retrieve Object Description */
|
|
/* */
|
|
/********************************************************************/
|
|
PGM PARM(&USR_PRF &OBJ_TYPE)
|
|
DCL VAR(&USR_PRF) TYPE(*CHAR) LEN(10)
|
|
DCL VAR(&OBJ_TYPE) TYPE(*CHAR) LEN(10)
|
|
DCL VAR(&ERRCDE) TYPE(*CHAR) LEN(16)
|
|
DCL VAR(&BYTPRV) TYPE(*INT) STG(*DEFINED) LEN(4) +
|
|
DEFVAR(&ERRCDE)
|
|
DCL VAR(&BYTAVL) TYPE(*INT) STG(*DEFINED) LEN(4) +
|
|
DEFVAR(&ERRCDE 5)
|
|
DCL VAR(&MSGID) TYPE(*CHAR) STG(*DEFINED) LEN(7) +
|
|
DEFVAR(&ERRCDE 9)
|
|
DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(8)
|
|
DCL VAR(&RCVVARSIZ) TYPE(*INT) LEN(4) VALUE(8)
|
|
DCL VAR(&SPC_NAME) TYPE(*CHAR) LEN(20) +
|
|
VALUE('ADOPTS QTEMP ')
|
|
DCL VAR(&SPC_SIZE) TYPE(*INT) LEN(4) VALUE(1)
|
|
DCL VAR(&SPC_INIT) TYPE(*CHAR) LEN(1) VALUE(X'00')
|
|
DCL VAR(&BLANKS) TYPE(*CHAR) LEN(50)
|
|
DCL VAR(&CONTIN_HDL) TYPE(*CHAR) LEN(20)
|
|
DCL VAR(&SPCPTR) TYPE(*PTR)
|
|
DCL VAR(&LISTHDR) TYPE(*CHAR) STG(*BASED) +
|
|
LEN(192) BASPTR(&SPCPTR)
|
|
DCL VAR(&LISTSTS) TYPE(*CHAR) STG(*DEFINED) +
|
|
LEN(1) DEFVAR(&LISTHDR 104)
|
|
DCL VAR(&PARMHDROFS) TYPE(*INT) STG(*DEFINED) +
|
|
LEN(4) DEFVAR(&LISTHDR 109)
|
|
DCL VAR(&LISTENOFS) TYPE(*INT) STG(*DEFINED) +
|
|
DEFVAR(&LISTHDR 125)
|
|
DCL VAR(&LISTENTNBR) TYPE(*INT) STG(*DEFINED) +
|
|
DEFVAR(&LISTHDR 133)
|
|
DCL VAR(&LISTENTSIZ) TYPE(*INT) STG(*DEFINED) +
|
|
DEFVAR(&LISTHDR 137)
|
|
DCL VAR(&LST_STATUS) TYPE(*CHAR) LEN(1)
|
|
DCL VAR(&LSTPTR) TYPE(*PTR)
|
|
DCL VAR(&LSTENT) TYPE(*CHAR) STG(*BASED) +
|
|
LEN(100) BASPTR(&LSTPTR)
|
|
DCL VAR(&OBJECT) TYPE(*CHAR) STG(*DEFINED) +
|
|
LEN(10) DEFVAR(&LSTENT 1)
|
|
DCL VAR(&CONTIN) TYPE(*CHAR) STG(*DEFINED) +
|
|
LEN(20) DEFVAR(&LSTENT 11)
|
|
DCL VAR(&CURENT) TYPE(*INT) LEN(4)
|
|
CALLSUBR SUBR(INIT)
|
|
CALLSUBR SUBR(PROCES)
|
|
RETURN
|
|
|
|
SUBR SUBR(PROCES)
|
|
/* */
|
|
/* This subroutine processes each entry returned by QSYLOBJP */
|
|
/* */
|
|
/* Do until the list is complete */
|
|
/* */
|
|
CHGVAR VAR(&LST_STATUS) VALUE(&LISTSTS)
|
|
DOUNTIL COND(&LST_STATUS *EQ 'C')
|
|
IF COND((&LISTSTS *EQ 'C') *OR (&LISTSTS *EQ +
|
|
'P')) THEN(DO)
|
|
/* */
|
|
/* And list entries were found */
|
|
/* */
|
|
IF COND(&LISTENTNBR *GT 0) THEN(DO)
|
|
/* */
|
|
/* Set &LSTPTR to first byte of the User Space */
|
|
/* */
|
|
CHGVAR VAR(&LSTPTR) VALUE(&SPCPTR)
|
|
/* */
|
|
/* Increment &LSTPTR to the first list entry */
|
|
/* */
|
|
CHGVAR VAR(%OFFSET(&LSTPTR)) VALUE(%OFFSET(&LSTPTR) +
|
|
+ &LISTENTOFS)
|
|
/* */
|
|
/* And process all the entries */
|
|
/* */
|
|
DOFOR VAR(&CURENT) FROM(1) TO(&LISTENTNBR)
|
|
SNDPGMMSG MSG(&OBJECT) TOPGMQ(*EXT)
|
|
/* */
|
|
/* After each entry, increment &LSTPTR to the next entry */
|
|
/* */
|
|
CHGVAR VAR(%OFFSET(&LSTPTR)) +
|
|
VALUE(%OFFSET(&LSTPTR) + &LISTENTSIZ)
|
|
ENDDO
|
|
ENDDO
|
|
/* */
|
|
/* If all entries in this list have been processed, check if */
|
|
/* more entries exist than can fit in one User Space */
|
|
/* */
|
|
IF COND(&LISTSTS *EQ 'P') THEN(DO)
|
|
/* */
|
|
/* by reseting LSTPTR to the start of the User Space */
|
|
/* */
|
|
CHGVAR VAR(&LSTPTR) VALUE(&SPCPTR)
|
|
/* */
|
|
/* and then incrementing &LSTPTR to Input Parameter Header */
|
|
/* */
|
|
CHGVAR VAR(%OFFSET(&LSTPTR)) VALUE(%OFFSET(&LSTPTR) +
|
|
+ &PARMHDROFS)
|
|
/* */
|
|
/* if the continuation handle is blank then the list is complete */
|
|
/* */
|
|
IF COND(&CONTIN *EQ ' ') THEN(CHGVAR +
|
|
VAR(&LST_STATUS) VALUE('C'))
|
|
ELSE CMD(DO)
|
|
/* */
|
|
/* call QSYLOBP to get more entries */
|
|
/* */
|
|
CHGVAR VAR(&CONTIN_HDL) VALUE(&CONTIN)
|
|
CALLSUBR SUBR(GETLST)
|
|
CHGVAR VAR(&LST_STATUS) VALUE(&LISTSTS)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
ELSE CMD(DO)
|
|
/* */
|
|
/* and if unexpected status, log an error */
|
|
/* */
|
|
SNDPGMMSG MSG('Unexpected status') TOPGMQ(*EXT)
|
|
RETURN
|
|
ENDDO
|
|
ENDDO
|
|
ENDSUBR
|
|
|
|
SUBR SUBR(GETLST)
|
|
/* */
|
|
/* Call QSYLOBJP to generte a list */
|
|
/* The continuation handle is primed by the caller of this */
|
|
/* subroutine */
|
|
/* */
|
|
CALL PGM(QSYLOBJP) PARM(&SPC_NAME 'OBJP0200' +
|
|
&USR_PRF &OBJ_TYPE &CONTIN_HDL &ERRCDE)
|
|
/* */
|
|
/* Check for errors on QSYLOBJP */
|
|
/* */
|
|
IF COND(&BYTAVL *GT 0) THEN(DO)
|
|
SNDPGMMSG MSG('Failure with QSYLOBJP') TOPGMQ(*EXT)
|
|
RETURN
|
|
ENDDO
|
|
ENDSUBR
|
|
|
|
SUBR SUBR(INIT)
|
|
/* */
|
|
/* One time initialization code for this program */
|
|
/* */
|
|
/* Set Error Code structure not to use exceptions */
|
|
/* */
|
|
CHGVAR VAR(&BYTPRV) VALUE(16)
|
|
/* */
|
|
/* Check if the User Space was previously created */
|
|
/* */
|
|
CALL PGM(QUSROBJD) PARM(&RCVVAR &RCVVARSIZ +
|
|
'OBJD0100' &SPC_NAME '*USRSPC' &ERRCDE)
|
|
/* */
|
|
/* Check for errors on QUSROBJD */
|
|
/* */
|
|
IF COND(&BYTAVL *GT 0) THEN(DO)
|
|
/* */
|
|
/* If CPF9801, then User Space not found */
|
|
/* */
|
|
IF COND(&MSGID *EQ 'CPF9801') THEN(DO)
|
|
/* */
|
|
/* So create a User Space for the list generated by QSYLOBJP */
|
|
/* */
|
|
CALL PGM(QUSCRTUS) PARM(&SPC_NAME 'QSYLOBJP' +
|
|
&SPC_SIZE &SPC_INIT '*ALL' &BLANKS '*YES' +
|
|
&ERRCDE '*USER')
|
|
/* */
|
|
/* Check for errors on QUSCRTUS */
|
|
/* */
|
|
IF COND(&BYTAVL *GT 0) THEN(DO)
|
|
SNDPGMMSG MSG('Failure with QUSCRTUS') TOPGMQ(*EXT)
|
|
RETURN
|
|
ENDDO
|
|
/* */
|
|
/* Else an error accessing the User Space */
|
|
/* */
|
|
ELSE CMD(DO)
|
|
SNDPGMMSG MSG('Failure with QUSROBJD') TOPGMQ(*EXT)
|
|
RETURN
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
/* */
|
|
/* Set QSYLOBJP (via GETLST) to start a new list */
|
|
/* */
|
|
CHGVAR VAR(&CONTIN_HDL) VALUE(&BLANKS)
|
|
CALLSUBR SUBR(GETLST)
|
|
/* */
|
|
/* Get a resolved pointer to the User Space */
|
|
/* */
|
|
CALL PGM(QUSPTRUS) PARM(&SPC_NAME &SPCPTR &ERRCDE)
|
|
/* */
|
|
/* Check for errors on QUSPTRUS */
|
|
/* */
|
|
IF COND(&BYTAVL *GT 0) THEN(DO)
|
|
SNDPGMMSG MSG('Failure with QUSPTRUS') TOPGMQ(*EXT)
|
|
RETURN
|
|
ENDDO
|
|
ENDSUBR
|
|
ENDPGM</pre>
|
|
</div>
|
|
</div>
|
|
<div>
|
|
<div class="familylinks">
|
|
<div class="parentlink"><strong>Parent topic:</strong> <a href="listOverview.htm" title="List APIs return a list unique to a given API. The section discusses the characteristics of a list API and provides information that you should be aware of when you use list APIs.">List APIs overview</a></div>
|
|
</div>
|
|
</div>
|
|
</body>
|
|
</html> |