× 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.



It is possible to take the "user or system" status of a library into the
*OBJD domain ... with a little programming.

The User-defined Attribute is 10 bytes long, can be set and even protected
with an API.  I have a hand-built command and cpp.

Though of course we shouldn't have to.

Jeff Bull
****************************************************************************
******
             CMD        PROMPT('Set Object USRDFNATR')

             PARM       KWD(OBJ) TYPE(QUAL1) MIN(1) PROMPT('Object +
                          name')
             PARM       KWD(TYPE) TYPE(*CHAR) LEN(7) RSTD(*YES) +
                          VALUES(*ALRTBL *AUTL *BNDDIR *CFGL +
                          *CHTFMT *CLD *CLS *CMD *CNNL *COSD *CRQD +
                          *CSI *CSPMAP *CSPTBL *CTLD *DEVD *DOC +
                          *DTAARA *DTADCT *DTAQ *EDTD *EXITRG *FCT +
                          *FILE *FLR *FNTRSC *FNTTBL *FORMDF *FTR +
                          *GSS *IPXD *JOBD *JOBQ *JOBSCD *JRN +
                          *JRNRCV *LIB *LIND *LOCALE *MENU *MODD +
                          *MODULE *MSGF *MSGQ *M36 *M36CFG *NODGRP +
                          *NODL *NTBD *NWID *NWSD *OUTQ *OVL +
                          *PAGDFN *PAGSEG *PDG *PGM *PNLGRP *PRDAVL +
                          *PRDDFN *PRDLOD *PSFCFG *QMFORM *QMQRY +
                          *QRYDFN *RCT *SBSD *SCHIDX *SPADCT +
                          *SQLPKG *SRVPGM *SSND *SVRSTG *S36 *TBL +
                          *USRIDX *USRPRF *USRQ *USRSPC *VLDL +
                          *WSCST) MIN(1) CHOICE(*VALUES) +
                          PROMPT('Object type')
             PARM       KWD(USRDFNATR) TYPE(*CHAR) LEN(10) +
                          DFT(*BLANK) CHOICE('character value') +
                          PROMPT('User defined attribute')
             PARM       KWD(ALWPGMCHG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
                          DFT(*YES) VALUES(*YES *NO) SPCVAL((*YES +
                          *YES) (*NO *NO)) PASSVAL(*DFT) +
                          CHOICE(*VALUES) PROMPT('Allow change by +
                          program')
 QUAL1:      QUAL       TYPE(*NAME) LEN(10) CHOICE('name')
             QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
                          *CURLIB)) CHOICE('name')
***************************************************************
             PGM        PARM(&OBJLIB &WKC007 &USRATR &ALWCHG)

/* QLICOBJD Parms */
             DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(20)
             DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)
             DCL        VAR(&DATA)   TYPE(*CHAR) LEN(22)
             DCL        VAR(&ALWCHG) TYPE(*CHAR) LEN(4)
             DCL        VAR(&ERRCDE) TYPE(*CHAR) LEN(22)

/* Contents of &DATA */
             DCL        VAR(&RCD) TYPE(*CHAR) LEN(4) VALUE(X'00000001')
             DCL        VAR(&KEY) TYPE(*CHAR) LEN(4) VALUE(X'00000009')
             DCL        VAR(&LEN) TYPE(*CHAR) LEN(4) VALUE(X'0000000A')
             DCL        VAR(&USRATR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&ALW) TYPE(*CHAR) LEN(1)

/* Contents of &ERRCDE */
             DCL        VAR(&ERA) TYPE(*CHAR) LEN(4) VALUE(X'00000016')
             DCL        VAR(&ERB) TYPE(*CHAR) LEN(4)
             DCL        VAR(&ERC) TYPE(*CHAR) LEN(7)
             DCL        VAR(&ERD) TYPE(*CHAR) LEN(1)
             DCL        VAR(&ERE) TYPE(*CHAR) LEN(6)

/* Work variables */
             DCL        VAR(&LIBNAM)  TYPE(*CHAR) LEN(10)
             DCL        VAR(&MSGDTA)  TYPE(*CHAR) LEN(512)
             DCL        VAR(&MSGF)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&MSGID)   TYPE(*CHAR) LEN(7)
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)

             DCL        VAR(&OBJNAM)  TYPE(*CHAR) LEN(10)
             DCL        VAR(&WKC007)  TYPE(*CHAR) LEN(7)

/* INITIALISATION */
 LBL000:
   /* Trap Unmonitored Error Messages */
             MONMSG     MSGID(CPF0000 MCH0000) EXEC(GOTO +
                          CMDLBL(LBL900))

   /* Parameter processing */
             CHGVAR     VAR(&OBJTYP) VALUE(&WKC007)
             CHGVAR     VAR(&ALW) VALUE('1')
             IF         COND(&ALWCHG *EQ '*NO') THEN(CHGVAR +
                          VAR(&ALW) VALUE('0'))

/* MAIN PROCESSING */

   /* Pack &DATA */
             CHGVAR     VAR(&DATA) VALUE(&RCD || &KEY || &LEN || +
                          &USRATR)

   /* Pack &ERRCDE */
             CHGVAR     VAR(&ERRCDE) VALUE(&ERA || &ERB || &ERC || +
                          &ERD)

   /* Validation */
             CHGVAR     VAR(&OBJNAM) VALUE(%SST(&OBJLIB 1 10))
             CHGVAR     VAR(&LIBNAM) VALUE(%SST(&OBJLIB 11 10))
             CHKOBJ     OBJ(&LIBNAM/&OBJNAM) OBJTYPE(&OBJTYP) AUT(*ALL)
             MONMSG     MSGID(CPF0000) +
             EXEC(DO)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Error +
                          encountered accessing object' |> &OBJNAM +
                          |> 'of type' |> &OBJTYP |> 'in library' +
                          |> &LIBNAM |< '. Either the object does +
                          not exist, or perhaps you do not have +
                          *ALL authority to it.  Check previous +
                          error messages in your joblog for more +
                          details.') TOPGMQ(*PRV) MSGTYPE(*ESCAPE)
             GOTO       CMDLBL(LBL990)
             ENDDO

   /* API call for USRDFNATR */
             CALL       PGM(QSYS/QLICOBJD) PARM(&RTNLIB &OBJLIB +
                          &OBJTYP &DATA &ERRCDE)
             MONMSG     MSGID(CPF0000) +
             EXEC(DO)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Error +
                          encountered with low-level system call.  +
                          Check joblog for details') TOPGMQ(*PRV) +
                          MSGTYPE(*ESCAPE)
             GOTO       CMDLBL(LBL990)
             ENDDO
             CHGVAR     VAR(&ERB) VALUE(%SST(&ERRCDE 5 4))
             CHGVAR     VAR(&ERC) VALUE(%SST(&ERRCDE 9 7))
             CHGVAR     VAR(&ERD) VALUE(%SST(&ERRCDE 16 1))
             CHGVAR     VAR(&ERE) VALUE(%SST(&ERRCDE 17 6))
             IF         COND(&ERC *NE '       ') +
             THEN(DO)
             SNDPGMMSG  MSGID(&ERC) MSGF(QCPFMSG) MSGDTA(&OBJLIB || +
                          %SST(&OBJTYP 2 6)) TOPGMQ(*PRV (*)) +
                          MSGTYPE(*COMP)
             GOTO       CMDLBL(LBL990)
             ENDDO

   /* API call for ALWCHGPGM */
      /* Pack &DATA */

             CHGVAR     VAR(&KEY) VALUE(X'00000008')
             CHGVAR     VAR(&LEN) VALUE(X'00000001')
             CHGVAR     VAR(&DATA) VALUE(&RCD || &KEY || &LEN || &ALW)

             CALL       PGM(QSYS/QLICOBJD) PARM(&RTNLIB &OBJLIB +
                          &OBJTYP &DATA &ERRCDE)
             MONMSG     MSGID(CPF0000) +
             EXEC(DO)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Error +
                          encountered with low-level system call.  +
                          Check joblog for details') TOPGMQ(*PRV) +
                          MSGTYPE(*ESCAPE)
             GOTO       CMDLBL(LBL990)
             ENDDO
             CHGVAR     VAR(&ERB) VALUE(%SST(&ERRCDE 5 4))
             CHGVAR     VAR(&ERC) VALUE(%SST(&ERRCDE 9 7))
             CHGVAR     VAR(&ERD) VALUE(%SST(&ERRCDE 16 1))
             CHGVAR     VAR(&ERE) VALUE(%SST(&ERRCDE 17 6))
             IF         COND(&ERC *NE '       ') +
             THEN(DO)
             SNDPGMMSG  MSGID(&ERC) MSGF(QCPFMSG) MSGDTA(&OBJLIB || +
                          %SST(&OBJTYP 2 6)) TOPGMQ(*PRV (*)) +
                          MSGTYPE(*COMP)
             GOTO       CMDLBL(LBL990)
             ENDDO

             GOTO       CMDLBL(LBL990) /* Normal exit */

/* UNMONITORED ERROR HANDLING */

   /* Process Diagnostic Messages */
 LBL900:     RCVMSG     MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(LBL910))
             IF         COND(&MSGID = '       ') THEN(GOTO +
                          CMDLBL(LBL910))
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(LBL910))
             GOTO       CMDLBL(LBL900)

   /* Print Diagnostics */
 LBL910:     OVRPRTF    FILE(QPJOBLOG) HOLD(*YES)
             DSPJOB     JOB(*) OUTPUT(*PRINT) OPTION(*JOBLOG)
             MONMSG     MSGID(CPF0000)
             OVRPRTF    FILE(QPPGMDMP) HOLD(*YES)
             DMPCLPGM

   /* Process Exception Message */
             RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)
             MONMSG     MSGID(CPF0000)
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*ESCAPE)
             MONMSG     MSGID(CPF0000)

/* Program exit */
 LBL990:     RETURN
             ENDPGM


Jeffrey E. Bull
OS400 Software Support Consultant
 
IBM Certified AS/400 System Administrator 

tel.      +44 [0] 149 454 9533               swb.   +44 [0] 149 454 9400
mbl.     +44 [0] 786 750 4961               fax.    +44 [0] 149 454 9454
web.     http://www.itm-group.co.uk
 
ITM Group Ltd, Latimer Square, White Lion Road, Amersham, Buckinghamshire,
HP7 9JQ, United Kingdom


-----Original Message-----
From: Joe Pluta [mailto:joepluta@PlutaBrothers.com]
Sent: 07 February 2003 13:50
To: Midrange Systems Technical Discussion
Subject: RE: QSYS2


> From: Al Barsa
>
> I copied an IBMer on the note, and apparently QSYS2 changed from an *IBM
> library to an *ALLUSR library over at V5R2.  I don't understand.  What are
> these yahoo's thinking.  This will @#$% up everybody's custom save/restore
> code, including mine.

I suggest that SOMEBODY with a little clout, or at least a little
visibility, write a letter to the powers that be over at IBM.  This is the
sort of needless, arbitrary decision that can cause havoc.

Who made this decision?  Why did they think it was a good idea?  How did
they justify screwing with people's systems, or did they JUST NOT THINK?

Somewhere along the line, somebody made or approved this decision.  Either
that person needs to be responsible and tell us why, or that person needs to
not be able to make these decisions.

This is the type of thinking that has to be (sorry to use a Mayberry-ism)
nipped in the bud.

Joe

_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@midrange.com
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@midrange.com
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.


________________________________________________________________________
This e-mail has been scanned for all viruses by ITM. The
service is powered by MessageLabs. For more information on a proactive
anti-virus service working around the clock, around the globe, 
email marketing@itm-group.co.uk
ITM - Managing Communication and Information through technology
Company registration number - 3783433
________________________________________________________________________


DISCLAIMER

Any opinions expressed in this email are those of the
individual and not necessarily the Company. This email
and any files transmitted with it, including replies and
forwarded copies (which may contain alterations) 
subsequently transmitted from the Company, are 
confidential and solely for the use of the intended recipient. If you are not 
the intended recipient or the 
person responsible for delivering to the intended recipient, 
be advised that you have received this email in error and
 that any use is strictly prohibited.

If you have received this email in error please notify the IT
manager by telephone on +44 (0)870 871 2233 or via 
email to Administrator@itm-group.co.uk, including a copy
of this message. Please then delete this email and 
destroy any copies of it.

________________________________________________________________________This 
e-mail has been scanned for all viruses by ITM. The
service is powered by MessageLabs. For more information on a proactive
anti-virus service working around the clock, around the globe, 
email marketing@itm-group.co.uk
ITM - Managing Communication and Information through technology
Company registration number - 
3783433________________________________________________________________________

As an Amazon Associate we earn from qualifying purchases.

This thread ...


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.