diff --git a/Copy_Mbrs/README.md b/Copy_Mbrs/README.md index e79c791..6917ffb 100644 --- a/Copy_Mbrs/README.md +++ b/Copy_Mbrs/README.md @@ -2,7 +2,7 @@ These are source files that will be copied into programs using /COPY or /INCLUDE -* ##AIDBTYES +* ##AIDBTYE 5250 Attention ID Definitions. These are the value that are returned in byte 369 of the display file indicator data structure when a screen entry is made. @@ -14,4 +14,6 @@ These are source files that will be copied into programs using /COPY or /INCLUDE Prototype definitions for procedures in the SRV_STR service program. +* SRV_SQL_P + Prorotype definitions for procedures in the SQL_SRV service program. diff --git a/Service_Pgms/README.md b/Service_Pgms/README.md index 4583893..1fea4a0 100644 --- a/Service_Pgms/README.md +++ b/Service_Pgms/README.md @@ -1,15 +1,19 @@ ### Service Programs -Utility Service Programs. This is probably the first code you want to explore before going on to the interactive programs. +Utility Service Programs. -* SRV_MSG +* SRV_MSG Contains procedures to send messages from an RPG program. -* SRV_STR +* SRV_STR Contains procedures to manipulate strings in an RPG program. +* SRV_SQL + + * Helper procedures for RPG programs using embedded SQL. + * CRTBNDDIR A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG. @@ -25,4 +29,3 @@ Utility Service Programs. This is probably the first code you want to explore be * SRV_STRTR RPG program to test the procedures in SRV_STR. - diff --git a/Service_Pgms/SRV_SQL.SQLRPGLE b/Service_Pgms/SRV_SQL.SQLRPGLE new file mode 100644 index 0000000..8c89692 --- /dev/null +++ b/Service_Pgms/SRV_SQL.SQLRPGLE @@ -0,0 +1,56 @@ +**FREE +//============================================================== +//=== SRV_SQL service program contains prodcedure relating to +//=== processing embedded SQL. +//============================================================== +// CRTRPGMOD MODULE(SRV_SQL) +// CRTSRVPGM SRVPGM(SRV_SQL) EXPORT(*ALL) +// ADDBNDDIRE BNDDIR(SQL_BND) OBJ((SRV_SQL *SRVPGM *DEFER)) + +ctl-opt nomain + bnddir('UTIL_BND') + option(*NoDebugIo: *srcstmt); + +//=== SQLProblem =============================================== +// For those "Never should happen" SQL errors. +// Issues DUMP(A) to dump memory, then ends program by +// sending an *ESCAPE message of the supplied debugging message, +// plus whatever SQL diagnostics we can fit into 512 chars. +dcl-proc SQLProblem export; + dcl-pi SQLProblem; + piSQLDebug varchar(200) const; + end-pi; + + /include copy_mbrs,Srv_Msg_P + + //--- Local Variables --------------------------------- + dcl-s myDebugMsg varchar(512); //Max CPF9898 supports + dcl-s wkRem int(10); + + // Returned SQL diagnostic info + dcl-s mySQLState CHAR(5); + dcl-s mySQLMsgTxt varchar(32740); + dcl-s mySQLMsgLgth int(5); + + exec sql get diagnostics condition 1 + :mySQLState = RETURNED_SQLSTATE, + :mySQLMsgTxt = MESSAGE_TEXT, + :mySQLMsgLgth = MESSAGE_LENGTH + ; + myDebugMsg = piSQLDebug + + ' - Unexpected SQL return: SQLSTATE=' + + mySQLState + + '. "'; + + // Fit in as much of mySQLMsgTxt as possible. + wkRem = (%size(myDebugMsg)-2) - %len(myDebugMsg); + if wkRem >= mySQLMsgLgth +1; + myDebugMsg += (mySQLMsgTxt +'"'); + else; + myDebugMsg += (%subst(mySQLMsgTxt: 1 :wkRem -5) + ' ..."'); + endif; + + dump(a); + SndEscMsg(myDebugMsg); + return; +end-proc;