Retrieve users authorized to an object (QSYRTVUA)

Found on the Midrange-L Mailing List: visit http://www.midrange.com to subscribe.

Contributed by: Carsten Flensburg

Here's a short sample that works:

     **
     **  Compile options:
     **
     **    CrtRpgMod Module( CBX119T )
     **              DbgView( *LIST )
     **
     **    CrtPgm    Pgm( CBX119T )
     **              Module( CBX119T )
     **              ActGrp( QILE )
     **
     **
     **-- 
Specifications -----------------------------------------------------**
     H Option( *SrcStmt )
     **-- Api error
tructure:  ----------------------------------------------**
     D ApiError        Ds
     D  AeBytPro                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0
     D  AeExcpId                      7a
     D                                1a
     D  AaExcpDta                   256a
     **-- Global
ariables:  -------------------------------------------------**
     D Idx             s             10i 0
     **-- User authorization
arameters:  ------------------------------------**
     D RuRcvVar        s          32767a
     D RuObjNam        s           4096a   Varying
     **
     D RuFdbInf        Ds
     D  FiBytRtnFb                   10i 0
     D  FiBytAvlFb                   10i 0
     D  FiBytRtnRv                   10i 0
     D  FiBytAvlRv                   10i 0
     D  FiNbrAutUsr                  10i 0
     D  FiUsrEntLen                  10i 0
     D  FiObjOwn                     10a
     D  FiObjPgp                     10a
     D  FiAutL                       10a
     D  FiSnsLvl                      1a
     **
     D RuInfEnt        Ds                  Based( pInfEnt )
     D  ReUsrPrf                     10a
     D  ReUsrTyp                      1a
     D  ReDtaAut                     10a
     D  ReAutlMgm                     1a
     D  ReObjMgm                      1a
     D  ReObjXst                      1a
     D  ReObjAlt                      1a
     D  ReObjRef                      1a
     D                               10a
     D  ReObjOpr                      1a
     D  ReDtaRead                     1a
     D  ReDtaAdd                      1a
     D  ReDtaUpd                      1a
     D  ReDtaDlt                      1a
     D  ReDtaExe                      1a
     D                               10a
     **-- Retrieve users authorized to an object:  ---------------------------**
     D RtvUsrObjAut    Pr                  ExtPgm( 'QSYRTVUA' )
     D  RuRcvVar                  32767a          Options( *VarSize )
     D  RuRcvVarLen                  10i 0 Const
     D  RuFdbInf                    256a          Options( *VarSize )
     D  RuFdbInfLen                  10i 0 Const
     D  RuFmtNam                      8a   Const
     D  RuObjPth                   4096a   Const  Options( *VarSize )
     D  RuObjPthLen                  10i 0 Const
     D  RuError                   32767a          Options( *VarSize )
     **
     C                   Eval      RuObjNam    =
'/qopensys/QUSER/BL2005.prn'
     **
     C                   CallP     RtvUsrObjAut( RuRcvVar
     C                                         : %Size( RuRcvVar )
     C                                         : RuFdbInf
     C                                         : %Size( RuFdbInf )
     C                                         : 'RTUA0100'
     C                                         : RuObjNam
     C                                         : %Len( RuObjNam )
     C                                         : ApiError
     C                                         )
     **
     C                   If        AeBytAvl    = *Zero
     **
     C                   Eval      pInfEnt     = %Addr( RuRcvVar )
     **
     C                   For       Idx = 1  To FiNbrAutUsr
     **
     **-- Do whatever...
     **
     C                   If        Idx         < FiNbrAutUsr
     C                   Eval      pInfEnt     = pInfEnt + FiUsrEntLen
     C                   EndIf
     **
     C                   EndFor
     C                   EndIf
     **
     C                   Return
     **

- A potential problem often comes from not specifying the exact length of
the object path and thus having the API include trailing blanks as part of
the object name - leading to a nonexisting object name.

Best regards,
Carsten Flensburg

[report a broken link by clicking here]