|
midrange.com
Here goes:
First the command:
CMD PROMPT('Reroute Messages using SMTP')
PARM KWD(MSGQ) TYPE(MSGQTYPE) CHOICE('Name of +
Message queue') PROMPT('Message Queue')
PARM KWD(EMAILADR) TYPE(*CHAR) LEN(30) DFT(*MSGQ) +
CHOICE('*MSGQ, EMail name') PROMPT('EMail +
name')
PARM KWD(DOMAIN) TYPE(*CHAR) LEN(30) DFT(DEKKO) +
CHOICE('DEKKO, or other WRKDIRE domain') +
PROMPT('EMail domain')
MSGQTYPE: QUAL TYPE(*SNAME) LEN(10) DFT(*USRPRF) +
SPCVAL((*USRPRF)) CHOICE('*USRPRF, +
message queue')
QUAL TYPE(*SNAME) DFT(QUSRSYS) CHOICE('QUSRSYS, +
library') PROMPT('Library')
Next, the CLP:
/* Group Dekko Services, LLC */
/* ALL RIGHTS RESERVED. */
/* */
/* This program will reroute messages to someone email account. */
/* */
/* */
/* Modification log: */
/* 05/07/98 by R.Berendt, CDP GDS,LLC */
/* Created */
/* 06/22/98 by R.Berendt, CDP GDS,LLC */
/* Chris Edwards' doesn't want SNADSCHK messages. */
/* */
/* */
PGM ( +
&MSGQ /* Name of message queue to monitor */ +
&EMAILADR /* SMTP EMail address. */ +
&DOMAIN /* Must be in WRKDIRE */ +
)
DCL &DESC *CHAR 44 /* Description of message */
DCL &DOMAIN *CHAR 30 /* Must be in WRKDIRE */
DCL &EMAILADR *CHAR 30 /* SMTP EMail address. */
DCL &MSGID *CHAR 7 /* Message number */
DCL &MSGLEN *DEC 5 /* Length of message text */
DCL &MSGQ *CHAR 20 /* Message queue and lib to monitor */
DCL &MSGQLIB *CHAR 10 /* Library of message queue to mon */
DCL &MSGQNAME *CHAR 10 /* Name of message queue to monitor */
DCL &MSGSEV *DEC 2 /* */
DCL &MSGTXT *CHAR 256 /* Message text */
DCL &SCANSTRING *CHAR 8 /* Scan for SNADSCHK */
DCL &SYSNAME *CHAR 8 /* Name of this system */
DCL &USRPRF *CHAR 10 /* User profile running job */
DCL &X *DEC 3 /* Counting variable */
/* +
| Retrive user profile of who is running this job. +
*/
RTVJOBA USER(&USRPRF)
/* +
| Parse message queue to monitor into object and library. +
*/
CHGVAR VAR(&MSGQNAME) VALUE(%SST(&MSGQ 1 10))
CHGVAR VAR(&MSGQLIB) VALUE(%SST(&MSGQ 11 10))
/* +
| If the &MSGQNAME is *USRPRF then retrieve the user profile of the
job +
*/
IF COND(&MSGQNAME = '*USRPRF') THEN(CHGVAR +
VAR(&MSGQNAME) VALUE(&USRPRF))
/* +
| If the &EMAILADR is *MSGQ then use the name of the message queue
for +
| the email address. +
*/
IF COND(&EMAILADR = '*MSGQ') THEN(CHGVAR +
VAR(&EMAILADR) VALUE(&MSGQNAME))
/* +
| Check validity of domain. for +
*/
DLTF FILE(QTEMP/XYZTEMP)
MONMSG MSGID(CPF0000)
DSPDIRE USRID(*ANY &DOMAIN) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/XYZTEMP)
MONMSG MSGID(CPF9006) CMPDTA(*NONE) EXEC(DO)
CHGVAR VAR(&MSGTXT) VALUE(&DOMAIN *BCAT 'is an +
invalid domain. It is not in the WRKDIRE +
with a *ANY entry.')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSGTXT) +
MSGTYPE(*ESCAPE)
GOTO CMDLBL(END)
ENDDO
/* +
| Create generic message description. for +
*/
RTVNETA SYSNAME(&SYSNAME)
CHGVAR VAR(&DESC) VALUE(&SYSNAME *TCAT ': ' *CAT +
&MSGQNAME *BCAT 'in' *BCAT &MSGQLIB)
LOOP:
/* +
| Receive the first new message that comes into message queue +
| Wait as long as necessary to receive the message. +
*/
RCVMSG MSGQ(&MSGQLIB/&MSGQNAME) WAIT(*MAX) RMV(*NO) +
MSG(&MSGTXT) MSGLEN(&MSGLEN) +
MSGID(&MSGID) SEV(&MSGSEV)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&MSGTXT) VALUE('Unable to monitor' *BCAT +
&MSGQLIB *TCAT '/' *TCAT &MSGQNAME *BCAT +
'on' *BCAT &SYSNAME)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSGTXT) +
MSGTYPE(*ESCAPE)
GOTO CMDLBL(END)
ENDDO
/* +
| If the message is greater than the maximum SNDDST supports, 256,
+
| then put '...' at the end of the message. +
*/
IF COND(&MSGLEN > 256) THEN(DO)
CHGVAR VAR(%SST(&MSGTXT 254 3)) VALUE('...')
ENDDO
/* +
| Chris Edwards doesn't want SNADSCHK messages. +
*/
IF COND(&USRPRF = 'CHRIS') THEN(DO)
CHGVAR VAR(&X) VALUE(1)
SCAN: IF COND(%SST(&MSGTXT &X 8) *EQ 'SNADSCHK') +
THEN(GOTO CMDLBL(LOOP))
CHGVAR VAR(&X) VALUE(&X + 1)
IF COND(&X < 100) THEN(GOTO CMDLBL(SCAN))
ENDDO /* CHRIS */
/* +
| Send the message. +
*/
SNDDST TYPE(*MSG) TOUSRID((&EMAILADR &DOMAIN)) +
DSTD(&DESC) MSG(&MSGTXT)
GOTO LOOP
END:
ENDPGM
Lastly, after the program is written:
The directory entry:
ADDDIRE USRID(*ANY DEKKO) USRD('*ANY at DEKKO.COM')
SYSNAME(TCPIP)
USRDFNFLD((SMTPDMN SMTP 'DEKKO.COM'))
PREFADR(*SMTP)
CHGJOBD JOBD(CHRIS/CHRISMSG)
JOBQ(QSYS/QSYSNOMAX)
TEXT('Send all messages into email')
USER(CHRIS)
RQSDTA('RRTMSGSMTP MSGQ(CHRIS)')
INLLIBL(QTEMP QGPL ROUTINES TAATOOL TAAFILE)
ADDAJE SBSD(QSYSWRK) JOB(CHRISMSG) JOBD(CHRIS/CHRISMSG)
Rob Berendt
--
"They that can give up essential liberty to obtain a little temporary
safety deserve neither liberty nor safety."
Benjamin Franklin
"Tom Jedrzejewicz @ San Pedro" <TJedrzejewicz
Sent by: midrange-l-bounces@xxxxxxxxxxxx
04/03/2003 12:14 PM
Please respond to Midrange Systems Technical Discussion
To: <midrange-l@xxxxxxxxxxxx>
cc:
Fax to:
Subject: Re: Refresh Question......
Sir -- this would be an excellent piece of code to post for the
archives!
>>> rob@xxxxxxxxx 04/03/03 08:09AM >>>
Have QSYSOPR monitored by a program. Every time a new message arrives,
forward it on to their email. We have a few users that stopped using
DSPMSG for their own messages quite some time ago and just check their
email. I'll be honest, I check my email more than my messages. In
fact
it's been 3 hours since I last did a dspmsg.
Rob Berendt
--
"They that can give up essential liberty to obtain a little temporary
safety deserve neither liberty nor safety."
Benjamin Franklin
"Segars, Steven " <Steven_Segars@xxxxxxx>
Sent by: midrange-l-bounces@xxxxxxxxxxxx
04/03/2003 08:51 AM
Please respond to Midrange Systems Technical Discussion
To: "'midrange-l@xxxxxxxxxxxx'" <midrange-l@xxxxxxxxxxxx>
cc:
Fax to:
Subject: Refresh Question......
We have a LAZY help desk and they monitor the QSYSOPR message queue and
they
leave it on that screen all the time. When the sprit moves them, they
press
the F5 key to update the screen to see if theirs any messages out there
that
need looking at. They ask me if there was a way to automatically invoke
the
F5 (REFRESH) key without them having to press it. I know I will have
to
create a new display screen like the WRKSYSACT one that can be set up
to
automatically update, but I was just wondering if someone knows of a
tool
that already does this without me having to recreate it?
Steven Segars
AS/400 Certified Specialist/Administrator
CSX Technology
Work: 904-633-5650
Fax: 904 633-1051
_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.
_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.
THIS MESSAGE IS INTENDED ONLY FOR THE USE OF THE INDIVIDUAL OR ENTITY TO
WHICH IT IS ADDRESSED AND MAY CONTAIN INFORMATION THAT IS PRIVILEGED,
CONFIDENTIAL AND EXEMPT FROM DISCLOSURE UNDER APPLICABLE LAW. If the
reader of this message is not the intended recipient, or the employee or
agent responsible for delivering the message to the intended recipient,
you are hereby notified that any dissemination, distribution, copying,
downloading, storing or forwarding of this communication is prohibited. If
you have received this communication in error, please notify us
immediately via email and delete the message from your computer files
and/or data base. Thank you.
_______________________________________________
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing
list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/midrange-l.
As an Amazon Associate we earn from qualifying purchases.
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.
