ecki/IBM-i-RPG-Free-CLP-Code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add API_SQL

Browse Source
This commit is contained in:
SJLennon 2021-08-24 15:29:30 -04:00
parent 83cd96240c
commit 82180c4408
16 changed files with 525 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
APIs/README.MD
View File

@ -1,6 +1,8 @@
# APIs, including QWCLOBJL (List Object Locks), QUSLJOB(List Job) QUSCRTUS, QUSDLTUS, QUSPTRUS (User Spaces)
User commands that use RPG and CL to call IBM i APIs.
- User commands that use RPG and CL to call IBM i APIs, sepecifically to list locks on objects
- RPGLE program to return the job type, by calling the QUSLJOB API,
- Commands to handle error messages in CL program, using the QMHMOVPM and QMHRSNEM APIs.
## QWCLOBJL (List Object Locks) API
@ -12,7 +14,9 @@ The company is long gone, but I recently found the code on my PC and resurrected
Now (2021) you can get similar information with SQL - see [Work Management Services](https://www.ibm.com/docs/en/i/7.4?topic=services-work-management) on the IBM site. However, I have not found an SQL interface to QWCLOBJL. I also suspect that this code if faster than SQL, but probably in most use cases speed may not be a factor.
### GETOBJUSR Command
**Update 08/2021**: See APIs_SQL for code that does the same thing but using SQL provided by IBM in [Work Management Services](https://www.ibm.com/docs/en/i/7.4?topic=services-work-management)
### GETOBJUSR.CMD
This is the top level interface. Prompted, it looks like this:
![GetObjUsr Prompt](Images/GetObjUsr_1.jpg)
@ -27,28 +31,28 @@ The message would be suitable for sending to the operator and look something lik
It shows the details of up to 4 jobs and lists how many additional jobs, if any, have locks.
### GETOBJUC
### GETOBJUC.CLLE
This the command processing program for the GETOBJUSR command. It calls GETOBJUR to get the lock information.
### GETOBJUR
### GETOBJUR.RPGLE
This RPG program creates a user space in QTEMP, then calls the QWCLOBJL (List Object Locks) API to populate the user spaces, calls SRTUSRSPC to sort by job, returns the requested message and/or file, then deletes the user space.
The code was originally in fixed form RPG/400, but I converted it to **FREE (using [Craig Rutledge's JCRCMDS](https://www.jcrcmds.com/)).
## GETOBJUP
## GETOBJUP.PF
DDS for the file created, if requested, in QTEMP. Resulting file contents look something like this:
![GetObjup Sample](Images/GetObjUsr_4.jpg)
### SRTUSRSPC
### SRTUSRSPC.RPGLE
This program sorts a user space. I believe I downloaded the code from the Old News 3X/400 site. It is fixed form RPG/400 that I haven't bothered to convert. Old, educational, and it works.
## QUSLJOB (List Job) API
### GETJOBTR
### GETJOBTR.RPGLE
This is a standalone program that returns the job type. GETOBJUR needed it, but I coded it separately in case it was useful elsewhere.

68
APIs_SQL/GETOBJUC.CLLE Normal file
View File

@ -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

259
APIs_SQL/GETOBJUR.SQLRPGLE Normal file
View File

@ -0,0 +1,259 @@
**FREE
/TITLE GETOBJUR - Get users of an object
//--------------------------------------------------------------------
// Note:
// The QSYS2.OBJECT_LOCK_INFO SQL service is used, so this code
// probably won't run prior to OS 7.2.
//--------------------------------------------------------------------
// Given an object and type, this program finds all jobs that have
// locks on the object. It returns a message suitable for sending
// to the system operator and/or a file, QTEMP/GETOBJUP, which
// could be used to send messages to all interactive users of the
// object, or for some other use. Or the jobname can be copied and
// pasted into a command, e.g. wrkjob 110080/LENNONS/QPAD142626.
// This program is called from CL program GETOBJUC.
// It uses the QSYS2.OBJECT_LOCK_INFO SQL view.
// Message looks like this:
// QIWS/QCUSTCDT *FILE is in use by 110088/LENNONS/QPAD142626.
// Or this:
// QIWS/QCUSTCDT *FILE is in use by 191174/LENNONS/QPAD160408,
// 191550/LENNONS/CUSTLST, 191551/LENNONS/INV_UPD, 191552/LENNONS/DAILYORD
// plus 1 more.
//--------------------------------------------------------------------
// Compile: CRTBNDRPG PGM(GETOBJUR) SRCFILE(...) DBGVIEW(*LIST)
//--------------------------------------------------------------------
// 12/00/97 LENNON Original Writing
// 07/--/2021 Converted to **FREE and Linear module.
// There are SQL services now that can provide similar
// infomations, but as far as I know there is no SQL
// interface to QWCLOBJL. And there certainly was not in
// 1997. This code probably performs better than existing
// SQL interfaces. For most use cases performance may not
// be a consideration.
// 08/--2021 Converted to use QSYS2.OBJECT_LOCK_INFO and to create the
// GETOBJUP file with SQL.
//--------------------------------------------------------------------
ctl-opt debug option(*nodebugio: *srcstmt)
dftactgrp(*no) actgrp(*caller)
bnddir('UTIL_BND')
main(Main);
//=== Prototypes =====================================================
/include DEMO,Srv_Msg_P
// Gets job type entry for this job.
// Returns: JobType has the job type. I=interactive, B=batch, etc.
dcl-pr GetJobType extpgm('GETJOBTR');
*n char(26); // JobName26
*n char(1); // JobType
end-pr;
//=== Program Parameters =============================================
// Input Parameters
// 1) pObject is object name (10c) + object library (10c)
// 2) pObjType is *FILE, *DTAARA, etc., standard OS/400 type
// 3) pObjMem is the member for files, or *NONE if just want users
// of the file.
// 4) pMsgYN is *YES to create a message.
// 5) pFileYN is *YES if file GETOBJUP is to be created in QTEMP
// Output Parameter
// PMsgFld is where the message gets created.
//=== Global Definitions =============================================
dcl-s JobName28 char(28); // like '580065/JOBNM/USER''
dcl-c SQLSuccess '00000';
dcl-c SQLNoData '02000';
dcl-c SQLNoMoreData '02000';
dcl-c SQLProcWarning '01548';
dcl-c SQLFileNotFound '42704';
//====================================================================
dcl-proc Main ;
//=== Misc Field Definitions =====================================
dcl-s NumJobs packed(5);
dcl-c MaxJobs const(4); //Maximum jobs for detailed reporting.
// If you increase MaxJobs, increase the message parameter by 30 bytes
// for each additional job.
dcl-s JobName26 char(26); // is name(10) User(10) number(6)
dcl-ds JobSQLDS; // Output data for GETOBJUP
JobName char(10);
JobUser char(10);
JobNum char(6);
JobType char(1);
JobNM28 char(28);
end-ds;
dcl-s theLibrary char(10);
dcl-s theObject char(10);
dcl-s j int(10);
// ---------------------------------------------------------
dcl-pi *n extpgm('GETOBJUR');
pObject char(20);
pObjType char(10);
pObjMem char(10);
pMsgYN char(4);
pMsgFld char(200);
pFileYN char(4);
end-pi;
//=== Code starts here ===========================================
exec sql set option datfmt=*iso,
closqlcsr=*endmod,
commit=*none;
// === Initialize requested outputs ===============================
if pMsgYN='*YES';
clear pMsgFld;
endif;
if pFileYN='*YES';
exec sql drop table qtemp.GETOBJUP;
if SQLSTATE <> SQLSuccess and SQLSTATE <> SQLFileNotFound;
SQLProblem('Delete GETOBJUP');
endif;
exec sql declare global temporary table GETOBJUP (
OUJOBNAME char(10),
OUJOBUSER char(10),
OUJOBNUM char(6),
OUJOBTYPE char(1),
OUJOBNAME28 CHAR(28)
);
if SQLSTATE <> SQLSuccess;
SQLProblem('Declare global tempory table GETOBJUP');
endif;
endif;
theObject = %subst(pObject:1:10);
theLibrary = %subst(pObject:11:10);
// === Find the locks ============================================
exec sql declare Lock_Cursor cursor for
select distinct JOB_NAME
from QSYS2.OBJECT_LOCK_INFO
where SYSTEM_OBJECT_SCHEMA = :thelibrary
and SYSTEM_OBJECT_NAME = :theobject
and OBJECT_TYPE = :pobjtype
and ifnull(SYSTEM_TABLE_MEMBER,' ') =
case when :pobjtype = '*file' and :pobjmem <> '*all' then :pobjmem
else ' '
END
order by JOB_NAME
;
exec sql open Lock_Cursor ;
if SQLSTT <> SQLSuccess;
SQLProblem('open Lock_Cursor');
endif;
// Loop through the cursor, building requested outputs
fetchNext();
dow SQLSTT <> SQLNoData;
NumJobs += 1;
if pFileYN='*YES';
// JobName28 is like '580065/USER/JOBNAME'
// 1234567890123456789
JobNum = %subst(JobName28 :1 :6); // Num Always 6
j = %scan('/' : JobName28 :8); // find 2nd '/' (j=12)
JobUser= %subst(JobName28 :8 : j-8); // User (lgth j-8 = 4)
JobName = %subst(JobName28: j+1); // Rest is Job Name
JobName26= JobName + JobUser + JobNum;
GetJobType(JobName26: JobType);
exsr WriteRec;
endif;
if pMsgYN='*YES';
exsr BldMsg;
endif;
fetchNext();
enddo;
// === End of Program ============================================
if pMsgYN='*YES';
select;
when NumJobs >= 1 and NumJobs <=MaxJobs;
pMsgfld=%trimr(pMsgFld) + '.';
when NumJobs > MaxJobs;
pMsgfld=%trimr(pMsgFld) + ' plus '
+ %trim(%editc(NumJobs-MaxJobs:'J'))
+ ' more.';
other;
endsl;
endif;
*inlr=*on;
// === BldMsg ====================================================
// Adds current job to the message until MaxJobs have been added.
begsr BldMsg;
select;
when NumJobs=1;
pMsgFld=
%trimr(%subst(pObject:11:10)) +'/' +
%trimr(%subst(pObject:1:10)) + ' ' +
%trimr(pObjType) +
' is in use by ' +
JobName28;
when NumJobs >= 2 and NumJobs <=MaxJobs;
pMsgFld=%trimr(pMsgfld) + ', ' +
JobName28;
endsl;
endsr;
// === WriteRec ==================================================
// Builds and writes a record to the file GETOBJUP
begsr WriteRec;
JobNM28 = JobName28;
exec sql insert into qtemp.GETOBJUP values(:JobSQLDS);
if SQLSTT <> SQLSuccess;
sqlProblem('Insert into GETOBJUP');
endif;
endsr;
end-proc;
// === fetchNext =====================================================
dcl-proc fetchNext;
exec sql fetch next from Lock_Cursor into :JobName28;
if SQLSTT <> SQLSuccess
and SQLSTT <> SQLNOData
and SQLSTT <> SQLProcWarning;
SQLProblem('fetchNext');
endif;
end-proc;
//=== 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 text.
dcl-proc SQLProblem;
dcl-pi SQLProblem;
piSQLDebug varchar(1024) value;
end-pi;
//--- Local Variables ---------------------------------
dcl-s myDebugMsg varchar(512); //Max CPF9898 supports
dcl-s wkRem int(10);
dcl-s myState CHAR(5);
dcl-s myMSGTXT varchar(32740);
dcl-s myMsgLgth int(5);
exec sql get diagnostics condition 1
:myState = RETURNED_SQLSTATE,
:myMsgTxt = MESSAGE_TEXT,
:myMsgLgth = MESSAGE_LENGTH
;
myDebugMsg = piSQLDebug
+ ' - Unexpected SQL return: SQLSTATE='
+ myState
+ '. "';
// Fit in as much of myMsgTxt as possible.
wkRem = (%size(myDebugMsg)-2) - %len(myDebugMsg);
if wkRem >= myMsgLgth +1;
myDebugMsg += (myMsgTxt +'"');
else;
myDebugMsg += (%subst(myMsgTxt: 1 :wkRem -5) + ' ..."');
endif;
dump(a);
SndEscMsg(myDebugMsg);
return;
end-proc;

50
APIs_SQL/GETOBJUSR.CMD Normal file
View File

@ -0,0 +1,50 @@
GETOBJUSR: CMD PROMPT('Get Users of an Object')
/*-----------------------------------------------------------------*/
/* CPP is GETOBJUC */
/* Compile: */
/* CRTCMD CMD(GETOBJUSR) PGM(GETOBJUC) */
/* ALLOW(*BPGM *IPGM *BMOD *IMOD) */
/*-----------------------------------------------------------------*/
/* 12/00/97 LENNON Original writting */
/*-----------------------------------------------------------------*/
PARM KWD(OBJECT) TYPE(Q1) MIN(1) PROMPT('Object +
Name')
PARM KWD(TYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
VALUES(*ALRTBL *AUTL *BNDDIR *CFGL +
*CHTFMT *CLD *CLS *CMD *CNNL *COSD *CRQD +
*CSI *CSPMAP *CSPTBL *CTLD *DEVD *DOC +
*DTAARA *DTADCT *DTAQ *EDTD *EXITRG *FCT +
*FILE *FLR *FNTRSC *FNTTBL *FORMDF *FTR +
*GSS *IPXD *JOBD *JOBQ *JOBSCD *JRN +
*JRNRCV *LIB *LIND *LOCALE *MENU *MODD +
*MODULE *MSGF *MSGQ *M36 *M36CFG *NODL +
*NTBD *NWID *NWSD *OUTQ *OVL *PAGDFN +
*PAGSEG *PDG *PGM *PNLGRP *PRDAVL *PRDDFN +
*PRDLOD *PSFCFG *QMFORM *QMQRY *QRYDFN +
*SBSD *SCHIDX *SPADCT *SQLPKG *SRVPGM +
*SSND *S36 *TBL *USRIDX *USRPRF *USRQ +
*USRSPC *WSCST) MIN(1) PROMPT('Object Type')
PARM KWD(MEMBER) TYPE(*NAME) LEN(10) DFT(*ALL) +
SPCVAL((*ALL) (*FIRST) (*NONE)) +
PMTCTL(ISFILE) PROMPT('Member')
PARM KWD(RETMSG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*YES) VALUES(*YES *NO) PROMPT('Return +
a message?')
PARM KWD(MSGFLD) TYPE(*CHAR) LEN(200) +
RTNVAL(*YES) PMTCTL(RETMSGY) +
PROMPT('Return Message Field')
PARM KWD(RETFILE) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) PROMPT('Return +
file QTEMP/GETOBJUSRP?')
Q1: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
RETMSGY: PMTCTL CTL(RETMSG) COND((*EQ *YES))
ISFILE: PMTCTL CTL(TYPE) COND((*EQ *FILE))

BIN
APIs_SQL/Images/GetObjUsr_1.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 34 KiB

BIN
APIs_SQL/Images/GetObjUsr_2.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 7.6 KiB

BIN
APIs_SQL/Images/GetObjUsr_3.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 19 KiB

BIN
APIs_SQL/Images/GetObjUsr_4.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 36 KiB

50
APIs_SQL/ReadMe.MD Normal file
View File

@ -0,0 +1,50 @@
# Using IBM [Work Management Services](https://www.ibm.com/docs/en/i/7.4?topic=services-work-management)
IBM has begun providing access to APIs using SQL. The code here uses the QSYS2.OBJECT_LOCK_INFO SQL view. It is shorter and simplified code that can be used to replace that in [APIs which returns users who have a lock on an object](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/APIs).
## GETOBJUSR.CMD
This command is the top level interface. It is unchanged from the version in [APIs](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/APIs), but it provided here for completeness.
Prompted, it looks like this:
![GetObjUsr Prompt](Images/GetObjUsr_1.jpg)
You specify the object and type and the command returns information on the locks on the object. You can return a file of objects and/or a message.
The returned file is GETOBJUP in QTEMP.
The returned message would be suitable for sending to the operator and look something like one of these:
![GetObjUsr Message](Images/GetObjUsr_2.jpg)
![GetObjUsr Message](Images/GetObjUsr_3.jpg)
It shows the details of up to 4 jobs and lists how many additional jobs, if any, have locks.
The job name can be copied and pasted into a WRKJOB command, e.g. `wrkjob 233920/LENNONS/QPAD151018`.
## GETOBJUP File
If requested, this file is created in QTEMP. The contents would look like this:
![GetObjUsr Message](Images/GetObjUsr_4.jpg)
## GETOBJUC.CLLE
This is the command processing program for the GETOBJUSR command. It does some housekeeping and calls GETOBJUR. Unlike the version in [APIs](https://github.com/SJLennon/IBM-i-RPG-Free-CLP-Code/tree/master/APIs), it does not need to create QTEMP.GETOBJUP.
## GETOBJUR.SQLRPGLE
This creates QTEMP/GETOBJUP if requested, using SQL. Then it retreives the job name using the QSYS2.OBJECT_LOCK_INFO view, and orders it by job name. It populates file GETOBJUP using SQL.
This about 100 lines shorter and it does not need the SRTUSRSPC program.
## T0/T1/T2/T3.CLLE
These are simple CL programs to test GETOBJUSR and display the results by sending a message and/or displaying the QTEMP/GETOBJUP file.
## T9xxx.CLLE
More complex testing:
- Call T9ALLOCMNY to create a interactive lock and several batch locks on QIWS/QCUSTCDT.
- Then call T9DSPMNY to display the locks.
- T9ALLOC1 creates a lock on QIWS/QCUSTCDT. It is called by T9ALLOCMNY.

14
APIs_SQL/T0.CLLE Normal file
View File

@ -0,0 +1,14 @@
PGM
/* Basic test, using a library as the object to report on */
/* Return both a message and a file */
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
GETOBJUSR OBJECT(QSYS/LENNONS2) TYPE(*LIB) +
MSGFLD(&MSG) RETFILE(*YES)
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
QRY FILE(QTEMP/GETOBJUP)
ENDPGM

11
APIs_SQL/T1.CLLE Normal file
View File

@ -0,0 +1,11 @@
PGM
/* Basic test, using a library as the object to report on */
/* Return just a message. */
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
GETOBJUSR OBJECT(QSYS/LENNONS2) TYPE(*LIB) MSGFLD(&MSG)
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
ENDPGM

13
APIs_SQL/T2.CLLE Normal file
View File

@ -0,0 +1,13 @@
PGM
/* Masic test, using a library as the oject of choice. */
/* Return just a file. Message will be blank. */
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
GETOBJUSR OBJECT(QSYS/LENNONS2) TYPE(*LIB) RETMSG(*NO) +
RETFILE(*YES)
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
QRY FILE(QTEMP/GETOBJUP)
ENDPGM

12
APIs_SQL/T3.CLLE Normal file
View File

@ -0,0 +1,12 @@
PGM
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
/* QSYS library. Lots of jobs. */
/* Return both a message and a file */
GETOBJUSR OBJECT(QSYS/QSYS) TYPE(*LIB) MSGFLD(&MSG) +
RETFILE(*YES)
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
QRY FILE(QTEMP/GETOBJUP)
ENDPGM

7
APIs_SQL/T9ALLOC1.CLLE Normal file
View File

@ -0,0 +1,7 @@
PGM
/* Create a lock and delay. Called by T9ALLOCMNY */
ALCOBJ OBJ((QIWS/QCUSTCDT *FILE *SHRRD)) WAIT(0)
DLYJOB DLY(90)
ENDPGM

20
APIs_SQL/T9ALLOCMNY.CLLE Normal file
View File

@ -0,0 +1,20 @@
PGM
/***************************************************************/
/* Creates locks on QIWS/QCUSTCDT to test GETOBJUR. */
/* Call T9DSPMNY to report the locks. */
/***************************************************************/
/* Create an interactive lock */
ALCOBJ OBJ((QIWS/QCUSTCDT *FILE *SHRRD))
/* Create some batch locks. Submitted jobs wait for 90 seconds */
/* so you can call T9DSPMAY to see the locks. */
SBMJOB CMD(CALL PGM(T9ALLOC1)) JOB(CUSTLST) +
JOBQ(QUSRNOMAX)
SBMJOB CMD(CALL PGM(T9ALLOC1)) JOB(INV_UPD) +
JOBQ(QUSRNOMAX)
SBMJOB CMD(CALL PGM(T9ALLOC1)) JOB(DAILYORD) +
JOBQ(QUSRNOMAX)
SBMJOB CMD(CALL PGM(T9ALLOC1)) JOB(YTD_RPT) +
JOBQ(QUSRNOMAX)
ENDPGM

10
APIs_SQL/T9DSPMNY.CLLE Normal file
View File

@ -0,0 +1,10 @@
PGM
/* Display locks after running T9ALLOCMNY */
DCL VAR(&MSG) TYPE(*CHAR) LEN(200)
GETOBJUSR OBJECT(QIWS/QCUSTCDT) TYPE(*FILE) +
MSGFLD(&MSG) RETFILE(*YES)
SNDMSG MSG(&MSG) TOUSR(*REQUESTER)
QRY FILE(QTEMP/GETOBJUP)
ENDPGM