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

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-21 09:16:18

QSYLATLO - List authorization list IFS objects
 
    **
     **  Program . . : CBX708
     **  Description : List authorization list IFS objects
     **  Author  . . : Carsten Flensburg
     **
     **
     **  Compile options:
     **    CrtRpgMod Module( CBX708 )
     **              DbgView( *LIST )
     **
     **    CrtPgm    Pgm( CBX708 )
     **              Module( CBX708 )
     **              ActGrp( QILE )
     **
     **
     **-- Header specifications:  --------------------------------------------**
     H Option( *SrcStmt )

     **-- Global variables:
     D Idx             s             10u 0
     D PthNam          s           5000a   Varying
     **-- Global constants:
     D OFS_MSGDTA      c                   16
     D USRSPC          c                   'AUTLSTOBJ QTEMP'

     **-- Api error data structure:
     D ERRC0100        Ds                  Qualified
     D  BytPro                       10i 0 Inz( %Size( ERRC0100 ))
     D  BytAvl                       10i 0 Inz
     D  MsgId                         7a
     D                                1a
     D  MsgDta                      128a

     **-- API path:
     D Qlg_Path_Name   Ds                  Qualified  Based( pQlg_Path_Name )
     D  CcsId                        10i 0
     D  CtrId                         2a
     D  LngId                         3a
     D                                3a
     D  PthTypI                      10i 0
     D  PthNamLen                    10i 0
     D  PthNamDlm                     2a
     D                               10a
     D  PthNam                     5000a
     **-- API header information:
     D ApiHdrInf       Ds                  Qualified  Based( pHdrInf )
     D  AutLst                       10a
     D  AutLstLib                    10a
     D  ObjOwn                       10a
     D  ObjPgp                       10a
     D  RsnCod                       10i 0
     D  OfsQsysObj                   10i 0
     D  NbrQsysEnt                   10i 0
     D  NbrQsysObj                   10i 0
     D  OfsQdlsObj                   10i 0
     D  NbrQdlsEnt                   10i 0
     D  NbrQdlsObj                   10i 0
     D  OfsDirEobj                   10i 0
     D  NbrDirEent                   10i 0
     D  NbrDirEobj                   10i 0
     **-- Authorization list IFS object entry:
     D ATLO0210        Ds                  Qualified  Based( pLstEnt )
     D  OfsPthNam                    10i 0
     D  LenPthNam                    10i 0
     D  ObjTyp                       10a
     D  AutHlr                        1a
     D  ObjOwn                       10a
     D  ObjAtr                       10a
     D  TxtDsc                       50a
     D  ObjPgp                       10a
     D                                1a
     D  AspDev                       10

     **-- User space generic header:
     D UsrSpcHdr       Ds                  Qualified  Based( pUsrSpc )
     D  OfsHdr                       10i 0 Overlay( UsrSpcHdr: 117 )
     D  OfsLst                       10i 0 Overlay( UsrSpcHdr: 125 )
     D  NumLstEnt                    10i 0 Overlay( UsrSpcHdr: 133 )
     D  SizLstEnt                    10i 0 Overlay( UsrSpcHdr: 137 )
     **-- User space pointers:
     D pUsrSpc         s               *   Inz( *Null )
     D pHdrInf         s               *   Inz( *Null )
     D pLstEnt         s               *   Inz( *Null )

     **-- Create user space:
     D CrtUsrSpc       Pr                  ExtPgm( 'QUSCRTUS' )
     D  SpcNamQ                      20a   Const
     D  ExtAtr                       10a   Const
     D  InzSiz                       10i 0 Const
     D  InzVal                        1a   Const
     D  PubAut                       10a   Const
     D  Text                         50a   Const
     D  Replace                      10a   Const  Options( *NoPass )
     D  Error                     32767a          Options( *NoPass: *VarSize )
     D  Domain                       10a   Const  Options( *NoPass )
     **-- Delete user space:
     D DltUsrSpc       Pr                  ExtPgm( 'QUSDLTUS' )
     D  SpcNamQ                      20a   Const
     D  Error                     32767a          Options( *VarSize )
     **-- Retrieve pointer to user space:
     D RtvPtrSpc       Pr                  ExtPgm( 'QUSPTRUS' )
     D  SpcNamQ                      20a   Const
     D  Pointer                        *
     D  Error                     32767a          Options( *NoPass: *VarSize )
     **-- List authorization list objects:
     D LstAutLstObj    Pr                  ExtPgm( 'QSYLATLO' )
     D  SpcNamQ                      20a   Const
     D  FmtNam                        8a   Const
     D  AutLst                       10a   Const
     D  Error                     32767a          Options( *VarSize )
     **-- Send program message:
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  MsgId                         7a   Const
     D  MsgFq                        20a   Const
     D  MsgDta                      128a   Const
     D  MsgDtaLen                    10i 0 Const
     D  MsgTyp                       10a   Const
     D  CalStkE                      10a   Const  Options( *VarSize )
     D  CalStkCtr                    10i 0 Const
     D  MsgKey                        4a
     D  Error                      1024a          Options( *VarSize )

     **-- Send escape message:
     D SndEscMsg       Pr            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgDta                    512a   Const  Varying

     **-- Entry parameters:
     D CBX708          Pr
     D  PxAutLst                     10a

     D CBX708          Pi
     D  PxAutLst                     10a

      /Free

        CrtUsrSpc( USRSPC
                 : *Blanks
                 : 65535
                 : x'00'
                 : '*CHANGE'
                 : *Blanks
                 : '*YES'
                 : ERRC0100
                 );

        LstAutLstObj( USRSPC
                    : 'ATLO0210'
                    : PxAutLst
                    : ERRC0100
                    );

        If  ERRC0100.BytAvl = *Zero;
          ExSr  PrcLstEnt;

        Else;
          If  ERRC0100.BytAvl < OFS_MSGDTA;
            ERRC0100.BytAvl = OFS_MSGDTA;
          EndIf;

          SndEscMsg( ERRC0100.MsgId
                   : 'QCPFMSG'
                   : %Subst( ERRC0100.MsgDta
                           : 1
                           : ERRC0100.BytAvl - OFS_MSGDTA
                           ));
        EndIf;

        DltUsrSpc( USRSPC: ERRC0100 );

        *InLr = *On;

        Return;

        BegSr  PrcLstEnt;

          RtvPtrSpc( USRSPC: pUsrSpc );

          pHdrInf = pUsrSpc + UsrSpcHdr.OfsHdr;
          pLstEnt = pUsrSpc + UsrSpcHdr.OfsLst;

          For  Idx = 1  to UsrSpcHdr.NumLstEnt;

            pQlg_Path_Name = pUsrSpc + ATLO0210.OfsPthNam;

            PthNam = %Subst( Qlg_Path_Name.PthNam: 1: Qlg_Path_Name.PthNamLen );

            If  Idx < UsrSpcHdr.NumLstEnt;
              pLstEnt += UsrSpcHdr.SizLstEnt +
                       ( %Size( Qlg_Path_Name ) -
                         %Size( Qlg_Path_Name.PthNam )) +
                         Qlg_Path_Name.PthNamLen;
            EndIf;
          EndFor;

        EndSr;

      /End-Free

     **-- Send escape message:  ----------------------------------------------**
     P SndEscMsg       B
     D                 Pi            10i 0
     D  PxMsgId                       7a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     D MsgKey          s              4a

      /Free

        SndPgmMsg( PxMsgId
                 : PxMsgF + '*LIBL'
                 : PxMsgDta
                 : %Len( PxMsgDta )
                 : '*ESCAPE'
                 : '*PGMBDY'
                 : 1
                 : MsgKey
                 : ERRC0100
                 );

        If  ERRC0100.BytAvl > *Zero;
          Return  -1;

        Else;
          Return   0;
        EndIf;

      /End-Free

     P SndEscMsg       E


Two things are worth mentioning regarding the processing of the list
entries:

- The offset to the path name structure is calculated from the beginning of
the user space, as opposed to the beginning of the list entry.

- The offset to the next list entry is calculated based on the following
variables: API header list entry size + size of fixed part of Path name
structure + Path name length.

Thanks to Carsten Flensburg
阅读(851) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~