オブジェクト名と基本的な情報を DSPOBJD より速く取得する (V5R4)

オブジェクト名とタイプだけを高速に取得する (V5R4)」でご紹介した”オブジェクトの名前と種類のみのリストを行う”プログラムですが、もうちょっと情報がほしいという場合もあるでしょう。
DSPOBJD で取得する情報ほどは必要なく、たとえば比較のためにオブジェクトの所有者・作成日付・変更日付程度が取得できればいい、というケースですね。

実は、「オブジェクト名とタイプだけを高速に取得する (V5R4)」のプログラムはそうした用途のためにそんなに難しくなく拡張できます。(こちらも同じ知りあいの人にもらったものです)

取得する情報の種類を API を呼び出す引数として指定するのですが、これを変更するだけなんですね。

オブジェクト名とタイプだけを高速に取得する (V5R4)」のプログラムでは、取得する情報の種類はごくシンプルな OBJL0100 でした。
↑のような情報の取得ということであればこれを OBJL0300 に指定を変えるだけで OK です。

指定できるものには、↓のような種類があります。

OBJL0100 Object names (fastest)
OBJL0200 Text description and extended attribute
OBJL0300 Basic object information
OBJL0400 Creation information
OBJL0500 Save and restore information; journal information
OBJL0600 Usage information
OBJL0700 All object information (slowest)

OBJL0100 は "fastest" とありますよね。だから「高速」だったわけです。

今回は "Basic" であるところの OBJL0300 を指定したサンプルになります。
当然、取得する情報が多くなれば、その分、負荷も時間もかかるようになります。用途によって使いわければいいでしょう。

      *                                                                                             
      *  CREATE TABLE OBJINF                                                                 
      *  (OBJECT CHAR ( 10) NOT NULL WITH DEFAULT,                                                  
      *   LIB CHAR ( 10) NOT NULL WITH DEFAULT,                                                     
      *   OBJTYPE CHAR ( 8) NOT NULL WITH DEFAULT,                                                  
      *   OBJATR CHAR ( 10) NOT NULL WITH DEFAULT,                                                  
      *   TEXT CHAR ( 50) NOT NULL WITH DEFAULT,                                                    
      *   OWNER CHAR ( 10) NOT NULL WITH DEFAULT,                                                   
      *   CREATE_DATE CHAR (17 ) NOT NULL WITH DEFAULT,                                             
      *   CHANGE_DATE CHAR (17 ) NOT NULL WITH DEFAULT,                                             
      *   ROW_TIMESTAMP TIMESTAMP NOT NULL WITH DEFAULT)                                            
      *                                                                                             
      *  CRTSQLRPGI OBJ(GETOBJINF) SRCFILE(QRPGLESRC)                                               
      *             COMMIT(*CS)                                                                     
      *             OBJTYPE(*MODULE) DBGVIEW(*SOURCE)                                               
      *                                                                                             
      *  CRTPGM PGM(GETOBJINF) MODULE(GETOBJINF CRTUSRSPCP)                                         
      *                                                                                             
     D GetObjInf       PR                                                                           
     D  obj                          10a   Const                                                    
     D  lib                          10a   Const                                                    
     D  objType                      10a   Const                                                    
      *                                                                                             
     D GetObjInf       PI                                                                           
     D  obj                          10a   Const                                                    
     D  lib                          10a   Const                                                    
     D  objType                      10a   Const                                                    
      *                                                                                             
     D CrtUsrspcP      PR              *                                                            
     D  Name                         20a                                                            
      *                                                                                             
     D GetObjInfo      Pr                  ExtPgm( 'QUSLOBJ' )                                      
     D  pUsrspcName                  20a   Const                                                    
     D  pFormatName                   8a   Const                                                    
     D  pObjLib                      20a   Const                                                    
     D  pObjType                     10a   Const                                                    
     D  ErrorCode                          like(APIErr)                                             
      *                                                                                             
     D CnvSysDate      Pr                  ExtPgm('QWCCVTDT')                                       
     D  inFMT                        10a   Const                                                    
     D  pSysdate                     10a   Const                                                    
     D  outFMT                       10a   Const                                                    
     D  pRtnVal                      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 OBJL0300        DS                  Qualified Based(jlPtr)                                   
     D  ObjName                      10a                                                            
     D  LibName                      10a                                                            
     D  ObjType                      10a                                                            
     D  infSts                        1a                                                            
     D  extObjAtr                    10a                                                            
     D  text                         50a                                                            
     D  usrdfnAtr                    10a                                                            
     D  rsvd1                         7a                                                            
     D  ASP                          10i 0                                                          
     D  Owner                        10a                                                            
     D  domain                        2a                                                            
     D  crtdate                       8a                                                            
     D  chgdate                       8a                                                            
     D  storage                      10a                                                            
     D  compsts                       1a                                                            
     D  alwchgbypgm                   1a                                                            
     D  chgbypgm                      1a                                                            
     D  audval                       10a                                                            
     D  DigiSign                      1a                                                            
     D  DigiSignBySys                 1a                                                            
     D  DigiSign2up                   1a                                                            
     D  rsvd2                         2a                                                            
     D  libASP                       10i 0                                                          
      *                                                                                             
     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 i               S              5  0                                                          
     D ObjLib          S             20a                                                            
     D crtdate         S             17a                                                            
     D chgdate         S             17a                                                            
      *                                                                                             
     D RcvSize         S             10  0 INZ(16776704)                                            
      *                                                                                             
     D HandleErr       PR                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
              %SubSt(ObjLib: 1:10) =  obj ;                                                         
              %SubSt(ObjLib:11:10) =  lib ;                                                         
                                                                                                    
              pName =    'GETOBJINF QTEMP     ' ;                                                   
              usPtr = CrtUsrspcP  (pName ) ;                                                        
                                                                                                    
              GetObjInfo ( pName                                                                    
                          :'OBJL0300'                                                               
                          :ObjLib                                                                   
                          :ObjType                                                                  
                          :APIErr ) ;                                                               
                                                                                                    
              If APIErr.ErrLEN <> 0 ;                                                               
                                                                                                    
                HandleErr() ;                                                                       
                return ;                                                                            
                                                                                                    
              endif ;                                                                               
                                                                                                    
              If GenericHeader.numberList = 0 ;                                                     
                                                                                                    
                return ;                                                                            
                                                                                                    
              endif ;                                                                               
                                                                                                    
              jlPtr = usPtr + GenericHeader.offsetList ;                                            
                                                                                                    
              for i = 1 to GenericHeader.numberList ;                                               
                                                                                                    
                CnvSysDate ( '*DTS'                                                                 
                            :OBJL0300.crtdate                                                       
                            :'*YYMD'                                                                
                            :crtdate                                                                
                            :APIErr ) ;                                                             
                                                                                                    
                CnvSysDate ( '*DTS'                                                                 
                            :OBJL0300.chgdate                                                       
                            :'*YYMD'                                                                
                            :chgdate                                                                
                            :APIErr ) ;                                                             
                                                                                                    
                exec SQL                                                                            
                   INSERT INTO OBJINF                                                        
                     VALUES(                                                                        
                           :OBJL0300.objname,                                                       
                           :OBJL0300.libname,                                                       
                           :OBJL0300.objtype,                                                       
                           :OBJL0300.extobjatr,                                                     
                           :OBJL0300.text,                                                          
                           :OBJL0300.owner,                                                         
                           :crtdate,                                                                
                           :chgdate,                                                                
                           CURRENT_TIMESTAMP                                                        
                          ) ;                                                                       
                                                                                                    
                jlPtr =  jlPtr + GenericHeader.sizeEntry ;                                          
                                                                                                    
              endfor ;                                                                              
                                                                                                    
              exec SQL  COMMIT ;                                                                    
                                                                                                    
              *inLR = *on ;                                                                         
              return ;                                                                              
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
      *                                                                                             
     P HandleErr       B                                                                            
     D HandleErr       PI                                                                           
      *                                                                                             
      /Free                                                                                         
                                                                                                    
      /End-Free                                                                                     
      *                                                                                             
     P HandleErr       E                                                                            

プログラムの構造自体は「オブジェクト名とタイプだけを高速に取得する (V5R4)」のプログラムと変わりないので、特に説明は必要ありませんね。

[Top Pageに戻る]

Ads by TOK2