Add API_SQL

2021-08-24 15:29:30 -04:00
parent 83cd96240c
commit 82180c4408
16 changed files with 525 additions and 7 deletions
@@ -0,0 +1,68 @@
+GETOBJUC: +
+  PGM PARM(&OBJECT &TYPE &MEMBER &RETMSG &RETMSGFLD &RETFILE)
+
+/* -----------------------------------------------------------------*/
+/* This program finds all the jobs which are using an object.       */
+/* It returns a message suitable for display to the operator        */
+/* and/or  file QTEMP/GETOBJUP listing all jobs.  This file         */
+/* could be used to send a message to all users of the object.      */
+/* -----------------------------------------------------------------*/
+/* Use the GETOBJUSR command to invoke this program                 */
+/* -----------------------------------------------------------------*/
+/* 11/24/97 LENNON Original writing                                 */
+/* -----------------------------------------------------------------*/
+/* 10/05/2001 Sam Lennon. If a non file object is locked *EXCL then */
+/*            RTVOBJD to get real library name to put in the        */
+/*            message fails. If this occurs, just continue and      */
+/*            *LIBL may appear in the message.                      */
+/* 08/--/2021 Sam Lennon. Change error handling to use commands to  */
+/*            call message APIs.                                    */
+/*            Remove GETOBJUP logic. Now created in RPG by SQL.     */
+/* -----------------------------------------------------------------*/
+
+/* Input parameters */
+  DCL VAR(&OBJECT)     TYPE(*CHAR) LEN(20)    /* Obj & lib */
+  DCL VAR(&TYPE)       TYPE(*CHAR) LEN(10)    /* Obj type  */
+  DCL VAR(&MEMBER)     TYPE(*CHAR) LEN(10)    /* if *FILE */
+  DCL VAR(&RETMSG)     TYPE(*CHAR) LEN(4)     /* Return a msg? */
+  DCL VAR(&RETMSGFLD)  TYPE(*CHAR) LEN(200)   /* Fld for msg */
+  DCL VAR(&RETFILE)    TYPE(*CHAR) LEN(4)     /* Return a file? */
+
+/* Variables used in this program */
+  DCL VAR(&OBJNAM)     TYPE(*CHAR) LEN(10)    /* Obj name  */
+  DCL VAR(&OBJLIB)     TYPE(*CHAR) LEN(10)    /* Obj lib   */
+  DCL VAR(&FRMOBJLIB)  TYPE(*CHAR) LEN(10)    /* For duping file */
+  DCL VAR(&FAKMSGFLD)  TYPE(*CHAR) LEN(1)     /* No msg fld passed */
+
+/* Catch unmonitored errors */
+  MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
+
+/* Convert *LIBL/*CURLIB into a real name, if possible     */
+  CHGVAR VAR(&OBJNAM) VALUE(%SST(&OBJECT 1 10))
+  CHGVAR VAR(&OBJLIB) VALUE(%SST(&OBJECT 11 10))
+  RTVOBJD OBJ(&OBJLIB/&OBJNAM) OBJTYPE(&TYPE) RTNLIB(&OBJLIB)
+  MONMSG MSGID(CPF9803) EXEC(DO) /*Cannot Allocate*/
+      GOTO       CMDLBL(PASTLIBGET)
+  ENDDO
+  CHGVAR VAR(%SST(&OBJECT 11 10)) VALUE(&OBJLIB)
+  PASTLIBGET: +
+
+/* Call RPG program to find the lock users */
+  IF COND(&RETMSG = '*YES') THEN(DO)
+      CALL PGM(GETOBJUR) PARM(&OBJECT &TYPE &MEMBER &RETMSG +
+         &RETMSGFLD &RETFILE)
+  ENDDO
+  ELSE CMD(DO)
+      CALL PGM(GETOBJUR) PARM(&OBJECT &TYPE &MEMBER &RETMSG +
+         &FAKMSGFLD &RETFILE)
+  ENDDO
+
+/* End of program */
+  GOTO CMDLBL(ENDPGM)
+
+/* Error handler - resend any trapped escape message */
+ERROR: +
+  MOVPGMMSG  MSGTYPE(*DIAG)
+  RSNESCMSG
+ENDPGM: +
+  ENDPGM