RPG からの CL コマンドの実行 (プロンプト/ヘルプ/構文チェック)

RPG から CL コマンドの実行 (system() 関数を使って)」や「RPG でのエラー処理 (QCMDEXC)」で RPG から CL コマンドを実行する方法を紹介してきましたが、今回またもうひとつ追加です。

QCMDEXC は S/38 の頃、というか CPF/RPG III の QCAEXEC をそのまま OS/400 にもってきただけのものなので、かなり機能の限定されたシンプルなAPI になっています。

今回は QCAPCMD という API を紹介してみたいと思います。


CL コマンドの実行

まず、「RPG でのエラー処理 (QCMDEXC)」をほぼそのまま置き換えたものが↓になります。これだけだと、まぁただの好き嫌いの問題とも言えますね。パラメータが多い分、面倒だ、という意見があるかもしれません。

     H DFTACTGRP(*NO)                                                                               
      *                                                                                             
     D EXECCL          PR                  EXTPGM('QCAPCMD')                                        
     D  cmdString                 32702    options(*varsize)                                        
     D                                     const                                                    
     D  cmdLen                       10i 0 const                                                    
     D  ctlblk                             likeds(CPOP0100)                                         
     D  ctlblklen                    10i 0 const                                                    
     D  ctlblkname                    8    const                                                    
     D  changedcmd                 1000    const                                                    
     D  chgcmdavl                    10i 0 const                                                    
     D  chgcmdlen                    10i 0 const                                                    
     D  error                              like(qusec)                                              
      *                                                                                             
      /copy qsysinc/qrpglesrc,qusec                                                                 
      *                                                                                             
     D CPOP0100        DS                                                                           
     D  type                         10i 0 inz(0)                                                   
     D  DBCS                          1a   inz('1')                                                 
     D  prompt                        1a   inz('0')                                                 
     D  syntax                        1a   inz('0')                                                 
     D  msgkey                        4a   inz(*blanks)                                             
     D  CCSID                        10i 0 inz(0)                                                   
     D  reserved                      5a   inz(x'0000000000')                                       
      *                                                                                             
     D CLRPFM          S             21a   INZ('CLRPFM FILE(QCHKACTJ)')                             
      *                                                                                             
      /Free                                                                                         
                                                                                                    
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    *blanks:                                                                        
                    0:                                                                              
                    0:                                                                              
                    qusec);                                                                         
                                                                                                    
             if (QUSBAVL <> 0);                                                                     
               if (QUSEI <> *BLANKS);                                                               
                select ;                                                                            
                when (QUSEI = 'CPF3142');                                                           
                  dsply 'NOT EXIST';                                                                
                when (QUSEI = 'CPF3156');                                                           
                  dsply 'IN USE';                                                                   
                other;                                                                              
                  dsply ('error ' + QUSEI);                                                         
                endsl;                                                                              
                endif;                                                                              
              endif;                                                                                
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free

この QCAPCMD という API は QCMDEXC にくらべていろんな機能が拡張されています。パラメータが多い、ということはそれだけいろんなことができる、ということでもあります。
将来のプログラムの拡張/機能追加を考えると、どうせ同じことができるのだったら QCMDEXC ではなくこちらを使っておいた方がいい、という考え方もあると思います。

ちなみにインフォメーションセンターに (V6R1 でも) 以下のように実行できるコマンドストリングの長さは 1〜 32702 の間となっています。

Length of source command string
INPUT; BINARY(4)

The length of the source command string. Valid values are between 1 and 32 702.

http://publib.boulder.ibm.com/infocenter/iseries/v6r1m0/topic/apis/qcapcmd.htm

プロンプトの表示

CPOP0100 の prompt を '1' にすると強制的にプロンプトが表示されるようになります。

             prompt = '1';                                                                          
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);

いったん指定コマンドのプロンプト画面 (F4 を押した画面ですね) が表示されるので、そこで変更を行えば QCAPCMD の出力用パラメータである changed command string と Length of changed command string available to return に変更後のコマンドとそのサイズが入ってきます。すぐ上のコーディング例ですと、changedcmd と changedcmdlen ですね。lastcmdavl は変更後のコマンド文字列を格納するためにとっておくバッファのサイズをあらかじめ指定しておくための入力用のパラメータです。
参考までに一番最初のコーディング例を見てみてください。プロンプトなどはしない仕様なので変更後のコマンドに関する入力/出力パラメータ用の変数も確保せず、すべて内容をブランクもしくはゼロに設定しています。

             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    *blanks:                                                                        
                    0:                                                                              
                    0:                                                                              
                    qusec);
     H DFTACTGRP(*NO)                                                                               
      *                                                                                             
     D EXECCL          PR                  EXTPGM('QCAPCMD')                                        
     D  cmdString                 32702    options(*varsize)                                        
     D                                     const                                                    
     D  cmdLen                       10i 0 const                                                    
     D  ctlblk                             likeds(CPOP0100)                                         
     D  ctlblklen                    10i 0 const                                                    
     D  ctlblkname                    8    const                                                    
     D  changedcmd                 1000    options(*varsize)                                        
     D  chgcmdavl                    10i 0 const                                                    
     D  chgcmdlen                    10i 0 const                                                    
     D  error                              like(qusec)                                              
      *                                                                                             
      /copy qsysinc/qrpglesrc,qusec                                                                 
      *                                                                                             
     D CPOP0100        DS                  qualified                                                
     D  type                         10i 0 inz(0)                                                   
     D  DBCS                          1a   inz('1')                                                 
     D  prompt                        1a   inz('0')                                                 
     D  syntax                        1a   inz('0')                                                 
     D  msgkey                        4a   inz(*blanks)                                             
     D  CCSID                        10i 0 inz(0)                                                   
     D  reserved                      5a   inz(x'0000000000')                                       
      *                                                                                             
     D CLRPFM          S             21a   INZ('CLRPFM FILE(QCHKACTJ)')                             
     D lastcmd         S           1000                                                             
     D lastcmdavl      S             10i 0 inz(1024)                                                
     D lastcmdlen      S             10i 0                                                          
      *                                                                                             
      /Free                                                                                         
                                                                                                    
             CPOP0100.prompt = '1';                                                                 
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);                                                                         
                                                                                                    
             CLRPFM = %trimR(lastcmd);                                                              
             CPOP0100.prompt = '0';                                                                 
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);                                                                         
                                                                                                    
             if (QUSBAVL <> 0);                                                                     
               if (QUSEI <> *BLANKS);                                                               
                select ;                                                                            
                when (QUSEI = 'CPF3142');                                                           
                  dsply 'NOT EXIST';                                                                
                when (QUSEI = 'CPF3156');                                                           
                  dsply 'IN USE';                                                                   
                other;                                                                              
                  dsply ('error ' + QUSEI);                                                         
                endsl;                                                                              
                endif;                                                                              
              endif;                                                                                
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free

ヘルプの表示

かなりくどくなってしまいますが、prompt を '3' にセットすると指定されたコマンドのヘルプを表示させることができます。

     H DFTACTGRP(*NO)                                                                               
      *                                                                                             
     D EXECCL          PR                  EXTPGM('QCAPCMD')                                        
     D  cmdString                 32702    options(*varsize)                                        
     D                                     const                                                    
     D  cmdLen                       10i 0 const                                                    
     D  ctlblk                             likeds(CPOP0100)                                         
     D  ctlblklen                    10i 0 const                                                    
     D  ctlblkname                    8    const                                                    
     D  changedcmd                 1000    options(*varsize)                                        
     D  chgcmdavl                    10i 0 const                                                    
     D  chgcmdlen                    10i 0 const                                                    
     D  error                              like(qusec)                                              
      *                                                                                             
      /copy qsysinc/qrpglesrc,qusec                                                                 
      *                                                                                             
     D CPOP0100        DS                  qualified                                                
     D  type                         10i 0 inz(0)                                                   
     D  DBCS                          1a   inz('1')                                                 
     D  prompt                        1a   inz('0')                                                 
     D  syntax                        1a   inz('0')                                                 
     D  msgkey                        4a   inz(*blanks)                                             
     D  CCSID                        10i 0 inz(0)                                                   
     D  reserved                      5a   inz(x'0000000000')                                       
      *                                                                                             
     D CLRPFM          S             21a   INZ('CLRPFM FILE(QCHKACTJ)')                             
     D lastcmd         S           1000                                                             
     D lastcmdavl      S             10i 0 inz(1024)                                                
     D lastcmdlen      S             10i 0                                                          
      *                                                                                             
      /Free                                                                                         
             CPOP0100.prompt = '3';                                                                 
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);                                                                         
                                                                                                    
                                                                                                    
             CPOP0100.prompt = '1';                                                                 
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);                                                                         
                                                                                                    
             CLRPFM = %trimR(lastcmd);                                                              
             CPOP0100.prompt = '0';                                                                 
             EXECCL(CLRPFM :                                                                        
                    %len(CLRPFM):                                                                   
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);                                                                         
                                                                                                    
             if (QUSBAVL <> 0);                                                                     
               if (QUSEI <> *BLANKS);                                                               
                select ;                                                                            
                when (QUSEI = 'CPF3142');                                                           
                  dsply 'NOT EXIST';                                                                
                when (QUSEI = 'CPF3156');                                                           
                  dsply 'IN USE';                                                                   
                other;                                                                              
                  dsply ('error ' + QUSEI);                                                         
                endsl;                                                                              
                endif;                                                                              
              endif;                                                                                
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free

構文チェックのみの実行

CPOP0100 の type を 1 に変更すると構文チェックのみで終了します。

上のような例ではあまりに人工的すぎるので、パラメータとしてコマンドが渡され、その構文チェックを行うような想定でプログラムを書いてみました。

CHKCMDSYN というプログラムになっています。入力パラメータとしてコマンド文字列とその長さをとるようにしています。
コマンドというものには、ブランクに有意味なものがあったりするので %trim などでトリミングすることができません。コマンドをあつかう API には必ずコマンドの文字列とともにその長さを渡すようになっていますが、やはりいろいろやってみた結果必要なようです。

     D CHKCMDSYN       PR                                                                           
     D  pcmdstr                    1000a   const                                                    
     D  pcmdstrlen                   15p 5 const

QCAPCMD からのエラーメッセージでは、最終的に CPF0001 という「コマンドそのものが正しくない」というメッセージ ID にほとんどなってしまうので、どういう問題があって構文チェックを通らなかったのかがわかりません。
CPF0001 の手前の診断メッセージをチェックするためには QMHRCVPM という API を使用して診断メッセージを取得する必要があります。PGMQ を指定した RCVMSG コマンドと同等な機能を実行させるための API になります。

     D RCVPGMMSG       PR                  ExtPgm('QMHRCVPM')                                       
     D   MsgInfo                  32767A   options(*varsize)                                        
     D   MsgInfoLen                  10I 0 const                                                    
     D   Format                       8A   const                                                    
     D   StackEntry                  10A   const                                                    
     D   StackCount                  10I 0 const                                                    
     D   MsgType                     10A   const                                                    
     D   MsgKey                       4A   const                                                    
     D   WaitTime                    10I 0 const                                                    
     D   MsgAction                   10A   const                                                    
     D   ErrCode                           like(APIErr)                                             
      *                                                                                             
     D RCVM0100        DS                  qualified                                                
     D   BytesRtn                    10I 0                                                          
     D   BytesAvail                  10I 0                                                          
     D   MsgSev                      10I 0                                                          
     D   MsgID                        7A                                                            
     D   MsgType                      2A                                                            
     D   MsgKey                       4A                                                            
     D                                7A                                                            
     D   CCSID_status                10I 0                                                          
     D   CCSID                       10I 0                                                          
     D   MsgDtaLen                   10I 0                                                          
     D   MsgDtaAvail                 10I 0                                                          
     D   MsgDta                    8000A                                                            
      *                                                                                             
     D APIErr          DS                  Qualified                                                
     D  ErrSize                      10i 0 inz(%size(APIErr))                                       
     D  ErrLen                       10i 0 inz(0)                                                   
     D  ErrID                         7a                                                            
     D  rsvd                          1a                                                            
     D  ErrData                   32767a                                                            
      *                                                                                             
      /Free                                                                                         
                  RCVPGMMSG(RCVM0100 :                                                              
                            %size(RCVM0100) :                                                       
                            'RCVM0100' :                                                            
                            '*' :                                                                   
                            0 :                                                                     
                            '*DIAG' :                                                               
                            RCVM0100.msgkey :                                                       
                            3600 :                                                                  
                            '*SAME' :                                                               
                            APIErr) ;
      /End-Free
     H DFTACTGRP(*NO)                                                                               
      *                                                                                             
     D CHKCMDSYN       PR                                                                           
     D  pcmdstr                    1000a   const                                                    
     D  pcmdstrlen                   15p 5 const                                                    
      *                                                                                             
     D CHKCMDSYN       PI                                                                           
     D  pcmdstr                    1000a   const                                                    
     D  pcmdstrlen                   15p 5 const                                                    
      *                                                                                             
     D EXECCL          PR                  EXTPGM('QCAPCMD')                                        
     D  cmdString                 32702    options(*varsize) const                                  
     D  cmdLen                       10i 0 const                                                    
     D  ctlblk                             likeds(CPOP0100)                                         
     D  ctlblklen                    10i 0 const                                                    
     D  ctlblkname                    8    const                                                    
     D  changedcmd                 1000    options(*varsize)                                        
     D  chgcmdavl                    10i 0 const                                                    
     D  chgcmdlen                    10i 0 const                                                    
     D  error                              like(qusec)                                              
      *                                                                                             
     D RCVPGMMSG       PR                  ExtPgm('QMHRCVPM')                                       
     D   MsgInfo                  32767A   options(*varsize)                                        
     D   MsgInfoLen                  10I 0 const                                                    
     D   Format                       8A   const                                                    
     D   StackEntry                  10A   const                                                    
     D   StackCount                  10I 0 const                                                    
     D   MsgType                     10A   const                                                    
     D   MsgKey                       4A   const                                                    
     D   WaitTime                    10I 0 const                                                    
     D   MsgAction                   10A   const                                                    
     D   ErrCode                           like(APIErr)                                             
      *                                                                                             
     D RCVM0100        DS                  qualified                                                
     D   BytesRtn                    10I 0                                                          
     D   BytesAvail                  10I 0                                                          
     D   MsgSev                      10I 0                                                          
     D   MsgID                        7A                                                            
     D   MsgType                      2A                                                            
     D   MsgKey                       4A                                                            
     D                                7A                                                            
     D   CCSID_status                10I 0                                                          
     D   CCSID                       10I 0                                                          
     D   MsgDtaLen                   10I 0                                                          
     D   MsgDtaAvail                 10I 0                                                          
     D   MsgDta                    8000A                                                            
      *                                                                                             
     D APIErr          DS                  Qualified                                                
     D  ErrSize                      10i 0 inz(%size(APIErr))                                       
     D  ErrLen                       10i 0 inz(0)                                                   
     D  ErrID                         7a                                                            
     D  rsvd                          1a                                                            
     D  ErrData                   32767a                                                            
      *                                                                                             
      /copy qsysinc/qrpglesrc,qusec                                                                 
      *                                                                                             
     D CPOP0100        DS                  qualified                                                
     D  type                         10i 0 inz(1)                                                   
     D  DBCS                          1a   inz('1')                                                 
     D  prompt                        1a   inz('0')                                                 
     D  syntax                        1a   inz('0')                                                 
     D  msgkey                        4a   inz(*blanks)                                             
     D  CCSID                        10i 0 inz(0)                                                   
     D  reserved                      5a   inz(x'0000000000')                                       
      *                                                                                             
     D cmdstr          S           1000    varying inz(*blanks)                                     
     D lastcmd         S           1000                                                             
     D lastcmdavl      S             10i 0 inz(1024)                                                
     D lastcmdlen      S             10i 0                                                          
      *                                                                                             
      /Free                                                                                         
                                                                                                    
             CPOP0100.type = 1;                                                                     
             cmdstr = %subst(pcmdstr : 1 : %int(pcmdstrlen)) ;                                      
             EXECCL(cmdstr :                                                                        
                    %len(cmdstr) :                                                                  
                    CPOP0100:                                                                       
                    %len(CPOP0100):                                                                 
                    'CPOP0100':                                                                     
                    lastcmd:                                                                        
                    lastcmdavl:                                                                     
                    lastcmdlen:                                                                     
                    qusec);                                                                         
                                                                                                    
             if (QUSBAVL <> 0);                                                                     
               if (QUSEI <> *BLANKS);                                                               
                select ;                                                                            
                when (QUSEI = 'CPF0001');                                                           
                  RCVPGMMSG(RCVM0100 :                                                              
                            %size(RCVM0100) :                                                       
                            'RCVM0100' :                                                            
                            '*' :                                                                   
                            0 :                                                                     
                            '*DIAG' :                                                               
                            RCVM0100.msgkey :                                                       
                            3600 :                                                                  
                            '*SAME' :                                                               
                            APIErr) ;                                                               
                  dsply ('error ' + RCVM0100.MSGID);                                                
                other;                                                                              
                  dsply ('error ' + QUSEI);                                                         
                endsl;                                                                              
                endif;                                                                              
              endif;                                                                                
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free

たとえば、こんなふうな CL プログラムを使ってテストします。

             CALL       PGM(APITEST/CHKCMDSYN) PARM('DSPFD fila(aaa)' 15)
             CALL       PGM(APITEST/CHKCMDSYN) PARM('DSPFD FILE(A) OUTPUT(*OUTFILE)' 30)

それぞれを実行してみると、原因となっているメッセージ ID を表示しているのが確認できます。

その他

使う人がいるかどうかわかりませんが、CPOP0100 の syntax を '1' にすると S/38 コマンドでの構文チェック/実行を行うようにできますよ。

[Top Pageに戻る]

Ads by TOK2