コマンド

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 /*( オブジェクト・リストAPI )*/                                      
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</span class=”code”> によってユーザー・スペースを検索して結果の文字ストリングを生成している。

以下に 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 定義のリスト