|
midrange.com
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.
