|
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 mailing list archive is Copyright 1997-2025 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.
