× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Hello Chuck,

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

Best regards,
Carsten Flensburg




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.