**
** Program . . : CBX1292
** Description : Manage profile authorization - CPP
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : January 20, 2005
**
**
** Program description:
**
**
** Compile options:
** CrtRpgMod Module( CBX1292 )
** DbgView( *NONE )
** Aut( *USE )
**
** CrtPgm Pgm( CBX1292 )
** Module( CBX1292 )
** ActGrp( *NEW )
** UsrPrf( *OWNER )
** Aut( *USE )
**
** ChgObjOwn Obj( CBX1292 )
** ObjType( *PGM )
** NewOwn( QSECOFR )
**
** ChgPgm Pgm( CBX1292 )
** RmvObs( *ALL )
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt )
**-- System information:
D PgmSts SDs Qualified
D PgmNam *Proc
D CurJob 10a Overlay( PgmSts: 244 )
D UsrPrf 10a Overlay( PgmSts: 254 )
D JobNbr 6a Overlay( PgmSts: 264 )
D CurUsr 10a Overlay( PgmSts: 358 )
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 512a
**-- Global constants:
D VLD_LST c 'CBX128L'
D QSY_IN_VLDL c 0
D QSY_SYSTEM_ATTR...
D c 0
D ADP_PRV_INVLVL c 1
**-- Validation list API structures:
D Qsy_Vfy_Only s 1a Inz( '0' )
**-- Global variables:
D AtrDta Ds Qualified
D CrtDat 8a
D LstVfyDat 8a
D PwdChgDat 8a
D InvPwdCnt 10i 0
**
D UsrDta s 128a
**-- Validation list attribute data:
D Qsy_Attr_Info_T...
D Ds Qualified
D Number_Attrs 10i 0 Inz( 1 )
D Res_align 12a
D Attr_Descr LikeDs( Qsy_Attr_Descr_T )
D Inz( *LikeDs )
**
D Qsy_Attr_Descr_T...
D Ds Qualified
D Attr_Location 10i 0 Inz( QSY_IN_VLDL )
D Attr_Type 10i 0 Inz( QSY_SYSTEM_ATTR )
D Attr_Res 8a Inz( *Allx'00' )
D Attr_ID_p *
D Attr_Other_Descr...
D 32a Inz( *Allx'00' )
D Attr_Data_Info...
D 96a
D Attr_VLDL LikeDs( Qsy_In_VLDL_T )
D Overlay( Attr_Data_Info: 1 )
D Inz( *LikeDs )
D Attr_In_Other...
D 96a Overlay( Attr_Data_Info: 1 )
D 64a Overlay( Attr_In_Other: 33 )
D Inz( *Allx'00' )
D Attr_Other_Data...
D 32a Inz( *Allx'00' )
**
D Qsy_In_VLDL_T Ds Qualified
D Attr_CCSID 10i 0 Inz( -1 )
D Attr_Len 10i 0 Inz( 1 )
D Attr_Res_1 8a Inz( *Allx'00' )
D Attr_Value_p *
**
D Qsy_Rtn_VLDL_Attr_T...
D Ds Qualified
D Bytes_Returned...
D 10i 0
D Bytes_Available...
D 10i 0
D Attr_Len 10i 0
D Attr_CCSID 10u 0
D Attr_Data LikeDs( Qsy_Rtn_Entry_Usage_Attr_T )
**
D Qsy_Rtn_Entry_Usage_Attr_T...
D Ds Qualified
D Create_Date 8a
D Last_Used_Date...
D 8a
D Encr_Data_Chg_Date...
D 8a
D Not_Valid_Verify_Count...
D 10i 0
**-- Validation list return data:
D Qsy_Rtn_Vld_Lst_Ent_T...
D Ds Qualified
D Entry_ID_Info LikeDs( Qsy_Entry_ID_Info_T )
D Encr_Data_Info...
D LikeDs( Qsy_Entry_Encr_Data_Info_T )
D Entry_Data_Info...
D LikeDs( Qsy_Entry_Data_Info_T )
D 4a
D AtrPtr *
**
D Qsy_Entry_ID_Info_T...
D Ds Qualified
D Entry_ID_Len 10i 0
D Entry_ID_CCSID...
D 10i 0 Inz( 65535 )
D Entry_ID 100a
**
D Qsy_Entry_Encr_Data_Info_T...
D Ds Qualified
D Encr_Data_Len 10i 0
D Encr_Data_CCSID...
D 10i 0 Inz( 65535 )
D Encr_Data 600a
**
D Qsy_Entry_Data_Info_T...
D Ds Qualified
D Entry_Data_Len...
D 10i 0
D Entry_Data_CCSID...
D 10i 0
D Entry_Data 1000a
**-- Global variables:
D AutFlg s 1a
D RtnCod s 1a
**-- Check special authority
D ChkSpcAut Pr ExtPgm( 'QSYCUSRS' )
D CsAutInf 1a
D CsUsrPrf 10a Const
D CsSpcAut 10a Const Dim( 8 ) Options( *VarSize )
D CsNbrAut 10i 0 Const
D CsCalLvl 10i 0 Const
D CsError 32767a Options( *VarSize )
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 1024a Options( *VarSize )
**-- Find validation list entry attributes:
D FndVldLstAtr Pr 10i 0 ExtProc( 'QsyFindValidation+
D LstEntryAttrs' )
D FvLstNam 20a Const
D FvEntId * Value
D FvRtnDta * Value
D FvAtrInf * Value
**-- Remove validation list entry:
D RmvVldLstE Pr 10i 0 ExtProc( 'QsyRemoveValidation+
D LstEntry' )
D RvLstNam 20a Const
D RvEntId * Value
**-- Get usage information:
D GetUsgInf Pr 28a
D PxVldLst 10a Const
D PxVldLstLib 10a Const
D PxUsrId 20a Const
**-- Remove user password:
D RmvUsrPwd Pr 10i 0
D PxVldLst 10a Const
D PxVldLstLib 10a Const
D PxUsrId 20a Const
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send message by type:
D SndMsgTyp Pr 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
D PxMsgTyp 10a Const
**-- Entry parameters:
D CBX1292 Pr
D PxUsrPrf 10a
D PxGrpPrf 10a
D PxOption 3a
**
D CBX1292 Pi
D PxUsrPrf 10a
D PxGrpPrf 10a
D PxOption 3a
/Free
ChkSpcAut( AutFlg
: PgmSts.UsrPrf
: '*SECADM'
: 1
: ADP_PRV_INVLVL
: ERRC0100
);
If ERRC0100.BytAvl > *Zero Or AutFlg = 'N';
SndEscMsg( 'Special authority *SECADM required.' );
Else;
Select;
When PxOption = 'RMV';
If RmvUsrPwd( VLD_LST: '*LIBL': PxUsrPrf + PxGrpPrf ) = -1;
SndEscMsg( 'Unexpected error occurred.' );
Else;
SndCmpMsg( 'Authorization code removed.' );
EndIf;
When PxOption = 'VFY';
AtrDta = GetUsgInf( VLD_LST
: '*LIBL'
: PxUsrPrf + PxGrpPrf
);
If AtrDta = *Blanks;
SndEscMsg( 'Unexpected error occurred.' );
Else;
SndMsgTyp( 'CBX0001'
: 'CBX1292M'
: PxUsrPrf + PxGrpPrf + AtrDta
: '*COMP'
);
EndIf;
EndSl;
EndIf;
*InLr = *On;
Return;
/End-Free
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( 'CPF9898'
: 'QCPFMSG *LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
P SndEscMsg E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*COMP'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
**
P SndCmpMsg E
**-- Send message by type: ---------------------------------------------**
P SndMsgTyp B
D Pi 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
D PxMsgTyp 10a Const
**
D MsgKey s 4a
/Free
SndPgmMsg( PxMsgId
: PxMsgF + '*LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: PxMsgTyp
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
P SndMsgTyp E
**-- Remove user password: ---------------------------------------------**
P RmvUsrPwd B Export
D Pi 10i 0
D PxVldLst 10a Const
D PxVldLstLib 10a Const
D PxUsrId 20a Const
/Free
Reset Qsy_Entry_ID_Info_T;
Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );
Return RmvVldLstE( PxVldLst + PxVldLstLib
: %Addr( Qsy_Entry_ID_Info_T )
);
/End-Free
P RmvUsrPwd E
**-- Get usage information: --------------------------------------------**
P GetUsgInf B Export
D Pi 28a
D PxVldLst 10a Const
D PxVldLstLib 10a Const
D PxUsrId 20a Const
/Free
Reset Qsy_Entry_ID_Info_T;
Reset Qsy_Entry_Encr_Data_Info_T;
Qsy_Entry_ID_Info_T.Entry_ID = PxUsrId;
Qsy_Entry_ID_Info_T.Entry_ID_Len = %Size( PxUsrId );
Qsy_Attr_Info_T.Attr_Descr.Attr_ID_p = %Alloc( 14 );
%Str( Qsy_Attr_Info_T.Attr_Descr.Attr_ID_p: 14 ) = 'QsyEntryUsage';
Qsy_Attr_Info_T.Attr_Descr.Attr_VLDL.Attr_Len =
%Size( Qsy_Rtn_VLDL_Attr_T );
Qsy_Attr_Info_T.Attr_Descr.Attr_VLDL.Attr_Value_p =
%Addr( Qsy_Rtn_VLDL_Attr_T );
If FndVldLstAtr( PxVldLst + PxVldLstLib
: %Addr( Qsy_Entry_ID_Info_T )
: %Addr( Qsy_Rtn_Vld_Lst_Ent_T )
: %Addr( Qsy_Attr_Info_T )
) = -1;
Return *Blanks;
Else;
Return %SubSt( Qsy_Rtn_VLDL_Attr_T.Attr_Data
: 1
: Qsy_Rtn_VLDL_Attr_T.Attr_Len
);
EndIf;
/End-Free
P GetUsgInf E
阅读(1647) | 评论(0) | 转发(0) |
