Mandato/programa GETLCKUSRC
Devuelve el usuario que esta bloqueando un objeto. Si hay mas que un usuario te devuelve el primero.

     
PGM PARM(&XOBJ &TYPE &USR &MBR)
                        
DCL VAR(&XOBJ) TYPE(*CHAR) LEN(20)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&USR) TYPE(*CHAR) LEN(10)
DCL VAR(&OBJ) TYPE(*CHAR) LEN(10)
DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&ERRORSW) TYPE(*LGL)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&USRSPC) TYPE(*CHAR) LEN(20) +
       VALUE('OBJLCK QTEMP')
DCL VAR(&FMTNAM) TYPE(*CHAR) LEN(8) +
       VALUE('OBJL0100')
DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
DCL VAR(&ERR) TYPE(*CHAR) LEN(96)
DCL VAR(&ATTR) TYPE(*CHAR) LEN(10) +
       VALUE(' ')
DCL VAR(&LENUS) TYPE(*CHAR) LEN(4)
DCL VAR(&VAL) TYPE(*CHAR) LEN(1) VALUE(' ')
DCL VAR(&PUBAUT) TYPE(*CHAR) LEN(10) +
       VALUE('*CHANGE')
DCL VAR(&TEXT) TYPE(*CHAR) LEN(50)
DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4)
DCL VAR(&LENDTA) TYPE(*CHAR) LEN(4)
DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(16)
DCL VAR(&NUM09) TYPE(*DEC) LEN(9)
DCL VAR(&OBJ100) TYPE(*CHAR) LEN(56)
MONMSG MSGID(CPF0000) EXEC(GOTO STDERR1)
CHGVAR VAR(&OBJ) VALUE(%SST(&XOBJ 01 10))
CHGVAR VAR(&OBJLIB) VALUE(%SST(&XOBJ 11 10))                   
CHGVAR VAR(&USR) VALUE(' ')  
CHKOBJ OBJ(&OBJLIB/&OBJ) OBJTYPE(&TYPE)
DLTUSRSPC USRSPC(QTEMP/OBJLCK)     
MONMSG CPF0000                   
CHGVAR VAR(%BIN(&LENUS)) VALUE(2048)
        CALL PGM(QUSCRTUS) PARM(&USRSPC &ATTR &LENUS &VAL +
             &PUBAUT &TEXT)
        CALL PGM(QWCLOBJL) PARM(&USRSPC &FMTNAM &XOBJ +
             &TYPE &MBR &ERR)
CHGVAR VAR(%BIN(&STRPOS)) VALUE(125)
CHGVAR VAR(%BIN(&LENDTA)) VALUE(56)
        CALL PGM(QUSRTVUS) PARM(&USRSPC &STRPOS &LENDTA +
             &RCVVAR)
CHGVAR VAR(&STRPOS) VALUE(%SST(&RCVVAR 1 4))
CHGVAR VAR(&NUM09) VALUE(%BIN(&STRPOS))
CHGVAR VAR(&NUM09) VALUE(&NUM09 + 1)
CHGVAR VAR(%BIN(&STRPOS)) VALUE(&NUM09)
CHGVAR VAR(&LENDTA) VALUE(%SST(&RCVVAR 13 4))
        CALL PGM(QUSRTVUS) PARM(&USRSPC &STRPOS &LENDTA +
             &OBJ100)
CHGVAR VAR(&USR) VALUE(%SST(&OBJ100 11 10))
EXIT: RETURN
/* STANDARD-FEHLERBEHANDLUNG, ANSPRUNG NUR NICHT ABGEFANGENEM FEHLER */

STDERR1: /* Standard error handling routine */

IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
   MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */

   CHGVAR &ERRORSW '1' /* Set to fail ir error occurs */
   STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
   MSGF(&MSGF) MSGFLIB(&MSGFLIB)

IF (&MSGID *EQ ' ') GOTO STDERR3
   SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
   MSGDTA(&MSGDTA) MSGTYPE(*DIAG)

   GOTO STDERR2 /* Loop back for addl diagnostics */

STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
   MSGF(&MSGF) MSGFLIB(&MSGFLIB)

   SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
   MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)

ENDPGM

Mandato

     

/* Compilar con parametros PGM(GETLCKUSRC) ALLOW((*BPGM) 
                          (*IPGM)) */
                        
 CMD PROMPT('Recuperar usuario de bloqueo')
 PARM KWD(OBJECT) TYPE(T1) PROMPT('Objeto')
 T1: QUAL TYPE(*NAME) LEN(10) MIN(1)
 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) SPCVAL((*LIBL +
    *LIBL)) PROMPT('Biblioteca')
 PARM KWD(TYPE) TYPE(*CHAR) LEN(10) +
    PROMPT('Tipo de objeto')
 PARM KWD(LCKUSR) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
    PROMPT('Usuario')
 PARM KWD(MBR) TYPE(*NAME) LEN(10) DFT(*FIRST) +
    SPCVAL((*FIRST *FIRST)) PMTCTL(P1) +
         PROMPT('Miembro')
 P1: PMTCTL CTL(TYPE) COND((*EQ '*FILE'))

Mandato cedido por Rainer
Puedes ver los fuentes del CL y del CMD
Febrero 2003

Comentarios de usuarios

Ver más documentos técnicos