| 
/* */
/* ATTENTION: CE PGM EST LIVRE A TITRE D'EXEMPLE. */
/* */
/* IL N'A PAS ETE TESTE DANS UN ENVIRONNEMENT NORMAL D'ENTREPRISE. */
/* L'UTILISATION ET LA MISE AU POINT EST DONC SOUS */
/* VOTRE RESPONSABILITE. */
/* ---------------------- */
PGM PARM(&FL &INFL)
DCL &ATR *CHAR 10
DCL &CMD *CHAR 50
DCL &SUIT *CHAR 3
DCL &FL *CHAR 20
DCL &INFL *CHAR 20
DCL &F *CHAR 10
DCL &L *CHAR 10
DCL &INF *CHAR 10
DCL &INL *CHAR 10
DCL &REF *CHAR 10
DCL &FLAG *LGL
DCL &MSGID *CHAR LEN(7)
DCL &MSGDTA *CHAR LEN(100)
DCL &MSGF *CHAR LEN(10)
DCL &MSGFLIB *CHAR LEN(10)
DCLF QADSPPGM
MONMSG MSGID(CPF0000) EXEC(GOTO ERR1) /* Std err */
CHGVAR &F %SST(&FL 1 10)
CHGVAR &L %SST(&FL 11 10)
CHGVAR &INF %SST(&INFL 1 10)
CHGVAR &INL %SST(&INFL 11 10)
OVRDBF FILE(QADSPPGM) TOFILE(&INL/&INF) SECURE(*YES) +
SHARE(*YES)
OPNQRYF FILE((QADSPPGM)) QRYSLT('whfnam *eq "' *CAT +
&F *CAT '" *and whlnam *eq "' *CAT &L *CAT +
'" *or whfnam *eq "' *CAT &F *CAT '" *AND +
whlnam *eq "*LIBL"') KEYFLD((WHPNAM))
CHGVAR &REF ' '
LECTURE: RCVF
MONMSG CPF0864 EXEC(GOTO FIN)
IF (&WHPNAM *EQ &REF) GOTO LECTURE
CHGVAR &REF &WHPNAM
RTVOBJD OBJ(&WHLIB/&WHPNAM) OBJTYPE(&ATR)
MONMSG CPF0000 EXEC(GOTO PROBLEM)
IF (&ATR *EQ 'DFU') THEN(DO) /* DFU */
|
|
DLTDFUPGM DFUPGM(&WHLIB/&WHPNAM)
MONMSG CPF0000
ENDDO
ELSE DO
IF (&ATR *EQ 'QRY') THEN(DO) /* QRY */
DLTQRY QRY(&WHLIB/&WHPNAM)
MONMSG CPF0000
ENDDO
ELSE DO
DLTPGM PGM(&WHLIB/&WHPNAM)
MONMSG CPF0000
ENDDO
ENDDO
IF (&ATR *EQ 'CLP') THEN(CHGVAR &ATR 'CL')
IF (%SST(&ATR 1 3) *EQ 'SQL') THEN(CHGVAR &SUIT ' ')
ELSE CMD(CHGVAR VAR(&SUIT) VALUE('PGM'))
CHGVAR VAR(&CMD) VALUE('CRT' *CAT &ATR *TCAT &SUIT +
*TCAT ' pgm(' *CAT &WHLIB *TCAT '/' *CAT +
&WHPNAM *TCAT ')')
CALL QCMDEXC PARM(&CMD 50)
MONMSG CPF0000 EXEC(DO)
PROBLEM: SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('programme ' *CAT &WHPNAM *CAT 'de +
type ' *CAT &ATR *TCAT 'non recompilé') +
MSGTYPE(*DIAG)
ENDDO
GOTO LECTURE
FIN:
DLTOVR QADSPPGM
MONMSG CPF0000
RETURN
ERR1:
IF &FLAG SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
CHGVAR &FLAG '1'
ERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO ERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO ERR2
ERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
|
|
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) ENDPGM |
