pgm ( +
&pUsrPrf +
)
dcl &pUsrPrf *char 10
dcl &UsrPrf *char 10
dcl &TempLib *char 10 value( 'QTEMP' )
dcl &qusrspc *char 20
dcl &ErrCod *char 4
dcl &hCont *char 20
dcl &us_hdr *char 150 /* Space header */
dcl &l_hdr *char 34 /* List header */
/* This is a general-purpose field to hold objlck data... */
dcl &us_obje *char 108 /* A single entry */
/* When retrieving *usrspc entries, we need a start position,.. */
dcl &STRPOS *dec 9
/* Loop checking... */
dcl &LoopChk *dec 11 value( 0 )
/* Total objects... */
dcl &tObjOwn *dec 11 value( 0 )
dcl &tObjOwn2 *dec 11 value( 0 )
/* General fields for RUSGENHDR... */
dcl &nbrlste *dec 7
dcl &ists *char 1
dcl &offshdr *char 4
SNDPGMMSG MSG('Begin') TOPGMQ(*EXT) MSGTYPE(*INFO)
chgvar &UsrPrf &pUsrPrf
chgvar &hCont ' '
chgvar &qusrspc ( 'LOBJOWN ' *cat &TempLib )
call QUSCRTUS ( +
&qusrspc +
'TMPLST ' +
x'00001000' +
X'00' +
'*ALL ' +
'Temp list obj owned ' +
'*YES ' +
x'0000000000000000' +
)
QFS_obj:
call QSYLOBJA ( +
&qusrspc +
'OBJA0100' +
&UsrPrf +
'*ALL ' +
'*OBJOWN ' +
&hCont +
x'0000000000000000' +
)
/* Retrieve the initialization data... */
call QUSRTVUS ( +
&qusrspc +
x'00000001' +
x'00000096' +
&us_hdr +
)
chgvar &nbrlste %bin( &us_hdr 133 4 )
chgvar &ists %sst( &us_hdr 104 1 )
chgvar &offshdr %sst( &us_hdr 117 4 )
chgvar %bin( &offshdr ) ( %bin( &offshdr ) + 1 )
call QUSRTVUS ( +
&qusrspc +
&offshdr +
x'00000022' +
&l_hdr +
)
chgvar &hCont %sst( &l_hdr 11 20 )
dmpclpgm
if ( &nbrlste *eq 0 ) do
sndpgmmsg msgid( CPF9898 ) msgf( QCPFMSG ) +
msgdta( 'No objects listed' )
goto Clean_up
enddo
/* Add this count to our total... */
chgvar &tObjOwn ( &tObjOwn + &nbrlste )
chgvar &LoopChk ( &LoopChk + 1 )
if ( &ists *eq 'P' ) do
goto QFS_obj
enddo
SNDPGMMSG MSG('Next') TOPGMQ(*EXT) MSGTYPE(*INFO)
chgvar &hCont ' '
IFS_obj:
call QSYLOBJA ( +
&qusrspc +
'OBJA0110' +
&UsrPrf +
'*ALL ' +
'*OBJOWN ' +
&hCont +
x'0000000000000000' +
)
/* Retrieve the initialization data... */
call QUSRTVUS ( +
&qusrspc +
x'00000001' +
x'00000096' +
&us_hdr +
)
chgvar &nbrlste %bin( &us_hdr 133 4 )
chgvar &ists %sst( &us_hdr 104 1 )
if ( &nbrlste *eq 0 ) do
sndpgmmsg msgid( CPF9898 ) msgf( QCPFMSG ) +
msgdta( 'No IFS objects listed' )
goto Clean_up
enddo
/* Add this count to our total... */
chgvar &tObjOwn2 ( &tObjOwn2 + &nbrlste )
chgvar &LoopChk ( &LoopChk + 1 )
if ( &ists *eq 'P' ) do
goto IFS_obj
enddo
Clean_up:
SNDPGMMSG MSG('End') TOPGMQ(*EXT) MSGTYPE(*INFO)
dmpclpgm
return
endpgm
Thanks to Tom Liotta
阅读(938) | 评论(0) | 转发(0) |
