295 lines
11 KiB
Plaintext
295 lines
11 KiB
Plaintext
|
|
//==============================================================
|
|
//=== SRV_MSG service program contains prodcedure for sending
|
|
//=== messages:
|
|
// With QMHSNDPM
|
|
// With Qp0zLprintf (to job log.)
|
|
//==============================================================
|
|
// CRTRPGMOD MODULE(SRV_MSG)
|
|
//
|
|
// CRTSRVPGM SRVPGM(SRV_MSG)
|
|
// SRCFILE(*LIBL/SRV_PGMS) SRCMBR(SRV_MSGBND)
|
|
// TEXT('Messages service program')
|
|
//
|
|
// ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER))
|
|
|
|
h nomain option(*NoDebugIo: *srcstmt)
|
|
/include copy_mbrs,Srv_Msg_P
|
|
|
|
//=== QMHSNDPM internal prototype =============================
|
|
D QMHSNDPM pr ExtPgm('QMHSNDPM')
|
|
D piMsgId 7a Const
|
|
D piMsgFile 20a Const
|
|
D piMsgData 1024a Const OPTIONS(*varsize)
|
|
D piMsgDataLgth 10i 0 Const
|
|
D piMsgType 10a Const
|
|
D piCallStk 10a Const
|
|
D piRelCallStk 10i 0 Const
|
|
D piRtnMsgKey 4a
|
|
D apiErrorDS 17a
|
|
|
|
//=== QMHRMVPM internal prototype =============================
|
|
d QMHRMVPM pr Extpgm('QMHRMVPM')
|
|
d pPgmMsgQ 10a
|
|
d PgmStk 10i 0
|
|
d MsgKey 4a
|
|
d Remove 10a
|
|
D apiErrorDS 17a
|
|
|
|
//=== Qp0zLprintf =============================================
|
|
d printF pr extproc('Qp0zLprintf')
|
|
d piMsg * value options(*string)
|
|
|
|
//=== SNDMSGPGMQ ===============================================
|
|
// SeND a MeSsaGe to a ProGraM message Queue.
|
|
// Sends a pre-defined message to a program message queue
|
|
// that you provide as a parameter.
|
|
|
|
// Primarily designed to be used in interactive programs
|
|
// that send messages via a message subfile.
|
|
|
|
// See also CLRMSGPGMQ which clears messages from a program
|
|
// message queue.
|
|
//==============================================================
|
|
// Conceptual call:
|
|
//=================
|
|
// H BndDir('UTIL_BND')
|
|
// /include copy_mbrs,Srv_Msg_P
|
|
// D ProgStatus sds
|
|
// D PgmName *PROC
|
|
// SNDMSGPGMQ(PgmName:
|
|
// Msgid:
|
|
// MsgFile:
|
|
// MsgDta);
|
|
//==============================================================
|
|
P SndMsgPgmQ b export
|
|
d SndMsgPgmQ pi
|
|
d pMsgQ 10
|
|
d pMsgid 7
|
|
d pMsgFile 10
|
|
d pMsgDta 512 options(*NOPASS)
|
|
d Varying
|
|
//=== Calling Parameters =======================================
|
|
// Parm I/O/B Description
|
|
// ---- ----- -----------
|
|
// pMsgQ I Message queue to send to. Usually the
|
|
// program name, or the MAIN procedure name
|
|
// obtained with %proc().
|
|
// pMsgId I Predefined message id, e.g. CPF9898.
|
|
// pMsgFile I Message file containing pMsgid. (Library
|
|
// is assumed as *LIBL.)
|
|
// pMsgDta I Optional: Data to substitute into the message.
|
|
// (Trailing blanks will be truncated before use.)
|
|
|
|
//=== API Error Code Structure ==================================
|
|
// We don't provide any bytes, so an error will cause a crash,
|
|
// because if we get an error here something bad has happened.
|
|
dAPIError ds 272
|
|
d APIEProv 1 4b 0 inz(0)
|
|
d APIEAvail 5 8b 0 inz(0)
|
|
d APIErrId 9 15 inz(*blanks)
|
|
//=== QMHSNDPM Parameters =======================================
|
|
d QMsgFile s 20
|
|
d MsgType s 10 inz('*INFO')
|
|
d StackCntr s 10i 0 inz(0)
|
|
d MsgKey s 4 inz(' ')
|
|
d MsgDta s 256 inz(' ')
|
|
d MsgDtaLgth s 10i 0
|
|
//=== SNDMSGPGMQ execution starts here ==========================
|
|
/free
|
|
QMsgFile = pMsgFile + '*LIBL';
|
|
// Message data length for QMHSNDPM is optional. If supplied,
|
|
// use, else default to 0.
|
|
if %parms > 3;
|
|
MsgDta = pMsgDta;
|
|
MsgDtaLgth = %len(%trimr(MsgDta));
|
|
else;
|
|
MsgDtaLgth = 0;
|
|
endif;
|
|
//=== Send message with API =====================================
|
|
QMHSNDPM (pMsgid
|
|
:QMsgFile
|
|
:MsgDta
|
|
:MsgDtaLgth
|
|
:MsgType
|
|
:pMsgQ
|
|
:StackCntr
|
|
:MsgKey
|
|
:APIError);
|
|
// Exit with LR off. This is a tiny routine which will probably
|
|
// be called again.
|
|
return;
|
|
/end-free
|
|
p SndMsgPgmQ e
|
|
|
|
//=== CLRMSGPGMQ =-=============================================
|
|
// CLeaRs all MeSsaGes from a ProGraM message Queue
|
|
// Clears all the messages from a program message queue that
|
|
// you specify as a parameter.
|
|
|
|
// It is primarily designed for use by interactive programs that
|
|
// send messages through a message subfile.
|
|
|
|
// See also SNDMSGPGMQ which sends a message to the program queue.
|
|
//
|
|
// Always returns *OFF
|
|
//===============================================================
|
|
|
|
// Conceptual call:
|
|
//=================
|
|
// H BndDir('UTIL_BND')
|
|
// /include copy_mbrs,Srv_Msg_P
|
|
// D ProgStatus sds
|
|
// D PgmName *PROC
|
|
// CLRMSGPGMQ(PgmName)
|
|
|
|
p ClrMsgPgmQ b export
|
|
D ClrMsgPgmQ pi N
|
|
d pPgmMsgQ 10
|
|
|
|
//=== API Error Code Structure ==================================
|
|
// We don't provide any bytes, so an error will cause a crash,
|
|
// because if we get an error here something bad has happened.
|
|
dAPIError ds 272
|
|
d APIEProv 1 4b 0 inz(0)
|
|
d APIEAvail 5 8b 0 inz(0)
|
|
d APIErrId 9 15 inz(*blanks)
|
|
//=== Parameters for QMHRMVPM API ===============================
|
|
d PgmStk s 10i 0 inz(0)
|
|
d MSgKey s 4 inz(*blanks)
|
|
d Remove s 10 inz('*ALL')
|
|
|
|
//=== Calling Parameters =============================================
|
|
// Parm I/O/B Description
|
|
// ---- ----- -----------
|
|
// pPGMMsgQ I Program message queue to clear.
|
|
|
|
//=== ClrMsgPgmQ execution starts here ==========================
|
|
/free
|
|
QMHRMVPM(pPgmMsgQ
|
|
:PgmStk
|
|
:MsgKey
|
|
:Remove
|
|
:APIError);
|
|
|
|
/free
|
|
// Exit with LR off. This is a tiny routine which will probably
|
|
// be called again.
|
|
RETURN *off;
|
|
/end-free
|
|
|
|
p ClrMsgPgmQ e
|
|
|
|
//=== SndEscMsg ===============================================
|
|
// Sends CPF9898 Escape message of the provided text.
|
|
// This will kill the current program and cause an
|
|
// exception in the one that called it.
|
|
|
|
P SndEscMsg B Export
|
|
|
|
D SndEscMsg PI
|
|
D piMsg 512a Const Varying
|
|
D piStackEnt 10i 0 Const options(*Nopass)
|
|
|
|
//--- Parameters for QMHSNDPM -------------------------
|
|
D MsgId c const('CPF9898')
|
|
d MsgF c const('QCPFMSG *LIBL ')
|
|
d MsgType c const('*ESCAPE ')
|
|
d PgmQue c const('* ')
|
|
d InvCount s 10i 0 inz(2)
|
|
d ApiError s 17a inz(X'00')
|
|
d RetMsgKey s 4a
|
|
D DataLen s 10i 0
|
|
|
|
//--- Local Variables ---------------------------------
|
|
D MsgData s 1024a
|
|
|
|
/FREE
|
|
|
|
DataLen = %len(PiMSG);
|
|
MsgData = piMsg;
|
|
|
|
if %parms = 2;
|
|
InvCount = piStackEnt;
|
|
else;
|
|
InvCount = 2;
|
|
endif;
|
|
|
|
QMHSNDPM(MsgId
|
|
:MsgF
|
|
:MsgData
|
|
:DataLen
|
|
:MsgType
|
|
:PgmQue
|
|
:InvCount
|
|
:RetMsgKey
|
|
:APIError);
|
|
return;
|
|
|
|
/end-free
|
|
|
|
P SndEscMsg E
|
|
|
|
//=== SndInfMsg ===============================================
|
|
// Sends CPF9898 Info message of the provided text to the
|
|
// external message queue.
|
|
// Useful for debugging. See also JobLogMsg.
|
|
|
|
P SndInfMsg B Export
|
|
|
|
D SndInfMsg PI
|
|
D piMsg 512a Const Varying
|
|
|
|
//--- Parameters for QMHSNDPM -------------------------
|
|
D MsgId c const('CPF9898')
|
|
d MsgF c const('QCPFMSG *LIBL ')
|
|
d MsgType c const('*INFO ')
|
|
d PgmQue c const('*EXT ')
|
|
d InvCount c const(2)
|
|
d ApiError s 17a inz(X'00')
|
|
d RetMsgKey s 4a
|
|
D DataLen s 10i 0
|
|
|
|
//--- Local Variables ---------------------------------
|
|
D MsgData s 1024a
|
|
|
|
/FREE
|
|
|
|
DataLen = %len(PiMSG);
|
|
MsgData = piMsg;
|
|
|
|
QMHSNDPM(MsgId
|
|
:MsgF
|
|
:MsgData
|
|
:DataLen
|
|
:MsgType
|
|
:PgmQue
|
|
:InvCount
|
|
:RetMsgKey
|
|
:APIError);
|
|
return;
|
|
|
|
/end-free
|
|
|
|
P SndInfMsg E
|
|
|
|
//=== JobLogMsg ===============================================
|
|
// Write arbitray message to the Job log.
|
|
// Uses Qp0zLprintf, which is a C function.
|
|
// Useful for debugging. See also SndInfMsg.
|
|
|
|
P JobLogMsg B Export
|
|
|
|
D JobLogMsg PI
|
|
D piMsg 512a Value Varying
|
|
|
|
d wkMsg s +1 like(piMSg)
|
|
d EOL c x'25'
|
|
|
|
/FREE
|
|
wkMsg = piMsg + EOL;
|
|
printF(wkMsg);
|
|
return;
|
|
/end-free
|
|
P JobLogMsg E
|