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

System API の使用例 - CL から RPG への書き直し -」と同様に、まったく同じフローのままで CL から ILE RPG に書き換えてみました。
System API プログラミングの基礎 (3) - ユーザースペース使用用の汎用プロシージャの作成 -」で紹介した CrtUsrspcP プロシージャを利用しています。

今回は「System API プログラミングの基礎 (5) - 配列を使用したユーザースペース内の取り出し位置指定 -」で紹介した、ユーザースペースの中の位置指定方法を使用しています。

参考までにこちらが元の 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

ポイント

ポインタの位置指定への配列の利用

今回、API で取得した情報へのアクセスには配列を使用しています。

ユーザースペースを作成し、開始位置のポインタを取得します。
そしてそのポインタを 1キャラクターの配列として定義し、取得したい情報を配列の要素として指定しておきます。
配列を使う場合の利点は、必要な場所だけの定義をしておけばいい、ということでしょうね。Generic Header のすべてを定義する必要はないわけです。

     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *  
      * CrtUsrspcP の戻り値
     D  ptr            S               *                                                            
      *                                                                                             
      * CrtUsrspcP の戻り値ポインタを起点にするデータ・ストラクチャ
     D  Space          DS                  Based(ptr)                                               
     D   sp1                      32767                                                             
     D   arr                          1    overlay(sp1) Dim(32767)                                  
     D   offset                      10i 0 overlay(sp1:125)                                         
     D   entries                     10i 0 overlay(sp1:133)                                         
     D   size                        10i 0 overlay(sp1:137) 

125 とか 133 とかは、以下のインフォメーション・センターの表の "Offset" を参照してセットしています。

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

こうしたユーザースペースが戻り値である API (List API) の場合、最初に "Generic Header" として、後に続くもともと API の呼び出し目的であるところの情報のリストにアクセスするための情報がまとめておいてあります。

オフセット 132 からの "Number of list entries" は、取得したい情報のリストの項目数なのですが、これが 0 であるということは条件にある情報がなかったということなので後続の処理を行う必要はないわけです。

              If entries = 0 ;                                                                      
                return ;                                                                            
              endif ;     

リスト情報へのアクセス

情報のリストへのオフセットを計算し、要素の大きさが取得したい情報の大きさに一致する配列にマップします。

後はその配列をヘッダから取得した項目数の回数だけ順次アクセスすればいいわけです。

     D  mbrptr         S               *                                                            
     D  mbrarr         S             56    based(mbrptr) dim(32767)                                 
      *         
              mbrptr = %addr(arr(offset + 1)) ;                                                     
                                                                                                    
              for i = 1 to entries ;                                                                
               JOBL0100 = mbrarr(i) ;                                                               
                writefile(JOBL0100.JobName                                                          
                         :JOBL0100.UsrName                                                          
                         :JOBL0100.JobNbr                                                           
                         :JOBL0100.JobSts) ;                                                        
              endfor ;         

リスト項目の配列

D 仕様書での mbrarr フィールドの 56 桁、というのはどこからわかるかというと、これもやはりインフォメーション・センターからの情報です。

CL では項目のサイズ (&ENTLEN) を開始位置に足しこむことによって、開始位置を指定して %SST で項目を切り出してきています。
今回の書き換えでは、ひとつひとつの項目をあらかじめ項目のサイズを指定した配列に格納し、配列の要素をカウントアップしていくことで項目の内容を順次に取り出しています。ヘッダにこの項目のサイズの情報はあるのですが、RPG では実行時に大きさを指定して配列を作成できないので、インフォメーション・センターであらかじめ JOBL0100 の長さを調べておいて指定しておくわけです。

http://publib.boulder.ibm.com/infocenter/iseries/v5r4/index.jsp?topic=/apis/qusljob.htm

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

↑を見ると、オフセット 54 + CHAR(2) なので 56 桁分用意しておけばいい、ということがわかります。

プログラム全文

書き換え後のプログラム全文です。

     H*DFTACTGRP(*no)                                                                               
      *                                                                                             
     D ChkActJobA      PR                                                                           
     D  QualJobName                  26a                                                            
     D  Status                       10a                                                            
      *                                                                                             
     D ChkActJobA      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 JOBL0100        DS                  Qualified                                                
     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  ptr            S               *                                                            
      *                                                                                             
     D  Space          DS                  Based(ptr)                                               
     D   sp1                      32767                                                             
     D   arr                          1    overlay(sp1) Dim(32767)                                  
     D   offset                      10i 0 overlay(sp1:125)                                         
     D   entries                     10i 0 overlay(sp1:133)                                         
     D   size                        10i 0 overlay(sp1:137)                                         
      *                                                                                             
     D  mbrptr         S               *                                                            
     D  mbrarr         S             56    based(mbrptr) dim(32767)                                 
      *                                                                                             
     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     ' ;                                                   
              ptr = CrtUsrspcP  (pName ) ;                                                          
                                                                                                    
              RtvJobInf ( pName                                                                     
                         :'JOBL0100'                                                                
                         :QualJobName                                                               
                         :pStatus                                                                   
                         :APIErr ) ;                                                                
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                HandleErr() ;                                                                       
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              If entries = 0 ;                                                                      
           // If GenericHeader.numberList = 0 ;                                                     
                return ;                                                                            
              endif ;                                                                               
                                                                                                    
              execCMD(%trimr(CLRPFM):%len(%trimr(CLRPFM))) ;                                        
                                                                                                    
              mbrptr = %addr(arr(offset + 1)) ;                                                     
           // jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              for i = 1 to entries ;                                                                
           // for i = 1 to GenericHeader.numberList ;                                               
               JOBL0100 = mbrarr(i) ;                                                               
                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