System API プログラミングの基礎 (2) - 戻り値をユーザースペースに置き換える -

「ジョブの最終実行 SQL ステートメントの取得」を、「System API プログラミングの基礎 (1) - 2つの結果取得方法 -」で紹介したユーティリティ・プロシージャを使用して書き直してみました。

データ・ストラクチャの定義と指定

ユーティリティでユーザースペースを作成/ポインタを取得し、あらかじめそのポインタフィールドを起点アドレスとして定義しておいたデータ・ストラクチャを戻り値として System API を呼び出します。
API の実行後すぐに返り値にアクセスすることができます。(これは書き直す前のものも同じですが)
ここでは、対象となる項目がなければ後続の処理は必要ないので、その確認を API の実行後すぐに行うために使用しています。

     D JOBI0900        DS                  Qualified Based(usPtr)  
                                 
              rc =                                                                                  
              GetUsrSpc (pName                                                                      
                        :ppubAut                                                                    
                        :pText                                                                      
                        :pReplace) ;                                                                
                                                                                                    
              rc =                                                                                  
              SetUsrSpc (pName                                                                      
                        :usPtr) ;                                                                   
                                                                                                    
              RtvJobSQL( JOBI0900 :                                                                 
                    RcvSize :                                                                       
                    'JOBI0900' :                                                                    
                    QualJobName :                                                                   
                    *blanks :                                                                       
                    APIErr :                                                                        
                    '0' ) ;                                                                         
                                                                                                    
                                                                                                    
          If JOBI0900.NBROPNCRS = 0 ;                                                              

開始アドレスの計算

リスト構造へアクセスするためには、目的とする情報の格納されているフィールドの位置情報を計算するわけですが、その計算の仕方が変わります。開始アドレスからオフセット分の相対位置をずらしたものになります。

         //StartPos = %dec(JOBI0900.OFSOPNCRS) ;                                                    
           StartPosC = %addr(JOBI0900) + (JOBI0900.OFSOPNCRS) ;       

値へのアクセス

書き直す元のコードもコメントとして併記してありますが、開始位置を計算して、その位置から %subst 組み込み関数を使用してデータ・ストラクチャ分だけ切り取る処理を行う必要がありましたが、ポインタを起点としたデータ・ストラクチャを利用する場合は、開始位置を計算しただけでその内容に即時にアクセス可能です。オペレーション・コード/命令が減りますね。まぁ、減った分、生産性とパフォーマンスは上がっている、とも言えます。

           for i = 1 to %dec(JOBI0900.NBROPNCRS) ;                                                  
           // CursorInfo = %subst(JOBI0900 : StartPos) ;                                            
           //↑のようなことをしなくても↓のようにアクセス可能                                                               
              SQLCurName = CursorInfo.SQLCurName ;                                                  
              SQLStmtname = CursorInfo.SQLStmtname ;                                                
              StartPosC = StartPosC + %size(CursorInfo) ;                                           
           // StartPos = StartPos + %size(CursorInfo) ;                                             
           endfor ;                                                                                 

書き直し後のコード

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

     H*DFTACTGRP(*no)                                                                               
      *                                                                                             
     D RtvSQLInfG      PR                                                                           
     D  JobName                      10a   CONST                                                    
     D  UserName                     10a   CONST                                                    
     D  JobNumber                     6a   CONST                                                    
      *                                                                                             
     D RtvSQLInfG      PI                                                                           
     D  ParmJobName                  10a   CONST                                                    
     D  ParmUserName                 10a   CONST                                                    
     D  ParmJobNumber                 6a   CONST                                                    
      *                                                                                             
     D GetUsrSpc       PR              N                                                            
     D  Name                         20a                                                            
     D  pubAut                       10a                                                            
     D  Text                         50a                                                            
     D  Replace                      10a                                                            
      *                                                                                             
     D SetUsrSpc       PR              N                                                            
     D  Name                         20a                                                            
     D  rtnPtr                         *                                                            
      *                                                                                             
     D RtvJobSQL       PR                  EXTPGM('QUSRJOBI')                                       
     D  RcvVar                    65535a   Options( *VarSize)                                       
     D* RcvVar                         *                                                            
     D  RcvVarLen                    10i 0 Const                                                    
     D  FmtName                       8a   Const                                                    
     D  QualJobName                  26a   Const                                                    
     D  InternalJobID                16a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
     D  ResetPfrStat                  1a   Const                                                    
      *                                                                                             
     D JOBI0900        DS                  Qualified Based(usPtr)                                   
     D  NbrBytesRtn                  10i 0                                                          
     D  NbrBytesAvl                  10i 0                                                          
     D  JobName                      10a                                                            
     D  UsrName                      10a                                                            
     D  JobNbr                        6a                                                            
     D  InternalJobID                16a                                                            
     D  JobSts                       10a                                                            
     D  JobType                       1a                                                            
     D  JobSubType                    1a                                                            
     D  SvrMode                       1a                                                            
     D  rsvd                          1a                                                            
     D  OfsOpnCrs                    10i 0                                                          
     D  SizOpnCrs                    10i 0                                                          
     D  NbrOpnCrs                    10i 0                                                          
     D  OfsCurCrs                    10i 0                                                          
     D  LenCurCrs                    10i 0                                                          
     D  StsCurCrs                    10i 0                                                          
     D  CCSIDCurCrs                  10i 0                                                          
     D  RDBname                      18a                                                            
     D  SQLObj                       10a                                                            
     D  SQLLib                       10a                                                            
     D  SQLObjType                   10a                                                            
     D  rsvd2                         4a                                                            
     D  CumNbrFullOpn                20i 0                                                          
     D  CumNbrPsedOpn                20i 0                                                          
     D  OfsCurSQL                    10i 0                                                          
     D  LenCurSQL                    10i 0                                                          
      *                                                                                             
     D*CursorInfo      DS                  Qualified                                                
     D CursorInfo      DS                  Qualified Based(StartPosC)                               
     D   ObjName                     10a                                                            
     D   ObjLib                      10a                                                            
     D   ObjType                     10a                                                            
     D   SQLCurName                  18a                                                            
     D   SQLStmtname                 18a                                                            
      *                                                                                             
     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 QualJobName     DS            26    Qualified                                                
     D  JobName                      10a                                                            
     D  UserName                     10a                                                            
     D  JobNumber                     6a                                                            
      *                                                                                             
     D pName           S             20a                                                            
     D ppubAut         S             10a                                                            
     D pText           S             50a                                                            
     D pReplace        S             10a                                                            
     D usPtr           S               *                                                            
     D rc              S               N                                                            
      *                                                                                             
     D RcvSize         S             10  0 INZ(16776704)                                            
      *                                                                                             
     D i               S              5  0                                                          
     D*StartPos        S              5  0                                                          
     D StartPosC       S               *                                                            
     D StartPosS       S               *                                                            
      *                                                                                             
     D SQLStmt         S          65535a   Varying                                                  
     D*SQL             DS                  Qualified Based(StartPosS)                               
     D* Stmt                      65525a   Varying                                                  
      *↑二桁ずれて入ってくるので不採用(原因追求せず)                                                                     
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
     D   SQLCurName    S             18a                                                            
     D   SQLStmtname   S             18a                                                            
      *                                                                                             
      /Free                                                                                         
              QualJobName.JobName = ParmJobName ;                                                   
              QualJobName.UserName = ParmUserName ;                                                 
              QualJobName.JobNumber = ParmJobNumber ;                                               
                                                                                                    
              pName =    'JOBI0900  QTEMP     ' ;                                                   
              ppubAut =  '*ALL      ' ;                                                             
              pText =    '' ;                                                                       
              pReplace = '*YES      ' ;                                                             
                                                                                                    
              rc =                                                                                  
              GetUsrSpc (pName                                                                      
                        :ppubAut                                                                    
                        :pText                                                                      
                        :pReplace) ;                                                                
                                                                                                    
              rc =                                                                                  
              SetUsrSpc (pName                                                                      
                        :usPtr) ;                                                                   
                                                                                                    
              RtvJobSQL( JOBI0900 :                                                                 
                    RcvSize :                                                                       
                    'JOBI0900' :                                                                    
                    QualJobName :                                                                   
                    *blanks :                                                                       
                    APIErr :                                                                        
                    '0' ) ;                                                                         
                                                                                                    
          If APIErr.ErrLEN <> 0 ;                                                                   
                                                                                                    
           HandleErr() ;                                                                            
                                                                                                    
          else ;                                                                                    
                                                                                                    
          If JOBI0900.NBROPNCRS <> 0 ;                                                              
                                                                                                    
         //StartPos = %dec(JOBI0900.OFSOPNCRS) ;                                                    
           StartPosC = %addr(JOBI0900) + (JOBI0900.OFSOPNCRS) ;                                     
                                                                                                    
           for i = 1 to %dec(JOBI0900.NBROPNCRS) ;                                                  
           // CursorInfo = %subst(JOBI0900 : StartPos) ;                                            
           //↑のようなことをしなくても↓のようにアクセス可能                                                               
              SQLCurName = CursorInfo.SQLCurName ;                                                  
              SQLStmtname = CursorInfo.SQLStmtname ;                                                
              StartPosC = StartPosC + %size(CursorInfo) ;                                           
           endfor ;                                                                                 
                                                                                                    
          else ;                                                                                    
                                                                                                    
           CursorInfo.SQLCurName = '*NONE' ;                                                        
                                                                                                    
          endIf ;                                                                                   
                                                                                                    
          StartPosS = %addr(JOBI0900) + (JOBI0900.OFSCURCRS) ;                                      
          SQLStmt = %str(StartPosS:%dec(JOBI0900.LENCURCRS)) ;                                      
           //桁数分だけ取ってくるために↑のように変更                                                                   
                                                                                                    
          //SQLStmt = %subst(JOBI0900:%dec(JOBI0900.OFSCURCRS)+1:                                   
          //                          %dec(JOBI0900.LENCURCRS)) ;                                   
                                                                                                    
          endIf ;                                                                                   
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E

書き直す元のコード

参考のため、元のものも転載しておきます。

     H DFTACTGRP(*no)                                                                               
      *                                                                                             
     D RtvSQLInf       PR                                                                           
     D  JobName                      10a   CONST                                                    
     D  UserName                     10a   CONST                                                    
     D  JobNumber                     6a   CONST                                                    
      *                                                                                             
     D RtvSQLInf       PI                                                                           
     D  ParmJobName                  10a   CONST                                                    
     D  ParmUserName                 10a   CONST                                                    
     D  ParmJobNumber                 6a   CONST                                                    
      *                                                                                             
     D RtvJobSQL       PR                  EXTPGM('QUSRJOBI')                                       
     D  RcvVar                    65535a   Options( *VarSize)                                       
     D  RcvVarLen                    10i 0 Const                                                    
     D  FmtName                       8a   Const                                                    
     D  QualJobName                  26a   Const                                                    
     D  InternalJobID                16a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
     D  ResetPfrStat                  1a   Const                                                    
      *                                                                                             
     D JOBI0900        DS         65535    Qualified                                                
     D  NbrBytesRtn                  10i 0                                                          
     D  NbrBytesAvl                  10i 0                                                          
     D  JobName                      10a                                                            
     D  UsrName                      10a                                                            
     D  JobNbr                        6a                                                            
     D  InternalJobID                16a                                                            
     D  JobSts                       10a                                                            
     D  JobType                       1a                                                            
     D  JobSubType                    1a                                                            
     D  SvrMode                       1a                                                            
     D  rsvd                          1a                                                            
     D  OfsOpnCrs                    10i 0                                                          
     D  SizOpnCrs                    10i 0                                                          
     D  NbrOpnCrs                    10i 0                                                          
     D  OfsCurCrs                    10i 0                                                          
     D  LenCurCrs                    10i 0                                                          
     D  StsCurCrs                    10i 0                                                          
     D  CCSIDCurCrs                  10i 0                                                          
     D  RDBname                      18a                                                            
     D  SQLObj                       10a                                                            
     D  SQLLib                       10a                                                            
     D  SQLObjType                   10a                                                            
     D  rsvd2                         4a                                                            
     D  CumNbrFullOpn                20i 0                                                          
     D  CumNbrPsedOpn                20i 0                                                          
     D  OfsCurSQL                    10i 0                                                          
     D  LenCurSQL                    10i 0                                                          
      *                                                                                             
     D CursorInfo      DS                  Qualified                                                
     D   ObjName                     10a                                                            
     D   ObjLib                      10a                                                            
     D   ObjType                     10a                                                            
     D   SQLCurName                  18a                                                            
     D   SQLStmtname                 18a                                                            
      *                                                                                             
     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 QualJobName     DS            26    Qualified                                                
     D  JobName                      10a                                                            
     D  UserName                     10a                                                            
     D  JobNumber                     6a                                                            
      *                                                                                             
     D RcvSize         S             10  0 INZ(262140)                                              
      *                                                                                             
     D i               S              5  0                                                          
     D StartPos        S              5  0                                                          
      *                                                                                             
     D SQLStmt         S          65535a   Varying                                                  
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free                                                                                         
              QualJobName.JobName = ParmJobName ;                                                   
              QualJobName.UserName = ParmUserName ;                                                 
              QualJobName.JobNumber = ParmJobNumber ;                                               
                                                                                                    
              RtvJobSQL( JOBI0900 :                                                                 
        //          %Size(JOBI0900) :                                                               
                    RcvSize :                                                                       
                    'JOBI0900' :                                                                    
                    QualJobName :                                                                   
                    *blanks :                                                                       
                    APIErr :                                                                        
                    '0' ) ;                                                                         
                                                                                                    
          If APIErr.ErrLEN <> 0 ;                                                                   
                                                                                                    
           HandleErr() ;                                                                            
                                                                                                    
          else ;                                                                                    
                                                                                                    
          If JOBI0900.NBROPNCRS <> 0 ;                                                              
                                                                                                    
           StartPos = %dec(JOBI0900.OFSOPNCRS) ;                                                    
                                                                                                    
           for i = 1 to %dec(JOBI0900.NBROPNCRS) ;                                                  
              CursorInfo = %subst(JOBI0900 : StartPos) ;                                            
              StartPos = StartPos + %size(CursorInfo) ;                                             
           endfor ;                                                                                 
                                                                                                    
          else ;                                                                                    
                                                                                                    
           SQLCurName = '*NONE' ;                                                        
                                                                                                    
          endIf ;                                                                                   
                                                                                                    
          SQLStmt = %subst(JOBI0900:%dec(JOBI0900.OFSCURCRS)+1:                                     
                                    %dec(JOBI0900.LENCURCRS)) ;                                     
                                                                                                    
          endIf ;                                                                                   
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E

ちなみに、「System API プログラミングの基礎 (3) - ユーザースペース使用用の汎用プロシージャの作成 -」を使用して書き直したものが「System API プログラミングの基礎 (4) - 戻り値をユーザースペースに置き換える [異版] -」にありますので、そちらも参照してみてください。

[Top Pageに戻る]

Ads by TOK2