Tweet
==begin member LSTCPP /*================================================= ============*/ /* To Compile: */ /* CRTCMD CMD(XXX/LSTCPP) PGM(XXX/CPP001R) + */ /* SRCFILE(XXX/QCMDSRC) VLDCKR(XXX/CPP001VC) */ /* */ /*================================================= ============*/ CMD PROMPT('List Command CPPs') PARM KWD(LIBR) TYPE(*CHAR) LEN(10) MIN(1) + CHOICE(*NONE) PROMPT('Library') ==end member ==begin member CPP001R ************************************************** ******************** * To compile: * * CRTBNDRPG PGM(XXX/CPP001R) SRCFILE(XXX/QRPGLESRC) + * * DFTACTGRP(*NO) * * * ************************************************** ******************** H OPTION(*SRCSTMT : *NODEBUGIO) FCPP001D CF E WORKSTN SFILE(cppsfl:sflrrn) F INFDS(WSDS) * CL Command strings DCRTDQ C 'CRTDTAQ DTAQ(QTEMP/CPPDQ) + D MAXLEN(101) SEQ(*KEYED) + D KEYLEN(10)' DCRTDQ2 C 'CRTDTAQ DTAQ(QTEMP/CMDDQ) + D MAXLEN(101) SEQ(*KEYED) + D KEYLEN(10)' DDLTDQ C 'DLTDTAQ DTAQ(QTEMP/CPPDQ)' DDLTDQ2 C 'DLTDTAQ DTAQ(QTEMP/CMDDQ)' * Process Command API Include D/COPY QSYSINC/QRPGLESRC,QCAPCMD * CL Command API Variables DCmd_Str S 100 DLen_Str S 9B 0 DCAP0100_SZ S 9B 0 INZ(%SIZE(QCAP0100)) DRcvVar_sz S 9B 0 INZ(0) DRcvVar S 1 * User Space Variables D pUserSpace S * D genericHeader DS based(pUserSpace) D headerOffset 117 120i 0 D headerSize 121 124i 0 D listOffset 125 128i 0 D listSize 129 132i 0 D numEntries 133 136i 0 D entrySize 137 140i 0 * List Object API Variables D allObjects DS D 10 inz('*ALL') D lib 10 D DS based(pObject) D oName 1 10 D oLib 11 20 D oType 21 30 * Create User Space API Variables DUser_Space DS D US_Name 20 INZ('OBJLST QTEMP ') D US_Attrib 10 INZ(*BLANKS) D US_Size 9B 0 INZ(9999) D US_Init_Val 1 INZ(' ') D US_Authority 10 INZ('*CHANGE') D US_Text 50 D US_Replace 10 INZ('*YES') * Rtv Cmd Info API Variables D CmdRcvr DS 314 D CmdCPP 29 38 D CmdCPPlib 39 48 D CmdSrcFil 49 58 D CmdSrcLib 59 68 D CmdSrcMbr 69 78 D CmdVCP 79 88 D CmdVCPlib 89 98 D CmdMsgf 149 158 D CmdMsgfLib 159 168 D CmdHlpPnl 169 178 D CmdHlpLib 179 188 D CmdHlpId 189 198 D CmdPrdLib 229 238 D CmdPOP 239 248 D CmdPOPlib 249 258 D CmdDesc 265 314 D CmdRcvrLn S 4b 0 inz(314) D CmdFmt S 8 inz('CMDI0100') D CmdQlName DS 20 D CmdName 10 overlay(CmdQlName) D CmdLibr 10 overlay(CmdQlName:11) D QualVCP S 21 * Data Queue Variables D dqName S 10 D dqLib S 10 inz('QTEMP ') D dqLngth S 5p 0 inz(101) D dqEntry S 101 D dqKeyln S 3p 0 inz(10) D dqKey S 10 D dqWait S 5p 0 inz(2) D dqOrder S 2 inz('GE') D dqSndr S 10 D dqSndrl S 3p 0 inz(10) * Error Messages DAPI_Error DS D ERR_Size 9B 0 INZ(256) D ERR_Length 9B 0 INZ(0) D ERR_ID 7 D ERR_Filler 1 D ERR_Data 256 * File feedback D WSDS DS D wssrlr 378 379B 0 * Program status D ProgStatus SDS D PgmNam *PROC D sflrrn S 5 0 D Truncate S 1 INZ('1') D Format S 8 D Space S 20 D Types S 10 D LastKey S 10 D Library S 10 D i S 10i 0 C *entry plist C parm Library * Initialize QCAPCMD options control block for CL processing C eval QCACMDPT = 0 C eval QCABCSDH = '0' C eval QCAPA = '0' C eval QCACMDSS = '0' C eval QCAMK = *BLANKS C eval QCAERVED = *LOVAL * Create Data Queues C eval Cmd_Str = CRTDQ C eval Len_Str = %SIZE(CRTDQ) C exsr ExecCmd C eval Cmd_Str = CRTDQ2 C eval Len_Str = %SIZE(CRTDQ2) C exsr ExecCmd C eval CmdLibr = Library * Create the user space in qtemp C exsr CrtUS C exsr ClrSfl * Get the list of all command objects in the library C eval lib = library C call 'QUSLOBJ' C parm US_Name Space C parm 'OBJL0100' Format C parm allObjects C parm '*CMD' Types * Process the list * Get a pointer to the user space containing the list C call 'QUSPTRUS' C parm US_Name Space C parm pUserSpace * Process the list C eval pObject = pUserSpace + listOffset C eval CmdCount = numEntries C do numEntries i * Retrieve command info and send to data queues C exsr RtvCmdi C if CmdVCP = '*NONE' C eval QualVCP = '*NONE' C else C eval QualVCP = %trim(CmdVCPlib) + '/' C + %trim(CmdVCP) C endif C eval dqEntry = CmdCPP + CmdName + CmdDesc + C CmdCPPlib + QualVCP C eval dqName = 'CPPDQ' C exsr SndDta C eval dqEntry = CmdName + CmdCPP + CmdDesc + C CmdCPPlib + QualVCP C eval dqName = 'CMDDQ' C exsr SndDta * Next objext C eval pObject = pObject + entrySize C enddo * Receive/Display queue entries (sequenced initially by CPP) C eval dqName = 'CPPDQ' C eval dqKey = *blank C exsr RcvDta C eval *IN11 = *ON C dou *INKC = *ON C exfmt cppctl * Fold / truncate C if Mode = Truncate C eval *IN11 = *ON C else C eval *IN11 = *OFF C endif * Position to C if Position <> *blank C exsr ReSend C eval dqKey = Position C exsr RcvDta C eval Position = *blank C iter C endif * Page down / roll up C if *IN26 = *ON C exsr RcvDta C iter C endif * Re-sequence C if *INKH = *ON C exsr ReSend C if dqName = 'CPPDQ' C eval dqName = 'CMDDQ' C else C eval dqName = 'CPPDQ' C endif C eval dqKey = *blank C exsr RcvDta C iter C endif C eval recno = wssrlr C enddo * Delete the data queues C eval Cmd_Str = DLTDQ C eval Len_Str = %SIZE(DLTDQ) C exsr ExecCmd C eval Cmd_Str = DLTDQ2 C eval Len_Str = %SIZE(DLTDQ2) C exsr ExecCmd * End program C eval *inlr = *on C return *--------------------------------------------------------------------- * CrtUS - Create User Space *--------------------------------------------------------------------- C CrtUS begsr C C CALL 'QUSCRTUS' C PARM US_Name C PARM US_Attrib C PARM US_Size C PARM US_Init_Val C PARM US_Authority C PARM US_Text C PARM US_Replace C PARM API_Error C * Error Processing User Space C if ERR_Length <> 0 C endif C C endsr C *--------------------------------------------------------------------- * ExecCmd - Execute a CL command *--------------------------------------------------------------------- C ExecCmd begsr * Process the requested CL command C call 'QCAPCMD' C parm Cmd_Str C parm Len_Str C parm QCAP0100 C parm CAP0100_SZ C parm 'CPOP0100' format C parm RcvVar 1 C parm 0 RcvVar_sz C parm RcvVar_sz C parm API_Error C * Error Processing C if ERR_Length <> 0 C endif C C endsr *--------------------------------------------------------------------- * RtvCmdi - retrieve command information *--------------------------------------------------------------------- C RtvCmdi begsr C eval CmdName = oName C eval CmdLibr = oLib C call 'QCDRCMDI' C parm CmdRcvr C parm CmdRcvrLn C parm CmdFmt C parm CmdQlName C parm API_Error C endsr *--------------------------------------------------------------------- * SndDta - send an entry to the data queue *--------------------------------------------------------------------- C SndDta begsr C eval dqKey = %subst(dqEntry:1:10) C eval dqLngth = 101 C call 'QSNDDTAQ' C parm dqName C parm dqLib C parm dqLngth C parm dqEntry C parm dqKeyln C parm dqKey C endsr *--------------------------------------------------------------------- * RcvDta - receive data queue entries and write them to the subfile *--------------------------------------------------------------------- C RcvDta begsr C do 15 i C call 'QRCVDTAQ' C parm dqName C parm dqLib C parm dqLngth C parm dqEntry C parm dqWait C parm dqOrder C parm dqKeyln C parm dqKey C parm dqSndrl C parm dqSndr * Condition sflend keyword C dqLngth comp 0 99 * Write to the subfile C if dqLngth > 0 and i < 15 C if dqName = 'CPPDQ' C eval DCPP = %subst(dqEntry:1:10) C eval DCMD = %subst(dqEntry:11:10) C else C eval DCMD = %subst(dqEntry:1:10) C eval DCPP = %subst(dqEntry:11:10) C endif C eval DTXT = %subst(dqEntry:21:50) C eval DCPPL= %subst(dqEntry:71:10) C eval DVCP = %subst(dqEntry:81:21) C eval sflrrn = sflrrn + 1 C write cppsfl C if i = 1 C eval recno = sflrrn C endif * Save the last key C if i = 14 C eval LastKey = dqKey C endif C endif * The 15th entry is only used to condition the sflend keyword * if an entry was found put it back on the queue and reset the key C if i = 15 and dqLngth > 0 C exsr SndDta C eval dqKey = LastKey C endif C if dqLngth = 0 C leave C endif C enddo * Display conditioning C dqName comp 'CPPDQ' 20 C sflrrn comp 0 50 21 C write ftr C endsr *--------------------------------------------------------------------- * ReSend - read all the subfile records and put them back on the queue *--------------------------------------------------------------------- C ReSend begsr C eval i = 1 C dou *IN98 = *ON C i chain cppsfl 98 C if *IN98 = *OFF C select C when dqName = 'CMDDQ' C eval dqEntry = DCMD + DCPP + DTXT + DCPPL + C DVCP C when dqName = 'CPPDQ' C eval dqEntry = DCPP + DCMD + DTXT + DCPPL + C DVCP C endsl C exsr SndDta C endif C eval i = i + 1 C enddo C exsr ClrSfl C endsr *--------------------------------------------------------------------- * ClrSfl - clear the subfile *--------------------------------------------------------------------- C ClrSfl begsr C eval *IN50 = *OFF C eval *IN51 = *OFF C write cppctl C eval *IN51 = *ON C eval sflrrn = 0 C eval recno = 0 C endsr ==end member ==begin member CPP001VC /************************************************** *******************/ /* To compile: */ /* CRTCLPGM PGM(XXX/CPP001VC) SRCFILE(XXX/QCLSRC) */ /* */ /************************************************** *******************/ PGM PARM(&LIBR) DCL &LIBR *CHAR 10 DCL &ERROR *CHAR 1 /* Check the library name is valid */ CHKOBJ OBJ(&LIBR) OBJTYPE(*LIB) MONMSG MSGID(CPF9800) EXEC(DO) SNDPGMMSG MSGID(CPD0035) MSGF(QCPFMSG) + MSGDTA('0000' *CAT &LIBR) MSGTYPE(*DIAG) CHGVAR VAR(&ERROR) VALUE('Y') ENDDO /* Send escape message if there was an error */ IF COND(&ERROR = 'Y') THEN(DO) SNDPGMMSG MSGID(CPF0002) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) ENDDO ENDPGM ==end member Figure 1: The lstcpp.txt file A* A DSPSIZ(24 80 *DS3) A PRINT A CF03 A* A R CPPSFL SFL A DCMD 10A O 8 4 A DCPP 10A O 8 15 A DTXT 50A O 8 26 A 9 15'Lib:' A DSPATR(HI) A DCPPL 10A O 9 20 A 9 33'VCP:' A DSPATR(HI) A DVCP 21A O 9 38 A* A R CPPCTL SFLCTL(CPPSFL) A SFLSIZ(0008) A SFLPAG(0007) A ROLLUP(26) A OVERLAY A N21 CF08 A 21 SFLINZ A N50 SFLCLR A 50 SFLDSP A 51 SFLDSPCTL A 99 SFLEND(*MORE) A 11 SFLDROP(CA11) A N11 SFLFOLD(CA11) A SFLMODE(&MODE) A RECNO 4S 0H SFLRCDNBR A MODE 1A H A 1 2USER A 1 30'List Command CPPs' A DSPATR(HI) A 1 71DATE A EDTCDE(Y) A PGMNAM 10A O 2 2 A 2 71TIME A 4 4'Library name . . . . . . :' A COLOR(BLU) A CMDLIBR 10A O 4 32DSPATR(HI) A 4 53'Position to:' A COLOR(BLU) A POSITION 10A B 4 66 A 5 4'Command count. . . . . . :' A COLOR(BLU) A CMDCOUNT 5Y 0O 5 32EDTCDE(3) A DSPATR(HI) A 7 4'Cmd Name' A DSPATR(HI) A 7 15'CPP Name' A DSPATR(HI) A 7 26'Description' A DSPATR(HI) A* A R FTR A 23 3'F3=Exit' A COLOR(BLU) A 20 23 12'F8=Seq by CMD' A COLOR(BLU) A 21 DSPATR(ND) A N20 23 12'F8=Seq by CPP' A COLOR(BLU) A 21 DSPATR(ND) A 23 27'F11=Fold' A COLOR(BLU) A 21 DSPATR(ND) Figure 2: The CPP001DF.txt file
Comment