The example program prints a report that shows all objects that adopt owner authority.
Refer to Example in RPG: List Object API for the original example.
/********************************************************************/
/* */
/* 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