ALCOBJで、ロックされているか否かを検査すると、ロックされていないとそのままロックしてしまいます。それが困るとき、これを使って下さい。
PGM (&PIOBJ &PIOBJL &PIOBJT &PIMBR &POLOCKED)
DCL &PIOBJ *CHAR 10
DCL &PIOBJL *CHAR 10
DCL &PIOBJT *CHAR 10
DCL &PIMBR *CHAR 10
DCL &PBERR *CHAR 4 X'000000'
DCL &POLOCKED *CHAR 1
DCL &W1OBJOBJL *CHAR 20
DCL &USR_SPACE *CHAR 20 'OBJLCK QTEMP '
DCL &LCK_INFO *CHAR 55
DCL &LCK_STS *CHAR 10
DCL &RTV_DATA *CHAR 16
/* FOR DECIMAL */
DCL &LST_OFFSET *DEC (9 0)
DCL &LST_COUNT *DEC (9 0)
DCL &WRK_COUNT *DEC (5 0) /* COUNTER */
/* FOR BINARY */
DCL &WRK_BIN *CHAR 4
DCL &RTV_STARTB *CHAR 4
DCL &RTV_LNGTHB *CHAR 4
MONMSG CPF0000 *N GOTO END
/*--------------------------------------*/
/* MAIN ROUTINE */
/*--------------------------------------*/
CHGVAR &POLOCKED 'N'
RETRY: CHGVAR &WRK_COUNT 0
CHKOBJ &PIOBJL/&PIOBJ &PIOBJT
CHGVAR &W1OBJOBJL (&PIOBJ||&PIOBJL)
/* CREATE USER SPACE */
CHKOBJ %SST(&USR_SPACE 11 10)/%SST(&USR_SPACE 1 10) *USRSPC
MONMSG CPF9801 *N CALL QUSCRTUS +
(&USR_SPACE 'WRK ' X'00001000' ' ' '*ALL' 'WORK USER SPACE')
CALL QWCLOBJL +
(&USR_SPACE 'OBJL0100' &W1OBJOBJL &PIOBJT &PIMBR &PBERR)
CHGVAR %BIN(&RTV_STARTB) 125 /* DEC. -> BIN. */
CHGVAR %BIN(&RTV_LNGTHB) 16
CALL QUSRTVUS (&USR_SPACE &RTV_STARTB &RTV_LNGTHB &RTV_DATA)
CHGVAR &WRK_BIN %SST(&RTV_DATA 9 4)
CHGVAR &LST_COUNT %BIN(&WRK_BIN)
IF (&LST_COUNT = 0 ) GOTO END
CHGVAR &WRK_BIN %SST(&RTV_DATA 1 4)
CHGVAR &LST_OFFSET %BIN(&WRK_BIN)
CHGVAR &RTV_LNGTHB %SST(&RTV_DATA 13 4)
CHGVAR %BIN(&RTV_STARTB) (&LST_OFFSET + 1)
/* RETRIEVE LIST DATA FROM THE USER SPACE */
RTV_JOB:
CHGVAR &WRK_COUNT (&WRK_COUNT + 1)
CALL QUSRTVUS (&USR_SPACE &RTV_STARTB &RTV_LNGTHB &LCK_INFO)
CHGVAR &LCK_STS %SST(&LCK_INFO 27 10)
IF (&LCK_STS^='*NONE') DO
CHGVAR &POLOCKED 'Y'
ENDDO
IF (&LST_COUNT = &WRK_COUNT) GOTO END
CHGVAR %BIN(&RTV_STARTB) (%BIN(&RTV_STARTB) + %BIN(&RTV_LNGTHB))
GOTO RTV_JOB
END:
RETURN
ENDPGM
コマンドソース CMD
CMD ('CHECK OBJECT LOCK')
PARM KWD(OBJ) TYPE(*NAME) LEN(10) MIN(1) +
PROMPT('OBJECT NAME')
PARM KWD(OBJLIB) TYPE(*NAME) LEN(10) +
SPCVAL((*LIBL)) MIN(1) PROMPT('OBJECT +
LIBRARY NAME')
PARM KWD(OBJTYPE) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('OBJECT TYPE')
PARM KWD(MBR) TYPE(*NAME) LEN(10) SPCVAL((*NONE)) +
MIN(1) PROMPT('FILE MEMBER NAME')
PARM KWD(STS) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
MIN(1) PROMPT('LOCKED Y/N')
利用方法
\ALCMSGQ:
CHKOBJLCK POSRJE POSRJE *MSGQ *NONE STS(&LCKSTS) IF (&LCKSTS='Y') DO GOTO \ALCMSGQ
ENDDO
|