From d89577bd3d803438bd76e31f5f521f262ff97ddb Mon Sep 17 00:00:00 2001 From: SJLennon <67484051+SJLennon@users.noreply.github.com> Date: Thu, 7 Oct 2021 13:09:31 -0400 Subject: [PATCH] Delete non .RPGLE source --- Service_Pgms/SRV_MSG | 257 ----------------------------------------- Service_Pgms/SRV_MSGTR | 165 -------------------------- Service_Pgms/SRV_STR | 45 -------- Service_Pgms/SRV_STRTR | 78 ------------- 4 files changed, 545 deletions(-) delete mode 100644 Service_Pgms/SRV_MSG delete mode 100644 Service_Pgms/SRV_MSGTR delete mode 100644 Service_Pgms/SRV_STR delete mode 100644 Service_Pgms/SRV_STRTR diff --git a/Service_Pgms/SRV_MSG b/Service_Pgms/SRV_MSG deleted file mode 100644 index 3d386cd..0000000 --- a/Service_Pgms/SRV_MSG +++ /dev/null @@ -1,257 +0,0 @@ - - //============================================================== - //=== SRV_MSG service program contains prodcedure for sending - //=== messages with QMHSNDPM - //============================================================== - // CRTRPGMOD MODULE(SRV_MSG) DEFINE(COMPILESRV_MSG) - // CRTSRVPGM SRVPGM(SRV_MSG) EXPORT(*ALL) - // ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER)) - - h nomain option(*NoDebugIo: *srcstmt) - /include Demo,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 - - //=== 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 Demo,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 80 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 Demo,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 1024a Const Varying - - //--- 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 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 SndEscMsg E - - //=== SndInfMsg =============================================== - // Sends CPF9898 Info message of the provided text to the - // external message queue. - // Useful for debugging. - - P SndInfMsg B Export - - D SndInfMsg PI - D piMsg 1024a 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 diff --git a/Service_Pgms/SRV_MSGTR b/Service_Pgms/SRV_MSGTR deleted file mode 100644 index 8c2acd1..0000000 --- a/Service_Pgms/SRV_MSGTR +++ /dev/null @@ -1,165 +0,0 @@ - - //=== Tests procedures in SRV_MSG service program ============= - H DftActGrp(*NO) ActGrp(*CALLER) option(*nodebugio: *srcstmt) - H BndDir('UTIL_BND') - - //=== Display File ============================================ - FSRV_MSGTD CF E WorkStn INFDS(dfInfDS) - F INDDS(dfIndDS) - F USROPN - - //=== Service Program Prototypes ============================== - /include DEMO,Srv_Msg_P - - //=== Named hexadecimal constants for function keys =========== - /include DEMO,##AIDBYTES - - //=== Display File Information Data Structure ================= - // Allows us to determine which function key was pressed - D dfInfDS DS - D Key 369 369 - //=== Display File Indicator Data Structure =================== - - // This is a "private" indicator area for the display file. - D dfIndDS ds 99 - D SH_ERR 40 40n - - //=== Global Switches ========================================= - D SflMsgSnt s n - D CowsComeHome c const('0') - - //=== Work Fields ============================================= - D inx s 10i 0 - - //=== Program Status Data Structure =========================== - D ProgStatus sds - D PgmName *PROC - - /FREE - //============================================================= - // === Main Program Loop ====================================== - //============================================================= - exsr init; - SFT_KEYS='F3/F12=Exit'; - dou CowsComeHome; - write SH_HDR; - write SFT_FKEY; - if SflMsgSnt = *on; - write MSGCTL; - endif; - - exfmt SH_HDR; - SH_ERR = *off; - - if key = F03 or Key = F12; - exsr CloseDownPgm; - return; - endif; - - if SH_MSG = ' '; - SH_ERR = *ON; // Please enter a message - iter; - endif; - - select; - //-- Enter Key --------------------------------------------- - when Key = Enter; - - //--- F04 -------------------------------------------------- - when Key = F04; - SflMsgSnt= SndSflMsg('CPF9898' : SH_MSG); - iter; - - //--- F05 -------------------------------------------------- - when Key = F05; - if SflMsgSnt = *on; - SflMsgSnt = ClrMsgPgmQ(PgmName); - write MSGCTL; - iter; - endif; - - //--- F06 -------------------------------------------------- - when Key = F06; - SndInfMsg(SH_MSG); - iter; - - //--- F07 -------------------------------------------------- - when Key = F07; - SndEscMsg(SH_MSG); - iter; - - endsl; - enddo; - - //============================================================= - //=== End of Main Program Loop ================================ - //============================================================= - - - //=== CloseDownPgm ============================================ - // Things to do before we issue a return to the caller - begsr CloseDownPgm; - *inlr = *on; - close SRV_MSGTD; - endsr; - - //=== Init ==================================================== - begsr Init; - MSGPGMQ = PgmName; - SH_PGM = PgmName; - if not %open(SRV_MSGTD); - open SRV_MSGTD; - endif; - endsr; - - //============================================================= - // S u b P r o c e d u r e s - //============================================================= - - //=== SndSflMsg =============================================== - // Send a message to the Error Subfile - // Returns: *ON - // Parameter: ErrMsgId => Msg Id to Send - // Parameter: ErrMsgData => Optional Error Message Data - // Parameter: ErrMsgFile => Optional Error Message File - // Defaults to CUSTMSGF - //------------------------------------------------------------ - /END-FREE - P SndSflMsg B - D SndSflMsg PI N - D ErrMsgId 7A CONST - D ErrMsgData 80A CONST - D OPTIONS(*NOPASS:*VARSIZE) - D ErrMsgFile 10A CONST - D OPTIONS(*NOPASS) - - // Local fields - D retField S N - D wkMsgId s 7a - D wkMsgFile s 10a - D wkMsgData s 80a varying - - /FREE - if %parms >2; - wkMsgFile = ErrMsgFile; - else; - wkMsgFile = 'QCPFMSG'; - ENDIF; - if %parms > 1; - wkMsgData = ErrMsgData; - else; - wkMsgData = ' '; - ENDIF; - wkMsgId = ErrMsgId; - SNDMSGPGMQ(PgmName: - wkMsgid: - wkMsgFile: - wkMsgData); - - retField = *on; - RETURN retField; - - /END-FREE - P SndSflMsg E - - diff --git a/Service_Pgms/SRV_STR b/Service_Pgms/SRV_STR deleted file mode 100644 index 592c23c..0000000 --- a/Service_Pgms/SRV_STR +++ /dev/null @@ -1,45 +0,0 @@ - //============================================================== - //=== 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 diff --git a/Service_Pgms/SRV_STRTR b/Service_Pgms/SRV_STRTR deleted file mode 100644 index a21c783..0000000 --- a/Service_Pgms/SRV_STRTR +++ /dev/null @@ -1,78 +0,0 @@ - - //=== 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