Difference between revisions of "Find Source Member (FNDSRCMBR)"
DaveLClarkI (talk | contribs) (→CL/ILE Program) |
DaveLClarkI (talk | contribs) (→CL/ILE Program) |
||
Line 127: | Line 127: | ||
DCL VAR(&WTIME) TYPE(*INT) LEN(4) VALUE(-1) | DCL VAR(&WTIME) TYPE(*INT) LEN(4) VALUE(-1) | ||
DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) | DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) | ||
+ | DCL VAR(&MBRLST) TYPE(*CHAR) LEN(10) VALUE('MBRLST') | ||
DCL VAR(&PNLGRP) TYPE(*CHAR) LEN(20) + | DCL VAR(&PNLGRP) TYPE(*CHAR) LEN(20) + | ||
VALUE('FNDSRCMBR *LIBL') | VALUE('FNDSRCMBR *LIBL') | ||
Line 228: | Line 229: | ||
CHGVAR VAR(&OPTION) VALUE('FRST') | CHGVAR VAR(&OPTION) VALUE('FRST') | ||
+ | /* build member list */ | ||
DOWHILE (*NOT &EOFSRC) | DOWHILE (*NOT &EOFSRC) | ||
CALLSUBR SUBR(GET_SRCF) | CALLSUBR SUBR(GET_SRCF) | ||
Line 294: | Line 296: | ||
/* user pressed F17=TOP key? */ | /* user pressed F17=TOP key? */ | ||
IF COND(&FUNC *EQ 2) THEN(DO) | IF COND(&FUNC *EQ 2) THEN(DO) | ||
− | CALL PGM(QUISETLA) PARM(&HANDLE | + | CALL PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' + |
'*SAME' 'TOP' 'S' &ERRCOD) | '*SAME' 'TOP' 'S' &ERRCOD) | ||
MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + | MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + | ||
Line 302: | Line 304: | ||
/* user pressed F18=BOTTOM key? */ | /* user pressed F18=BOTTOM key? */ | ||
IF COND(&FUNC *EQ 3) THEN(DO) | IF COND(&FUNC *EQ 3) THEN(DO) | ||
− | CALL PGM(QUISETLA) PARM(&HANDLE | + | CALL PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' + |
'*SAME' 'BOT' 'S' &ERRCOD) | '*SAME' 'BOT' 'S' &ERRCOD) | ||
MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + | MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + | ||
Line 312: | Line 314: | ||
*AND &OPTION *NE 'FRST') THEN(DO) | *AND &OPTION *NE 'FRST') THEN(DO) | ||
/* delete subfile on refresh */ | /* delete subfile on refresh */ | ||
− | CALL PGM(QUIDLTL) PARM(&HANDLE | + | CALL PGM(QUIDLTL) PARM(&HANDLE &MBRLST &ERRCOD) |
ENDDO | ENDDO | ||
Line 434: | Line 436: | ||
CHGVAR VAR(&VARLEN) VALUE(132) | CHGVAR VAR(&VARLEN) VALUE(132) | ||
CALL PGM(QUIADDLE) PARM(&HANDLE &VARBUF &VARLEN + | CALL PGM(QUIADDLE) PARM(&HANDLE &VARBUF &VARLEN + | ||
− | 'MEMBERS' | + | 'MEMBERS' &MBRLST &OPTION &LEHNDL &ERRCOD) |
CHGVAR VAR(&OPTION) VALUE('NEXT') | CHGVAR VAR(&OPTION) VALUE('NEXT') | ||
ENDSUBR | ENDSUBR |
Revision as of 21:54, 3 January 2019
Contents
Summary
The following are the complete definitions and instructions needed for using the Find Source Member (FNDSRCMBR) command. This command searches for multiple occurrences of a specified (generic) member name, as found anywhere on the system (according to your specified filter criteria), and then uses a UIM list panel to allow you to work with them—while also making their attributes available for viewing. From that panel you can compare, change, copy, remove, display, and/or rename the members shown. Your enhancements to this code could form a basis for "the poor-man's PDM."
By Dave Clark
Sample Application
Note that the CL program included in this sample uses two different CL-based data structures. Thus, this is also an example of the easy way to use data structures in CL programming. The &VARBUF data structure is used with the UIM Put Dialog Variable (QUIPUTV) API and the UIM Add List Entry (QUIADDLE) API. The &APIERRC data structure is a CL/ILE version of the RPG/ILE API Error Code Structure (ApiErrC).
Command Definition
Place the following in a QCMDSRC member named FNDSRCMBR and compile it.
/******************************************************************************/ /* Program Name: FNDSRCMBR -- Find Source Member */ /* Programmer: Dave L Clark I */ /* Date: June 17, 2016 */ /* Project/Request #: JIRA IN-40 -- Create command to find source members */ /* Purpose: This command searches the specified libraries for a */ /* matching source file and member name. The resulting */ /* list displays in a subfile for option processing. */ /*----------------------------------------------------------------------------*/ /* Create as follows: */ /* */ /* CRTCMD CMD(*CURLIB/FNDSRCMBR) PGM(*LIBL/FNDSRCMBR) */ /* */ /*----------------------------------------------------------------------------*/ /* Modification Log: */ /* */ /* Mod# Date User Description */ /* ---- ---------- ---------- ----------------------------------------------- */ /* M000 */ /******************************************************************************/ FNDSRCMBR: CMD PROMPT('Find Source Member') TEXT('Find + Source Member') HLPID(*CMD) + HLPPNLGRP(FNDSRCMBR) PARM KWD(SRCMBR) TYPE(*GENERIC) LEN(10) MIN(1) + SPCVAL(('*')) PROMPT('Source member') PARM KWD(SRCFILE) TYPE(SRCF) PROMPT('Source file') SRCF: QUAL TYPE(*NAME) LEN(10) DFT(QRPGLESRC) QUAL TYPE(*NAME) LEN(10) DFT(*CURLIB) + SPCVAL((*ALL) (*ALLUSR) (*USRLIBL) + (*CURLIB)) PROMPT('Library')
CL/ILE Program
Place the following in a QCLSRC or QCLLESRC member named FNDSRCMBR and compile it.
/******************************************************************************/ /* Program Name: FNDSRCMBR -- Find Source Member */ /* Programmer: Dave L Clark I */ /* Date: June 17, 2016 */ /* Project/Request #: JIRA IN-40 -- Create command to find source members */ /* Purpose: This command searches the specified libraries for a */ /* matching source file and member name. The resulting */ /* list displays in a subfile for option processing. */ /*----------------------------------------------------------------------------*/ /* Create as follows: */ /* */ /* CRTBNDCL PGM(*CURLIB/FNDSRCMBR) SRCFILE(*CURLIB/QCLSRC) */ /* */ /*----------------------------------------------------------------------------*/ /* Modification Log: */ /* */ /* Mod# Date User Description */ /* ---- ---------- ---------- ----------------------------------------------- */ /* M000 */ /******************************************************************************/ FNDSRCMBR: PGM PARM(&SRCMBR &SRCFILE) DCLPRCOPT TEXT('Find Source Member') + DFTACTGRP(*NO) ACTGRP(QILE) /* parameter variables */ DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10) DCL VAR(&SRCFILE) TYPE(*CHAR) LEN(20) DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) + STG(*DEFINED) DEFVAR(&SRCFILE 1) DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10) + STG(*DEFINED) DEFVAR(&SRCFILE 11) /* work variables */ DCL VAR(&CONTINUE) TYPE(*LGL) LEN(1) VALUE('1') DCL VAR(&EOFSRC) TYPE(*LGL) LEN(1) VALUE('0') DCL VAR(&GOTMBR) TYPE(*LGL) LEN(1) VALUE('0') DCL VAR(&INTERACT) TYPE(*CHAR) LEN(1) DCL VAR(&FILEATRB) TYPE(*CHAR) LEN(3) DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) DCL VAR(&MBROPT) TYPE(*CHAR) LEN(5) DCL VAR(&TIME) TYPE(*CHAR) LEN(8) DCL VAR(&DATE) TYPE(*CHAR) LEN(10) DCL VAR(&MBRNAME) TYPE(*CHAR) LEN(10) DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) DCL VAR(&CRTDATE) TYPE(*CHAR) LEN(19) DCL VAR(&CHGDATE) TYPE(*CHAR) LEN(19) DCL VAR(&MBRTEXT) TYPE(*CHAR) LEN(50) DCL VAR(&PFX) TYPE(*DEC) LEN(3 0) DCL VAR(&RCDCOUNT) TYPE(*DEC) LEN(10 0) DCL VAR(&DLTCOUNT) TYPE(*DEC) LEN(10 0) DCL VAR(&MBRSIZE) TYPE(*DEC) LEN(15 0) DCL VAR(&RCVR) TYPE(*CHAR) LEN(400) DCL VAR(&RCVL) TYPE(*INT) LEN(4) VALUE(400) DCL VAR(&QOUT) TYPE(*CHAR) LEN(20) DCL VAR(&QFNM) TYPE(*CHAR) LEN(20) /* bit testing */ DCL VAR(&CHAR) TYPE(*CHAR) LEN(1) DCL VAR(&BIT_2_ON) TYPE(*LGL) LEN(1) DCL VAR(&BIT_4_ON) TYPE(*LGL) LEN(1) DCL VAR(&BIT_POS) TYPE(*INT) LEN(4) /* API variables */ DCL VAR(&FULHLP) TYPE(*CHAR) LEN(1) VALUE('N') DCL VAR(&REDSPO) TYPE(*CHAR) LEN(1) VALUE('N') DCL VAR(&USRTSK) TYPE(*CHAR) LEN(1) VALUE('N') DCL VAR(&CSTKC) TYPE(*INT) LEN(4) VALUE(0) DCL VAR(&CSTKQ) TYPE(*CHAR) LEN(10) VALUE('*CALLER') DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) DCL VAR(&CSROPT) TYPE(*CHAR) LEN(1) VALUE('D') DCL VAR(&LSTENT) TYPE(*CHAR) LEN(4) VALUE('NONE') DCL VAR(&ERRENT) TYPE(*CHAR) LEN(4) VALUE('NONE') DCL VAR(&WTIME) TYPE(*INT) LEN(4) VALUE(-1) DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) DCL VAR(&MBRLST) TYPE(*CHAR) LEN(10) VALUE('MBRLST') DCL VAR(&PNLGRP) TYPE(*CHAR) LEN(20) + VALUE('FNDSRCMBR *LIBL') DCL VAR(&OPTION) TYPE(*CHAR) LEN(4) DCL VAR(&APPSCP) TYPE(*INT) LEN(4) VALUE(-1) DCL VAR(&EXTPRM) TYPE(*INT) LEN(4) DCL VAR(&ERRCOD) TYPE(*INT) LEN(4) VALUE(0) DCL VAR(&FUNC) TYPE(*INT) LEN(4) VALUE(5) DCL VAR(&LEHNDL) TYPE(*INT) LEN(4) DCL VAR(&VARLEN) TYPE(*INT) LEN(4) /* this buffer performs double duty for both panel header and list detail */ DCL VAR(&VARBUF) TYPE(*CHAR) LEN(132) DCL VAR(&VAR_SRCLIB) TYPE(*CHAR) LEN(10) STG(*DEFINED) DEFVAR(&VARBUF 1) DCL VAR(&VAR_SRCMBR) TYPE(*CHAR) LEN(10) STG(*DEFINED) DEFVAR(&VARBUF 11) DCL VAR(&VAR_MBRTYP) TYPE(*CHAR) LEN(10) STG(*DEFINED) DEFVAR(&VARBUF 21) DCL VAR(&VAR_MBRTXT) TYPE(*CHAR) LEN(50) STG(*DEFINED) DEFVAR(&VARBUF 31) DCL VAR(&VAR_CRTDAT) TYPE(*CHAR) LEN(19) STG(*DEFINED) DEFVAR(&VARBUF 81) DCL VAR(&VAR_CHGDAT) TYPE(*CHAR) LEN(19) STG(*DEFINED) DEFVAR(&VARBUF 100) DCL VAR(&VAR_RCDCNT) TYPE(*DEC) LEN(10 0) STG(*DEFINED) DEFVAR(&VARBUF 119) DCL VAR(&VAR_MBRSIZ) TYPE(*DEC) LEN(15 0) STG(*DEFINED) DEFVAR(&VARBUF 125) /* error handling variables */ DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) VALUE('QCPFMSG') DCL VAR(&MSGLIB) TYPE(*CHAR) LEN(10) VALUE('*LIBL') DCL VAR(&MSGDATA) TYPE(*CHAR) LEN(3000) DCL VAR(&APIERRC) TYPE(*CHAR) LEN(3016) DCL VAR(&API_BPROV) TYPE(*UINT) LEN(4) STG(*DEFINED) DEFVAR(&APIERRC 1) DCL VAR(&API_BAVAIL) TYPE(*UINT) LEN(4) STG(*DEFINED) DEFVAR(&APIERRC 5) DCL VAR(&API_MSGID) TYPE(*CHAR) LEN(7) STG(*DEFINED) DEFVAR(&APIERRC 9) DCL VAR(&API_RSRVD) TYPE(*CHAR) LEN(1) STG(*DEFINED) DEFVAR(&APIERRC 16) DCL VAR(&API_MDATA) TYPE(*CHAR) LEN(3000) STG(*DEFINED) DEFVAR(&APIERRC 17) /* work files */ DCLF FILE(QAFDBASI) OPNID(SRC) ALWVARLEN(*YES) /* ============================================================= */ /* ======================= S E T U P ======================= */ /* ============================================================= */ OVRMSGF MSGF(&MSGF) TOMSGF(&MSGLIB/&MSGF) RTVJOBA TYPE(&INTERACT) /* verify source file attributes */ CALLSUBR SUBR(VFY_SRCF) /* ============================================================= */ /* ============ B E G I N P R O C E S S I N G ============ */ /* ============================================================= */ /* open the display application */ CALL PGM(QUIOPNDA) PARM(&HANDLE &PNLGRP &APPSCP + &EXTPRM &FULHLP &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) /* put panel id and source file name on the screen */ CHGVAR VAR(&VAR_SRCLIB) VALUE(&PNLGRP) CHGVAR VAR(&VAR_SRCMBR) VALUE(&SRCF) CHGVAR VAR(&VAR_MBRTYP) VALUE(&SRCLIB) CHGVAR VAR(&VAR_MBRTXT) VALUE(&SRCMBR) CHGVAR VAR(&VARLEN) VALUE(40) CALL PGM(QUIPUTV) PARM(&HANDLE &VARBUF &VARLEN + 'HEADER' &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) /* loop on screen interactions */ DOWHILE COND(&CONTINUE) IF COND(&FUNC *EQ 5) THEN(DO) /* (re)build list? */ /* retrieve available file descriptions */ SNDPGMMSG MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Searching + for source files...') TOPGMQ(*EXT) + MSGTYPE(*STATUS) /* special handling for *USRLIBL filter */ IF COND(&SRCLIB *EQ *USRLIBL) THEN(DO) CHGVAR VAR(&SRCF) VALUE(&SRCF *TCAT '*') ENDDO /* list matching files into an output file */ DSPFD FILE(&SRCLIB/&SRCF) TYPE(*BASATR) + OUTPUT(*OUTFILE) OUTFILE(QTEMP/SRCFLIST) + OUTMBR(*FIRST *REPLACE) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) /* override to the source file list */ OVRDBF FILE(QAFDBASI) TOFILE(QTEMP/SRCFLIST) CHGVAR VAR(&EOFSRC) VALUE('0') /* retrieve matching member descriptions */ SNDPGMMSG MSGID(CPF9897) MSGF(&MSGF) MSGDTA('Building + member list...') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHGVAR VAR(&OPTION) VALUE('FRST') /* build member list */ DOWHILE (*NOT &EOFSRC) CALLSUBR SUBR(GET_SRCF) IF COND(*NOT &EOFSRC) THEN(DO) IF COND(&SRCMBR *EQ '*') THEN(DO) CHGVAR VAR(&MBRNAME) VALUE(*FIRSTMBR) ENDDO ELSE CMD(DO) CHGVAR VAR(&MBRNAME) VALUE(&SRCMBR) ENDDO CHGVAR VAR(&MBROPT) VALUE(*SAME) CALLSUBR SUBR(GET_MBRD) IF COND(*NOT &GOTMBR) THEN(DO) ITERATE ENDDO CALLSUBR SUBR(PUT_MBRD) CHGVAR VAR(&MBROPT) VALUE(*NEXT) DOWHILE COND(&MBRNAME *NE &SRCMBR) CALLSUBR SUBR(GET_MBRD) IF COND(&GOTMBR) THEN(DO) CALLSUBR SUBR(PUT_MBRD) ENDDO ENDDO ENDDO ENDDO SNDPGMMSG MSGID(CPF9897) MSGF(&MSGF) MSGDTA(' ') + TOPGMQ(*EXT) MSGTYPE(*STATUS) ENDDO /* display the panel */ CALL PGM(QUIDSPP) PARM(&HANDLE &FUNC 'WRKSRCM' + &REDSPO &ERRCOD &USRTSK &CSTKC &CSTKQ + &MSGKEY &CSROPT &LSTENT &ERRENT &WTIME) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) /* user pressed F3=EXIT key? */ IF COND(&FUNC *LT 0) THEN(DO) CHGVAR VAR(&CONTINUE) VALUE('0') ENDDO /* user pressed ENTER key? */ IF COND(&FUNC *EQ 1) THEN(DO) CHGVAR VAR(&VARLEN) VALUE(40) CALL PGM(QUIGETV) PARM(&HANDLE &VARBUF &VARLEN + 'HEADER' &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) CHGVAR VAR(&SRCF) VALUE(&VAR_SRCMBR) CHGVAR VAR(&SRCLIB) VALUE(&VAR_MBRTYP) CHGVAR VAR(&SRCMBR) VALUE(&VAR_MBRTXT) CALLSUBR SUBR(VFY_SRCF) CHGVAR VAR(&VAR_SRCMBR) VALUE(&SRCF) CHGVAR VAR(&VAR_MBRTYP) VALUE(&SRCLIB) CHGVAR VAR(&VAR_MBRTXT) VALUE(&SRCMBR) CHGVAR VAR(&VARLEN) VALUE(40) CALL PGM(QUIPUTV) PARM(&HANDLE &VARBUF &VARLEN + 'HEADER' &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) CHGVAR VAR(&FUNC) VALUE(5) /* do refresh */ ENDDO /* user pressed F17=TOP key? */ IF COND(&FUNC *EQ 2) THEN(DO) CALL PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' + '*SAME' 'TOP' 'S' &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) ENDDO /* user pressed F18=BOTTOM key? */ IF COND(&FUNC *EQ 3) THEN(DO) CALL PGM(QUISETLA) PARM(&HANDLE &MBRLST 'SAME' + '*SAME' 'BOT' 'S' &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) ENDDO /* user requested a F5=REFRESH? */ IF COND(&FUNC *EQ 5 + *AND &OPTION *NE 'FRST') THEN(DO) /* delete subfile on refresh */ CALL PGM(QUIDLTL) PARM(&HANDLE &MBRLST &ERRCOD) ENDDO /* close the source file list and remove override */ CLOSE OPNID(SRC) DLTOVR FILE(QAFDBASI) MONMSG MSGID(CPF9841) EXEC(DO) RCVMSG MSGTYPE(*LAST) RMV(*YES) ENDDO /* loop on screen interactions */ ENDDO /* close the display application */ CALL PGM(QUICLOA) PARM(&HANDLE 'M' &ERRCOD) MONMSG MSGID(CPF0000 CPE0000 CPD0000) EXEC(GOTO + CMDLBL(ABORT)) /* ============================================================= */ /* =========== E N D O F P R O C E S S I N G =========== */ /* ============================================================= */ RETURN ABORT: /* if running interactively, relay message to line 24 of menu */ IF COND(&INTERACT *EQ '1') THEN(DO) RCVMSG MSGTYPE(*LAST) RMV(*NO) MSGDTA(&MSGDATA) + MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) + MSGDTA(&MSGDATA) TOPGMQ(*PRV) + MSGTYPE(*ESCAPE) ENDDO /* else... */ ELSE CMD(DO) CHGJOB LOG(4 *SAME *SECLVL) /* print joblog */ ENDDO RETURN /* ============================================================= */ /* ============= G E T S O U R C E F I L E ============= */ /* ============================================================= */ GET_SRCF: SUBR SUBR(GET_SRCF) RCVF OPNID(SRC) MONMSG MSGID(CPF0864) EXEC(DO) CHGVAR VAR(&EOFSRC) VALUE('1') ENDDO ENDSUBR /* ============================================================= */ /* ====== G E T M E M B E R D E S C R I P T I O N ====== */ /* ============================================================= */ GET_MBRD: SUBR SUBR(GET_MBRD) CHGVAR VAR(&GOTMBR) VALUE('1') RTVMBRD FILE(&SRC_ATLIB/&SRC_ATFILE) MBR(&MBRNAME + &MBROPT) RTNMBR(&MBRNAME) SRCTYPE(&SRCTYPE) + SRCCHGDATE(&CHGDATE) CRTDATE(&CRTDATE) + TEXT(&MBRTEXT) NBRCURRCD(&RCDCOUNT) + NBRDLTRCD(&DLTCOUNT) DTASPCSIZ(&MBRSIZE) /* end of member list? */ MONMSG MSGID(CPF3018 CPF3019 CPF3049 CPF9815) EXEC(DO) RCVMSG MSGTYPE(*LAST) RMV(*YES) CHGVAR VAR(&MBRNAME) VALUE(&SRCMBR) CHGVAR VAR(&GOTMBR) VALUE('0') ENDDO IF COND(&GOTMBR + *AND &MBROPT *EQ '*NEXT') THEN(DO) /* end of generic member list? */ IF COND(&PFX *GT 0) THEN(DO) IF COND(%SST(&SRCMBR 1 &PFX) + *NE %SST(&MBRNAME 1 &PFX)) THEN(DO) CHGVAR VAR(&MBRNAME) VALUE(&SRCMBR) CHGVAR VAR(&GOTMBR) VALUE('0') ENDDO ENDDO ENDDO ENDSUBR /* ============================================================= */ /* ====== P U T M E M B E R D E S C R I P T I O N ====== */ /* ============================================================= */ PUT_MBRD: SUBR SUBR(PUT_MBRD) CHGVAR VAR(&VAR_SRCLIB) VALUE(&SRC_ATLIB) CHGVAR VAR(&VAR_SRCMBR) VALUE(&MBRNAME) CHGVAR VAR(&VAR_MBRTYP) VALUE(&SRCTYPE) CHGVAR VAR(&VAR_MBRTXT) VALUE(&MBRTEXT) IF COND(%SST(&CRTDATE 1 1) *EQ '0') THEN(DO) CHGVAR VAR(&DATE) VALUE('19' || %SST(&CRTDATE 2 2) + *CAT '/' *CAT %SST(&CRTDATE 4 2) + *CAT '/' *CAT %SST(&CRTDATE 6 2)) ENDDO ELSE CMD(DO) CHGVAR VAR(&DATE) VALUE('20' || %SST(&CRTDATE 2 2) + *CAT '/' *CAT %SST(&CRTDATE 4 2) + *CAT '/' *CAT %SST(&CRTDATE 6 2)) ENDDO CHGVAR VAR(&TIME) VALUE(%SST(&CRTDATE 8 2) + *CAT ':' *CAT %SST(&CRTDATE 10 2) + *CAT ':' *CAT %SST(&CRTDATE 12 2)) CHGVAR VAR(&VAR_CRTDAT) VALUE(&DATE *BCAT &TIME) IF COND(%SST(&CHGDATE 1 1) *EQ '0') THEN(DO) CHGVAR VAR(&DATE) VALUE('19' || %SST(&CHGDATE 2 2) + *CAT '/' *CAT %SST(&CHGDATE 4 2) + *CAT '/' *CAT %SST(&CHGDATE 6 2)) ENDDO ELSE CMD(DO) CHGVAR VAR(&DATE) VALUE('20' || %SST(&CHGDATE 2 2) + *CAT '/' *CAT %SST(&CHGDATE 4 2) + *CAT '/' *CAT %SST(&CHGDATE 6 2)) ENDDO CHGVAR VAR(&TIME) VALUE(%SST(&CHGDATE 8 2) + *CAT ':' *CAT %SST(&CHGDATE 10 2) + *CAT ':' *CAT %SST(&CHGDATE 12 2)) CHGVAR VAR(&VAR_CHGDAT) VALUE(&DATE *BCAT &TIME) CHGVAR VAR(&VAR_RCDCNT) VALUE(&RCDCOUNT) CHGVAR VAR(&VAR_MBRSIZ) VALUE(&MBRSIZE) CHGVAR VAR(&VARLEN) VALUE(132) CALL PGM(QUIADDLE) PARM(&HANDLE &VARBUF &VARLEN + 'MEMBERS' &MBRLST &OPTION &LEHNDL &ERRCOD) CHGVAR VAR(&OPTION) VALUE('NEXT') ENDSUBR /* ============================================================= */ /* ========== V E R I F Y S O U R C E F I L E ========== */ /* ============================================================= */ VFY_SRCF: SUBR SUBR(VFY_SRCF) /* verify source file attributes */ CHGVAR VAR(&QFNM) VALUE(&SRCF *CAT '*LIBL') CHGVAR VAR(&API_BPROV) VALUE(%LEN(&APIERRC)) CALL PGM(QDBRTVFD) PARM(&RCVR &RCVL &QOUT + 'FILD0100' &QFNM '*FIRST' '1' '*LCL' + '*INT' &APIERRC) IF COND(&API_BAVAIL *GT 0) THEN(DO) SNDPGMMSG MSGID(&API_MSGID) MSGF(QCPFMSG) + MSGDTA(&API_MDATA) MSGTYPE(*ESCAPE) ENDDO CHGVAR VAR(&CHAR) VALUE(%SST(&RCVR 9 1)) /* atrb byte */ CHGVAR VAR(&BIT_POS) VALUE(2) /* test file atrb bit */ CALLPRC PRC('_TSTBTS') PARM((&CHAR) (&BIT_POS *BYVAL)) + RTNVAL(&BIT_POS) CHGVAR VAR(&BIT_2_ON) VALUE(&BIT_POS *EQ 1) CHGVAR VAR(&BIT_POS) VALUE(4) /* test file type bit */ CALLPRC PRC('_TSTBTS') PARM((&CHAR) (&BIT_POS *BYVAL)) + RTNVAL(&BIT_POS) CHGVAR VAR(&BIT_4_ON) VALUE(&BIT_POS *EQ 1) IF (&BIT_2_ON) + (CHGVAR &FILEATRB *LF) /* on = lf */ ELSE CMD(CHGVAR &FILEATRB *PF) /* off = pf */ IF (&BIT_4_ON) + (CHGVAR &FILETYPE *SRC) /* on = src */ ELSE CMD(CHGVAR &FILETYPE *DATA) /* off = data */ IF COND(&FILEATRB *NE '*PF' + *OR &FILETYPE *NE '*SRC') THEN(DO) SNDPGMMSG MSGID(CPF9897) MSGF(&MSGF) MSGDTA('File is + not a physical source file.') + MSGTYPE(*ESCAPE) ENDDO /* set length of generic prefix */ CHGVAR VAR(&PFX) VALUE(1) DOWHILE COND(%SST(&SRCMBR &PFX 1) *NE '*' + *AND &PFX *LT 10) CHGVAR VAR(&PFX) VALUE(&PFX + 1) ENDDO IF COND(%SST(&SRCMBR &PFX 1) *EQ '*') THEN(DO) CHGVAR VAR(&PFX) VALUE(&PFX - 1) ENDDO ENDSUBR /* ============================================================= */ ENDPGM
UIM Panel Group
Place the following in a QPNLSRC member named FNDSRCMBR and compile it.
.****************************************************************************** .* Program Name: FNDSRCMBR -- Find Source Member * .* Programmer: Dave L Clark I * .* Date: June 17, 2016 * .* Project/Request #: JIRA IN-40 -- Create command to find source members * .* Purpose: This command searches the specified libraries for a * .* matching source file and member name. The resulting * .* list displays in a subfile for option processing. * .*----------------------------------------------------------------------------* .* Create as follows: * .* * .* CRTPNLGRP PNLGRP(*CURLIB/FNDSRCMBR) SRCFILE(*CURLIB/QPNLSRC) * .* * .*----------------------------------------------------------------------------* .* Modification Log: * .* * .* Mod# Date User Description * .* ---- ---------- ---------- ----------------------------------------------- * .* M000 * .****************************************************************************** :pnlgrp. .*===================================================================== .* Define data classes .*===================================================================== :class name=BIN2 basetype='BIN 15'. :eclass. :class name=OPTCLS basetype='ACTION'. :eclass. :class name=OBJCLS basetype='OBJNAME 10'. :eclass. :class name=OBJLIB basetype='OBJNAME 10'. :tl. :ti value='"*ALL"'. *ALL :ti value='"*ALLUSR"'. *ALLUSR :ti value='"*USRLIBL"'. *USRLIBL :ti value='"*CURLIB"'. *CURLIB :etl. :eclass. :class name=GENCLS basetype='NAME 10 GENERIC'. :tl. :ti value='"*"'. * :etl. :eclass. :class name=INTCLS10 basetype='PACKED 10 0'. :eclass. :class name=INTCLS15 basetype='PACKED 15 0'. :eclass. :class name=DTETME basetype='CHAR 19'. :eclass. :class name=TXTCLS basetype='CHAR 50'. :eclass. :class name=PRMCLS basetype='CHAR 255'. :eclass. .*============================~======================================== .* Define data variables .*===================================================================== :var name=PNLID class=OBJCLS. :var name=SRCF class=OBJCLS. :var name=LIBL class=OBJLIB. :var name=MEMB class=GENCLS. :var name=MBRVIEW class=BIN2. :var name=OPT class=OPTCLS. :var name=LIB class=OBJCLS. :var name=MBR class=OBJCLS. :var name=TYP class=OBJCLS. :var name=REC class=INTCLS10. :var name=SIZ class=INTCLS15. :var name=CRT class=DTETME. :var name=CHG class=DTETME. :var name=TXT class=TXTCLS. :var name=PRM class=PRMCLS. .*==================================================================== .* Define variable records and list definition .*==================================================================== :varrcd name=HEADER vars='PNLID SRCF LIBL MEMB'. :varrcd name=MEMBERS vars='LIB MBR TYP TXT CRT CHG REC SIZ'. :listdef name=MBRLST vars='OPT LIB MBR TYP TXT CRT CHG REC SIZ'. .*==================================================================== .* Define conditions and truth tables .*==================================================================== :cond name=MBRVIEW1 expr='MBRVIEW=0'. :cond name=MBRVIEW2 expr='MBRVIEW=1'. :cond name=MBRVIEW3 expr='MBRVIEW=2'. :tt name=MBRTT conds='MBRVIEW1 MBRVIEW2 MBRVIEW3'. :ttrow values=' 1 0 0 '. :ttrow values=' 0 1 0 '. :ttrow values=' 0 0 1 '. :ett. .*===================================================================== .* Define the key list .*===================================================================== :keyl name=KEYS help=KLIST. :keyi key=F1 help=HELP action='HELP'. F1=Help :keyi key=F3 help=EXIT action='EXIT SET' varupd=NO. F3=Exit :keyi key=F4 help=PROMPT action='PROMPT'. F4=Prompt :keyi key=F5 help=REFRESH action='RETURN 5' varupd=NO. F5=Refresh :keyi key=F9 help=RETRIEVE action='RETRIEVE'. F9=Retrieve :keyi key=F11 help=CHGVIEW action='CHGVIEW' cond=MBRVIEW1. F11=Member dates :keyi key=F11 help=CHGVIEW action='CHGVIEW' cond=MBRVIEW2. F11=Member text :keyi key=F11 help=CHGVIEW action='CHGVIEW' cond=MBRVIEW3. F11=Member size :keyi key=F17 help=TOP action='RETURN 2'. F17=Top of List :keyi key=F18 help=BOTTOM action='RETURN 3'. F18=End of List :keyi key=F24 help=MOREKEYS action='MOREKEYS'. F24=More keys :keyi key=ENTER help=ENTERKY action='ENTER'. :keyi key=HELP help=HELPKY action='HELP'. :keyi key=PAGEUP help=PAGEUPKY action='PAGEUP'. :keyi key=PAGEDOWN help=PAGEDNKY action='PAGEDOWN'. :keyi key=PRINT help=PRINTKY action='PRINT'. :ekeyl. .*===================================================================== .* Define the panel .*===================================================================== :panel name=WRKSRCM help=MLIST keyl=KEYS enter='RETURN 1' panelid=PNLID depth=FIT width=80 topsep=SYSNAM tt=mbrtt. Work with Source Member :data depth=4. :datacol width=20. :datacol width=12. :datacol width='*'. :datagrp grpsep=NONE COMPACT. :datagrp grpsep=QINDENT COMPACT help='FNDSRCMBR/SRCFILE'. :datai var=SRCF usage=INOUT. Source file :datac.Name :datai var=LIBL usage=INOUT. Library :datac.Name, *ALL, *ALLUSR, *USRLIBL, *CURLIB :edatagrp. :datai var=MEMB usage=INOUT help='FNDSRCMBR/SRCMBR'. Source member :datac.Name, generic*, * :edatagrp. :edata. .*===================================================================== .* Define the List .*===================================================================== :list actor=UIM depth='*' extact=NO listdef=MBRLST maxhead=1 maxactl=1 view=MBRVIEW parms=PRM. :topinst.Type options, press Enter. .*--------------------------------------------------------------------- .* Define the actions for each option in the list .*--------------------------------------------------------------------- :listact option=1 enter='CMD ?CMPPFM ?*NEWFILE(&lib./&srcf.) ?*NEWMBR(&mbr.) &prm.' prompt='CMD ?CMPPFM ?*NEWFILE(&lib./&srcf.) ?*NEWMBR(&mbr.) &prm.' help='MLIST/OPT1'. 1=Compare :listact option=2 enter='CMD ?CHGPFM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.)' enter=' ?-EXPDATE() ?-SHARE() ?-UNIT() &prm.' prompt='CMD ?CHGPFM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.' help='MLIST/OPT2'. 2=Change :listact option=3 enter='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)' enter=' ??TOMBR(*FROMMBR) ??MBROPT(*REPLACE) &prm.' prompt='CMD ?CPYF ?*FROMFILE(&lib./&srcf.) ?*FROMMBR(&mbr.)' prompt=' ??TOMBR(*FROMMBR) ??MBROPT(*REPLACE) &prm.' help='MLIST/OPT3'. 3=Copy :listact option=4 enter='CMD ?RMVM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.' prompt='CMD ?RMVM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.' help='MLIST/OPT4'. 4=Remove :listact option=5 enter='CMD DSPPFM FILE(&lib./&srcf.) MBR(&mbr.) &prm.' prompt='CMD ?DSPPFM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.' help='MLIST/OPT5'. 5=Display :listact option=7 enter='CMD ?RNMM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.' prompt='CMD ?RNMM ?*FILE(&lib./&srcf.) ?*MBR(&mbr.) &prm.' help='MLIST/OPT7'. 7=Rename .*--------------------------------------------------------------------- .* Define the columns and headings in the list .*--------------------------------------------------------------------- :listcol var=OPT usage=INOUT maxwidth=2 help='MLIST/OPTIONS'. Op :listcol var=LIB usage=OUT maxwidth=10 help='MLIST/LIB'. Library :listcol var=MBR usage=OUT maxwidth=10 help='MLIST/MBR'. Member :listcol var=TYP usage=OUT maxwidth=10 help='MLIST/TYP'. Type :listcol var=REC usage=OUT maxwidth=11 help='MLIST/REC'. Records :listcol var=SIZ usage=OUT maxwidth=16 help='MLIST/SIZ'. Size :listcol var=CRT usage=OUT maxwidth=19 help='MLIST/CRT'. Created :listcol var=CHG usage=OUT maxwidth=19 help='MLIST/CHG'. 'Last changed' :listcol var=TXT usage=OUT maxwidth=50 help='MLIST/TXT'. Text .*--------------------------------------------------------------------- .* Define the views in the list (toggle with F11) .*--------------------------------------------------------------------- :listview cols='OPT LIB MBR TYP REC SIZ'. :listview cols='OPT LIB MBR CRT CHG'. :listview cols='OPT LIB MBR TXT'. :elist. .*--------------------------------------------------------------------- .* include a command line that allows parameters for options .*--------------------------------------------------------------------- :cmdline size=SHORT.Parameters or command .*===================================================================== .* End of panel .*===================================================================== :epanel. .*===================================================================== .* Help for member list display .*===================================================================== :help name=MLIST. Work with Source Member - Help :p.The Work with Source Member panel displays the libraries and member names that were found by the Find Source Member (FNDSRCMBR) command. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/OPTIONS'. Options - Help :xh3.Options :ehelp. :help name='MLIST/OPT1'. :parml. :pt.1=Compare :pd. Compare a source member with an older member. :eparml. :ehelp. :help name='MLIST/OPT2'. :parml. :pt.2=Change :pd. Change a source member's attributes. :eparml. :ehelp. :help name='MLIST/OPT3'. :parml. :pt.3=Copy :pd. Copy a source member to a new member. :eparml. :ehelp. :help name='MLIST/OPT4'. :parml. :pt.4=Remove :pd. Remove (delete) a source member from its source file. :eparml. :ehelp. :help name='MLIST/OPT5'. :parml. :pt.5=Display :pd. Display the content of a source member. :eparml. :ehelp. :help name='MLIST/OPT7'. :parml. :pt.7=Rename :pd. Rename a source member to a new member name. :eparml. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/LIB'. Library - Help :xh3.Library :p.This is the library in which the source member was found. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/MBR'. Member - Help :xh3.Member :p.This is the name of the source member found. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/TYP'. Type - Help :xh3.Type :p.This is the associated member source type. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/REC'. Records - Help :xh3.Records :p.This is the number of records in the source member. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/SIZ'. Size - Help :xh3.Size :p.This is the size (in bytes) of the source member. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/CRT'. Created - Help :xh3.Created :p.This is the date and time the source member was created. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/CHG'. Changed - Help :xh3.Changed :p.This is the date and time the source member was last changed. :ehelp. .*--------------------------------------------------------------------- :help name='MLIST/TXT'. Text - Help :xh3.Text :p.This is the associated source member's text description. :ehelp. .*--------------------------------------------------------------------- :help name=KLIST. Function Keys - Help :xh3.Function keys :ehelp. :help name=HELP. :parml. :pt.F1=Help :pd. Provides additional information about using the display or a specific field on the display. :eparml. :ehelp. :help name=EXIT. :parml. :pt.F3=Exit :pd. Ends the current task and returns to the display from which the task was started. :eparml. :ehelp. :help name=PROMPT. :parml. :pt.F4=Prompt :pd. Provides assistance in typing additional parameter values for an option or in using a command. :eparml. :ehelp. :help name=REFRESH. :parml. :pt.F5=Refresh :pd. Shows the display you are viewing with updated information. :eparml. :ehelp. :help name=RETRIEVE. :parml. :pt.F9=Retrieve :pd. Displays the last command you entered on the command line and any parameters you included. The first time this key is pressed, it shows the last command you ran. The second time this key is pressed, it shows the command you ran before that -- and so on. :eparml. :ehelp. :help name=CHGVIEW. :parml. :pt.F11=Alternate view :pd. Switches to an alternate view of the display. :eparml. :ehelp. :help name=TOP. :parml. :pt.F17=Top of List :pd. Position to the first entry in the list. :eparml. :ehelp. :help name=BOTTOM. :parml. :pt.F18=End of List :pd. Position to the last entry in the list. :eparml. :ehelp. :help name=MOREKEYS. :parml. :pt.F24=More keys :pd. Shows additional function keys on the display. The function keys can be used even when they are not shown on the display. :eparml. :ehelp. :help name=ENTERKY. :parml. :pt.ENTER key :pd. Submits information on the display for processing. :eparml. :ehelp. :help name=HELPKY. :parml. :pt.HELP key :pd. Provides additional information about using the display or a specific field on the display. :eparml. :ehelp. :help name=PAGEDNKY. :parml. :pt.PageDown (RollUp) key :pd. Moves forward to show additional information for this display. Page Down (Roll Up) shows the next group of items until you reach the end of the information. :eparml. :ehelp. :help name=PAGEUPKY. :parml. :pt.PageUp (RollDown) key :pd. Moves backward to show additional information for this display. Page Up (Roll Down) shows the previous group of items until you reach the beginning of the information. :eparml. :ehelp. :help name=PRINTKY. :parml. :pt.PRINT key :pd. Prints information currently shown on the display. :eparml. :ehelp. .********************************************************************** .* Help for command FNDSRCMBR .********************************************************************** :help name='FNDSRCMBR'. Find Source Member - Help :p.The Find Source Member (FNDSRCMBR) command searches the specified libraries for matching source file and member names. The resulting list displays in a subfile for subsequent option processing. :ehelp. .******************************************* .* Help for parameter SRCMBR .******************************************* :help name='FNDSRCMBR/SRCMBR'. Source member (SRCMBR) - Help :xh3.Source member (SRCMBR) :p.This specifies the member name to search for in the specified source file(s). :p.This is a required parameter. :parml. :pt.:pv.name:epv. :pd. Specify the name of a specific source member to find. :pt.:pv.generic-name:epv. :pd. You may specify a generic source member name if you wish to find several members with the same prefix characters in their name. To qualify as a generic name, the value specified must end with an asterisk. :pt.:pv.*:epv. :pd. Use this special value to match on all members in a source file. :eparml. :ehelp. .******************************************* .* Help for parameter SRCFILE .******************************************* :help name='FNDSRCMBR/SRCFILE'. Source file (SRCFILE) - Help :xh3.Source file (SRCFILE) :p.This specifies the source files to search for the specified member name(s). :p.:hp2.Qualifier 1: Source file:ehp2. :parml. :pt.:pv.name:epv. :pd. Specify the name of a specific source physical file to be searched. The default is the QRPGLESRC file, but any source file name may be specified. :eparml. :p.:hp2.Qualifier 2: Library:ehp2. :parml. :pt.:pv.name:epv. :pd. Specify the name of the library to be searched. :pt.:pk def.*CURLIB:epk. :pd. The current library for the thread is searched. If no library is specified as the current library for the thread, the QGPL library is searched. This is the default. :pt.:pk.*ALL:epk. :pd. All libraries in the system, including QSYS, are searched. :pt.:pk.*ALLUSR:epk. :pd. All user libraries are searched. This includes all libraries with names that do not begin with the letter Q (with some exceptions). :pt.:pk.*USRLIBL:epk. :pd. The current library entry (if any) and the libraries in the user portion of the library list are searched. :eparml. :ehelp. :epnlgrp.
References
- RPG/ILE version of API Error Code Structure (ApiErrC)
- RPG/ILE version of Retrieve Database File Description (QDBRTVFD) API
- RPG/ILE version of UIM Open Display Application (QUIOPNDA) API
- RPG/ILE version of UIM Put Dialog Variable (QUIPUTV) API
- RPG/ILE version of UIM Get Dialog Variable (QUIGETV) API
- RPG/ILE version of UIM Add List Entry (QUIADDLE) API
- RPG/ILE version of UIM Delete List (QUIDLTL) API
- RPG/ILE version of UIM Display Panel (QUIDSPP) API
- RPG/ILE version of UIM Set List Attributes (QUISETLA) API