即時監控工作站錯誤訊息 CPF5140，並終止該工作站
Monitor interactive job which got CPF5140 error message and end it
即時監控工作站錯誤訊息 CPF5140，並終止該工作站。
因為使用者有時會因等待輸入暫停過久，直接將5250工作站直接點擊右上角關閉方塊，
此時系統會拋出 CPF5140 錯誤，此時若該工作站正執行大量資料的存取，系統仍會繼續
執行，但最終仍無法傳回資訊，導致系統浪費資源，要防止此狀況發生，就須即時監控並
終止該工作站 JOB。
File : QCLSRC
Member: WCHCPF5140
Type : CLP
Usage : CRTCLPGM PGM(QGPL/WCHCPF5140)
Start
STRWCH SSNID(WCHCPF5140) WCHPGM(QGPL/WCHCPF5140)
WCHMSG((CPF5140))
WCHMSGQ((*JOBLOG))
WCHJOB((*ALL/*ALL/*ALL))
End
WRKWCH *ALL use option 2 to End Watch
/* ================================================================ */
/* */
/* Program : WCHCPF5140 */
/* */
/* Description: Monitor interactive job which got CPF5410 */
/* and end it to prevent system from high CPU usage */
/* */
/* Date : 2016/02/01 */
/* */
/* Author : Vengoal Chang */
/* ================================================================ */
/* */
/* */
/* CRTCLPGM PGM(WCHCPF5140) */
/* */
/* */
/* STRWCH SSNID(WCHCPF5140) WCHPGM(QGPL/WCHCPF5140) */
/* WCHMSG((CPF5140)) */
/* WCHMSGQ((*JOBLOG)) */
/* WCHJOB((*ALL/*ALL/*ALL)) */
/* */
/* ================================================================ */
Pgm Parm(&Type &Session &Error &Data)
Dcl Var(&Type) Type(*Char) Len(10)
Dcl Var(&Session) Type(*Char) Len(10)
Dcl Var(&Error) Type(*Char) Len(10)
Dcl Var(&Data) Type(*Char) Len(2000)
Dcl Var(&LenEvtDta) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 1)
Dcl Var(&Job) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 33)
Dcl Var(&User) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 43)
Dcl Var(&Nbr ) Type(*Char) Len( 6) +
Stg(*Defined) DefVar(&Data 53)
Dcl Var(&MSGID) Type(*Char) Len(7) +
Stg(*Defined) DefVar(&Data 5)
Dcl Var(&MsgF) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 391)
Dcl Var(&MsgFLib) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&Data 401)
Dcl Var(&OffRplDta) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 441)
Dcl Var(&LenRplDta) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 445)
Dcl Var(&OrgLenRpl) Type(*Int) Len(4) +
Stg(*Defined) DefVar(&Data 59)
Dcl Var(&MsgDtaPtr) Type(*Ptr)
Dcl Var(&MsgDta) Type(*Char) Len(1010) +
Stg(*Based) BasPtr(&MsgDtaPtr)
/* CPF5140 char data */
Dcl Var(&MsgUser ) Type(*Char) Len(10) +
Stg(*Defined) DefVar(&MsgDta 1)
Dcl Var(&Host ) Type(*Char) Len(255) +
Stg(*Defined) DefVar(&MsgDta 11)
Dcl Var(&QualMsgf) Type(*Char) Len(20)
Dcl Var(&MsgTxt ) Type(*Char) Len(1024)
Dcl Var(&Rtvm0100 ) Type(*Char) Len(1024)
Dcl Var(&RplDta ) Type(*Char) Len(1024)
Dcl Var(&SysValTo) Type(*Char) Len(500)
Dcl VAR(&MsgTxtLenC) Type(*Char) Len(4)
Dcl VAR(&MsgTxtLen ) Type(*Dec ) Len(5 0)
Dcl VAR(&RplDtaLenC) Type(*Char) Len(4)
Dcl VAR(&ErrCode) Type(*Char) Len(15) /* Error Code */
/* Check to make sure this is a *MSGID watch */
If Cond(&Type = '*MSGID') Then(Do)
/* Check to make sure this is for CPF5140 */
If Cond(&MsgID = 'CPF5140') Then(Do)
ChgVar Var(&MsgDtaPtr) Value(%Addr(&Data))
Chgvar Var(%Offset(&MsgDtaPtr)) +
Value(%Offset(&MsgDtaPtr) + &OffRplDta)
ChgVar &RplDta %sst(&MsgDta 1 &LenRplDta)
ChgVar &QualMsgf (&MsgF *Cat &MsgFLib)
ChgVar %BIN(&MSGTXTLENC) 1024
ChgVar %BIN(&RplDtaLenC) &LenRplDta
ChgVar %BIN(&ErrCode 1 4) 15
Call QMHRTVM ( +
&Rtvm0100 +
&MsgTxtLenC +
'RTVM0100' +
&MSGID +
&QUALMSGF +
&RplDta +
&RplDtaLenC +
'*YES ' +
'*NO ' +
&Errcode)
ChgVar &MsgTxtLenC %SST(&Rtvm0100 9 4)
ChgVar &MsgTxtLen %BIN(&MsgTxtLenC)
ChgVar &MsgTxt (&MSGID *CAT ':' *BCAT +
%SST(&Rtvm0100 25 &MsgTxtLen) *BCAT +
'Job ' *BCAT +
&Nbr *CAT '/' *CAT &User *Tcat '/' *CAT &Job +
*BCAT 'was ended by watch program')
EndJob Job(&NBR/&USER/&JOB) Option(*IMMED)
MonMsg CPF0000
SndPgmMsg MsgId(CPF9898) Msgf(QCPFMSG) MsgDta(&MsgTxt) +
ToUsr(*SYSOPR)
EndDo
EndDo /* End If &Type = *MSGID */
ChgVar Var(&Error) Value(' ')
EndPgm
參照: STRWCH - Watch Exit Programs Explained with CL Example
星期四, 11月 09, 2023
2016-02-02 即時監控工作站錯誤訊息 CPF5140，並終止該工作站
2013-05-15 使用 API QGYOLMSG Open List of Messages 列出 Message queue 的訊息 -- Command CVTMSGQ
使用 API QGYOLMSG Open List of Messages 列出 Message queue 的訊息 -- Command CVTMSGQ
CVTMSGQ -- Convert message queue messages to DB file CVTMSGQP
File : QDDSSRC
Member: CVTMSGQP
Type : PF
Usage : CRTPF CVTMSGQP
A* Out file used by CVTMSGQ command - CVTMSGQP file
A R MSGR
A* SYSNAME 8 COLHDG('System' 'name')
A MSGCVTD 6 COLHDG('Message' +
A 'convert' 'date')
A MSGCVTT 6 COLHDG('Message' +
A 'convert' 'time')
A MSGID 7 COLHDG('Message' 'Id')
A MSGTYPE 2 COLHDG('Message' 'Type')
A MSGRPYSTS 1 COLHDG('Message' +
A 'reply' 'status')
A CRTBRKMSG 1 COLHDG('CrtBrkMsg')
A QUALJOB 26 COLHDG('QUALJOB')
A MSGDATE 7 COLHDG('Msg date' +
A 'CYYMMDD')
A MSGTIME 6 COLHDG('MSg time' +
A 'HHMMSS')
A MSGKEY 4 COLHDG('Message' 'key')
A MSGFILE 10 COLHDG('Message' 'file')
A MSGFILELIB 10 COLHDG('Message' 'file' +
A 'lib')
A MSGTEXT 2048O COLHDG('Message' 'text')
A MSGQ 10 COLHDG('Message' 'queue' +
A 'name')
A MSGQLIB 10 COLHDG('Message' 'queue' +
A 'library')
A SNDPGMNAME 10 COLHDG('Sending' 'program' +
A 'name')
A SNDUSRPRF 10 COLHDG('Sending' 'user ' +
A 'profile')
File : QRPGLESRC
Member: CVTMSGQ
Type : RPGLE
Usage : CRTBNDRPG CVTMSGQ
H Debug(*Yes) Option(*SrcStmt: *NoDebugIO) Optimize(*Basic)
H DftActGrp(*NO)
FCVTMSGQP UF A E K Disk
D main pr ExtPgm('CVTMSGQ')
D msgqQual 20a Const
D main pi
D msgqQual 20a Const
D*--------------------------------------------------
D openMsgQ pr n
D msgqQual 20a Const
D Criteria 10a Options(*nopass)
D Const
D*--------------------------------------------------
D readMsgQ pr n
D MsgText 2048a
D MsgID 7a
D MsgType 2a
D MsgRpySts 1a
D CrtBrkMsgSts 1a
D QualifiedJob 26a
D MsgDate 7a
D MsgTime 6a
D MsgKey 4a
D MsgFile 10a
D MsgFileLib 10a
D MsgQ 10a
D MsgQLib 10a
D SndPgmName 10a
D SndUsrPrf 10a
D*--------------------------------------------------
D closeMsgQ pr
D*--------------------------------------------------
// error handling
*/copy QSYSINC/QRPGLESRC,QUSEC
DQUSEC DS
D QUSBPRV 10i 0 Inz(%Size(QUSEC))
D QUSBAVL 10i 0
D QUSEI 7
D QUSERVED 1
D QUMSGDTA 128
// global data structures
D ListInfoDs ds Qualified
D Inz
D TotalRecs 10i 0
D RecsRtrnd 10i 0
D Handle 4a
D RecLength 10i 0
D InfoComplt 1a
D DateTime 13a
D ListStatus 1a
D 1a
D InfoLength 10i 0
D FirstRec 10i 0
D 40a
// global stand-alone
D Record# s 10i 0
// global constants
D NUMBEROFFIELDS c Const(7)
D MsgText S 2048a
D MsgID S 7a
D MsgType S 2a
D MsgRpySts S 1a
D CrtBrkMsgSts S 1a
D QualJob S 26a
D MsgDate S 7a
D MsgTime S 6a
D MsgKey S 4a
D MsgFile S 10a
D MsgFileLib S 10a
D MsgQ S 10a
D MsgQLib S 10a
D SndPgmName S 10a
D SndUsrPrf S 10a
D eof S n
D tempDatetime S 13
D CVTMSGQ DS 50 Dtaara('QTEMP/CVTMSGQ')
D LstDateTime 13
C eval *InLr = *On
C CallP openMsgQ(msgqQual)
C TIME FULTIM 12 0
C MOVEL FULTIM MSGCVTT
C MOVE FULTIM MSGCVTD
C Dow not eof
C eval eof = readMsgQ(
C MsgText :
C MsgID :
C MsgType :
C MsgRpySts :
C CrtBrkMsgSts :
C QualJob :
C MsgDate :
C MsgTime :
C MsgKey :
C MsgFile :
C MsgFileLib :
C MsgQ :
C MsgQLib :
C SndPgmName :
C SndUsrPrf)
C If not eof
C *Lock In CvtMsgQ
C eval tempDateTime = MsgDate + MsgTime
C If tempDateTime >= LstDateTime
C eval LstDateTime = tempDateTime
C write(e) msgR
C Out CVTMSGQ
C endIf
C endIf
* Inquiry msgtype 05 and The message is waiting for a reply
C If CrtBrkMsgSts = '1' or
C ( MsgType = '05' and
C MsgRpySts = 'W')
C* MsgRpySts dsply
C* MsgId dsply
C* dump
C EndIf
C EndDo
C CallP closeMsgQ()
P*--------------------------------------------------
P* Procedure name: openMsgQ
P* Purpose: Open list of MSGQ messages
P* Returns: Error condition
P* Parameter: MsgQ => Message queue name
P* Parameter: Criteria => Selection criteria (optional)
P*--------------------------------------------------
P openMsgQ b Export
D openMsgQ pi n
D MsgQQual 20a Const
D Criteria 10a Options(*nopass)
D Const
D* Local fields
// external prototypes
D*--------------------------------------------------
D* Procedure name: qGyOlMsg
D* Purpose: Open List of Messages (QGYOLMSG) API
D* Parameter: Rcvr => Receiver variable
D* Parameter: RcvrLength => Length of receiver variable
D* Parameter: ListInfo => List info
D* Parameter: Recs2Rtrn => Number of records to return
D* Parameter: Sort => Sort information
D* Parameter: Select => Msg selection info
D* Parameter: LenSelect => Size of msg selection info
D* Parameter: QueueInfo => User or queue information
D* Parameter: MsgQueue => Message queues used
D* Parameter: Error => Error code
D*--------------------------------------------------
D qGyOlMsg pr ExtPgm('QGY/QGYOLMSG')
D Rcvr 1a
D RcvrLength 10i 0 Const
D ListInfo LikeDs(ListInfoDs)
D Recs2Rtrn 10i 0 Const
D Sort 1a Const
D Select LikeDs(SelectDs)
D LenSelect 10i 0 Const
D QueueInfo 21a Const
D MsgQueue 44a
D Error 256a Options(*varsize)
// data structures
D QueueInfoDs ds Qualified
D UserOrQueue 1a Inz('0')
D QueueName 10a
D QueueLib 10a
D SelectDs ds Qualified
D* Direction 10a Inz('*PRV')
D Direction 10a Inz('*NEXT')
D 2a
D Severity 10i 0 Inz(0)
D MaxMsgLen 10i 0 Inz(-1)
D MaxHelpLen 10i 0 Inz(-1)
D OSSelect 10i 0 Inz(44)
D NbrSelect 10i 0 Inz(1)
D OSMsgKeys 10i 0 Inz(54)
D OSFieldIDs 10i 0 Inz(58)
D NbrFields 10i 0 Inz(NUMBEROFFIELDS)
D Criteria 10a Dim(1) Inz('*ALL')
D* MsgKey 4a Dim(1) Inz(x'FFFFFFFF')
D MsgKey 4a Dim(1) Inz(x'00000000')
D FldID 10i 0 Dim(NUMBEROFFIELDS)
// stand-alone
D MsgQueueUsed s 44a
D Rcvr s 1a
D retField s n
/free
Monitor;
Clear Record#;
Reset QUSEC;
// set queue name
QueueInfoDs.QueueName = %SubSt(MsgqQual:1:10);
QueueInfoDs.QueueLib = %SubSt(MsgqQual:11:10);
dump;
// select messages to return
If %parms() = 2;
SelectDs.Criteria(1) = Criteria;
Endif;
// select fields to return
SelectDs.FldID(1) = 1001; // Reply status
SelectDs.FldID(2) = 0201; // Replacement data or immediate message text
SelectDs.FldID(3) = 0601; // Qualified sender job name
SelectDs.FldID(4) = 0302; // Message with replacement data
SelectDs.FldID(5) = 1002; // Critical break message status
SelectDs.FldID(6) = 0603; // Sending program name
SelectDs.FldID(7) = 0607; // Sending user profile
// list messages
qGyOlMsg(Rcvr: %size(Rcvr): ListInfoDs: -1: '0': SelectDs:
%size(SelectDs): QueueInfoDs: MsgQueueUsed: QUSEC);
// check for errors
If QUSEI <> *blank;
retField = *on;
Endif;
On-Error;
retField = *on;
Endmon;
// close list on error
If retField = *on;
closeMsgQ();
Endif;
Return retField;
/end-free
P openMsgQ e
//.......................................................................
P*--------------------------------------------------
P* Procedure name: readMsgQ
P* Purpose: Read next message from list
P* Returns: End-of-file
P* Parameter: Msg => Message (output)
P* Parameter: MsgID => Message ID (output)
P* Parameter: MsgType => Message type (output)
P* Parameter: QualifiedJob => Job name/user/number (output)
P* Parameter: MsgDate => Date sent (output)
P* Parameter: MsgTime => Time sent (output)
P*--------------------------------------------------
P readMsgQ b Export
D readMsgQ pi n
D Msg 2048a
D MsgID 7a
D MsgType 2a
D MsgRpySts 1a
D CrtBrkMsgSts 1a
D QualifiedJob 26a
D MsgDate 7a
D MsgTime 6a
D MsgKey 4a
D MsgFile 10a
D MsgFileLib 10a
D MsgQ 10a
D MsgQLib 10a
D SndPgmName 10a
D SndUsrPrf 10a
D* Local fields
// external prototypes
D*--------------------------------------------------
D* Procedure name: qGyGtLe
D* Purpose: Get List Entries (QGYGTLE) API
D* Returns: null
D* Parameter: Rcvr => Receiver variable
D* Parameter: RcvrLen => Length of receiver variable
D* Parameter: Handle => Request handle
D* Parameter: ListInfo => List info
D* Parameter: Recs2Rtrn => Number of records to return
D* Parameter: Rec#2Rtrn => Starting record
D* Parameter: Error => Error code
D*--------------------------------------------------
D qGyGtLe pr ExtPgm('QGY/QGYGTLE')
D Rcvr LikeDs(RcvrDs)
D RcvrLen 10i 0 Const
D Handle 4a
D ListInfo LikeDs(ListInfoDs)
D Recs2Rtrn 10i 0 Const
D Rec#2Rtrn 10i 0
D Error 256a Options(*varsize)
D*--------------------------------------------------
D* Procedure name: qMhRtvM
D* Purpose: Retrieve Message (QMHRTVM) API
D* Returns: null
D* Parameter: MsgInfo => Message information
D* Parameter: LenMsgInfo => Length of message information
D* Parameter: Format => Format name
D* Parameter: MsgId => Message identifier
D* Parameter: MsgFile => Qualified message file name
D* Parameter: ReplaceData => Replacement data
D* Parameter: LenReplaceData => Length of replacement data
D* Parameter: SubValues => Replace substitution values
D* Parameter: FmtCtlChar => Return format control characters
D* Parameter: Error => Error code
D*--------------------------------------------------
D qMhRtvM pr ExtPgm('QMHRTVM')
D MsgInfo Like(MsgData)
D LenMsgInfo 10i 0 Const
D Format 8a Const
D MsgId 7a Const
D MsgFile 20a Const
D ReplaceData Like(ReplacementData)
D Const
D LenReplaceData...
D 10i 0 Const
D SubValues 10a Const
D FmtCtlChar 10a Const
D Error 256a Options(*varsize)
// data structures
D ListDataDs ds Based(pListDataDs)
D Qualified
D OSNextFld 10i 0
D LenFldInfo 10i 0
D FieldID 10i 0
D TypeOfData 1a
D StsOfData 1a
D 14a
D LenOfData 10i 0
D Data 32000a
D MsgData ds Qualified
D BytesReturn 10i 0
D BytesAvail 10i 0
D LenMsgReturn 10i 0
D LenMsgAvail 10i 0
D LenMsgHelpRtn 10i 0
D LenMsgHelpAvl 10i 0
D Msg 2048a
D RcvrDs ds Qualified
D Inz
D OSNextMsg 10i 0
D OSFields 10i 0
D NbrFlds 10i 0
D MsgSev 10i 0
D MsgID 7a
D MsgType 2a
D MsgKey 4a
D MsgFile 10a
D MsgFileLib 10a
D MsgQ 10a
D MsgQLib 10a
D DateSent 7a
D TimeSent 6a
D EntryArr 1 32767a Dim(32767)
D SelectDs ds Qualified
D Direction 10a Inz('*PRV')
D 2a
D Severity 10i 0 Inz(0)
D MaxMsgLen 10i 0 Inz(-1)
D MaxHelpLen 10i 0 Inz(-1)
D OSSelect 10i 0 Inz(44)
D NbrSelect 10i 0 Inz(1)
D OSMsgKeys 10i 0 Inz(54)
D OSFieldIDs 10i 0 Inz(58)
D NbrFields 10i 0 Inz(NUMBEROFFIELDS)
D Criteria 10a Dim(1) Inz('*ALL')
D MsgKey 4a Dim(1) Inz(x'FFFFFFFF')
D FldID 10i 0 Dim(NUMBEROFFIELDS)
// stand-alone
D ReplacementData...
D s 256a
D retField s n
D DataLocation s 5u 0
D i s 5u 0
D x s 3u 0
/free
Monitor;
Record# += 1;
Reset QUSEC;
// retrieve entry from list
qGyGtLe(RcvrDs: %size(RcvrDs): ListInfoDs.Handle: ListInfoDs: 1:
Record#: QUSEC);
// check for errors
If QUSEI = *blank;
MsgKey = RcvrDs.MsgKey;
MsgFile = RcvrDs.MsgFile;
MsgFileLib = RcvrDs.MsgFileLib;
MsgQ = RcvrDs.MsgQ;
MsgQLib = RcvrDs.MsgQLib;
// parse out msg from list entry
DataLocation = RcvrDs.OSFields + 1;
For x = 0 to (RcvrDs.NbrFlds - 1);
pListDataDs =
%addr( RcvrDs.EntryArr(DataLocation) );
DataLocation += ListDataDs.LenFldInfo;
Select;
When ListDataDs.FieldID = 1001;
// control field => initialize
//Clear i;
//Iter;
MsgRpySts = %subst(ListDataDs.Data: 1:
ListDataDs.LenOfData);
When ListDataDs.FieldID = 1002;
// Critical break message status
CrtBrkMsgSts = %subst(ListDataDs.Data: 1:
ListDataDs.LenOfData);
When ListDataDs.FieldID = 201;
// store replacement data
ReplacementData = %subst(ListDataDs.Data: 1:
ListDataDs.LenOfData);
When ListDataDs.FieldID = 601;
// store job info
QualifiedJob = %subst(ListDataDs.Data: 1:
ListDataDs.LenOfData);
When ListDataDs.FieldID = 302;
// combine message w/ replacement data
qMhRtvM(MsgData: %len(MsgData): 'RTVM0100': RcvrDs.MsgId:
RcvrDs.MsgFile + RcvrDs.MsgFileLib:
ReplacementData: %len(ReplacementData): '*YES':
'*NO': QUSEC);
If MsgData.Msg <> *blank;
// store in Msg
Msg = MsgData.Msg;
Else;
// if result is blank, use msg from list
Msg = %subst(ListDataDs.Data: 1: ListDataDs.LenOfData);
Endif;
MsgID = RcvrDs.MsgID;
MsgType = RcvrDs.MsgType;
MsgDate = RcvrDs.DateSent;
MsgTime = RcvrDs.TimeSent;
When ListDataDs.FieldID = 603;
SndPgmName= %subst(ListDataDs.Data: 1: ListDataDs.LenOfData);
When ListDataDs.FieldID = 607;
SndUsrPrf = %subst(ListDataDs.Data: 1: ListDataDs.LenOfData);
Endsl;
Endfor;
Else;
retField = *on;
Endif;
On-Error;
retField = *on;
Endmon;
// close list on error
If retField = *on;
closeMsgQ();
Endif;
Return retField;
/end-free
P readMsgQ e
//.......................................................................
D*--------------------------------------------------
D* Procedure name: closeMsgQ
D* Purpose: Close list of MSGQ messages
D* Returns: null
D*--------------------------------------------------
P closeMsgQ b Export
D closeMsgQ pi
D* Local fields
// external prototypes
D*--------------------------------------------------
D* Procedure name: qGyClst
D* Purpose: Close List (QGYCLST) API
D* Returns: null
D* Parameter: Handle => Request handle
D* Parameter: Error => Error code
D*--------------------------------------------------
D qGyClst pr ExtPgm('QGY/QGYCLST')
D Handle 4a
D Error 256a Options(*varsize)
/free
qGyClst(ListInfoDs.Handle : QUSEC);
/end-free
P closeMsgQ e
File : QCLSRC
Member: CVTMSGQC
Type : CLP
Usage : CRTCLPGM CVTMSGQC
/* =============================================================== */
/* = Command CvtMsgQ CPP = */
/* = Description : Convert MsgQ Msgs to data base file = */
/* =============================================================== */
/* = Date : 2013/05/15 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Pgm Parm(&FullMsgQ )
Dcl &FullMsgq *Char 20
Dcl &Msgq *Char 10
Dcl &MsgqLib *Char 10
MonMsg CPF0000 *N GoTo Error
ChgVar &MsgQ %SST(&FullMsgq 1 10)
ChgVar &MsgQLib %SST(&FullMsgq 11 10)
ChkObj &MsgQLib/&MsgQ OBJTYPE(*MSGQ)
ChkObj *LIBL/CVTMSGQP OBJTYPE(*FILE)
ChkObj *LIBL/CVTMSGQP OBJTYPE(*FILE)
ChkObj QTEMP/CVTMSGQ OBJTYPE(*DTAARA)
MonMsg CPF9801 *N Do
CrtDtaAra DtaAra(QTEMP/CVTMSGQ) Type(*CHAR) Len(50)
EndDo
Call CVTMSGQ (&FullMsgQ)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CVTMSGQ
Type : CMD
Usage : CRTCMD CMD( CVTMSGQ ) PGM( CVTMSGQC ) SRCMBR( CVTMSGQ )
/*****************************************************************/
/* */
/* COMMAND NAME: CVTMSGQ */
/* */
/* AUTHOR : Vengoal Chang */
/* */
/* DATE WRITTEN: 2013/05/14 */
/* */
/* DESCRIPTION : Convert MSGQ messages to database */
/* */
/* CVTMSGQC *PGM CLP CVTMSGQ CPP */
/* CVTMSGQ *PGM RPGLE Convert MSGQ messages to DB */
/* CVTMSGQP *FILE PF CVTMSGQ Outfile */
/* */
/* CRTCMD CMD( CVTMSGQ ) */
/* PGM( CVTMSGQC ) */
/* SRCMBR( CVTMSGQ ) */
/* */
/*****************************************************************/
CMD PROMPT('Convert Message Queue to DB')
PARM KWD(MSGQ) TYPE(QUAL1) SNGVAL((*NONE)) MIN(1) +
PROMPT('Message queue')
QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) +
PROMPT('Library name')
參考資訊:
Open List of Messages (QGYOLMSG) API
星期三, 11月 08, 2023
2010-07-13 如何監控 QSYSOPR 所指定重要訊息並將訊息傳送至 Email ?
如何監控 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
2008-09-09 如何從 Message Queue 中自動回覆訊息? (Command: AUTORPY with Message Handling APIs)
如何從 Message Queue 中自動回覆訊息? (Command: AUTORPY with Message Handling APIs)
可以使用 WRKRPYLE, ADDRPYLE, RMVRPYLE 新增，移除系統自動回覆訊息 Id。
當所執行的工作環境參數值為 INQMSGRPY(*SYSRPYL)時，一有需要回覆的訊息產生時，
系統會先去自動回覆訊息表列(reply list entry)，尋找所要回覆訊息 ID 是否存在，
若存在，立即以所指定的回應值回覆。若不存在，就需要手動回覆。
工作環境參數值為 INQMSGRPY(*RQD)時，需要手動回覆。
若要針對需要手動回覆的訊息，作自動回覆時，可以 AUTORPY 來回覆。
Auto Reply (AUTORPY)
Type choices, press Enter.
Message queue . . . . . . . . . > Name
Library . . . . . . . . . . . *LIBL Name, *LIBL, *CURLIB
Reply message id . . . . . . . . > Character value
Reply . . . . . . . . . . . . . >
Reply to job . . . . . . . . . . Name
File : QRPGLESRC
Member : AUTORPY
Type : RPGLE
Usage : CRTBNDRPG PGM(AUTORPY) TGTRLS(V5R1M0)
**
** Program . . : AUTORPY
** Description : Auto Reply Message - CPP
** Author . . : Vengoal Chang
** Date . . . : 2008/09/09
**
**
**
** Program summary
** ---------------
**
** Message handling API:
** QMHLSTM List Nonprogram Messages
**
** QMHSNDRM Send Reply Message
**
** QMHRTVM Retrieve message
**
** QMHSNDPM Send program message
**
**
**
** Compile options:
** CrtBndRpg Pgm( AUTORPY )
** TgtRls( V5R1M0 )
**
**
**-- Header specifications: --------------------------------------------**
H Debug Option(*Srcstmt:*NoDebugIO) DftActGrp(*NO) ActGrp(*Caller)
**-- Retrieve message: ------------------------------------------
D GetMsg Pr ExtPgm( 'QMHRTVM' )
D RtRcvVar 32767a Options( *VarSize )
D RtRcvVarLen 10i 0 Const
D RtFmtNam 10a Const
D RtMsgId 7a Const
D RtMsgFq 20a Const
D RtMsgDta 512a Const Options( *VarSize )
D RtMsgDtaLen 10i 0 Const
D RtRplSubVal 10a Const
D RtRtnFmtChr 10a Const
D RtError 32767a Options( *VarSize )
D GetSize ds
D GetBytRtn 10i 0
D GetBytAvl 10i 0
D Fmt0400 ds based(FmtPtr)
D BytRtn 10i 0
D BytAvl 10i 0
D OffDftRpy 53 56i 0
D LenDftRpyR 57 60i 0
D RpyType 105 114
D MaxRpyLen 117 120i 0
D OffVldRpy 125 128i 0
D NbrVldRpyR 129 132i 0
D LenVldRpyR 133 136i 0
D LenVldRpyA 137 140i 0
D LenVldRpyE 141 144i 0
D Upper C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
D Lower C 'abcdefghijklmnopqrstuvwxyz'
D DftRpy S 32
D DftRpyE S 32 based(DftRpyPtr)
D VldRpyE S 32 based(VldRpyPtr)
D VldRpyAryStr S 320
D VldRpyAry S 32 Dim(10)
D VldRpyAryIdx S 3i 0
D ErrorNull Ds
D BytesProv 10i 0 inz(0)
D BytesAvaile 10i 0 inz(0)
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D MsgId 7a Const
D MsgFq 20a Const
D MsgDta 128a Const
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 1024a Options( *VarSize )
* Prototypes
D CrtUsrSpc PR ExtPgm( 'QUSCRTUS' )
D QlSpcName 20 Const
D ExtAttr 10 Const
D SizeInBytes 10I 0 Const
D InitVal 1 Const
D PublicAut 10 Const
D TextDesc 50 Const
D Replace 10 Const
D ReplaceYes C '*YES'
D ReplaceNo C '*NO'
D ApiErrInfo Like( ApiErr )
D ChgUsrSpcAttr PR ExtPgm( 'QUSCUSAT' )
D RetdLibName 10
D QlUsrSpcName 20 Const
D AttrToChg Like( EnableAutoExtendDs )
D Const
D ApiErrInf Like( ApiErr )
D DltUsrSpc PR ExtPgm( 'QUSDLTUS' )
D QlUsrSpcName 20 Const
D ApiErrInfo Like( ApiErr )
D AddrOfUsrSpc PR ExtPgm( 'QUSPTRUS' )
D QlUsrSpcName 20 Const
D PtrToUsrSpc *
D ApiErrInfo Like( ApiErr )
D As400ObjFound PR N
D QlObjName 20 Value
D ObjType 10 Value
D SndRpyMsg PR ExtPgm( 'QMHSNDRM' )
D SndMsgKey 4 Const
D SndQualMsgq 20 Const
D SndRpyMsgTxt 100 Const
D SndRpyMsgLen 10I 0 Const
D SndRmvMsg 10 Const
D ApiErrInf Like( ApiErr )
D LstMsgsFrmQ PR ExtPgm( 'QMHLSTM' )
D QlUsrSpcName 20 Const
D FmtName 8 Const
D LSTM0100 C 'LSTM0100'
D MsgSltInf Like( MsgSltInfo )
D Const
D SizeOfMsgSltInf...
D 10I 0 Const
D FmtOfMsgSltInf...
D 8 Const
D MSLT0100 C 'MSLT0100'
D ApiErrInf Like( ApiErr )
* Other program data
D RetdLibName S 10
D EnableAutoExtendDs...
D DS
D NumFlds 10I 0 Inz( 1 )
D KeyForAutoExtend...
D 10I 0 Inz( 3 )
D LengthOfData 10I 0 Inz( 1 )
D AutoExtendVal 1 Inz( '1' )
D ApiErr DS
D AeBytesProv 10I 0 Inz( %Size( ApiErr ) )
D AeBytesAvl 10I 0
D AeMsgId 7
D 1
D AeMsgDta 256
D MsgSltInfo DS
D MsiMaxMsgsReq 10I 0 Inz( -1 )
D MsiListDirection...
D 10 Inz( '*NEXT' )
D MsiSelectionCriterion...
D 10 Inz( '*MNR' )
D MsiSevCriterion...
D 10I 0 Inz( *Zero )
D MsiMaxMsgLen 10I 0 Inz( 112 )
D MsiMaxHlpLen 10I 0 Inz( 4 )
D MsiOffstToQlMsgqName...
D 10I 0
D MsiOffstToStrMsgKey...
D 10I 0
D MsiNumMsgQs 10I 0 Inz( 1 )
D MsiOffstToFldRetdId...
D 10I 0
D MsiNumFldsToReturn...
D 10I 0 Inz( 3 )
D MsiQlMsgqName 20
D MsiStrMsgKey 4 Inz( X'00000000' )
D MsiFldRetdId 10I 0 Inz( 302 )
D MsiFldRetdId1 10I 0 Inz( 601 )
D MsiFldRetdId2 10I 0 Inz(1001 )
D UsrSpcHdr DS Based( SpcPtr )
D OffstTo1stSpcEntry...
D 125 128I 0
D NumberOfMsgs 133 136I 0
D UsrSpcEntry DS Based( UsePtr )
D UseOffstToNxtEntry...
D 1 4I 0
D UseOffstToFldsReturned...
D 5 8I 0
D UseMsgId 17 23
D UseMsgType 24 25
D UseMsgKey 26 29
D UseMsgF 30 39
D UseMsgFLib 40 49
D UseMsgQ 50 59
D UseMsgQLib 60 69
D RetdFldsDs DS Based( RetdFldsDsPtr )
D NextFldRtnOfs 1 4I 0
D Rf1stLvlTxtLen...
D 29 32I 0
D Rf1stLvlTxt 33 144
D ScMsgId S 7
D ScMsgType S 2
D ScMsgKey S 4
D ScJob S 10
D ScUsr S 10
D ScNbr S 6
D ScJobSts S 10
D ScRpySts S 1
D Sc1stLvl S 112
D dftRpyValueErr S N
D main PR ExtPgm('AUTORPY')
D qualMsgqName 20
D rpyMsgid 7
D rpyMsgValue 32
D rpyToJob 10
D main PI
D qualMsgqName 20
D rpyMsgid 7
D rpyMsgValue 32
D rpyToJob 10
C Eval MsiQlMsgqName = qualMsgQName
C CallP As400ObjFound( MsiQlMsgqName:
C '*MSGQ' )
* Set offset fields in the Msi data structure
C Eval MsiOffstToQlMsgqName
C = %Addr( MsiQlMsgqName )
C - %Addr( MsgSltInfo )
C Eval MsiOffstToStrMsgKey
C = %Addr( MsiStrMsgKey )
C - %Addr( MsgSltInfo )
C Eval MsiOffstToFldRetdId
C = %Addr( MsiFldRetdId )
C - %Addr( MsgSltInfo )
C ExSr LoadUsrSpc
C ExSr ProcessMsgs
C Eval *INLR = *On
* = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
* LoadUsrSpc - Creates and then loads the user space with the
* 1st level text of all messages in the specified
* message queue.
C LoadUsrSpc BegSr
* Just to be on the safe side, delete the user space before
* attempting to create it.
C CallP DltUsrSpc( 'MSGSPC QTEMP': ApiErr )
C CallP CrtUsrSpc( 'MSGSPC QTEMP':
C *Blank:
C 25000:
C X'00':
C '*ALL':
C *Blank:
C ReplaceYes:
C ApiErr )
* If there was an error in the API, terminate the subroutine
C If AeBytesAvl > *Zero
C CallP SndEscMsg( AeMsgId
C : 'QCPFMSG'
C : %Subst( AeMsgDta: 1: AeBytesAvl-16 )
C )
C LeaveSr
C EndIf
* Turn on the autoextend attribute for this user space
C CallP ChgUsrSpcAttr( RetdLibName:
C 'MSGSPC QTEMP':
C EnableAutoExtendDs:
C ApiErr )
* If there was an error in the API, terminate the subroutine
C If AeBytesAvl > *Zero
C LeaveSr
C EndIf
* Populate the user space with the messages
C CallP LstMsgsFrmQ( 'MSGSPC QTEMP':
C LSTM0100:
C MsgSltInfo:
C %Size( MsgSltInfo ):
C MSLT0100:
C ApiErr )
* If there was an error in the API, terminate the subroutine
C If AeBytesAvl > *Zero
C CallP SndEscMsg( AeMsgId
C : 'QCPFMSG'
C : %Subst( AeMsgDta: 1:AeBytesAvl- 16 )
C )
C LeaveSr
C EndIf
* Get a pointer to the user space
C CallP AddrOfUsrSpc( 'MSGSPC QTEMP':
C SpcPtr:
C ApiErr )
* If there was an error in the API, terminate the subroutine
C If AeBytesAvl > *Zero
C CallP SndEscMsg( AeMsgId
C : 'QCPFMSG'
C : %Subst( AeMsgDta: 1: AeBytesAvl-16 )
C )
C LeaveSr
C EndIf
C EndSr
* = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
* ProcessMsgs -- Process messages in the specified message queue
C ProcessMsgs BegSr
* Set the basing pointer for the User Space Entry for the first
* message in the subfile.
C Eval UsePtr
C = SpcPtr + OffstTo1stSpcEntry
C Do NumberOfMsgs
* move user space values to screen
C Eval ScMsgId = UseMsgId
C Eval ScMsgType = UseMsgType
C Eval ScMsgKey = UseMsgKey
C* ScMsgId dsply
* get Message Text
C Eval RetdFldsDsPtr
C = SpcPtr + UseOffstToFldsReturned
C Eval Sc1stLvl
C = %Subst( Rf1stLvlTxt: 1:
C Rf1stLvlTxtLen )
* get Sender Qualjob
C Eval RetdFldsDsPtr
C = SpcPtr + NextFldRtnOfs
C Eval SCJob
C = %Subst( Rf1stLvlTxt: 1: 10)
C Eval SCUsr
C = %Subst( Rf1stLvlTxt:11: 10)
C Eval SCNbr
C = %Subst( Rf1stLvlTxt:21: 6)
* get message reply status
C Eval RetdFldsDsPtr
C = SpcPtr + NextFldRtnOfs
C Eval SCRpySts
C = %Subst( Rf1stLvlTxt: 1: 10)
C* ScRpySts dsply
C If UseMsgType = '05' and
C SCRpySts = 'W'
C If UseMsgId = rpyMsgId
C ExSr ChkRpyValue
C If rpyToJob = *blanks or
C (rpyToJob <> *blanks and
C ScJob = rpyToJob )
C ExSr RpyMsg
C EndIf
C EndIf
C EndIf
C Eval UsePtr = SpcPtr
C + UseOffstToNxtEntry
C EndDo
C EndSr
* = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
* ChkRpyValue - Check reply value valid or not
C ChkRpyValue BegSr
c eval dftRpyValueErr = *Off
C* How much storage is needed for everything?
C callp GetMsg( GetSize :%size(GetSize)
C :'RTVM0400' :UseMsgId
C : UseMsgF + UseMsgFLib
C :' ' :0
C :'*NO' :'*NO'
C :ErrorNull)
c* Allocate it and then call the API again
c eval FmtPtr = %alloc(GetBytAvl)
c callp GetMsg( Fmt0400 :GetBytAvl
c :'RTVM0400' :UseMsgID
c :UseMsgF + UseMsgFLib
c :' ' :0
c :'*NO' :'*NO'
c :ErrorNull)
c* Default replies returned
c if rpyMsgValue = '*DFT'
c if LenDftRpyR > 0
c eval DftRpyPtr = FmtPtr + OffDftRpy
c eval DftRpy = %SubSt(DftRpyE:1:LenDftRpyR)
c* DftRpy dsply
c eval rpyMsgValue = DftRpy
c else
c eval dftRpyValueErr = *On
c endif
c endif
c* Any valid replies returned
c if NbrVldRpyR > 0
c eval VldRpyPtr = FmtPtr + OffVldRpy
c eval VldRpyAryIdx = 1
c reset VldRpyAry
c do NbrVldRpyR
c* VldRpyE dsply
c eval VldRpyAryStr = %trim(VldRpyAryStr) +
c ' ' + %trim(VldRpyE)
c eval VldRpyAry(VldRpyAryIdx) = VldRpyE
c eval VldRpyAryIdx = VldRpyAryIdx + 1
c eval VldRpyPtr = VldRpyPtr + LenVldRpyE
c enddo
c if Not dftRpyValueErr
c lower:upper xlate rpyMsgValue rpyMsgValue
c if %lookup(rpyMsgValue: VldRpyAry) = 0
C CallP SndEscMsg( 'CPF9898'
C : 'QCPFMSG'
C : 'MsgId: ' + UseMsgId +
C ' reply value ' + %trim(rpyMsgValue) +
C ' is not valid, valid reply value is '+
C %trim(VldRpyAryStr)
C )
c endif
c else
C CallP SndEscMsg( 'CPF9898'
C : 'QCPFMSG'
C : 'MsgId: ' + UseMsgId +
C ' reply value ' + %trim(rpyMsgValue) +
C ' is not valid, no default reply' +
C ' setting, valid reply value is '+
C %trim(VldRpyAryStr)
C )
c endif
C endif
C EndSr
* = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
*
C RpyMsg BegSr
C
C CALLP SndRpyMsg ( SCMsgKey :
C MsiQlMsgqName :
C %trim(rpyMsgValue):
C %len(%trim(rpyMsgValue)):
C '*NO' :
C ApiErr)
* If there was an error in the API, terminate the subroutine
C If AeBytesAvl > *Zero
C* AeMsgId DSPLY
C CallP SndEscMsg( AeMsgId
C : 'QCPFMSG'
C : %Subst( AeMsgDta: 1 )
C )
C Else
C Callp SndCmpMsg(
C 'MsgId:' + rpyMsgId + ' replied to job'+
C ' ' + %trim(SCNbr) + '/' + %trim(SCUSr)+
C '/' + %trim(SCJob) + ' with value ' +
C %trim(rpyMsgValue) + '.'
C )
C EndIf
C
C EndSr
* = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * =
* As400ObjFound - Attempts to locate an AS/400 object
P As400ObjFound B
D As400ObjFound PI N
D QlObjName 20 Value
D ObjType 10 Value
* Local variables and prototypes
D RtvObjDesc PR ExtPgm( 'QUSROBJD' )
D RcvrVar 8
D LenRcvrVar 10I 0 Const
D FmtName 8 Const
D QlObjName 20 Const
D ObjType 10 Const
D ApiErrInf Like( ApiErr )
D ApiErr DS
D AeBytesProv 10I 0 Inz( %Size( ApiErr ) )
D AeBytesAvl 10I 0
D AeMsgId 7
D 1
D AeMsgDta 256
D Rcvr S 8
* Invoke the QUSROBJD API to attempt to locate the object
C CallP RtvObjDesc( Rcvr:
C %Size( Rcvr ):
C 'OBJD0100':
C QlObjName:
C ObjType:
C ApiErr )
* If the API returns any error at all, I assume we were unable to
* locate the object.
C If AeBytesAvl > *Zero
C CallP SndEscMsg( AeMsgId
C : 'QCPFMSG'
C : %Subst( AeMsgDta: 1:AeBytesAvl- 16 )
C )
C Return *Off
C Else
C Return *On
C EndIf
P As400ObjFound E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
C Callp SndPgmMsg( PxMsgId
C : PxMsgF + '*LIBL'
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*ESCAPE'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ApiErr
C )
C If AeBytesAvl > *Zero
C Return -1
C
C Else
C Return 0
C EndIf
P SndEscMsg E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
D MsgKey s 4a
C Callp SndPgmMsg( 'CPF9897'
C : 'QCPFMSG *LIBL'
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*COMP'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ApiErr
C )
C If AeBytesAvl > *Zero
C Return -1
C
C Else
C Return 0
C EndIf
**
P SndCmpMsg E
File : QCMDSRC
Member : AUTORPY
Type : CMD
Usage : CRTCMD CMD(AUTORPY) PGM(AUTORPY)
/* =============================================================== */
/* = Command....... AutoRpy = */
/* = CPP........... AutoRpy RPGLE = */
/* = Description... Auto reply to the sender of an inquiry = */
/* = message. = */
/* = = */
/* = CrtCmd Cmd( AutoRpy ) = */
/* = Pgm( AutoRpy ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2008/09/09 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Auto Reply')
PARM KWD(MSGQ) TYPE(QUAL2) MIN(1) PROMPT('Message +
queue')
PARM KWD(MSGID) TYPE(*CHAR) LEN(7) PROMPT('Reply +
message id')
PARM KWD(REPLY) TYPE(*CHAR) LEN(32) DFT(*DFT) +
SPCVAL((*DFT)) PROMPT('Reply')
PARM KWD(LMTRPYJOB) TYPE(*NAME) LEN(10) +
PROMPT('Reply to job')
QUAL2: QUAL TYPE(*NAME) EXPR(*YES)
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
(*CURLIB)) EXPR(*YES) PROMPT('Library')
測試方式:
1.
CRTMSGF QGPL/TESTMSGF
/* Add message id with no default reply value */
ADDMSGD MSGID(TST0001) MSGF(QGPL/TESTMSGF) MSG(TEST_001) SEV(99) VALUES(C D R I)
/* Add message id with default reply value */
ADDMSGD MSGID(TST0002) MSGF(QGPL/TESTMSGF) MSG(TEST_001) SEV(99) VALUES(C D R I) DFT(C)
2.
AUTORPYT1 CLP:
PGM
DCL &CURUSR *CHAR 10
RTVJOBA USER(&CURUSR)
SNDUSRMSG MSGID(TST0001) MSGF(QGPL/TESTMSGF) +
TOUSR(&CURUSR)
ENDPGM
AUTORPYT2 CLP:
PGM
DCL &CURUSR *CHAR 10
RTVJOBA USER(&CURUSR)
SNDUSRMSG MSGID(TST0002) MSGF(QGPL/TESTMSGF) +
TOUSR(&CURUSR)
ENDPGM
3.
Compile AUTORPYT1, AUTORPYT2
4. for example use USER01 subbmit job
SBMJOB CMD(CALL AUTORPYT1) JOB(JOB1)
SBMJOB CMD(CALL AUTORPYT2) JOB(JOB2)
5.
DSPMSG USER01
Display Messages
System: DDSC810
Queue . . . . . : USER01 Program . . . . : *DSPMSG
Library . . . : QUSRSYS Library . . . :
Severity . . . : 00 Delivery . . . : *HOLD
Type reply (if required), press Enter.
Job 690946/USER01/JOB2 completed normally on 09/09/08 at 15:17:58.
Job 690962/USER01/JOB1 completed normally on 09/09/08 at 15:17:58.
TEST 0001
Reply . . .
Waiting for reply to message on message queue USER01.
TEST_002
Reply . . .
Waiting for reply to message on message queue USER01.
6.
AUTORPY MSGQ(USER01) MSGID(TST0001)
MSGID TST001 does not set default reply value,so we got following message :
Additional Message Information
Message ID . . . . . . : CPF9898 Severity . . . . . . . : 40
Message type . . . . . : Information
Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:19:26
Message . . . . : MsgId: TST0001 reply value *DFT is not valid, no default
reply setting, valid reply value is C D E F.
Cause . . . . . : This message is used by application programs as a general
escape message.
7.
AUTORPY MSGQ(USER01) MSGID(TST0001) REPLY(C)
Got following message:
Additional Message Information
Message ID . . . . . . : CPF9897 Severity . . . . . . . : 40
Message type . . . . . : Information
Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:22:06
Message . . . . : MsgId:TST0001 replied to job 690963/USER01/JOB1 with
value C.
Cause . . . . . : No additional online help information is available.
7.1 DSPMSG USER01
Display Messages
System: DDSC810
Queue . . . . . : USER01 Program . . . . : *DSPMSG
Library . . . : QUSRSYS Library . . . :
Severity . . . : 00 Delivery . . . : *HOLD
Type reply (if required), press Enter.
Job 690946/USER01/JOB2 completed normally on 09/09/08 at 15:17:58.
Job 690962/USER01/JOB1 completed normally on 09/09/08 at 15:17:58.
TEST 0001
Reply . . : C
Waiting for reply to message on message queue USER01.
TEST_002
Reply . . .
Waiting for reply to message on message queue USER01.
Job 690963/VENGOAL/JOB1 completed normally on 09/09/08 at 15:22:06.
8.
AUTORPY MSGQ(USER01) MSGID(TST0002) REPLY(RR) <== Reply TST002 message with wrong value
Got following message:
Additional Message Information
Message ID . . . . . . : CPF9898 Severity . . . . . . . : 40
Message type . . . . . : Information
Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:26:54
Message . . . . : MsgId: TST0002 reply value RR is not valid, valid reply
value is C D R I.
Cause . . . . . : This message is used by application programs as a general
escape message.
9.
AUTORPY MSGQ(USER01) MSGID(TST0002) JOB(JOB3)
Because we just submitted JOB1,JOB2, the TST0002 still isn't replied.
DSPMSG USER01 will got same step 7.1 result.
10.
AUTORPY MSGQ(USER01) MSGID(TST0002) LMTRPYJOB(JOB2)
Got following message:
Additional Message Information
Message ID . . . . . . : CPF9897 Severity . . . . . . . : 40
Message type . . . . . : Information
Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:34:13
Message . . . . : MsgId:TST0002 replied to job 690965/USER01/JOB2 with
value C.
Cause . . . . . : No additional online help information is available.
10.1
DSPMSG USER01
Display Messages
System: DDSC810
Queue . . . . . : USER01 Program . . . . : *DSPMSG
Library . . . : QUSRSYS Library . . . :
Severity . . . : 00 Delivery . . . : *HOLD
Type reply (if required), press Enter.
Job 690946/USER01/JOB2 completed normally on 09/09/08 at 15:17:58.
Job 690962/USER01/JOB1 completed normally on 09/09/08 at 15:17:58.
TEST 0001
Reply . . : C
Waiting for reply to message on message queue USER01.
TEST_002
Reply . . : C
Waiting for reply to message on message queue USER01.
Job 690963/USER01/JOB1 completed normally on 09/09/08 at 15:22:06.
Job 690965/USER01/JOB2 completed normally on 09/09/08 at 15:34:13.
星期二, 11月 07, 2023
2006-12-20 如何擷取某工作 Joblog 中某一 MsgID 的訊息內容是否包含指定字串?(Command SCNJOBLOG)
如何擷取某工作 Joblog 中某一 MsgID 的訊息內容是否包含指定字串?(Command SCNJOBLOG)
File : QRPGLESRC
Member: SCNJOBMSGR
Type : RPGLE
Usage : CRTBNDRPG SCNJOBMSGR
H DFTACTGRP(*NO) ACTGRP(*CALLER) BNDDIR('QC2LE') EXPROPTS(*RESDECPOS)
H DATFMT(*ISO) TIMFMT(*ISO) OPTION(*NODEBUGIO) DEBUG
*----------------------------------------------------------------
* SCNJOBLOG Scan specified job's job log by MSGID to
* search some string in job log
* Copyright (C) 12/12/2006 Vengoal Chang
* This program is free software, you can redistribute it and/or modify it under the terms
* of the GNU General Public License as published by the Free Software Foundation.
*
*----------------------------------------------------------------
* This program retrieve specified job job's log and return found
* search string or not.
*
* CRTBNDRPG with target release V5R1 and later
*
*----------------------------------------------------------------
* api (application program interfaces) used:
* quscrtus create user space
* qusptrus retrieve pointer to user space
* qmhljobl list job log messages
* qmhsndm send non-program messages
*----------------------------------------------------------------
D uSpaceName s 20 inz('RTVJOBLOG QTEMP ')
D msgtxt s 256
D QUSLIB s 10
* -------------------------------------------------------------------
* - User space attributes data structure -
* -------------------------------------------------------------------
D QUSAttr DS
D QUSNumRec 10I 0 Inz( 1 )
D QUSKey 10I 0 Inz( 3 )
D QUSRecLen 10I 0 Inz( 1 )
D QUSRecData 1A Inz( '1' )
*----------------------------------------------------------------
D struct DS
D msgdln 10I 0
D msgq# 10I 0
D msgkey 4
D msgq 20 INZ('QSYSOPR *LIBL ')
*
*----------------------------------------------------------------
* Get user space list info from header section.
*----------------------------------------------------------------
D ds based(uHeadPtr)
D uOffSetToList 125 128i 0
D uNumOfEntrys 133 136i 0
D uSizeOfEntry 137 140i 0
*
D uListEntry1 ds Based(uListPtr )
D uOffsetToNext 10i 0 overlay(uListEntry1:1)
D uOffsetToFlds 10i 0 overlay(uListEntry1:5)
D uNumFldsRetrnd 10i 0 overlay(uListEntry1:9)
D uMsgSeverity 10i 0 overlay(uListEntry1:12)
D uMsgId 7a overlay(uListEntry1:17)
D uMsgType 2a overlay(uListEntry1:24)
D uMsgKey 4a overlay(uListEntry1:26)
D uMsgFile 20a overlay(uListEntry1:30)
D uMsgFileName 10a overlay(uListEntry1:30)
D uMsgFileLib 10a overlay(uListEntry1:40)
* these fields repeat for each key selected.
D uListEntry2 ds Based(uListPtr2)
D u2OffsetToNext 10i 0
D u2LengthOfFlds 10i 0
D u2IdentifierF 10i 0
D u2TypeOfData 1a
D u2StatOfData 1a
D u2Reserved 14a
D u2LengthOfData 10i 0
D u2Data 500
*----------------------------------------------------------------
* Error return code parm for APIs.
*----------------------------------------------------------------
D vApiErrDs ds
D vbytpv 10i 0 inz(%size(vApiErrDs))
D vbytav 10i 0 inz(0)
D vmsgid 7a
D vresvd 1a
D vrpldta 50a
*
*----------------------------------------------------------------
* Message selection data structure.
*
* Retrieve JOB Log direction
*-----------------------------|-------------|--------------------
* Parameter | From Top | From Bottom
*-----------------------------|-------------|--------------------
* msListDirection | *NEXT | *PRV
* msStartingMessageKey | X'00000000' | X'FFFFFFFF'
*----------------------------------------------------------------
D MsgSelectDS ds
D msMaxMsgRequested...
D 10i 0 inz(-1) overlay(msgSelectDS:1) num of msg requested
D msListDirection...
D 10a inz('*NEXT') overlay(msgSelectDS:5) List direction
D msQualifiedJobName...
D 10a inz('*') overlay(msgSelectDS:15) * = current job
D msQualifiedUserName...
D 10a inz(' ') overlay(msgSelectDS:25) = current job
D msQualifiedJobNumber...
D 6a inz(' ') overlay(msgSelectDS:35) = current job
D msInternalJobIdentifier...
D 16a inz(' ') overlay(msgSelectDS:41) = current job
D msStartingMessageKey...
D 4a inz(x'00000000') start newest message
D overlay(msgselectDS:57)
D msMaxMsgLength...
D 10i 0 inz(500) overlay(msgSelectDS:61) id 301,302 lengths
D msMaxMsgHelpLength...
D 10i 0 inz(100) overlay(msgSelectDS:65) id 401,402,403,404
D msOffsetToIdentifiersOfFieldstoReturn...
D 10i 0 inz(84) overlay(msgSelectDS:69) to start of array
D msNumberOfFieldsToReturn...
D 10i 0 inz(1) overlay(msgSelectDS:73)
D msOffsetToCallMsgQname...
D 10i 0 inz(88) overlay(msgSelectDS:77)
D msLengthOfCallMsgQname...
D 10i 0 inz(1) overlay(msgSelectDS:81)
D msIndentifiersOfFieldsToReturn...
D 10i 0 inz(0302) overlay(msgSelectDS:85)
D msCallMessageQueueName...
D 1a inz('*') overlay(msgSelectDS:89)
*----------------------------------------------------------------
* Create Prototypes for calls
* --------------------------------------------------------------------
* - QusCrtUs - Create User Space API -
* - -
* - Usage Length Type Parameter Description -
* - -
* - Input 20 Character Qualified user space name -
* - Input 10 Character Extended attribute -
* - Input 4 0 Binary Initial size -
* - Input 1 Character Initial value -
* - Input 10 Character Public authority -
* - Input 50 Character Text description -
* --------------------------------------------------------------------
D quscrtus PR ExtPgm('QUSCRTUS')
D 20
D 10 const
D 10i 0 const
D 1 const
D 10 const
D 50 const
D 10 const
Db like(vApiErrDS)
* -------------------------------------------------------------------
* - Qusptrus - Get user space pointer API -
* - -
* - Usage Length Type Parameter Description -
* - -
* - Input 20 Character Qualified user space name -
* - Output * Pointer UserSpace Pointer -
* - Output Error Code -
* - -----------------------------------------------------------------
D qusptrus PR ExtPgm('QUSPTRUS') retrieve pointer
D 20 Space Name
D * pointer
Db like(vApiErrDS) error parm
* -------------------------------------------------------------------
* - Quscusat - Change User Space Attributes API -
* - -
* - Usage Length Type Parameter Description -
* - -
* - Output 10 Character Returned library -
* - Input 20 Character Qualified user space name -
* - Input 13 Character Attribute structure -
* - Output Error code -
* -------------------------------------------------------------------
D quscusat PR ExtPgm( 'QUSCUSAT' )
D 10A Const
D 20A Const
D 13A Const
Db like(vApiErrDS)
* ---------------------------------------------------------------
D system PR 10I 0 extproc('system')
D i_cmd * value options(*string)
*
D EXCP_MSGID S 7A import('_EXCP_MSGID')
* --------------------------------------------------------------
D qmhljobl PR ExtPgm('QMHLJOBL ')
D 20
D 8 const
Db like(MsgSelectDS)
D 10i 0 const
D 8 const
Db like(vApiErrDS)
* --------------------------------------------------------------
D SNDPGMMSG PR EXTPGM('QMHSNDPM')
D MESSAGEID 7A CONST
D QUALMSGF 20A CONST
D MSGDATA 256A CONST
D MSGDTALEN 10I 0 CONST
D MSGTYPE 10A CONST
D CALLSTKENT 10A CONST
D CALLSTKCNT 10I 0 CONST
D MESSAGEKEY 4A
D ERRORCODE 32766A OPTIONS(*VARSIZE)
* --------------------------------------------------------------
D main PR extpgm('SCNJOBLOGR')
D jobname 10
D jobuser 10
D jobnumber 6
D msgId 7
D searchStr 48
D includeQuote 4
D StrFound 1
D main PI
D jobname 10
D jobuser 10
D jobnumber 6
D msgId 7
D searchStr 48
D includeQuote 4
D StrFound 1
D searchString S 50
D strpos S 5I 0
D quote S 1 Inz('''')
D WWMSGLEN S 10I 0
D WWTHEKEY S 4A
*----------------------------------------------------------------
C eval msQualifiedJobName = jobname
C eval msQualifiedUserName = jobuser
C eval msQualifiedJobNumber = jobnumber
C If includeQuote = '*YES'
C eval searchString = quote + %trim(searchStr) +
C quote
C Else
C eval searchString = %trim(searchStr)
C EndIf
C eval StrFound = '0'
*----------------------------------------------------------------
* Create user space
C callp QUSCRTUS(
C uSpaceName:
C 'TEST':
C 1500000:
C x'00':
C '*ALL':
C 'User Space RTVJOBLOG' :
C '*NO':
C vApiErrDs)
* set UserSpace to autoextended
C CallP QUSCUSAT( QUSLib :
C uSpaceName :
C QUSAttr :
C vApiErrDs )
* Get pointer to user space
C callp QUSPTRUS(
C uSpaceName:
C uHeadPtr:
C vApiErrDs)
* call api to load job log into user space.
C callp QMHLJOBL(
C uSpaceName:
C 'LJOB0100':
C MsgSelectDS:
C %len(MsgSelectDS):
C 'JSLT0100':
C vApiErrDs)
* Process elements
*
C If vbytav = 0
C eval uListPtr = uHeadPtr + uOffSetToList
1B C do uNumOfEntrys
C If uMsgId = msgId
C eval uListPtr2 = uHeadPtr + uOffsetToFlds
C eval msgtxt = %subst(u2Data:1:U2LengthOfData)
C eval strPos = %scan(%trim(searchString) : msgtxt)
C If strPos > 0
C eval StrFound = '1'
C leave
C EndIf
C EndIf
C eval uListPtr = uHeadPtr + uOffsetToNext
1E C enddo
C Else
C eval msgtxt = 'API Error: ' + vmsgid +
C '. Please see job log for detail'
C eval WWMSGLEN = %len(%trimr(msgtxt))
C CALLP SNDPGMMSG('CPF9897': 'QCPFMSG *LIBL':
C msgtxt:WWMSGLEN: '*ESCAPE':
C '*PGMBDY': 1: WWTHEKEY: vApiErrDs)
C EndIf
C eval *inlr = *on
C return
File : QCMDSRC
Member: SCNJOBMSG
Type : CMD
Usage : CRTCMD CMD(lib/SCNJOBLOG) PGM(lib/SCNJOBLOGR) ALLOW(*IPGM *BPGM)
/********************************************************************/
/* Title: SCNJOBLOG: Scan jobs log */
/* */
/* Description - This command performs job log scaned by MSGID */
/* */
/* The Create Command command should include the following: */
/* */
/* CRTCMD CMD(SCNJOBLOG) PGM(SCNJOBLOGR) */
/* ALLOW(*IPGM *BPGM) */
/********************************************************************/
/* =============================================================== */
/* = Date : 2006/12/20 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
/*------------------------------------------------*/
/* Command Definition */
/*------------------------------------------------*/
CMD PROMPT('Scan Job Log by MSGID')
PARM KWD(JOB) TYPE(*SNAME) LEN(10) MIN(1) +
PROMPT('Job name')
PARM KWD(USER) TYPE(*SNAME) LEN(10) MIN(1) +
PROMPT('User name')
PARM KWD(JOBNBR) TYPE(*CHAR) LEN(6) RANGE(000000 +
999999) MIN(1) PROMPT('Job number')
PARM KWD(MSGID) TYPE(*CHAR) LEN(7) SPCVAL((*ALL)) +
MIN(1) PROMPT('Message ID to be searched')
PARM KWD(SCHSTR) TYPE(*CHAR) LEN(50) +
PROMPT('String searched in MSGID Text')
PARM KWD(QUOTE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) PROMPT('Include +
quote between SCHSTR')
PARM KWD(FOUND) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
PROMPT('CL var for String found (1)')
File : QCLSRC
Member: SCNJOBLOGT
Type : CLP
Usage : 指定 job, usr, jobnbr, search-msgid, search-string 取代小寫部分
CRTCLPGM SCNJOBLOGT
CALL SCNJOBLOGT
PGM
DCL &RC *CHAR 1 /* RC=1 found, RC <> 1 not found */
SCNJOBLOG JOB(job) USER(usr) JOBNBR(jobnbr) +
MSGID(search-msgid) SCHSTR(search-string) FOUND(&RC)
MONMSG CPF9897
ENDPGM
訂閱：
文章 (Atom)