midrange.com code scratchpad
Name:
Test List Objects Owned via QSYLOBJA
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
12/05/2007 11:34:02 pm
IP:
Logged
Description:
Accepts a *USRPRF as parameter input. CALLs QSYLOBJA with both formats 'OBJA0100' and 'OBJA0110'. After each CALL, the populated *USRSPC is queried to see how many objects were listed. A DMPCLPGM at the end shows program variable contents. This was purely a test coding to get a feeling for differences between the two API formats.
Code:
  1. pgm     ( +
  2.           &pUsrPrf     +
  3.         )
  4.  
  5.    dcl    &pUsrPrf         *char      10
  6.  
  7.  
  8.    dcl    &UsrPrf          *char      10
  9.  
  10.    dcl    &TempLib         *char      10     value( 'QTEMP' )
  11.  
  12.    dcl    &qusrspc         *char      20
  13.  
  14.    dcl    &ErrCod          *char       4
  15.    dcl    &hCont           *char      20
  16.  
  17.  
  18.    dcl    &us_hdr          *char     150   /* Space header      */
  19.    dcl    &l_hdr           *char      34   /* List header       */
  20.  
  21. /* This is a general-purpose field to hold objlck data...           */
  22.    dcl    &us_obje         *char     108   /* A single entry    */
  23.  
  24. /* When retrieving *usrspc entries, we need a start position,..     */
  25.    dcl    &STRPOS          *dec        9
  26.  
  27. /* Loop checking...                                                 */
  28.    dcl    &LoopChk         *dec       11     value( 0 )
  29.  
  30. /* Total objects...                                                 */
  31.    dcl    &tObjOwn         *dec       11     value( 0 )
  32.    dcl    &tObjOwn2        *dec       11     value( 0 )
  33.  
  34.  
  35. /* General fields for RUSGENHDR...                                  */
  36.    dcl    &nbrlste         *dec        7
  37.    dcl    &ists            *char       1
  38.    dcl    &offshdr         *char       4
  39.  
  40.  
  41.              SNDPGMMSG  MSG('Begin') TOPGMQ(*EXT) MSGTYPE(*INFO)
  42.  
  43.  
  44.    chgvar        &UsrPrf           &pUsrPrf
  45.    chgvar        &hCont            ' '
  46.    chgvar        &qusrspc        ( 'LOBJOWN   ' *cat &TempLib )
  47.  
  48.    call    QUSCRTUS   ( +
  49.                         &qusrspc                +
  50.                         'TMPLST    '            +
  51.                         x'00001000'             +
  52.                         X'00'                   +
  53.                         '*ALL      '            +
  54.                         'Temp list obj owned    ' +
  55.                         '*YES      '            +
  56.                         x'0000000000000000'     +
  57.                       )
  58.  
  59.  
  60. QFS_obj:
  61.  
  62.    call    QSYLOBJA   ( +
  63.                         &qusrspc                +
  64.                         'OBJA0100'              +
  65.                         &UsrPrf                 +
  66.                         '*ALL      '            +
  67.                         '*OBJOWN   '            +
  68.                         &hCont                  +
  69.                         x'0000000000000000'     +
  70.                       )
  71.  
  72. /*  Retrieve the initialization data...                             */
  73.  
  74.    call    QUSRTVUS   ( +
  75.                         &qusrspc                +
  76.                         x'00000001'             +
  77.                         x'00000096'             +
  78.                         &us_hdr                 +
  79.                       )
  80.  
  81.    chgvar    &nbrlste        %bin( &us_hdr    133 4 )
  82.    chgvar    &ists           %sst( &us_hdr    104 1 )
  83.    chgvar    &offshdr        %sst( &us_hdr    117 4 )
  84.  
  85.    chgvar    %bin( &offshdr ) ( %bin( &offshdr ) + 1 )
  86.  
  87.    call    QUSRTVUS   ( +
  88.                         &qusrspc                +
  89.                         &offshdr                +
  90.                         x'00000022'             +
  91.                         &l_hdr                  +
  92.                       )
  93.  
  94.    chgvar    &hCont          %sst( &l_hdr  11  20 )
  95.  
  96. dmpclpgm
  97.  
  98.    if  ( &nbrlste *eq 0 )     do
  99.       sndpgmmsg  msgid( CPF9898 ) msgf( QCPFMSG ) +
  100.                    msgdta( 'No objects listed' )
  101.       goto   Clean_up
  102.    enddo
  103.  
  104. /* Add this count to our total...                            */
  105.  
  106.    chgvar    &tObjOwn         ( &tObjOwn  + &nbrlste )
  107.    chgvar    &LoopChk         ( &LoopChk  + 1 )
  108.  
  109.    if  ( &ists *eq 'P' )      do
  110.       goto   QFS_obj
  111.    enddo
  112.  
  113.              SNDPGMMSG  MSG('Next') TOPGMQ(*EXT) MSGTYPE(*INFO)
  114.  
  115.    chgvar        &hCont            ' '
  116.  
  117. IFS_obj:
  118.  
  119.    call    QSYLOBJA   ( +
  120.                         &qusrspc                +
  121.                         'OBJA0110'              +
  122.                         &UsrPrf                 +
  123.                         '*ALL      '            +
  124.                         '*OBJOWN   '            +
  125.                         &hCont                  +
  126.                         x'0000000000000000'     +
  127.                       )
  128.  
  129. /*  Retrieve the initialization data...                             */
  130.  
  131.    call    QUSRTVUS   ( +
  132.                         &qusrspc                +
  133.                         x'00000001'             +
  134.                         x'00000096'             +
  135.                         &us_hdr                 +
  136.                       )
  137.  
  138.    chgvar    &nbrlste        %bin( &us_hdr    133 4 )
  139.    chgvar    &ists           %sst( &us_hdr    104 1 )
  140.  
  141.  
  142.    if  ( &nbrlste *eq 0 )     do
  143.       sndpgmmsg  msgid( CPF9898 ) msgf( QCPFMSG ) +
  144.                    msgdta( 'No IFS objects listed' )
  145.       goto   Clean_up
  146.    enddo
  147.  
  148. /* Add this count to our total...                            */
  149.  
  150.    chgvar    &tObjOwn2        ( &tObjOwn2 + &nbrlste )
  151.    chgvar    &LoopChk         ( &LoopChk  + 1 )
  152.  
  153.    if  ( &ists *eq 'P' )      do
  154.       goto   IFS_obj
  155.    enddo
  156.  
  157.  
  158.  
  159. Clean_up:
  160.  
  161.              SNDPGMMSG  MSG('End') TOPGMQ(*EXT) MSGTYPE(*INFO)
  162.  
  163. dmpclpgm
  164.  
  165.    return
  166.  
  167. endpgm
  168.  
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css