Add SRV_STR Stuff

This commit is contained in:
SJLennon 2020-10-03 15:18:23 -04:00
parent 8daf3e8953
commit 74f2e263d1
6 changed files with 146 additions and 1 deletions

View File

@ -10,4 +10,8 @@ These are source files that will be copied into programs using /COPY or /INCLUDE
Prototype definitions for procedures in the SRV_MSG service program.
* SRV_STR_P
Prototype definitions for procedures in the SRV_STR service program.

8
Copy_Mbrs/SRV_STR_P Normal file
View File

@ -0,0 +1,8 @@
//=== Prototypes for SRV_STR routines ========================
//============================================================
d CenterStr pr 256a varying
d InStr 256a varying const
d
//=== End of Prototypes forSRV_STR Routines ==================

View File

@ -1,7 +1,8 @@
PGM
/* Create UTIL_BND binding directory in *CURLIB */
/* Change next statement if a different library is needed */
/* Change next statement if needed */
CRTBNDDIR BNDDIR(*CURLIB/UTIL_BND) TEXT('Utilities +
Service PGMs')
ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER))
ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_STR *SRVPGM *DEFER))
ENDPGM

View File

@ -6,6 +6,10 @@ Utility Service Programs. This is probably the first code you want to explore be
Contains procedures to send messages from an RPG program.
* SRV_STR
Contains procedures to manipulate strings in an RPG program.
* CRTBNDDIR
A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG.
@ -17,3 +21,8 @@ Utility Service Programs. This is probably the first code you want to explore be
* SRV_MSGTD
Display file used by SRV_MSGTR.
* SRV_STRTR
RPG program to test the procedures in SRV_STR.

45
Service_Pgms/SRV_STR Normal file
View File

@ -0,0 +1,45 @@
//==============================================================
//=== SRV_STR service program contains procedures working
//=== with strings
//==============================================================
// CRTRPGMOD MODULE(SRV_STR)
// CRTSRVPGM SRVPGM(SRV_STR) EXPORT(*ALL)
// ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_STR *SRVPGM *DEFER))
//=== CenterStr ================================================
// Return the centered string. The input string is normally
// fixed length and RPG will promote it to varying on the
// call. A varying string is returned which RPG will reset
// to fixed if needed.
// It will also execute with a varying string input but the
// result may not be what you expect.
//
// Conceptual call:
//=================
// H BndDir('UTIL_BND')
// /include Demo,Srv_Str_P
// d Head S 20A inz('Inquiry')
// Head = CenterStr(Head);
// Notes:
// CenterStr is small, but it is convenient.
// Could add left and right justify, but...
// Left justify is simple in RPG:
// str = %trim(str);
// Right justify is also simple:
// evalr str = %trim(str);
h nomain option(*NoDebugIo: *srcstmt)
/include Demo,SRV_STR_P
p CenterStr b export
d CenterStr pi 256a varying
d InStr 256a varying const
d
d blanks s 256a varying inz
d trimInStr s 256a varying
/free
trimInStr = %trim(InStr);
// Set length to materialize required leading blanks.
%len(blanks) = %int((%len(inStr) - %len(trimInStr))/2);
return blanks + trimInStr;
/end-free
p CenterStr e

78
Service_Pgms/SRV_STRTR Normal file
View File

@ -0,0 +1,78 @@
//=== Test the SRV_STR service program========================
H DftActGrp(*NO) ActGrp(*CALLER) option(*nodebugio: *srcstmt)
H BndDir('UTIL_BND')
d X1 S 1A inz('A') One char
d X2 S 2A inz('B ') Two char
d X3 S 4A inz('C ') 3 blanks
d X4 S 5A inz('D ') 4 blanks
d X5 S 6A inz('E ') 5 blanks
d X0 S 5A inz(' ') all blank
d Xl S 20A inz('20-chars ') longer
d Xm S 21A inz(' 21-Chars') longer
d Xv S 24 inz(' 24-varying ') varying Varying-note result
d l1 S 20A inz(' ABCDE ') Left align
d l2 S 20A inz('Left already ') Left align
d r1 S 20A inz('abc') Right align
d r2 S 20A inz(' defgh ') Right align
/include Demo,SRV_STR_P
/free
x1 = tst(x1);
dsply ('-' + x1 + '-');
x2 = tst(x2);
dsply ('-' + x2 + '-');
x3 = tst(x3);
dsply ('-' + x3 + '-');
x4=tst(x4);
dsply ('-' + x4 + '-');
x5 = tst(x5);
dsply ('-' + x5 + '-');
x0 = tst(x0);
dsply ('-' + x0 + '-');
xl = tst(xl);
dsply ('-' + xl + '-');
xm = tst(xm);
dsply ('-' + xm + '-');
xv = tst(xv);
dsply ('-' + xv + '-');
dsply ('---- Left Justify ---');
dsply ('-' + l1 + '-');
l1 =%trim(l1);
dsply ('-' + l1 + '-');
dsply ('-' + l2 + '-');
l2 =%trim(l2);
dsply ('-' + l2 + '-');
dsply ('---- Right Justify ---');
dsply ('-' + r1 + '-');
evalr r1 = %trim(r1);
dsply ('-' + r1 + '-');
dsply ('-' + r2 + '-');
evalr r2 = %trim(r2);
dsply ('-' + r2 + '-');
*inlr = *on;
return;
/END-FREE
p tst b
d tst pi 50a varying
d II 50a varying const
/free
dsply '---------------------';
DSPLY ('-' + ii + '-');
return CenterStr(ii);
/end-free
p tst e