Move Program Messages & Resend Escape Message
To disallow *PUBLIC to see messages in a message queue but still be able to send
messages to it, set *PUBLIC authority to *CHANGE and remove read data authority.
- And check that the user profile relating to the message queue has *ALL authority
to avoid problems on that account.
Here's a small CL program that will do it for a single user profile message queue:
/*-- Compile instructions: ------------------------------------------*/
/*-- USRPRF(*OWNER) and transfer ownership to QSECOFR */
/*-- Parameters: ---------------------------------------------------*/
Pgm &UsrPrf
Dcl &UsrPrf *Char 10
/*-- Global variables: ---------------------------------------------*/
Dcl &MsgQ *Char 10
Dcl &MsgQlib *Char 10
Dcl &UsrPrf *Char 10
Dcl &MsgKey *Char 4 ' '
Dcl &ToCalStkE *Char 38
/*-- Global monitor: -----------------------------------------------*/
MonMsg CPF0000 *None GoTo Error
/*-- Message API parameter inz: ------------------------------------*/
ChgVar %Bin( &ToCalStkE 1 4 ) 1
ChgVar %Sst( &ToCalStkE 5 20 ) '*NONE *NONE '
ChgVar %Bin( &ToCalStkE 25 4 ) 10
ChgVar %Sst( &ToCalStkE 29 10 ) '*PGMBDY '
/*-- Set user message queue authority: -----------------------------*/
If ( &UsrPrf = ' ' ) Do
ChgVar &UsrPrf '*CURRENT'
EndDo
Else Do
ChkObj &UsrPrf *USRPRF
EndDo
RtvUsrPrf &UsrPrf MsgQ( &MsgQ ) MsgQlib( &MsgQlib ) +
RtnUsrPrf( &UsrPrf )
AlcObj (( &MsgQlib/&MsgQ *MSGQ *EXCL )) Wait( 0 )
RvkObjAut &MsgQlib/&MsgQ *MSGQ +
User( *ALL ) Aut( *ALL )
GrtObjAut &MsgQlib/&MsgQ *MSGQ +
User( *PUBLIC ) Aut( *OBJOPR *ADD *UPD *DLT *EXECUTE )
GrtObjAut &MsgQlib/&MsgQ *MSGQ +
User( &UsrPrf ) Aut( *ALL )
DlcObj (( &MsgQlib/&MsgQ *MSGQ *EXCL ))
/*-- Return: -------------------------------------------------------*/
Return:
Call QMHMOVPM ( &MsgKey +
'*COMP' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000000000008' +
)
Return
/*-- Error routines: -----------------------------------------------*/
Error:
Call QMHMOVPM ( &MsgKey +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000000000008' +
)
Call QMHRSNEM ( &MsgKey +
x'0000000000000008' +
&ToCalStkE +
x'00000026' +
'RSNM0100' +
'* ' +
x'00000000' +
)
EndPgm:
EndPgm
Thanks to Carsten Flensburg
阅读(918) | 评论(0) | 转发(0) |
