Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1271800
  • 博文数量: 287
  • 博客积分: 11000
  • 博客等级: 上将
  • 技术积分: 3833
  • 用 户 组: 普通用户
  • 注册时间: 2007-08-16 08:43
文章分类
文章存档

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-21 09:32:30

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
阅读(899) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~