使用 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月 09, 2023
2013-05-15 使用 API QGYOLMSG Open List of Messages 列出 Message queue 的訊息 -- Command CVTMSGQ
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言