ecki/IBM-i-RPG-Free-CLP-Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use Binder Source, add JobLogMsg

Browse Source
This commit is contained in:
SJLennon 2021-12-08 12:12:14 -05:00
parent 0e57f94f2a
commit 5e99362069
7 changed files with 265 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Copy_Mbrs/SRV_MSG_P.RPGLE
View File

@ -13,10 +13,21 @@
//============================================================
D SndEscMsg pr Send ESC Msg
D piMsg 1024a Const Varying
D piMsg 512a Const Varying
//============================================================
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 ==================

35
Service_Pgms/README.md
View File

@ -1,23 +1,41 @@
### Service Programs
Utility Service Programs.
Utility Service Programs.
* SRV_MSG
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
Contains procedures to manipulate strings in an RPG program.
**CenterStr**: Center a string.
* 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
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
RPG program to test the procedures in SRV_MSG.
@ -26,6 +44,19 @@ Utility Service Programs.
Display file used by SRV_MSGTR.
* SRVMSGTL
RPG program to test and demonstate JobLogMsg in SRV_MSG.
* SRV_STRTR
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

79
Service_Pgms/SHOW.RPGLE Normal file
View File

@ -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;

57
Service_Pgms/SHOW_T.RPGLE Normal file
View File

@ -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;

40
Service_Pgms/SRV_MSG.RPGLE
View File

@ -1,10 +1,16 @@
//==============================================================
//=== SRV_MSG service program contains prodcedure for sending
//=== messages with QMHSNDPM
//=== messages:
// With QMHSNDPM
// With Qp0zLprintf (to job log.)
//==============================================================
// 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))
h nomain option(*NoDebugIo: *srcstmt)
@ -30,6 +36,10 @@
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
@ -178,7 +188,7 @@
P SndEscMsg B Export
D SndEscMsg PI
D piMsg 1024a Const Varying
D piMsg 512a Const Varying
//--- Parameters for QMHSNDPM -------------------------
D MsgId c const('CPF9898')
@ -216,12 +226,12 @@
//=== SndInfMsg ===============================================
// Sends CPF9898 Info message of the provided text to the
// external message queue.
// Useful for debugging.
// Useful for debugging. See also JobLogMsg.
P SndInfMsg B Export
D SndInfMsg PI
D piMsg 1024a Const Varying
D piMsg 512a Const Varying
//--- Parameters for QMHSNDPM -------------------------
D MsgId c const('CPF9898')
@ -255,3 +265,23 @@
/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

8
Service_Pgms/SRV_MSGBND.BND Normal file
View File

@ -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

40
Service_Pgms/SRV_MSGTL.RPGLE Normal file
View File

@ -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;