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.
F***************************************************************
F***************************************************************
F*
F* Program: List objects that adopt owner authority
F*
F* Language: ILE RPG
F*
F* Description: This program prints a report showing all objects
F* that adopt owner authority. The two parameters
F* passed to the program are the profile to be
F* checked and the type of objects to be listed.
F* The parameter values are the same as those
F* accepted by the QSYLOBJP API.
F*
F* APIs Used: QSYLOBJP - List Objects that Adopt Owner Authority
F* QUSCRTUS - Create User Space
F* QUSPTRUS - Retrieve Pointer to User Space
F* QUSROBJD - Retrieve Object Description
F*
F***************************************************************
F***************************************************************
F*
FQPRINT O F 132 PRINTER OFLIND(*INOF)
D*
D* Error Code parameter include
D*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
DSPC_NAME S 20 INZ('ADOPTS QTEMP ')
DSPC_SIZE S 9B 0 INZ(1)
DSPC_INIT S 1 INZ(X'00')
DLSTPTR S *
DSPCPTR S *
DARR S 1 BASED(LSTPTR) DIM(32767)
DRCVVAR S 8
DRCVVARSIZ S 9B 0 INZ(8)
D*****************************************************************
D*
D* The following QUSGEN include from QSYSINC is copied into
D* this program so that it can be declared as BASED on SPCPTR
D*
D*****************************************************************
DQUSH0100 DS BASED(SPCPTR)
D* Qus Generic Header 0100
D QUSUA 1 64
D* User Area
D QUSSGH 65 68B 0
D* Size Generic Header
D QUSSRL 69 72
D* Structure Release Level
D QUSFN 73 80
D* Format Name
D QUSAU 81 90
D* API Used
D QUSDTC 91 103
D* Date Time Created
D QUSIS 104 104
D* Information Status
D QUSSUS 105 108B 0
D* Size User Space
D QUSOIP 109 112B 0
D* Offset Input Parameter
D QUSSIP 113 116B 0
D* Size Input Parameter
D QUSOHS 117 120B 0
D* Offset Header Section
D QUSSHS 121 124B 0
D* Size Header Section
D QUSOLD 125 128B 0
D* Offset List Data
D QUSSLD 129 132B 0
D* Size List Data
D QUSNBRLE 133 136B 0
D* Number List Entries
D QUSSEE 137 140B 0
D* Size Each Entry
D QUSSIDLE 141 144B 0
D* CCSID List Ent
D QUSCID 145 146
D* Country ID
D QUSLID 147 149
D* Language ID
D QUSSLI 150 150
D* Subset List Indicator
D QUSERVED00 151 192
D* Reserved
D*****************************************************************
D*
D* The following QSYLOBJP include from QSYSINC is copied into
D* this program so that it can be declared as BASED on LSTPTR
D*
D*****************************************************************
D QSYLOBJP C 'QSYLOBJP'
D*****************************************************************
D*Header structure for QSYLOBJP
D*****************************************************************
DQSYOBJPH DS BASED(LSTPTR)
D* Qsy OBJP Header
D QSYUN00 1 10
D* User name
D QSYCV00 11 30
D* Continuation Value
D*****************************************************************
D*Record structure for OBJP0200 format
D*****************************************************************
DQSY0200L02 DS BASED(LSTPTR)
D* Qsy OBJP0200 List
D QSYNAME06 1 10
D* Name
D QSYBRARY06 11 20
D* Library
D QSYOBJT13 21 30
D* Object Type
D QSYOBJIU00 31 31
D* Object In Use
D QSYOBJA11 32 41
D* Object Attribute
D QSYOBJT14 42 91
D* Object Text
C*
C* Start of mainline
C*
C *ENTRY PLIST
C PARM USR_PRF 10
C PARM OBJ_TYPE 10
C EXSR INIT
C EXSR PROCES
C EXSR DONE
C*
C* Start of subroutines
C*
C*****************************************************************
C PROCES BEGSR
C*
C* This subroutine processes each entry returned by QSYLOBJP
C*
C*
C* Do until the list is complete
C*
C MOVE QUSIS LST_STATUS 1
C*
C LST_STATUS DOUEQ 'C'
C*
C* If valid information was returned
C*
C QUSIS IFEQ 'C'
C QUSIS OREQ 'P'
C*
C* and list entries were found
C*
C QUSNBRLE IFGT 0
C*
C* set LSTPTR to the first byte of the User Space
C*
C EVAL LSTPTR = SPCPTR
C*
C* increment LSTPTR to the first List entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOLD + 1)) (5)
C*
C* and process all of the entries
C*
C DO QUSNBRLE (6)
C EXCEPT OBJ_ENTRY
C*
C* after each entry, increment LSTPTR to the next entry
C*
C EVAL LSTPTR = %ADDR(ARR(QUSSEE + 1)) (7)
C END
C END
C*
C* If all entries in this User Space have been processed, check
C* if more entries exist than can fit in one User Space
C*
C QUSIS IFEQ 'P'
C*
C* by resetting LSTPTR to the start of the User Space
C*
C EVAL LSTPTR = SPCPTR
C*
C* and then incrementing LSTPTR to the Input Parameter Header
C*
C EVAL LSTPTR = %ADDR(ARR(QUSOIP + 1))
C*
C* If the continuation handle in the Input Parameter Header is
C* blank, then set the List status to Complete
C*
C QSYCV00 IFEQ *BLANKS
C MOVE 'C' LST_STATUS
C ELSE
C*
C* Else, call QSYLOBJP reusing the User Space to get more
C* List entries
C*
C MOVE QSYCV00 CONTIN_HDL (2)
C EXSR GETLST
C MOVE QUSIS LST_STATUS
C END
C END
C ELSE
C*
C* And if an unexpected status, log an error (not shown) and exit
C*
C EXSR DONE
C END
C END
C ENDSR
C*****************************************************************
C GETLST BEGSR
C*
C* Call QSYLOBJP to generate a list
C* The continuation handle is set by the caller of this
C* subroutine.
C*
C CALL QSYLOBJP
C PARM SPC_NAME
C PARM 'OBJP0200' MBR_LIST 8
C PARM USR_PRF
C PARM OBJ_TYPE
C PARM CONTIN_HDL 20 (3)
C PARM QUSEC
C*
C* Check for errors on QSYLOBJP
C*
C QUSBAVL IFGT 0
C MOVEL 'QSYLOBJP' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C INIT BEGSR
C*
C* One time initialization code for this program
C*
C* Set Error Code structure not to use exceptions
C*
C Z-ADD 16 QUSBPRV
C*
C* Check to see if the User Space was previously created in
C* QTEMP. If it was, simply reuse it.
C*
C CALL 'QUSROBJD'
C PARM RCVVAR
C PARM RCVVARSIZ
C PARM 'OBJD0100' ROBJD_FMT 8
C PARM SPC_NAME
C PARM '*USRSPC' SPC_TYPE 10
C PARM QUSEC
C*
C* Check for errors on QUSROBJD
C*
C QUSBAVL IFGT 0
C*
C* If CPF9801, then User Space was not found
C*
C QUSEI IFEQ 'CPF9801'
C*
C* So create a User Space for the List generated by QSYLOBJP
C*
C CALL 'QUSCRTUS'
C PARM SPC_NAME
C PARM 'QSYLOBJP ' EXT_ATTR 10
C PARM SPC_SIZE
C PARM SPC_INIT
C PARM '*ALL' SPC_AUT 10
C PARM *BLANKS SPC_TEXT 50
C PARM '*YES' SPC_REPLAC 10
C PARM QUSEC
C PARM '*USER' SPC_DOMAIN 10
C*
C* Check for errors on QUSCRTUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSCRTUS' APINAM 10
C EXSR APIERR
C END
C*
C* Else, an error occurred accessing the User Space
C*
C ELSE
C MOVEL 'QUSROBJD' APINAM 10
C EXSR APIERR
C END
C END
C*
C* Set QSYLOBJP (via GETLST) to start a new list
C*
C MOVE *BLANKS CONTIN_HDL
C EXSR GETLST
C*
C* Get a resolved pointer to the User Space for performance
C*
C CALL 'QUSPTRUS'
C PARM SPC_NAME
C PARM SPCPTR
C PARM QUSEC
C*
C* Check for errors on QUSPTRUS
C*
C QUSBAVL IFGT 0
C MOVEL 'QUSPTRUS' APINAM 10
C EXSR APIERR
C END
C ENDSR
C*****************************************************************
C APIERR BEGSR
C*
C* Log any error encountered, and exit the program
C*
C APINAM DSPLY
C QUSEI DSPLY
C EXSR DONE
C ENDSR
C*****************************************************************
C DONE BEGSR
C*
C* Exit the program
C*
C EXCEPT END_LIST
C EVAL *INLR = '1'
C RETURN
C ENDSR
OQPRINT E OBJ_ENTRY 1
O 'Object: '
O QSYNAME06
O ' Library: '
O QSYBRARY06
O ' Type: '
O QSYOBJT13
O ' Text: '
O QSYOBJT14
OQPRINT E END_LIST 1
O '*** End of List'