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
阅读(854) | 评论(0) | 转发(0) |
