16. リスト検索を実現するには？
コマンドを表示したときに右端のコマンド・パラメータの説明に「リストは F4」という
説明が表示されて、F4キーを押してパラメータの候補を検索した経験がおありであると思う。
このリスト検索をユーザー・プログラムを使って動的に行うこともできる。
次の例となるコマンド OPNDTA は F4キーを押すとオブジェクトをユーザーで検索して候補を
リスト形式で表示させることができる。
【 コマンド・ソースOPNDTA 】
0001.00 CMD PROMPT(' オープン・データ ')
0002.00 PARM KWD(FILE) TYPE(FILE1) +
0003.00 PROMPT(' ファイル ')
0004.00 PARM KWD(MBR) TYPE(*NAME) LEN(10) DFT(*FIRST) +
0005.00 SPCVAL((*FIRST)) PROMPT(' メンバー ')
0006.00 FILE1: QUAL TYPE(*NAME) LEN(10) DFT(*SAME) +
0007.00 SPCVAL((*SAME)) CHOICE(*PGM) +
0008.00 CHOICEPGM(RDALIB/SELFILCL)
0009.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0010.00 SPCVAL((*LIBL)) PROMPT(' ライブラリー ')
0011.00 DFNEXC: PMTCTL CTL(FILE) COND((*EQ '*SAME '))
0012.00 PARM KWD(OPNDFN) TYPE(OPNDFN) PMTCTL(DFNEXC) +
0013.00 PROMPT('OPNDTA 定義 ')
0014.00 OPNDFN: QUAL TYPE(*NAME) LEN(10) DFT(*NONE) +
0015.00 SPCVAL((*NONE)) CHOICE(*PGM) +
0016.00 CHOICEPGM(RDALIB/SELOPNCL)
0017.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0018.00 SPCVAL((*LIBL) (*CURLIB)) +
0019.00 PROMPT(' ライブラリー ')
0020.00 PARM KWD(OPNTXT) TYPE(*CHAR) LEN(50) DFT(*BLANK) +
0021.00 PMTCTL(DFNEXC) +
0022.00 PROMPT(' テキスト '' 記述 ''')
0023.00 PARM KWD(OPNAUT) TYPE(*NAME) LEN(10) +
0024.00 DFT(*LIBCRTAUT) SPCVAL((*LIBCRTAUT) +
0025.00 (*CHANGE) (*ALL) (*EXCLUDE) (*USE)) +
0026.00 PMTCTL(DFNEXC) PROMPT(' 権限 ')
【 解説 】
注目して頂きたいのは
FILE1: QUAL TYPE(*NAME) LEN(10) DFT(*SAME) + 0007.00 SPCVAL((*SAME)) CHOICE(*PGM) + 0008.00 CHOICEPGM(RDALIB/SELFILCL)
の CHOICE(*PGM) CHOICEPGM(RDALIB/SELFILCL) 部分である。
これによって選択プログラムを指定している。
【 選択プログラム SELFILCL のCLPソース 】
0001.00 PGM PARM(&RCVCMD &SNDPRM)
0002.00 /*---------------------------------------------------------*/
0003.00 /* SELFIL : ファイル名の選択 ( CHOICEPGM ) */
0004.00 /*---------------------------------------------------------*/
0005.00 DCL VAR(&RCVCMD) TYPE(*CHAR) LEN(21)
0006.00 DCL VAR(&CMD) TYPE(*CHAR) LEN(10)
0007.00 DCL VAR(&KWD) TYPE(*CHAR) LEN(10)
0008.00 DCL VAR(&ACT) TYPE(*CHAR) LEN(1)
0009.00 DCL VAR(&SNDPRM) TYPE(*CHAR) LEN(2000)
0010.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(80)
0011.00 DCL VAR(&OBJECTLIB) TYPE(*CHAR) LEN(20)
0012.00 DCL VAR(&OBJECT) TYPE(*CHAR) LEN(10)
0013.00 DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
0014.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0015.00 DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4) /* 2 進数 */
0016.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */
0017.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) /* 2 進数 */
0018.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(4)
0019.00 DCL VAR(&PRMHED) TYPE(*CHAR) LEN(30)
0020.00 DCL VAR(&TOTAL) TYPE(*CHAR) LEN(2)
0021.00 DCL VAR(&PRM1992) TYPE(*CHAR) LEN(1992)
0022.00 DCL VAR(&LENGTH) TYPE(*DEC) LEN(8 0)
0023.00 DCL VAR(&USER) TYPE(*CHAR) LEN(10)
0024.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0025.00
0026.00 CHGVAR VAR(&CMD) VALUE(%SST(&RCVCMD 01 10))
0027.00 CHGVAR VAR(&KWD) VALUE(%SST(&RCVCMD 11 10))
0028.00 CHGVAR VAR(&ACT) VALUE(%SST(&RCVCMD 21 1))
0029.00 OVRMSGF MSGF(QCPFMSG) TOMSGF(RDALIB/RDAMSG)
0030.00 IF COND(&ACT *EQ 'C') THEN(DO)
0031.00 CHGVAR VAR(&SNDPRM) VALUE(' 名前 , *SAME, リストは F4')
0032.00 RETURN
0033.00 ENDC: ENDDO
0034.00 IF COND(&ACT *EQ 'P') THEN(DO)
0035.00 /* ************************************************ */
0036.00 /* *PRV ライブラリーの検索 */
0037.00 /* ************************************************ */
0038.00 RTVJOBA USER(&USER)
0039.00 RTVDTAARA DTAARA(QGPL/&USER (43 10)) RTNVAR(&OBJLIB)
0040.00
0041.00 CHGVAR VAR(&OBJECT) VALUE('*ALL ')
0042.00 /*-----------------------------------------------*/
0043.00 /* < 説 明 > */
0044.00 /* */
0045.00 /* オブジェクト : &OBJECT.&FILLIB の */
0046.00 /* 記述を検索する。 */
0047.00 /* */
0048.00 /*-----------------------------------------------*/
0049.00 CHGVAR VAR(%BIN(&APIERR)) VALUE(0)
0050.00 CHGVAR VAR(&OBJECTLIB) VALUE(&OBJECT *CAT &OBJLIB)
0051.00 /*( ﾏｰﾅﾞｰ､ﾇsﾟｰﾇ の作成 )*/
0052.00 CALL PGM(QUSCRTUS) PARM('QUSLOBJ QTEMP ' +
0053.00 'PF ' 1000 ' ' '*ALL ' +
0054.00 'QUSROBJD 用ユーザー空間 ' '*YES ' &APIERR)
0055.00 MONMSG CPF9870
0056.00
0057.00 /*( オブジェクト・リストＡＰＩ )*/
0058.00 CALL PGM(QUSLOBJ) PARM('QUSLOBJ QTEMP ' +
0059.00 'OBJL0200' &OBJECTLIB '*FILE ' &APIERR)
0060.00 /*( OPNDTA 選択 )*/
0061.00 CALL PGM(RDALIB/SELFIL) PARM(&RCVCMD &PRMHED +
0062.00 &LENGTH &PRM1992)
0063.00 CHGVAR VAR(%BIN(&TOTAL)) VALUE(&LENGTH)
0064.00 CHGVAR VAR(&SNDPRM) VALUE(&TOTAL *CAT &PRM1992)
0065.00 RETURN
0066.00 ENDP: ENDDO
0067.00 ERROR: RCVMSG RMV(*NO) MSG(&MSG)
0068.00 SNDMSG: SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0069.00 ENDPGM: ENDPGM
【 解説 】
このCLP は2つの機能がある。
ひとつはプロンプトの説明を表示することであり、もうひとつは F4キーによる検索を行うことである。
PGM PARM(&RCVCMD &SNDPRM)
の &RCVCMD の最初の一桁目が文字 ' C ' である場合は プロンプト説明 のために、このCLPが呼ばれたことを意味し、最初の一桁目が文字 ' P ' である場合は 検索要求 のために、このCLP が呼ばれたことを意味している。
文字 ' P ' の場合は 検索 のために API を利用してユーザー・スペースにオブジェクト・リストを出力してから RPG: SELFIL によってユーザー・スペースを検索して結果の文字ストリングを生成している。
以下に RPGソースを示す。
【 SELFIL RPGソース 】
0001.00 H Y/ 0002.00 F******** ファイルの選択 ( CHOICEPGM ) ************************** 0003.00 F* 0004.00 F***************************************************************** 0005.00 E HDR 1 1 30 見出し 0006.00 E PRM 52 36 返還 mﾞｰj 0007.00 E KJR 256 1 漢字補正 0008.00 IALEN DS 0009.00 I B 1 20ALLLEN 0010.00 IRCVPRM DS 0011.00 I 1 10 CMD 0012.00 I 11 20 KWD 0013.00 I 21 21 ACTCOD 0014.00 IKEYDTA DS 0015.00 I B 1 20KEYLEN 0016.00 I 3 12 KEYNAM 0017.00 I 13 36 KEYTXT 0018.00 IUSRSPC DS 0019.00 I 1 10 USNAME 0020.00 I 11 20 USLIB 0021.00 IRCVVAR DS 0022.00 I B 1 40OFFSET 0023.00 I B 9 120NOENTR 0024.00 I B 13 160LSTSIZ 0025.00 ISPCBIN DS 0026.00 I B 1 40LENDTA 0027.00 I B 5 80STRPOS 0028.00 I B 9 120LENOBJ 0029.00 I B 13 160NXTPOS 0030.00 I* ﾒﾇnmﾞｰj､ﾈhﾆｭ] ... eﾎﾞﾆﾞｩhn､ﾒﾇn API : QUSLOBJ.OBJL0200 0031.00 IRCVAR2 DS 0032.00 I 1 10 OBJNAM 0033.00 I 11 20 OBJLIB 0034.00 I 21 30 OBJTYP 0035.00 I 32 41 OBJATR 0036.00 I 42 91 OBJTXT 0037.00 I 92 101 OBJUSR 0038.00 +C*----------------------------------------------------+ 0039.00 C* 他の ﾎﾟﾜhﾞ[w からの CALL---ﾌﾟ[xｰjｰ の受取 * 0040.00 C*----------------------------------------------------+ 0041.00 C *ENTRY PLIST | 0042.00 C PARM PRM21 21 | 0043.00 C PARM PRMHED 30 | 0044.00 C PARM LENGTH 80 | 0045.00 C PARM PRM | 0046.00 C*----------------------------------------------------+ 0047.00 C MOVE PRM21 RCVPRM 0048.00 C ACTCOD IFEQ 'C' ACT=C 0049.00 C MOVE HDR,1 PRMHED 0050.00 C SETON LR 0051.00 C END ACT=C 0052.00 C* 0053.00 C ACTCOD IFEQ 'P' ACT=P 0054.00 C EXSR READ 0055.00 C Z-ADDM LENGTH 0056.00 C END ACT=P 0057.00 C RETRN 0058.00 C END TAG 0059.00 C****************************************************** 0060.00 C *INZSR BEGSR 0061.00 C****************************************************** 0062.00 CSR Z-ADD34 KEYLEN 0063.00 CSR MOVEL'PF-DTA 'PF 10 0064.00 CSR MOVEL'PF 'PFAS 10 0065.00 CSR MOVEL'PF-38DTA'PF38 10 0066.00 CSR MOVEL'LF 'LF 10 0067.00 CSR MOVEL'OPNDFN 'CMPUSR 10 0068.00 CSR INZEND ENDSR 0069.00 C****************************************************** 0070.00 C READ BEGSR 0071.00 C****************************************************** 0072.00 +C* ( ﾏｰﾅﾞｰ､ﾇsﾟｰﾇ : QUSLOBJ の読み取り ) 0073.00 C* ﾎｧｰﾓnﾞ の ﾒﾇn API : QUSLOBJ によって作成された 0074.00 C* ﾏｰﾅﾞｰ 空間 : QUSLOBJ.QTEMP を検索する。 0075.00 CSR MOVEL'QUSLOBJ 'USNAME 0076.00 CSR MOVEL'QTEMP 'USLIB 0077.00 CSR PRM21 IFNE PRM21B PRM21<>PRM21 0078.00 CSR PRM21 OREQ PRM21 0079.00 CSR CONT ANDEQ' ' 0080.00 CSR MOVE PRM21 PRM21B 21 0081.00 CSR MOVE ' ' CONT 1 続く ... 0082.00 C* 1. ﾒﾇnmﾞｰjﾈhﾆｭ] の eﾎﾈｮn 値を検索 0083.00 CSR Z-ADD125 STRPOS 0084.00 CSR Z-ADD16 LENDTA 0085.00 C*----------------------------------------------------+ 0086.00 C CALL 'QUSRTVUS' | 0087.00 C PARM USRSPC | 0088.00 C PARM STRPOS | 0089.00 C PARM LENDTA | 0090.00 C PARM RCVVAR | 0091.00 C*----------------------------------------------------+ 0092.00 C* DS:RCVVAR によって OFFSET,LSTSIZ を受取った 0093.00 CSR Z-ADDOFFSET STRPOS 0094.00 CSR ADD 1 STRPOS 0095.00 CSR Z-ADDLSTSIZ LENDTA 0096.00 CSR ELSE PRM21<>PRM21 0097.00 CSR Z-ADDNXTPOS STRPOS 0098.00 CSR Z-ADD0 M 40 0099.00 CSR END PRM21<>PRM21 0100.00 C*( ユーザースペースの読み取り ) 0101.00 CSR 1 DO NOENTR N 40 N=1-NOENTR 0102.00 C*----------------------------------------------------+ 0103.00 C CALL 'QUSRTVUS' | 0104.00 C PARM USRSPC | 0105.00 C PARM STRPOS | 0106.00 C PARM LENDTA | 0107.00 C PARM RCVAR2 | 0108.00 C*----------------------------------------------------+ 0109.00 CSR OBJATR IFEQ PF OBJATR 0110.00 CSR OBJUSR ANDNECMPUSR 0111.00 CSR OBJATR OREQ PFAS 0112.00 CSR OBJUSR ANDNECMPUSR 0113.00 CSR OBJATR OREQ LF 0114.00 CSR OBJUSR ANDNECMPUSR 0115.00 CSR OBJATR OREQ PF38 0116.00 CSR OBJUSR ANDNECMPUSR 0117.00 CSR M IFLT 52 M<52 0118.00 CSR ADD 1 M 0119.00 CSR MOVELOBJNAM KEYNAM 0120.00 CSR MOVELOBJTXT KEYTXT 0121.00 +CSR MOVEAKEYTXT KJR 補正 ﾎｧｰﾓn 0122.00 CSR Z-ADD24 KJLEN 30 ﾎｧｰﾓnﾞ 長 0123.00 CSR EXSR KANJI 漢字補正 0124.00 CSR MOVEAKJR KEYTXT 0125.00 CSR MOVELKEYDTA PRM,M 0126.00 CSR ELSE M<52 0127.00 CSR MOVE '*' CONT 1 続く ... 0128.00 CSR Z-ADDSTRPOS NXTPOS 0129.00 CSR GOTO REDEND 0130.00 CSR END M<52 0131.00 CSR END OBJATR 0132.00 C* 0133.00 C* - - - - - - - - - - - - - - - - - - - 0134.00 CSR ADD LENDTA STRPOS 0135.00 CSR END N=1-NOENTR 0136.00 CSR MOVE ' ' CONT 1 続く ... 0137.00 CSR SETON LR 0138.00 CSR REDEND ENDSR 0139.00 C****************************************************** 0140.00 C KANJI BEGSR 0141.00 C****************************************************** 0142.00 C*( 漢字補正 ﾅﾎﾞ､ﾓｰk] ) 0143.00 CSR Z-ADDKJLEN KL 30 0144.00 CSR KL SUB 1 KM 30 0145.00 CSR KL ADD 1 KU 30 0146.00 CSR MOVEA*BLANKS KJR,KU 0147.00 C* 漢字 ﾎｧｰﾓnﾞ の O/E O/F の欠落を補正する。 0148.00 CSR MOVE ' ' OEOF 2 0149.00 CSR MOVELOEOF OE 1 0150.00 CSR MOVE OEOF OF 1 0151.00 CSR Z-ADD1 KJ 20 0152.00 CSR NXTKJ TAG 0153.00 CSR OE LOKUPKJR,KJ 50 0154.00 CSRN50 GOTO KJ0END 0155.00 CSR Z-ADDKJ KJE 20 0156.00 CSR KJE IFEQ KL 0157.00 CSR MOVE *BLANKS KJR,KL 0158.00 CSR GOTO KJ0END 0159.00 CSR END 0160.00 C* 0161.00 CSR KJE IFLT KJLEN KJE < 30 0162.00 CSR ADD 1 KJ 0163.00 CSR OF LOKUPKJR,KJ 50 0164.00 CSR 50 KJ CABEQKJLEN KJ0END 0165.00 CSR 50 ADD 1 KJ 0166.00 CSR 50 GOTO NXTKJ 0167.00 CSR END KJE < 30 0168.00 C*( OE に対応する OF がなかった ) 0169.00 CSR ADD KL KJE 0170.00 CSR KJE DIV 2 KJA 20 0171.00 CSR MVR KJB 20 0172.00 C* KJB=0:OE は偶数桁にある 0173.00 C* KJB=1:OE は奇数桁にある 0174.00 CSR KJB IFEQ *ZEROS KJB=0 0175.00 CSR MOVE OF KJR,KM 0176.00 CSR MOVE ' ' KJR,KL 0177.00 CSR ELSE KJB=0 0178.00 CSR MOVE OF KJR,KL 0179.00 CSR END KJB=0 0180.00 CSR KJ0END ENDSR 0181.00 ** HDR 0182.00 OPNDTA 定義のリスト
