¿ Quieres imprimir esta página ? Volver a la página principal de Recursos iSeries AS400 ¿ Necesitas ayuda ? En pruebas
System i5 iSeries AS400 Recursos. Compartiendo generamos conocimiento
Novedades en Recursos iSeries AS400
Noticias tecnológicas
Documentos
GETLCKUSRC

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

Nombre:
Mail:
Comentario:
 

Subir a la parte superior de la web

 

 

NUESTRA COMUNIDAD EN
ÚNETE Y.... ¡¡ PARTICIPA !!
Dossiers técnicos iSeries y AS400
- Seguridad
- Alta disponibilidad.
Nuestros links favoritos
- Tendencias tecnologías de la información
Expertos en tecnologías de la información, nos dan su punto de vista sobre las tendencias actuales y futuras
- Los últimos anuncios sobre hardware-software para iSeries AS400 realizados por IBM
- Freeware y shareware para el iSeries AS400
- Utilidades para el iSeries AS400 realizadas por profesionales
- Documentos. Trucos e ideas para resolver tus problemas
- Los manuales y links más interesantes del iSeries AS400

  Links patrocinados
  •  
  •  

[ Soy nuevo |   Profesionales |   AS qué |   Empresas |    Foros |   Recomiéndanos |    Productos ]
 
Recursos iSeries AS400. Es una web de: PUBLICACIONES HELP400, S.L. CIF:B-60-202827 Gran Vía de les Corts Catalanes, núm. 715, Entresuelo – 3ª - Barcelona - Tel.+34.932.310.049