如何監控 QSYSOPR 所指定重要訊息並將訊息傳送至 Email ?
File : QDDSSRC
Member: MONMSGIDP
Type : PF
Usage : CRTPF MONMSGIDP
A R MONR
A MSGID 7
A K MSGID
ADD following MSGID which include word "attention" in message text to MONMSGIDP
CPF0907
CPI1165
CPI099B
CPF1050
CPI099D
CPPEA01
CPPEA02
CPPEA03
CPPEA04
CPPEA05
CPPEA06
CPPEA10
CPPEA11
CPPEA12
CPPEA13
CPPEA14
CPPEA18
CPPEA19
CPPEA23
CPPEA25
CPPEA26
CPPEA28
CPPEA30
CPPEA31
CPPEA38
CPPEA39
CPPEA40
CPPEA42
CPPEA47
CPPEA5A
CPPEA51
CPPEA52
CPPEA53
CPPEA54
CPPEA55
CPPEA56
CPPEA57
CPPEA58
CPPEA59
CPPEA60
CPPEA62
CPP1604
CPP8982
CPP8983
CPP8984
CPP8985
CPP8986
CPP8987
TCP2613
CPA57E9
File : QRPGLESRC
Member: MONQSYSOPR
Type : RPGLE
Usage : CRTBNDRPG PGM(MONQSYSOPR) TGTRLS(V5R1M0)
Target release must be V5R1 later for free format.
see document Configuring OS/400 SMTP
SBMJOB CMD(CALL MONQSYSOPR PARM('responsetouser@company.com'))
**
** Program . . : MONQSYSOPR
** Description : Monitor QSYSOPR message queue message which defined
** in PF MONMSGIDP, retrieve first level message and
** send mail with first level mesage by SNDDST command
** Author . . : Vengoal Chang
**
** Date . . : 2010/05/17
**
**-- Header specifications: --------------------------------------------**
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
FMONMSGIDP IF E K Disk
DMAIN Pr ExtPgm( 'MONSYSOPR')
D RspToMail 32
D
DMAIN PI
D RspToMail 32
**-- API error information:
D ERRC0100 Ds Qualified
D BytPro 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 128a
**-- Object information:
D OBJD0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D ObjNam 10a
D ObjLib 10a
D ObjTyp 10a
D ObjLibRtn 10a
**-- Message information structure:
D RCVM0200 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D MsgSev 10i 0
D MsgId 7a
D MsgTyp 2s 0
D MsgKey 4a
D MsgFilNam 10a
D MsgFilLib_s 10a
D MsgFilLib_u 10a
D SndJobNam 10a
D SndJobUsr 10a
D SndJobNbr 6a
D SndPgmNam 12a
D 4a
D DatSnt 7s 0
D TimSnt 6s 0
D TimSntMs 6s 0
D SndUsrPrf 10a
D 1a
D CcsIdStsTxt 10i 0
D CcsIdStsDta 10i 0
D AlrOpt 9a
D CcsIdMsgTxt 10i 0
D CcsIdMsgDta 10i 0
D DtaLenRtn 10i 0
D DtaLenAvl 10i 0
D MsgLenRtn 10i 0
D MsgLenAvl 10i 0
D HlpLenRtn 10i 0
D HlpLenAvl 10i 0
D VarDta 32767a
**
D MsgTxt52 s 52a
D MsgTxt s 1024a Varying
D MsgDta s 4096a Varying
D SecLvl s 4096a Varying
D MsgRpy s 1024a Varying
**-- Global variables:
D SecLvlFmt s 78a Dim( 64 )
D MsgTxtFmt s 78a Dim( 64 )
D NbrLinMsg s 5i 0
D NbrLinSec s 5i 0
D LinIdx s 5i 0
D SysDts s z
D MsgKey s 4a
D MsgTyp s 10a
D cmdStr S 3048
**-- Global constants:
D OFS_MSGDTA c 16
D JOB_CCSID c 0
D RPY_SENT c '2'
D TYP_INQ c 5
D TYP_RPY c 21
D MSG_TXT c '&N Message . . . . : '
D RPY_DTA c 'Reply . . . . . : '
D NO_WAIT c 0
D KEEP_STS c '*SAME'
D NULL c ''
D WAIT_MAX c -1
D OLD_STS c '*OLD'
D QUOTE C X'7D'
**-- Receive non-program message:
D RcvMsg Pr ExtPgm( 'QMHRCVM' )
D RcvVar 65535a Options( *VarSize )
D RcvVarLen 10i 0 Const
D FmtNam 10a Const
D MsgQueQ 20a Const
D MsgTyp 10a Const
D MsgKey 4a Const
D Wait 10i 0 Const
D MsgAct 10a Const
D Error 32767a Options( *VarSize )
D CcsId 10i 0 Const Options( *NoPass )
D AlwDftRpyRjt 10i 0 Const Options( *NoPass )
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D MsgId 7a Const
D MsgFil_q 20a Const
D MsgDta 32767a Const Options( *VarSize )
D MsgDtaLen 10i 0 Const
D MsgTyp 10a Const
D CalStkE 10a Const Options( *VarSize )
D CalStkCtr 10i 0 Const
D MsgKey 4a
D Error 32767a Options( *VarSize )
D CalStkElen 10i 0 Const Options( *NoPass )
D CalStkEq 20a Const Options( *NoPass )
D DspWait 10i 0 Const Options( *NoPass )
D CalStkEnTp 20a Const Options( *NoPass )
D CcsId 10i 0 Const Options( *NoPass )
**-- Retrieve message:
D RtvMsg Pr ExtPgm( 'QMHRTVM' )
D RcvVar 32767a Options( *VarSize )
D RcvVarLen 10i 0 Const
D FmtNam 10a Const
D MsgId 7a Const
D MsgFil_q 20a Const
D MsgDta 512a Const Options( *VarSize )
D MsgDtaLen 10i 0 Const
D RplSubVal 10a Const
D RtnFmtChr 10a Const
D Error 32767a Options( *VarSize )
D RtvOpt 10a Const Options( *NoPass )
D CvtCcsId 10i 0 Const Options( *NoPass )
D RplCcsId 10i 0 Const Options( *NoPass )
*** Prototypes for external subprocedures:
D Cmd PR ExtPgm('QCMDEXC')
D command 3048A OPTIONS(*VARSIZE) CONST
D length 15P 5 const
D MsqNam_q Ds
D ObjNam 10a inz('QSYSOPR')
D LibNam 10a inz('*LIBL')
D DateSentC S 19
D DateSent Ds 13
D DateSnt 7s 0
D TimeSnt 6s 0
D SentYY 2 overlay(DateSent:2)
D SentMM 2 overlay(DateSent:4)
D SentDD 2 overlay(DateSent:6)
D SentHH 2 overlay(DateSent:8)
D SentMin 2 overlay(DateSent:10)
D Sentss 2 overlay(DateSent:12)
C
C MsgIDKey Klist
C KFld MSGID
/free
*InLr = *On;
MsgTyp = '*ANY';
DoW (1=1) ;
RcvMsg( RCVM0200
: %Size( RCVM0200 )
: 'RCVM0200'
: MsqNam_q
: MsgTyp
: MsgKey
: WAIT_MAX
: OLD_STS
: ERRC0100
: JOB_CCSID
);
If ERRC0100.BytAvl > *Zero;
ExSr EscApiErr;
EndIf;
If RCVM0200.MsgFilLib_u = *Blanks;
RCVM0200.MsgFilLib_u = RCVM0200.MsgFilLib_s;
EndIf;
MsgDta = %Subst( RCVM0200.VarDta
: 1
: RCVM0200.DtaLenRtn
);
MsgTxt = %Subst( RCVM0200.VarDta
: RCVM0200.DtaLenRtn + 1
: RCVM0200.MsgLenRtn
);
If RCVM0200.MsgId = *Blanks;
MsgTxt = MsgDta;
MsgTxt52 = MsgDta;
Else ;
MsgTxt52 = MsgTxt;
chain RCVM0200.MsgId MONMSGIDP;
If %found ;
//dsply RCVM0200.MsgId;
//dsply MsgTxt52;
Exsr SndMail;
EndIf;
EndIf;
EndDo;
BegSr EscApiErr;
If ERRC0100.BytAvl < OFS_MSGDTA;
ERRC0100.BytAvl = OFS_MSGDTA;
EndIf;
SndPgmMsg( ERRC0100.MsgId
: 'QCPFMSG *LIBL'
: %Subst( ERRC0100.MsgDta: 1: ERRC0100.BytAvl - OFS_MSGDTA )
: ERRC0100.BytAvl - OFS_MSGDTA
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
EndSr;
/end-free
c SndMail BegSr
c Eval DateSnt = RCVM0200.DatSnt
c Eval TimeSnt = RCVM0200.TimSnt
c Eval DateSentC = '20' + SentYY + '-' +
c SentMM + '-' + SentDD + '-' +
c SentHH + ':' + SentMIN+ ':' +
c SentSS
c EVAL MsgTxt ='Message sent at '+DateSentc+' '+
c RCVM0200.MsgId + ':' + MsgTxt
c EVAL cmdSTR = 'SNDDST TYPE(*LMSG) TOINTNET(' +
c %trim(RspToMail) + ') DSTD(' +
c QUOTE + 'Emergency Event' + QUOTE +
c ') LONGMSG(' + QUOTE +
c %trim(MsgTxt) + QUOTE +
c ') SUBJECT(' + QUOTE +
c 'AS400 Attention Emergency Event' +
c QUOTE + ')'
c callp(e) Cmd(%trim(cmdStr) : %len(%trim(cmdstr)))
c EndSr
星期三, 11月 08, 2023
2010-07-13 如何監控 QSYSOPR 所指定重要訊息並將訊息傳送至 Email ?
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言