|
here's an old S/38 homegrown verion (CL & CMD).... <CLP> /* DELETE DATA BASE RELATIONS - COMMAND PROCESSOR */ PGM PARM(&OBJECT &OBJTYP) DCL VAR(&OBJECT) TYPE(*CHAR) LEN(20) DCL VAR(&OBJNAM) TYPE(*CHAR) LEN(10) DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10) DCL VAR(&OBJTYP) TYPE(*CHAR) LEN(7) DCL VAR(&MSG) TYPE(*CHAR) LEN(512) MONMSG MSGID(CPF0000) EXEC(GOTO RCVMSG) RMVMSG CLEAR(*ALL) CHGVAR VAR(&OBJNAM) VALUE(%SST(&OBJECT 1 10)) CHGVAR VAR(&OBJLIB) VALUE(%SST(&OBJECT 11 10)) IF COND(&OBJTYP = '*CLS ') THEN(DO) DLTCLS CLS(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*MENU ') THEN(DO) DLTMNU MENU(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*PNLGRP') THEN(DO) DLTPNLGRP PNLGRP(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*QRYDFN') THEN(DO) DLTQRY QRY(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*QMFORM') THEN(DO) DLTQMFORM QMFORM(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*QMQRY ') THEN(DO) DLTQMQRY QMQRY(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*CMD ') THEN(DO) DLTCMD CMD(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO /* IF COND(&OBJTYP = '*CTLD ') THEN(DO) */ /* DLTCUD CUD(&OBJNAM.&OBJLIB) */ /* GOTO CMDLBL(END) */ /* ENDDO */ /* IF COND(&OBJTYP = '*DEVD ') THEN(DO) */ /* DLTDEVD DEVD(&OBJNAM.&OBJLIB) */ /* GOTO CMDLBL(END) */ /* ENDDO */ IF COND(&OBJTYP = '*DOC ') THEN(DO) DLTDOC DOC(&OBJNAM) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*DOCL ') THEN(DO) DLTDOCL DOCL(&OBJNAM) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*DTAARA') THEN(DO) DLTDTAARA DTAARA(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*DTAQ ') THEN(DO) DLTDTAQ DTAQ(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*EDTD ') THEN(DO) DLTEDTD EDTD(&OBJNAM) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*FILE ') THEN(DO) DLTF FILE(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*GSS ') THEN(DO) DLTGSS GSS(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*JOBD ') THEN(DO) DLTJOBD JOBD(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO /* IF COND(&OBJTYP = '*JOBQ ') THEN(DO) */ /* DLTJOBQ JOBQ(&OBJNAM.&OBJLIB) */ /* GOTO CMDLBL(END) */ /* ENDDO */ IF COND(&OBJTYP = '*JRN ') THEN(DO) DLTJRN JRN(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*JRNRCV') THEN(DO) DLTJRNRCV JRNRCV(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*LIB ') THEN(DO) DLTLIB LIB(&OBJNAM) GOTO CMDLBL(END) ENDDO /* IF COND(&OBJTYP = '*LIND ') THEN(DO) */ /* DLTLIND LIND(&OBJNAM.&OBJLIB) */ /* GOTO CMDLBL(END) */ /* ENDDO */ IF COND(&OBJTYP = '*MSGF ') THEN(DO) DLTMSGF MSGF(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*MSGQ ') THEN(DO) DLTMSGQ MSGQ(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*OUTQ ') THEN(DO) DLTOUTQ OUTQ(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*PGM ') THEN(DO) DLTPGM PGM(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*PRTIMG') THEN(DO) DLTPRTIMG PRTIMG(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO /* IF COND(&OBJTYP = '*SBSD ') THEN(DO) */ /* DLTSBSD SBSD(&OBJNAM.&OBJLIB) */ /* GOTO CMDLBL(END) */ /* ENDDO */ IF COND(&OBJTYP = '*SPADCT') THEN(DO) DLTSPADCT DCT(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*TBL ') THEN(DO) DLTTBL TBL(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO IF COND(&OBJTYP = '*TBL ') THEN(DO) DLTTBL TBL(&OBJNAM.&OBJLIB) GOTO CMDLBL(END) ENDDO /* IF COND(&OBJTYP = '*USRPRF') THEN(DO) */ /* DLTUSRPRF USRPRF(&OBJNAM) */ /* GOTO CMDLBL(END) */ /* ENDDO */ SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' || + &OBJTYP |< ' Not Recognized Object Type') + TOPGMQ(*SAME) RCVMSG: RCVMSG MSG(&MSG) MONMSG MSGID(CPF0000) EXEC(GOTO END) SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' || + &MSG) TOPGMQ(*PRV) MSGTYPE(*DIAG) MONMSG MSGID(CPF0000) EXEC(GOTO END) SNDPGMMSG MSGID(CPF9899) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000) EXEC(GOTO END) GOTO CMDLBL(END) END: ENDPGM <CLP> <CMD> CMD PROMPT('Delete Object') PARM KWD(OBJ) TYPE(QUAL1) MIN(1) PROMPT('Object') QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) QUAL TYPE(*NAME) LEN(10) MIN(1) PROMPT('Library') PARM KWD(TYP) TYPE(*CHAR) LEN(7) RSTD(*NO) MIN(1) + PROMPT('Object Type') <CMD>
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.