You are here:
DBG/400
>
DBG400 Web
>
SourceCodeList
>
CodeSamples
>
ClpCHGAUTDRAW
(27 Dec 2006,
MartinRowe
)
(raw view)
E
dit
A
ttach
---+ CHGAUTDRAW This CL program runs as a background task on our iSeries monitoring for new streamfiles created by a specific user in a specific IFS directory. As new files show up it changes the authority on them. Note that the two commands [[CmdMOVDIAGMSG][MOVDIAGMSG]] and [[CmdRSNESCMSG][RSNESCMSG]] are from Tom Liotta's excellent [[http://zap.to/tl400][Sharea]] site Note that when using RTVJRNE with QSYS objects the object name is found in the RTNJRNE parm value at position 2-11 (%SST(&RTNJRNE 2 10)), and the library in 12-21 (%SST(&RTNJRNE 12 10)) <verbatim> PGM DCL VAR(&DTQLEN) TYPE(*DEC) LEN(5 0) VALUE(6) DCL VAR(&DTQDTA) TYPE(*CHAR) LEN(6) DCL VAR(&DTQWAIT) TYPE(*DEC) LEN(5 0) VALUE(300) DCL VAR(&DTQNOWAIT) TYPE(*DEC) LEN(5 0) VALUE(0) DCL VAR(&OBJ) TYPE(*CHAR) LEN(86) DCL VAR(&TESTOBJ) TYPE(*CHAR) LEN(12) DCL VAR(&RTNJRNE) TYPE(*CHAR) LEN(1000) DCL VAR(&FTPDRAWSEQ) TYPE(*DEC) LEN(10 0) DCL VAR(&FROMENT) TYPE(*DEC) LEN(10 0) DCL VAR(&RTNSEQNBR) TYPE(*DEC) LEN(10 0) /* ***************************************************************** */ /* GLOBAL MESSAGE MONITOR */ /* ***************************************************************** */ MONMSG MSGID(CPF0000 RPG0000 QRG0000 RSF0000 + MCH0000) EXEC(GOTO CMDLBL(##ERROR)) GOTO CMDLBL(##NOERROR) ##ERROR: MOVDIAGMSG MONMSG MSGID(CPF0000) RSNESCMSG MONMSG MSGID(CPF0000) RETURN ##NOERROR: /* ***************************************************************** */ /* START OF MAINLINE CODE */ /* ***************************************************************** */ /* Get the last journal entry processed */ RTVDTAARA DTAARA(FTPDRAWSEQ) RTNVAR(&FTPDRAWSEQ) CHGVAR VAR(&FROMENT) VALUE(&FTPDRAWSEQ + 1) LOOPTOP: /* Pull back the next Created Object entry for the FTPDRAWING user */ RTVJRNE JRN(QAUDJRN) RCVRNG(*CURCHAIN) + FROMENT(&FROMENT) ENTTYP(CO) + USRPRF(FTPDRAWING) RTNSEQNBR(&RTNSEQNBR) + RTNJRNE(&RTNJRNE) /* Drop into the wait loop if a recognised error found */ /* CPF7073=No entry received, CPF9803=Cannot allocate object */ MONMSG MSGID(CPF7073 CPF9803) EXEC(GOTO CMDLBL(WAIT)) CHGVAR VAR(&TESTOBJ) VALUE(%SST(&RTNJRNE 925 12)) /* If this is a folder/stmf entry under /moorespc/CentralStore */ IF COND(&TESTOBJ *EQ 'CentralStore') THEN(DO) CHGVAR VAR(&OBJ) VALUE(%SST(&RTNJRNE 915 86)) /* Set authority */ CHGAUT OBJ(&OBJ) AUTL(CENTRAL) MONMSG MSGID(CPF0000) CHGAUT OBJ(&OBJ) USER(*PUBLIC) DTAAUT(*AUTL) + OBJAUT(*NONE) MONMSG MSGID(CPF0000) ENDDO /* Update last entry processed */ CHGDTAARA DTAARA(FTPDRAWSEQ) VALUE(&RTNSEQNBR) /* Check for shutdown request (no waiting) */ CALL PGM(QRCVDTAQ) PARM('CFTPDRW01Q' '*LIBL ' + &DTQLEN &DTQDTA &DTQNOWAIT) /* If flag set to leave... */ IF COND(&DTQDTA *EQ 'CANCEL') THEN(GOTO + CMDLBL(ENDPGM)) /* Bump up sequence number for next try */ CHGVAR VAR(&FROMENT) VALUE(&RTNSEQNBR + 1) GOTO CMDLBL(LOOPTOP) /* Job delay - while waiting for more entries to appear in the journal */ WAIT: CALL PGM(QRCVDTAQ) PARM('CFTPDRW01Q' '*LIBL ' + &DTQLEN &DTQDTA &DTQWAIT) /* If flag set to leave... */ IF COND(&DTQDTA *EQ 'CANCEL') THEN(GOTO + CMDLBL(ENDPGM)) /* No escape yet... */ GOTO CMDLBL(LOOPTOP) ENDPGM: RETURN ENDPGM </verbatim> -- Main.MartinRowe - 27 Dec 2006
E
dit
|
A
ttach
|
P
rint version
|
H
istory
: r1
|
B
acklinks
|
V
iew topic
|
Edit
w
iki text
|
M
ore topic actions
Topic revision: r1 - 27 Dec 2006 - 17:37:36 -
MartinRowe
DBG400
Log In
DBG400 Web
Index
Search
Changes
Notifications
Statistics
Site Map
Downloads
Webs
DBG400
Jamaro
Main
Sandbox
Sandtub
System
Send a link to this page
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400?
Send feedback