System API の使用例 - CL から RPG への書き直し -

活動ジョブの検査」を、まったく同じフローのままで CL から ILE RPG に書き換えてみました。元々書いた人のロジックを尊重してそのままにしてあります。

CL の場合、メニューを駆動するため、またコマンドを組み合わせたユーティリティを簡便に作るため、というのがもともとの用途であり、高度なプログラミングのためには RPG や COBOL があるでしょう、というのが設計意図のように思います。
S/38、AS/400 を使うであろう、本職がコンピュータの専門家、プログラマーなどではない人たちのために、プログラミング言語としては思い切って最小限の仕様になっています。たとえば、データ型は文字と数字のみ、フロー制御は GOTO のみ、といったところですね。

それゆえにわかりやすく、OS/400 初心者はまず CL プログラミングから、といった学習の仕方もできてきたような気もするのですが、かつてのような簡単なメニューや簡単なユーティリティの作成すらも、それこそ System API などを使ってもそうなのですが、いろんな工夫をしないと対処できないようになってきています。
たとえば、このプログラムの中にもありますが、データ変換のための CHGVAR や、ループ構造の実現のための GOTO、などですね。

こうしたいわばプログラムの本筋に関係ない "CHGVAR" や、もはやプログラムを書くような人にはより自然な FOR や DO に代わっての "GOTO" によって、かえって読みにくいプログラムになってしまっているように感じます。

こちらで紹介しているように、最近の RPG の進化はめざましく、より洗練されたプログラミング言語になってきています。
ある意味、今まで CL にあった親しみやすさやとっつきやすさが RPG にも取り入れられてきた、といった感じでしょうか。

と、いうことで RPG に書き換えてみた次第です。
ユーザースペースの扱いには「System API プログラミングの基礎 (3) - ユーザースペース使用用の汎用プロシージャの作成 -」で紹介した CrtUsrspcP プロシージャを利用しています。

こちらが元の CL プログラムになります。

             PGM        PARM(&PARM1 &STS)                                       
             DCL        VAR(&FILE) TYPE(*CHAR) LEN(10)                           
             DCL        VAR(&PARM1) TYPE(*CHAR) LEN(26)                         
             DCL        VAR(&JOBPARM) TYPE(*CHAR) LEN(26)                       
             DCL        VAR(&JOB) TYPE(*CHAR) LEN(10)                           
             DCL        VAR(&USR) TYPE(*CHAR) LEN(10)                           
             DCL        VAR(&NBR) TYPE(*CHAR) LEN(6)                             
             DCL        VAR(&STS) TYPE(*CHAR) LEN(10)                           
             DCL        VAR(&OBJ) TYPE(*CHAR) LEN(10)                           
             DCL        VAR(&USRSPC) TYPE(*CHAR) LEN(20) +                       
                          VALUE('CHKACTJOB QTEMP     ')                         
             DCL        VAR(&JOBNAME) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&USRNAME) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&JOBNBR) TYPE(*CHAR) LEN(6)                         
             DCL        VAR(&JOBSTS) TYPE(*CHAR) LEN(10)                         
             DCL        VAR(&LSTJOBE) TYPE(*CHAR) LEN(52)                       
             DCL        VAR(&BIN4) TYPE(*CHAR) LEN(4)                           
             DCL        VAR(&ENTRY) TYPE(*DEC) LEN(8 0)                         
             DCL        VAR(&STR) TYPE(*DEC) LEN(8 0)                           
             DCL        VAR(&OFFSET) TYPE(*DEC) LEN(8 0)                         
             DCL        VAR(&OFFSETB) TYPE(*CHAR) LEN(4)                         
             DCL        VAR(&ENTLEN) TYPE(*DEC) LEN(8 0)                         
             DCL        VAR(&ENTLENB) TYPE(*CHAR) LEN(4)                         
             CHGVAR     VAR(&JOB) VALUE(%SST(&PARM1 1 10))                       
             CHGVAR     VAR(&USR) VALUE(%SST(&PARM1 11 10))                     
             CHGVAR     VAR(&NBR) VALUE(%SST(&PARM1 21 6))                       
             IF         COND(&JOB = '          ') THEN(CHGVAR +                 
                          VAR(&JOB) VALUE('*ALL     '))                         
             IF         COND(&USR = '          ') THEN(CHGVAR +                 
                          VAR(&USR) VALUE('*ALL     '))                         
             IF         COND(&NBR = '      ') THEN(CHGVAR VAR(&NBR) +           
                          VALUE('*ALL  '))                                       
             IF         COND(&STS = '          ') THEN(CHGVAR +                 
                          VAR(&STS) VALUE('*ALL     '))                         
             CHGVAR     VAR(&OBJ) VALUE(%SST(&USRSPC 1 10))                     
             DLTUSRSPC  USRSPC(QTEMP/&OBJ)                                       
             MONMSG     MSGID(CPF0000)                                           
             CLRPFM     FILE(QCHKACTJ)                                           
             CALL       PGM(QUSCRTUS) PARM(&USRSPC 'CHKACTJOB ' +               
                          X'00000100' ' ' '*ALL      ' 'CHKACTJOB +             
                          TEMPORARY USER SPACE')                                 
             CHGVAR     VAR(%SST(&JOBPARM 1 10)) VALUE(&JOB)                     
             CHGVAR     VAR(%SST(&JOBPARM 11 10)) VALUE(&USR)                   
             CHGVAR     VAR(%SST(&JOBPARM 21 6)) VALUE(&NBR)                     
             CALL       PGM(QUSLJOB) PARM(&USRSPC 'JOBL0100' +                   
                          &JOBPARM &STS)                                         
             CALL       PGM(QUSRTVUS) PARM(&USRSPC X'00000085' +                 
                          X'00000004' &BIN4)                                     
             CHGVAR     VAR(&ENTRY) VALUE(%BIN(&BIN4))                           
             IF         COND(&ENTRY = 0) THEN(GOTO CMDLBL(NOJOB))               
             CALL       PGM(QUSRTVUS) PARM(&USRSPC X'00000089' +                 
                          X'00000004' &ENTLENB)                                 
             CHGVAR     VAR(&ENTLEN) VALUE(%BIN(&ENTLENB))                       
             CALL       PGM(QUSRTVUS) PARM(&USRSPC X'0000007D' +                 
                          X'00000004' &OFFSETB)                                 
             CHGVAR     VAR(&OFFSET) VALUE(%BIN(&OFFSETB))                       
             CHGVAR     VAR(&STR) VALUE(&OFFSET + 1)                             
 DO:         CHGVAR     VAR(%BIN(&BIN4)) VALUE(&STR)                             
             CALL       PGM(QUSRTVUS) PARM(&USRSPC &BIN4 &ENTLENB +             
                          &LSTJOBE)                                             
             CHGVAR     VAR(&JOBNAME) VALUE(%SST(&LSTJOBE 1 10))                 
             CHGVAR     VAR(&USRNAME) VALUE(%SST(&LSTJOBE 11 10))               
             CHGVAR     VAR(&JOBNBR) VALUE(%SST(&LSTJOBE 21 6))                 
             CHGVAR     VAR(&JOBSTS) VALUE(%SST(&LSTJOBE 43 10))                 
             CHGVAR     VAR(&FILE) VALUE('QCHKACTJ')                             
       /*    CALL       PGM(WRITEFILE) PARM(&JOBNAME &USRNAME +                 
                          &JOBNBR &JOBSTS)                        */             
             CALLPRC    PRC(WRITEFILE) PARM(&JOBNAME &USRNAME +                 
                          &JOBNBR &JOBSTS)                                       
             CHGVAR     VAR(&STR) VALUE(&STR + &ENTLEN)                         
             CHGVAR     VAR(&ENTRY) VALUE(&ENTRY - 1)                           
             IF         COND(&ENTRY = 0) THEN(GOTO CMDLBL(NOJOB))               
             GOTO       CMDLBL(DO)                                               
 NOJOB:      ENDPGM

ポイント

ユーザースペースの利用

ユーザースペースを作成し、開始位置のポインタを取得します。
そしてそのポインタを、取得したい情報をすべて列記したデータ・ストラクチャの起点として指定します。これだけで、起点となるポインタを取得すると同時に、データ・ストラクチャ名.サブフィールド名ですぐに値にアクセスすることができます。

     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *  
      * CrtUsrspcP の戻り値
     D  usPtr          S               *                                                            
      *                                                                                             
      * CrtUsrspcP の戻り値ポインタを起点にするデータ・ストラクチャ
     D GenericHeader   DS                  Qualified Based(usPtr)                                   
     D  userarea                     64a                                                            
     D  size                         10i 0                                                          
     D  releaselevel                  4                                                             
     D  formatname                    8                                                             
     D  APIused                      10                                                             
     D  DateCreated                  13                                                             
     D  InforSts                      1                                                             
     D  sizeUsed                     10i 0                                                          
     D  offsetInput                  10i 0                                                          
     D  sizeInput                    10i 0                                                          
     D  offsetHeader                 10i 0                                                          
     D  sizeHeader                   10i 0                                                          
     D  offsetList                   10i 0                                                          
     D  sizeList                     10i 0                                                          
     D  numberList                   10i 0                                                          
     D  sizeEntry                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  cntryID                       2                                                             
     D  langID                        3                                                             
     D  subsetInd                     1                                                             
     D  rsvd                         42      

GenericHeader データ・ストラクチャの内容は、インフォメーション・センターにある↓をそのまま定義したものになります。

Generic header format 0100

Offset Type Field
Dec Hex
0 0 CHAR(64) User area
64 40 BINARY(4) Size of generic header
68 44 CHAR(4) Structure's release and level
72 48 CHAR(8) Format name
80 50 CHAR(10) API used
90 5A CHAR(13) Date and time created
103 67 CHAR(1) Information status
104 68 BINARY(4) Size of user space used
108 6C BINARY(4) Offset to input parameter section
112 70 BINARY(4) Size of input parameter section
116 74 BINARY(4) Offset to header section
120 78 BINARY(4) Size of header section
124 7C BINARY(4) Offset to list data section
128 80 BINARY(4) Size of list data section
132 84 BINARY(4) Number of list entries
136 88 BINARY(4) Size of each entry
140 8C BINARY(4) CCSID of data in the list entries
144 90 CHAR(2) Country or region ID
146 92 CHAR(3) Language ID
149 95 CHAR(1) Subsetted list indicator
150 96 CHAR(42) Reserved

リスト情報へのアクセス

GenericHeader に受け取った offsetList の値を使用して、取得した情報のリストへのポインタを取得します。やはりこれだけで、情報リストの個別の項目にアクセスできます。
GenericHeader の numberList が項目数になっていますので、その項目数に達するまで for ループを実行して、取得したリストの情報を処理します。

     D jlPtr           S               *                                                            
     D JOBL0100        DS                  Qualified Based(jlPtr)                                   
     D  JobName                      10a                                                            
     D  UsrName                      10a                                                            
     D  JobNbr                        6a                                                            
     D  InternalJobID                16a                                                            
     D  JobSts                       10a                                                            
     D  JobType                       1a                                                            
     D  JobSubType                    1a                                                            
     D  rsvd                          1a      

              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              for i = 1 to GenericHeader.numberList ;                                               
                writefile(JOBL0100.JobName                                                          
                         :JOBL0100.UsrName                                                          
                         :JOBL0100.JobNbr                                                           
                         :JOBL0100.JobSts) ;                                                        
                jlPtr =  jlPtr + GenericHeader.sizeEntry ;                                          
              endfor ;  

JOBL0100 データ・ストラクチャは、インフォメーション・センターにある以下の情報をそのまま定義したものです。

JOBL0100 Format

Offset Type Field
Dec Hex
0 0 CHAR(10) Job name used
10 A CHAR(10) User name used
20 14 CHAR(6) Job number used
26 1A CHAR(16) Internal job identifier
42 2A CHAR(10) Status
52 34 CHAR(1) Job type
53 35 CHAR(1) Job subtype
54 36 CHAR(2) Reserved

コマンドの実行

事前に書き出しファイル (QCHKACTJ ) をクリアするのには、QCMDEXC プログラムをサブプロシージャとして定義して使用しています。

     D execCMD         PR                  EXTPGM('QCMDEXC')                                        
     D  cmdString                  1000    CONST                                                    
     D                                     Options(*varsize)                                        
     D  cmdLen                       15p 5 Const                                                    
     D CLRPFM          S             21a   INZ('CLRPFM FILE(QCHKACTJ)')                             
      *       
              execCMD(%trimr(CLRPFM):%len(%trimr(CLRPFM))) ;   

プログラム全文

こちらが書き直し後のプログラムの全文です。

      *                                                                                             
     D ChkActJobR      PR                                                                           
     D  QualJobName                  26a                                                            
     D  Status                       10a                                                            
      *                                                                                             
     D ChkActJobR      PI                                                                           
     D  pQualJobName                 26a                                                            
     D  pStatus                      10a                                                            
      *                                                                                             
     D QualJobName     DS            26    Qualified                                                
     D  JobName                      10a                                                            
     D  UserName                     10a                                                            
     D  JobNumber                     6a                                                            
      *                                                                                             
     D execCMD         PR                  EXTPGM('QCMDEXC')                                        
     D  cmdString                  1000    CONST                                                    
     D                                     Options(*varsize)                                        
     D  cmdLen                       15p 5 Const                                                    
     D CLRPFM          S             21a   INZ('CLRPFM FILE(QCHKACTJ)')                             
      *                                                                                             
     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *                                                                                             
     D RtvJobInf       PR                  EXTPGM('QUSLJOB')                                        
     D  pJobName                     10a   CONST                                                    
     D  pUserName                    10a   CONST                                                    
     D  pJobNumber                    6a   CONST                                                    
     D  pStatus                      10a   CONST                                                    
     D  ErrorCode                          like(APIErr)                                             
      *                                                                                             
     D GenericHeader   DS                  Qualified Based(usPtr)                                   
     D  userarea                     64a                                                            
     D  size                         10i 0                                                          
     D  releaselevel                  4                                                             
     D  formatname                    8                                                             
     D  APIused                      10                                                             
     D  DateCreated                  13                                                             
     D  InforSts                      1                                                             
     D  sizeUsed                     10i 0                                                          
     D  offsetInput                  10i 0                                                          
     D  sizeInput                    10i 0                                                          
     D  offsetHeader                 10i 0                                                          
     D  sizeHeader                   10i 0                                                          
     D  offsetList                   10i 0                                                          
     D  sizeList                     10i 0                                                          
     D  numberList                   10i 0                                                          
     D  sizeEntry                    10i 0                                                          
     D  CCSID                        10i 0                                                          
     D  cntryID                       2                                                             
     D  langID                        3                                                             
     D  subsetInd                     1                                                             
     D  rsvd                         42                                                             
      *                                                                                             
     D jlPtr           S               *                                                            
     D JOBL0100        DS                  Qualified Based(jlPtr)                                   
     D  JobName                      10a                                                            
     D  UsrName                      10a                                                            
     D  JobNbr                        6a                                                            
     D  InternalJobID                16a                                                            
     D  JobSts                       10a                                                            
     D  JobType                       1a                                                            
     D  JobSubType                    1a                                                            
     D  rsvd                          1a                                                            
      *                                                                                             
     D pName           S             20a                                                            
     D usPtr           S               *                                                            
      *                                                                                             
     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                                                            
      *                                                                                             
     D WriteFile       PR                                                                           
     D  oJobName                     10a   CONST                                                    
     D  oUserName                    10a   CONST                                                    
     D  oJobNumber                    6a   CONST                                                    
     D  oStatus                      10a   CONST                                                    
      *                                                                                             
     D i               S              5  0                                                          
      *                                                                                             
     D RcvSize         S             10  0 INZ(16776704)                                            
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
             QualJobName = pQualJobName ;                                                           
                                                                                                    
               if QualJobName.JobName = *blanks ;                                                   
                  QualJobName.JobName = '*ALL'  ;                                                   
               endif ;                                                                              
                                                                                                    
               if QualJobName.UserName = *blanks ;                                                  
                  QualJobName.UserName = '*ALL'  ;                                                  
               endif ;                                                                              
                                                                                                    
               if QualJobName.JobNumber = *blanks ;                                                 
                  QualJobName.JobNumber = '*ALL'  ;                                                 
               endif ;                                                                              
                                                                                                    
               if pStatus = *blanks ;                                                               
                  pStatus = '*ALL'  ;                                                               
               endif ;                                                                              
                                                                                                    
              pName =    'CHKACTJOB QTEMP     ' ;                                                   
              usPtr = CrtUsrspcP  (pName ) ;                                                        
                                                                                                    
              RtvJobInf ( pName                                                                     
                         :'JOBL0100'                                                                
                         :QualJobName                                                               
                         :pStatus                                                                   
                         :APIErr ) ;                                                                
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                HandleErr() ;                                                                       
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              If GenericHeader.numberList = 0 ;                                                     
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              execCMD(%trimr(CLRPFM):%len(%trimr(CLRPFM))) ;                                        
                                                                                                    
              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              for i = 1 to GenericHeader.numberList ;                                               
                writefile(JOBL0100.JobName                                                          
                         :JOBL0100.UsrName                                                          
                         :JOBL0100.JobNbr                                                           
                         :JOBL0100.JobSts) ;                                                        
                jlPtr =  jlPtr + GenericHeader.sizeEntry ;                                          
              endfor ;                                                                              
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E

[Top Pageに戻る]

Ads by TOK2