Use Binder Source, add JobLogMsg
This commit is contained in:
SJLennon
@@ -13,10 +13,21 @@
|
|||||||
|
|
||||||
//============================================================
|
//============================================================
|
||||||
D SndEscMsg pr Send ESC Msg
|
D SndEscMsg pr Send ESC Msg
|
||||||
D piMsg 1024a Const Varying
|
D piMsg 512a Const Varying
|
||||||
|
|
||||||
//============================================================
|
//============================================================
|
||||||
D SndInfMsg pr Send INF Msg
|
D SndInfMsg pr Send INF Msg
|
||||||
D piMsg 1024a Const Varying
|
D piMsg 512a Const Varying
|
||||||
|
|
||||||
|
//============================================================
|
||||||
|
D JobLogMsg Pr
|
||||||
|
D piMsg 512a Value Varying Msg to job log
|
||||||
|
|
||||||
|
//============================================================
|
||||||
|
D Show pr extpgm('SHOW') Show popup msg
|
||||||
|
D piPext 8192a Const Varying
|
||||||
|
D piMsgId 7a Const options(*NOPASS)
|
||||||
|
d piMsgFile 21a Const options(*NOPASS)
|
||||||
|
|
||||||
|
|
||||||
//=== End of Prototypes forSRV_MSG Routines ==================
|
//=== End of Prototypes forSRV_MSG Routines ==================
|
||||||
|
|||||||
+33
-2
@@ -1,23 +1,41 @@
|
|||||||
### Service Programs
|
### Service Programs
|
||||||
|
|
||||||
Utility Service Programs.
|
Utility Service Programs.
|
||||||
|
|
||||||
* SRV_MSG
|
* SRV_MSG
|
||||||
|
|
||||||
Contains procedures to send messages from an RPG program.
|
Contains procedures to send messages from an RPG program.
|
||||||
|
|
||||||
|
**SndMSgPgmQ**: Send message to a provided program queue. (Interactive programming.)
|
||||||
|
|
||||||
|
**ClrMsgPgmQ**: Clears all messages from the provided program queue. (Interactive programming.)
|
||||||
|
|
||||||
|
**SndEscMsg**: Send provided text as an escape message.
|
||||||
|
|
||||||
|
**SndInfMsg**: Send provided text as info message to the external message queue.
|
||||||
|
|
||||||
|
**JobLogMsg**: Send provided text to the job log using Qp0zLprintf, a C function. For testing, convenient alternative to the DSPLY opcode.
|
||||||
|
|
||||||
* SRV_STR
|
* SRV_STR
|
||||||
|
|
||||||
Contains procedures to manipulate strings in an RPG program.
|
Contains procedures to manipulate strings in an RPG program.
|
||||||
|
|
||||||
|
**CenterStr**: Center a string.
|
||||||
|
|
||||||
* SRV_SQL
|
* SRV_SQL
|
||||||
|
|
||||||
* Helper procedures for RPG programs using embedded SQL.
|
Helper procedures for RPG programs using embedded SQL.
|
||||||
|
|
||||||
|
**SqlProblem**: For those "never should happen" SQL errors. Does DUMP(A) and dends escape message of provided text and SQL diagnostics.
|
||||||
|
|
||||||
* CRTBNDDIR
|
* CRTBNDDIR
|
||||||
|
|
||||||
A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG.
|
A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG.
|
||||||
|
|
||||||
|
* SRVMSGBND
|
||||||
|
|
||||||
|
Binder source used when creating SRV_MSG.
|
||||||
|
|
||||||
* SRV_MSGTR
|
* SRV_MSGTR
|
||||||
|
|
||||||
RPG program to test the procedures in SRV_MSG.
|
RPG program to test the procedures in SRV_MSG.
|
||||||
@@ -26,6 +44,19 @@ Utility Service Programs.
|
|||||||
|
|
||||||
Display file used by SRV_MSGTR.
|
Display file used by SRV_MSGTR.
|
||||||
|
|
||||||
|
* SRVMSGTL
|
||||||
|
|
||||||
|
RPG program to test and demonstate JobLogMsg in SRV_MSG.
|
||||||
|
|
||||||
* SRV_STRTR
|
* SRV_STRTR
|
||||||
|
|
||||||
RPG program to test the procedures in SRV_STR.
|
RPG program to test the procedures in SRV_STR.
|
||||||
|
|
||||||
|
* SHOW
|
||||||
|
|
||||||
|
RPG program to display a 5250 message using the QUILNGTX API. Useful for testing, but possibly
|
||||||
|
JobLogMsg in SRV_MSG is more useful. Really should be part of SRV_MSG, but it is totally *FREE for and I have left SRV_MSG partially fixed.
|
||||||
|
|
||||||
|
SHOW_T
|
||||||
|
|
||||||
|
RPG program to test & exercise SHOW
|
||||||
|
|||||||
@@ -0,0 +1,79 @@
|
|||||||
|
**free
|
||||||
|
// +---------------------------------------------------------------+
|
||||||
|
// + SHOW (display) text in an IBM i 5250 pop-up window +
|
||||||
|
// +---------------------------------------------------------------+
|
||||||
|
// Replacement (partial) for the DSPLY opcode:
|
||||||
|
// 1. Accepts text lenths much great than 52.
|
||||||
|
// 2. Does not accept input.
|
||||||
|
//
|
||||||
|
// Uses the Display Long Text (QUILNGTX) API to display a pop-up
|
||||||
|
// window containing the passed string.
|
||||||
|
// API doesn't display bidirectional right to left text.
|
||||||
|
//
|
||||||
|
// Error Messages
|
||||||
|
// Message ID Error Message Text
|
||||||
|
// CPF3C90 E Literal value cannot be changed
|
||||||
|
// CPF6A4C E At least one parameter value is not correct. Reason code is &1
|
||||||
|
// CPF9871 E Error occurred while processing
|
||||||
|
// "Inspired" by others. Thanks to:
|
||||||
|
// Nick Litten https://www.nicklitten.com/dsply-sucks-quilngtx-rocks/
|
||||||
|
// Michael Sansoterra https://www.itjungle.com/2011/09/21/fhg092111-story02/
|
||||||
|
//
|
||||||
|
// == NOTE =====================================================================
|
||||||
|
// This should probably be part of the SRV_MSG service program, but since this
|
||||||
|
// is **FREE and SRV_MSG is only partially free, I'm leaving it as a separate
|
||||||
|
// program. For now, anyway...
|
||||||
|
//
|
||||||
|
// Probably only useful for testing/debugging and the JOBLOGMSG procdure in
|
||||||
|
// SRV_PGM is probably more useful.
|
||||||
|
// =============================================================================
|
||||||
|
|
||||||
|
ctl-opt option(*NoDebugIo: *srcstmt)
|
||||||
|
dftactgrp(*no) actgrp(*caller)
|
||||||
|
main(Show);
|
||||||
|
|
||||||
|
dcl-proc Show ;
|
||||||
|
dcl-pi Show;
|
||||||
|
p_Text varchar(8192) const;
|
||||||
|
p_MsgId char(7) Options(*nopass:*omit);
|
||||||
|
p_MsgFile char(21) Options(*nopass:*omit);
|
||||||
|
end-pi;
|
||||||
|
|
||||||
|
dcl-ds myApiError ;
|
||||||
|
APIEProv int(10) inz(%SIZE(APIEData)) pos(1);
|
||||||
|
APIEAvail int(10) inz(0) pos(5);
|
||||||
|
APIErrID char(7) pos(9);
|
||||||
|
APIErrRsv char(1);
|
||||||
|
APIEData char(256);
|
||||||
|
end-ds;
|
||||||
|
|
||||||
|
dcl-pr QUILNGTX extpgm('QUILNGTX');
|
||||||
|
*n char(8192) const; // MsgText
|
||||||
|
*n int(10) const; // MsgLength
|
||||||
|
*n char(7) const; // MessageId
|
||||||
|
*n char(21) const; // MessageFile
|
||||||
|
*n options( *omit: *varsize ) like( myApierror ); // ErrorDS
|
||||||
|
end-pr;
|
||||||
|
|
||||||
|
dcl-s MsgId like(p_MsgId);
|
||||||
|
dcl-s MsgFile like(p_MsgFile);
|
||||||
|
|
||||||
|
If %Parms = 1;
|
||||||
|
MsgId = 'CAE0103'; // 'Press Enter to continue.'
|
||||||
|
MsgFile = 'QCPFMSG *LIBL';
|
||||||
|
Elseif %Parms = 2;
|
||||||
|
MsgId = p_MsgId;
|
||||||
|
MsgFile = 'QCPFMSG *LIBL';
|
||||||
|
Elseif %Parms = 3;
|
||||||
|
MsgId = p_MsgId;
|
||||||
|
MsgFile = p_MsgFile;
|
||||||
|
Endif;
|
||||||
|
APIEAvail = 0; // Errors cause a crash.
|
||||||
|
QUILNGTX ( p_Text
|
||||||
|
: %Len(p_Text)
|
||||||
|
: MsgId
|
||||||
|
: MsgFile
|
||||||
|
: myApiError
|
||||||
|
);
|
||||||
|
return;
|
||||||
|
end-proc;
|
||||||
@@ -0,0 +1,57 @@
|
|||||||
|
**free
|
||||||
|
//=== Tests the SHOW program (the QUILNGTX API) ====== ========
|
||||||
|
Ctl-Opt DftActGrp(*NO) ActGrp(*CALLER) option(*nodebugio: *srcstmt);
|
||||||
|
Ctl-Opt BndDir('UTIL_BND');
|
||||||
|
|
||||||
|
//=== Service Program Prototypes ==============================
|
||||||
|
/include copy_mbrs,Srv_Msg_P
|
||||||
|
|
||||||
|
dcl-s short1 char(30) inz('A typical short msg.');
|
||||||
|
|
||||||
|
dcl-s msg68 char(68)
|
||||||
|
inz('This is a 68 char long field with trailing blanks');
|
||||||
|
dcl-s msg68LB char(68)
|
||||||
|
inz(' A 68 char field with 10 leading blanks (removed) ');
|
||||||
|
dcl-s name76 char(76) inz;
|
||||||
|
|
||||||
|
dcl-s scale1 char(68)
|
||||||
|
inz('12345678901234567890123456789012345678901234567890123456789012345678');
|
||||||
|
dcl-s scale2 char(68)
|
||||||
|
inz('< 1 2 3 4 5 6 >');
|
||||||
|
dcl-s loong char(8192) inz(' ');
|
||||||
|
dcl-s wrap char(272) INZ(
|
||||||
|
'This is a very very long message and wrapping +
|
||||||
|
is expected at a suita+
|
||||||
|
ble break point. Like at a blank.');
|
||||||
|
|
||||||
|
show(scale1 + scale2);
|
||||||
|
show(scale1+scale2+scale1+scale2+scale1+scale2+scale1+scale2+scale1);
|
||||||
|
|
||||||
|
show(short1);
|
||||||
|
|
||||||
|
show(msg68);
|
||||||
|
|
||||||
|
msg68 = '68 bytes, with 67 & 68 non-blank';
|
||||||
|
%subst(msg68:67:2) = '<<';
|
||||||
|
show(msg68);
|
||||||
|
|
||||||
|
%subst(msg68lb:67:2) = '<<';
|
||||||
|
show(msg68LB);
|
||||||
|
|
||||||
|
name76 = 'Wrap after 68';
|
||||||
|
%subst(name76 :68) = ' A wrap!';
|
||||||
|
Show(name76);
|
||||||
|
|
||||||
|
show('This is an extemporaneous mesage');
|
||||||
|
|
||||||
|
show(wrap);
|
||||||
|
|
||||||
|
loong = '< 8192 long field of blanks. Blank lines are removed.';
|
||||||
|
%subst(loong:4096) = 'This is text starting at 4096 of the 8192 field.';
|
||||||
|
%subst(loong :8191 :1) = '>';
|
||||||
|
show(loong);
|
||||||
|
|
||||||
|
show('With a BAD message id' : 'ZZZ9999');
|
||||||
|
show('With a message id: CAE9049 (picked purely for demo purposes).' : 'CAE9049');
|
||||||
|
|
||||||
|
*inlr = *on;
|
||||||
@@ -1,10 +1,16 @@
|
|||||||
|
|
||||||
//==============================================================
|
//==============================================================
|
||||||
//=== SRV_MSG service program contains prodcedure for sending
|
//=== SRV_MSG service program contains prodcedure for sending
|
||||||
//=== messages with QMHSNDPM
|
//=== messages:
|
||||||
|
// With QMHSNDPM
|
||||||
|
// With Qp0zLprintf (to job log.)
|
||||||
//==============================================================
|
//==============================================================
|
||||||
// CRTRPGMOD MODULE(SRV_MSG)
|
// CRTRPGMOD MODULE(SRV_MSG)
|
||||||
// CRTSRVPGM SRVPGM(SRV_MSG) EXPORT(*ALL)
|
//
|
||||||
|
// CRTSRVPGM SRVPGM(SRV_MSG)
|
||||||
|
// SRCFILE(*LIBL/SRV_PGMS) SRCMBR(SRV_MSGBND)
|
||||||
|
// TEXT('Messages service program')
|
||||||
|
//
|
||||||
// ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER))
|
// ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER))
|
||||||
|
|
||||||
h nomain option(*NoDebugIo: *srcstmt)
|
h nomain option(*NoDebugIo: *srcstmt)
|
||||||
@@ -30,6 +36,10 @@
|
|||||||
d Remove 10a
|
d Remove 10a
|
||||||
D apiErrorDS 17a
|
D apiErrorDS 17a
|
||||||
|
|
||||||
|
//=== Qp0zLprintf =============================================
|
||||||
|
d printF pr extproc('Qp0zLprintf')
|
||||||
|
d piMsg * value options(*string)
|
||||||
|
|
||||||
//=== SNDMSGPGMQ ===============================================
|
//=== SNDMSGPGMQ ===============================================
|
||||||
// SeND a MeSsaGe to a ProGraM message Queue.
|
// SeND a MeSsaGe to a ProGraM message Queue.
|
||||||
// Sends a pre-defined message to a program message queue
|
// Sends a pre-defined message to a program message queue
|
||||||
@@ -178,7 +188,7 @@
|
|||||||
P SndEscMsg B Export
|
P SndEscMsg B Export
|
||||||
|
|
||||||
D SndEscMsg PI
|
D SndEscMsg PI
|
||||||
D piMsg 1024a Const Varying
|
D piMsg 512a Const Varying
|
||||||
|
|
||||||
//--- Parameters for QMHSNDPM -------------------------
|
//--- Parameters for QMHSNDPM -------------------------
|
||||||
D MsgId c const('CPF9898')
|
D MsgId c const('CPF9898')
|
||||||
@@ -216,12 +226,12 @@
|
|||||||
//=== SndInfMsg ===============================================
|
//=== SndInfMsg ===============================================
|
||||||
// Sends CPF9898 Info message of the provided text to the
|
// Sends CPF9898 Info message of the provided text to the
|
||||||
// external message queue.
|
// external message queue.
|
||||||
// Useful for debugging.
|
// Useful for debugging. See also JobLogMsg.
|
||||||
|
|
||||||
P SndInfMsg B Export
|
P SndInfMsg B Export
|
||||||
|
|
||||||
D SndInfMsg PI
|
D SndInfMsg PI
|
||||||
D piMsg 1024a Const Varying
|
D piMsg 512a Const Varying
|
||||||
|
|
||||||
//--- Parameters for QMHSNDPM -------------------------
|
//--- Parameters for QMHSNDPM -------------------------
|
||||||
D MsgId c const('CPF9898')
|
D MsgId c const('CPF9898')
|
||||||
@@ -255,3 +265,23 @@
|
|||||||
/end-free
|
/end-free
|
||||||
|
|
||||||
P SndInfMsg E
|
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
|
||||||
|
|||||||
@@ -0,0 +1,8 @@
|
|||||||
|
STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('Version 1.0')
|
||||||
|
/********************************************************************/
|
||||||
|
EXPORT SYMBOL(CLRMSGPGMQ)
|
||||||
|
EXPORT SYMBOL(SNDESCMSG)
|
||||||
|
EXPORT SYMBOL(SNDINFMSG)
|
||||||
|
EXPORT SYMBOL(SNDMSGPGMQ)
|
||||||
|
EXPORT SYMBOL(JOBLOGMSG)
|
||||||
|
ENDPGMEXP
|
||||||
@@ -0,0 +1,40 @@
|
|||||||
|
**FREE
|
||||||
|
//=== Tests JobLogMsg procedures in SRV_MSG service program ========
|
||||||
|
ctl-opt option(*NoDebugIo: *SrcStmt :*NoUnref) indent(' |')
|
||||||
|
ActGrp('QILE') DftActGrp(*no)
|
||||||
|
BndDir('UTIL_BND':'SQL_BND')
|
||||||
|
Main(Main);
|
||||||
|
|
||||||
|
/include copy_mbrs,Srv_Msg_P
|
||||||
|
|
||||||
|
dcl-proc Main ;
|
||||||
|
dcl-pi *n extpgm('SRV_MSGTL');
|
||||||
|
end-pi;
|
||||||
|
|
||||||
|
dcl-s name char(72) inz('Name72');
|
||||||
|
dcl-s name73 char(73) inz;
|
||||||
|
dcl-s name76 char(76) inz;
|
||||||
|
|
||||||
|
dcl-s scale2 char(73) inz(
|
||||||
|
'1234567890123456789012345678901234567890123456789012345678901234567890123');
|
||||||
|
dcl-s scale char(73) inz(
|
||||||
|
' 1 2 3 4 5 6 7 ');
|
||||||
|
*inlr = *on;
|
||||||
|
JobLogMsg(scale );
|
||||||
|
JobLogMsg(scale2 );
|
||||||
|
JobLogMsg(name );
|
||||||
|
|
||||||
|
name = 'No wrap 73';
|
||||||
|
name73 = name + 'Y';
|
||||||
|
JobLogMsg(name73 );
|
||||||
|
|
||||||
|
name = 'Wrap after 73';
|
||||||
|
name76 = name + 'WRAP';
|
||||||
|
JobLogMsg(name76 );
|
||||||
|
|
||||||
|
// JobLogMsg(scale2 );
|
||||||
|
// JobLogMsg(scale );
|
||||||
|
|
||||||
|
SndInfMsg('SndInfMsg - to compare to JobLogMsg');
|
||||||
|
JobLogmsg('JobLogMsg - to compare to SndInfMsg');
|
||||||
|
end-proc;
|
||||||
Reference in New Issue
Block a user