From 6e68066de002bce5a1e2c2a568fce8cf31f71d61 Mon Sep 17 00:00:00 2001 From: SJLennon <67484051+SJLennon@users.noreply.github.com> Date: Tue, 29 Sep 2020 15:38:54 -0400 Subject: [PATCH] Add Supporting code Copy file and service program --- Copy_Mbrs/##AIDBYTES | 51 ++++++++ Copy_Mbrs/README.md | 13 +++ Copy_Mbrs/SRV_MSG_P | 22 ++++ README.md | 10 +- Service_Pgms/CRTBNDDIR | 7 ++ Service_Pgms/README.md | 19 +++ Service_Pgms/SRV_MSG | 257 +++++++++++++++++++++++++++++++++++++++++ Service_Pgms/SRV_MSGTD | 89 ++++++++++++++ Service_Pgms/SRV_MSGTR | 165 ++++++++++++++++++++++++++ 9 files changed, 632 insertions(+), 1 deletion(-) create mode 100644 Copy_Mbrs/##AIDBYTES create mode 100644 Copy_Mbrs/README.md create mode 100644 Copy_Mbrs/SRV_MSG_P create mode 100644 Service_Pgms/CRTBNDDIR create mode 100644 Service_Pgms/README.md create mode 100644 Service_Pgms/SRV_MSG create mode 100644 Service_Pgms/SRV_MSGTD create mode 100644 Service_Pgms/SRV_MSGTR diff --git a/Copy_Mbrs/##AIDBYTES b/Copy_Mbrs/##AIDBYTES new file mode 100644 index 0000000..e65ce5a --- /dev/null +++ b/Copy_Mbrs/##AIDBYTES @@ -0,0 +1,51 @@ + // 5250 Attention Indicator (AID) definitions + D F01 C CONST(X'31') + D F02 C CONST(X'32') + D F03 C CONST(X'33') + D F04 C CONST(X'34') + D F05 C CONST(X'35') + D F06 C CONST(X'36') + D F07 C CONST(X'37') + D F08 C CONST(X'38') + D F09 C CONST(X'39') + D F10 C CONST(X'3A') + D F11 C CONST(X'3B') + D F12 C CONST(X'3C') + D F13 C CONST(X'B1') + D F14 C CONST(X'B2') + D F15 C CONST(X'B3') + D F16 C CONST(X'B4') + D F17 C CONST(X'B5') + D F18 C CONST(X'B6') + D F19 C CONST(X'B7') + D F20 C CONST(X'B8') + D F21 C CONST(X'B9') + D F22 C CONST(X'BA') + D F23 C CONST(X'BB') + D F24 C CONST(X'BC') + // Page Down/Roll Up + D RollUp C CONST(X'F5') + D PageDown C CONST(X'F5') + // Page Up/Roll Down + D RollDown C CONST(X'F4') + D PageUp C CONST(X'F4') + // Enter + D Enter C CONST(X'F1') + D Home C CONST(X'F8') + + //Mouse events linked to DDS MOUBTN keyword + d ME00 c const(x'70') + d ME01 c const(x'71') + d ME02 c const(x'72') + d ME03 c const(x'73') + d ME04 c const(x'74') + d ME05 c const(x'75') + d ME06 c const(x'76') + d ME07 c const(x'77') + d ME08 c const(x'78') + d ME09 c const(x'79') + d ME10 c const(x'7A') + d ME11 c const(x'7B') + d ME12 c const(x'7C') + d ME13 c const(x'7D') + d ME14 c const(x'7E') diff --git a/Copy_Mbrs/README.md b/Copy_Mbrs/README.md new file mode 100644 index 0000000..5b622fb --- /dev/null +++ b/Copy_Mbrs/README.md @@ -0,0 +1,13 @@ +### Copy Members + +These are source files that will be copied into programs using /COPY or /INCLUDE + +* ##AIDBTYES + + 5250 Attention ID Definitions. These are the value that are return in byte 369 of the display file indicator data structure when a screen entry is made. + +* SRV_MSG_P + + Prototype definition for procedures in the SRV_MSG service program. + + diff --git a/Copy_Mbrs/SRV_MSG_P b/Copy_Mbrs/SRV_MSG_P new file mode 100644 index 0000000..c09f01b --- /dev/null +++ b/Copy_Mbrs/SRV_MSG_P @@ -0,0 +1,22 @@ + + //=== Prototypes for SRV_MSG routines ======================== + //============================================================ + D SndMsgPgmQ pr Send Msg to PGM Q + D pMsgQ 10 + D pMsgid 7 + D pMsgFile 10 + D pMsgDta 80 options(*NOPASS) + D Varying + //============================================================ + D ClrMsgPgmQ pr N Clear PGM Msg Q + D pPgmMsgQ 10 + + //============================================================ + D SndEscMsg pr Send ESC Msg + D piMsg 1024a Const Varying + + //============================================================ + D SndInfMsg pr Send INF Msg + D piMsg 1024a Const Varying + + //=== End of Prototypes forSRV_MSG Routines ================== diff --git a/README.md b/README.md index 14cf5b2..876d64a 100644 --- a/README.md +++ b/README.md @@ -6,6 +6,14 @@ More developers are learning about the **IBM i** as a wonderful business platfor My intent is to provide real programs that help you learn, or improve your current understanding, and which you can adapt to you needs. Feel free to provide comments and feedback. -### SQL_SKELETON +## Copy_Mbrs + +Code to be copies into other programs. + +## Service_Pgms + +Utility support routines that are called from other code. + +## SQL_SKELETON Batch program with SQL embedded in RPGLE. Includes error checking and handling. There are two versions, one in completely free format and one not free with the D-Specs in fixed format. diff --git a/Service_Pgms/CRTBNDDIR b/Service_Pgms/CRTBNDDIR new file mode 100644 index 0000000..6574c45 --- /dev/null +++ b/Service_Pgms/CRTBNDDIR @@ -0,0 +1,7 @@ + PGM +/* Create UTIL_BND binding directory in *CURLIB */ +/* Change next statement if a different library is needed */ + CRTBNDDIR BNDDIR(*CURLIB/UTIL_BND) TEXT('Utilities + + Service PGMs') + ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER)) + ENDPGM diff --git a/Service_Pgms/README.md b/Service_Pgms/README.md new file mode 100644 index 0000000..768bf71 --- /dev/null +++ b/Service_Pgms/README.md @@ -0,0 +1,19 @@ +### Service Programss + +Utility Service Programs + +* SRV_MSG + + Contains procedures to send messages from an RPG program. + +* CRTBNDDIR + + A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG. + +* SRV_MSGTR + + RPG program to test the procedures in SRV_MSG. + +* SRV_MSGTD + + Display file used by SRV_MSGTR. diff --git a/Service_Pgms/SRV_MSG b/Service_Pgms/SRV_MSG new file mode 100644 index 0000000..3d386cd --- /dev/null +++ b/Service_Pgms/SRV_MSG @@ -0,0 +1,257 @@ + + //============================================================== + //=== 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_MSGTD b/Service_Pgms/SRV_MSGTD new file mode 100644 index 0000000..3183b60 --- /dev/null +++ b/Service_Pgms/SRV_MSGTD @@ -0,0 +1,89 @@ + A*%%TS SD 20200723 195503 LENNONS REL-V7R4M0 5770-WDS + A*=============================================================== + A* Display to test functions in SRV_MSG service program + A*=============================================================== + A*%%EC + A DSPSIZ(24 80 *DS3) + A PRINT + A INDARA + A ALTHELP + A CA03 + A CF04 + A CF05 + A CF06 + A CF07 + A CA12 + A HELP + A*=============================================================== + A*=== Screen Header: Fields begin with SH_ ===================== + A* + A R SH_HDR + A*%%TS SD 20111207 212036 SLENNON REL-V7R1M0 5770-WDS + A OVERLAY + A TEXT('Screen Header') + A SH_PGM 10A O 1 2 + A 1 27'Test SRV_MSG Service Program' + A 1 72DATE + A EDTCDE(Y) + A 2 2USER + A SH_FUNCT 50A O 2 16DSPATR(HI) + A 2 72TIME + A 4 4'Message to send:' + A SH_MSG 69 B 5 4 + A 8 4'F4 - SndMsgPgmQ' + A 9 4'F5 - ClrMsgPgmQ' + A 10 4'F6 - SndInfMsg' + A 11 4'F7 - SndEscMsg' + A 40 6 4'Please enter a message.' + A DSPATR(RI) + A*=============================================================== + A*=== Screen footer & function keys: Fields begin with SFT_ ==== + A* + A R SFT_FKEY + A*%%TS SD 20111208 204102 SLENNON REL-V7R1M0 5770-WDS + A TEXT('Screen Footer') + A OVERLAY + A 22 2' Demo Cor- + A p of America - + A ' + A DSPATR(UL) + A SFT_KEYS 78A O 23 2COLOR(BLU) + A*=============================================================== + A*=== Message Subfile: No fields =============================== + A* + A R MSGSFL SFL + A*%%TS SD 19990831 134515 LENNON$S REL-V4R2M0 5769-PW1 + A TEXT('Message Subfile') + A SFLMSGRCD(24) + A MSGKEY SFLMSGKEY + A MSGPGMQ SFLPGMQ(10) + A*=============================================================== + A*=== Message Subfile Control: No fields ======================== + A* + A R MSGCTL SFLCTL(MSGSFL) + A*%%TS SD 19990831 134515 LENNON$S REL-V4R2M0 5769-PW1 + A TEXT('Message Subfile Control') + A PAGEDOWN + A PAGEUP + A OVERLAY + A SFLDSP + A SFLDSPCTL + A SFLINZ + A N90 SFLEND + A SFLSIZ(0002) + A SFLPAG(0001) + A MSGPGMQ SFLPGMQ(10) + A*=============================================================== + A*=== Dummy Record ============================================== + A* + A R DUMMY + A 24 79'*' + A*%%RS+ + A*%%RS+ + A*%%RS+ + A*%%RS+ + A*%%RS+ + A*%%RS+ + A*%%RS+ + A*%%RS+ + A*%%RS diff --git a/Service_Pgms/SRV_MSGTR b/Service_Pgms/SRV_MSGTR new file mode 100644 index 0000000..8c2acd1 --- /dev/null +++ b/Service_Pgms/SRV_MSGTR @@ -0,0 +1,165 @@ + + //=== 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 + +