PGM PARM(&LIB &TXT &AUT)
DCL &LIB *CHAR 10
DCL &TXT *CHAR 50
DCL &AUT *CHAR 8
DCL &CODE *DEC (5 0)
DCL &CODC *CHAR 5
DCL &ERRLEN *DEC (5 0)
DCL &ERRTXT *CHAR 70
DCL &MSGTXT *CHAR 70
CHKOBJ OBJ(QSYS/&LIB) OBJTYPE(*LIB)
MONMSG CPF9801 EXEC(GOTO SUITE)
MONMSG CPF0000
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Une +
bibliotheque existe déja sous ce nom') +
MSGTYPE(*ESCAPE)
RETURN
SUITE: RCVMSG MSGTYPE(*EXCP)
CALL PGM(CRTDROPDB) PARM('C' &LIB &CODE &ERRLEN +
&ERRTXT)
IF (&CODE *GE 0) DO
IF (&TXT *NE '*SQLTXT') DO
CHGOBJD OBJ(&LIB) OBJTYPE(*LIB) TEXT(&TXT)
ENDDO
RVKOBJAUT OBJ(&LIB) OBJTYPE(*LIB) USER(*PUBLIC) AUT(*ALL)
MONMSG CPF0000
GRTOBJAUT OBJ(&LIB) OBJTYPE(*LIB) USER(*PUBLIC) AUT(&AUT)
MONMSG CPF0000
IF (&CODE *GT 0) DO
CHGVAR VAR(&CODC) VALUE(&CODE)
CHGVAR VAR(&MSGTXT) VALUE(%SST(&ERRTXT 1 &ERRLEN))
SNDPGMMSG MSGID('SQL' *CAT %SST(&CODC 2 4)) +
MSGF(QSQLMSG) MSGDTA(&MSGTXT) MSGTYPE(*DIAG)
ENDDO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Bibliotheque SQL ' *CAT &LIB *BCAT +
'crée') MSGTYPE(*COMP)
ENDDO
ELSE DO
CHGVAR VAR(&CODC) VALUE(&CODE)
CHGVAR VAR(&MSGTXT) VALUE(%SST(&ERRTXT 1 &ERRLEN))
SNDPGMMSG MSGID('SQL' *CAT %SST(&CODC 2 4)) +
MSGF(QSQLMSG) MSGDTA(&MSGTXT) MSGTYPE(*DIAG)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Bibliotheque ' *CAT &LIB *BCAT 'non +
|