Categoría : Programación
Autor : Victor Velardez
Título : Analizar Claves de Archivos (ANZKEYF)

Descripción del truco:
Muchas veces me toco encontrarme en un desarrollo que por lo general es para ayer, es entonces que lleve a la pratica la programacion con el usuario sentado al lado de uno, y mientras me contaban el problema, diseñaba la solución, pero como conocer todas la vias de accesos de las tablas que necesitaba consultar y cuales eran sus nombres. Fue asi que surgio la idea de desarrollar esta herramienta a la cual le proveo el nombre del archivo fisico y la secuencia de lo campos en que necesito la clave, la aplicacion me muestra todas los archivos que cumplen esa condicion, y no tengo que perder tiempo revisando todas las DDS

Código en formato texto
Fecha 02-03-2004

Comando ANZKEYF

/*---------------------------------------*/                           
/* ANZKEYF COMMAND:                      */                           
/* AUTOR : VICTOR VELARDEZ               */                           
/* FECHA : 11/06/2001                    */                           
/* E-MAIL: VELARDEZV@.COMAFI.COM.AR      */                           
/*                                       */                           
/*---------------------------------------*/                           
             CMD        PROMPT('Analiza vias de acceso')          
             PARM       KWD(JRNRCV) TYPE(QUAL) PROMPT('Archivo de +
                          Base de Datos')                          
             PARM       KWD(KEYFLD) TYPE(*CHAR) LEN(10) +           
                          SPCVAL((*ALL)) MIN(1) MAX(10) +           
                          LISTDSPL(*INT4) PROMPT('Campos Claves a +
                          buscar')                                 
 QUAL:       QUAL       TYPE(*NAME) MIN(1)                          
             QUAL       TYPE(*CHAR) LEN(10) DFT(*LIBL) +            
                          PROMPT('Biblioteca')   

PGM        PARM(&OBJ &KEYFLD)                            
                                                                      
             DCL        VAR(&OBJ) TYPE(*CHAR) LEN(20)                 
             DCL        VAR(&F) TYPE(*CHAR) LEN(10)                   
             DCL        VAR(&L) TYPE(*CHAR) LEN(10)                   
             DCL        VAR(&KEYFLD) TYPE(*CHAR) LEN(100)             
             DCL        VAR(&NBRCURRCD) TYPE(*DEC) LEN(10 0)          
             DCL        VAR(&OBJATR) TYPE(*CHAR) LEN(10)              
             DCLF       FILE(QADSPDBR) RCDFMT(QWHDRDBR)               
                                                                      
             DLTOVR     FILE(*ALL)                                    
             MONMSG     MSGID(CPF0000)                                
             RCLRSC                                                   
             MONMSG     MSGID(CPF0000)                                
             DLTF       FILE(QTEMP/DBR)                               
             MONMSG     MSGID(CPF0000)                                
             DLTF       FILE(QTEMP/FDF)                               
             MONMSG     MSGID(CPF0000)                                
             DLTF       FILE(QTEMP/FDFP)                              
             MONMSG     MSGID(CPF0000)                                
             DLTF       FILE(QTEMP/SELEC)                               
             MONMSG     MSGID(CPF0000)                                  
             CHGVAR     VAR(&F) VALUE(%SST(&OBJ 01 10))                 
             CHGVAR     VAR(&L) VALUE(%SST(&OBJ 11 10))                 
                                                                        
             IF         COND(&L ¬= '*LIBL     ') THEN(DO)           
             CHKOBJ     OBJ(QSYS/&L) OBJTYPE(*LIB)                    
             MONMSG     MSGID(CPF0000) EXEC(DO)                       
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No se + 
                          ha encontrado la biblioteca ' || &L) +     
                          MSGTYPE(*DIAG)                              
             GOTO       CMDLBL(END_PGM)                               
             ENDDO                                                    
             ENDDO                                                    
                                                                      
             CHKOBJ     OBJ(&L/&F) OBJTYPE(*FILE)                     
             MONMSG     MSGID(CPF0000) EXEC(DO)                       
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('No se + 
                          ha encontrado el archivo ' || &F |< ' +   
                          de Biblioteca ' || &L) MSGTYPE(*DIAG)      
             GOTO       CMDLBL(END_PGM)       
             ENDDO                                                    
                                                                      
             RTVOBJD    OBJ(&L/&F) OBJTYPE(*FILE) OBJATR(&OBJATR)     
                                                                      
             IF         COND(&OBJATR ¬= 'PF        ') THEN(DO)      
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('El +    
                          Objeto ' || &F |< ' de la Biblioteca ' + 
                          || &L |< ', no es un archivo físico') +   
                          MSGTYPE(*DIAG)                                
             GOTO       CMDLBL(END_PGM)                               
             ENDDO                                                      
             DSPDBR     FILE(&L/&F) OUTPUT(*OUTFILE) OUTFILE(QTEMP/DBR) 
             MONMSG     MSGID(CPF0000) EXEC(DO)                         
                CPYF FROMFILE(QSYS/QADSPDBR) TOFILE(QTEMP/DBR) +        
                     MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)          
                     MONMSG CPF0000                                     
             ENDDO                                                      
                                                                        
             RTVMBRD    FILE(QTEMP/DBR) NBRCURRCD(&NBRCURRCD)           
                                                                        
             IF         COND(&NBRCURRCD = 0) THEN(DO)          
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('El +       
                          Objeto ' || &F |< ' de la Biblioteca ' || +
                          &L |< ', no tiene vias de acceso +           
                          asociadas') MSGTYPE(*DIAG)                    
             GOTO       CMDLBL(END_PGM)                                 
             ENDDO                                                      
                                                                        
             DSPFD      FILE(&L/&F) TYPE(*ACCPTH) OUTPUT(*OUTFILE) +    
                          OUTFILE(QTEMP/FDFP)                           
             MONMSG     MSGID(CPF0000) EXEC(DO )                        
             CPYF       FROMFILE(QSYS/QAFDACCP) TOFILE(QTEMP/FDFP) +    
                          MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)     
                     MONMSG CPF0000                                     
             ENDDO                                                      
             OVRDBF     FILE(QADSPDBR) TOFILE(QTEMP/DBR)                
RCVF:                                                                   
             RCVF       DEV(*FILE) RCDFMT(*FILE)                        
             MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(CONTINUE))      
             DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*ACCPTH) +           
                          OUTPUT(*OUTFILE) FILEATR(*LF) +               
                          OUTFILE(QTEMP/FDF) OUTMBR(*FIRST *ADD)        
             MONMSG     MSGID(CPF0000) EXEC(DO )                       
             CPYF       FROMFILE(QSYS/QAFDACCP) TOFILE(QTEMP/FDF) +    
                          MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)    
                     MONMSG CPF0000                                    
             ENDDO                                                     
             DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*SELECT) +          
                          OUTPUT(*OUTFILE)  +                          
                          OUTFILE(QTEMP/SELEC) OUTMBR(*FIRST *ADD)     
             MONMSG     MSGID(CPF0000)  EXEC(DO)                       
             CPYF       FROMFILE(QSYS/QAFDSELO) TOFILE(QTEMP/SELEC) +  
                          MBROPT(*ADD) CRTFILE(*YES) FMTOPT(*NOCHK)    
                     MONMSG CPF0000                                    
             ENDDO                                                     
             GOTO       CMDLBL(RCVF)                                   
                                                                       
CONTINUE:                                                              
             DLTOVR     FILE(QAFDACCP)                                 
             MONMSG     MSGID(CPF0000)                                 
             CLOF       OPNID(QAFDACCP)                                
             MONMSG     MSGID(CPF0000)                                 
             OVRDBF     FILE(QAFDACCP) TOFILE(QTEMP/FDF)  SHARE(*YES)  
             OPNQRYF    FILE((QAFDACCP)) QRYSLT('*ALL') +               
                          KEYFLD((APFILE) (APLIB) (APKEYN))             
             CALL       PGM(TOL010) PARM(&F &L &KEYFLD)                 
             DLTOVR *ALL                                                
             RCLRSC                                                     
END_PGM:                                                                
             ENDPGM                                                     

TOL010 (RPG)

      *                                                                 
     FQAFDACCPIP  E                    DISK                             
     FFDFP    IF  E                    DISK                             
     F            QWHFDACP                          KRENAMERCD          
     FSELEC   IF  E                    DISK                             
     FTOL010W CF  E                    WORKSTN                          
     F                                        RECNO KSFILE SFL          
     F                                        RECNO1KSFILE SFL1         
      * ---------------------------------------------------------------
     E                    FLD        10 10                             
     E                    CMP        10 10                             
     E                    CMP1       10 10                             
     E                    PNT        10  2 0                           
     E                    FLD1       10 10                             
     E                    STR       100  1                             
      * ---------------------------------------------------------------
     IRCD                                                               
     I              APRCEN                          BPRCEN              
     I              APRDAT                          BPRDAT              
     I              APRTIM                          BPRTIM              
     I              APFILE                          BPFILE             
     I              APLIB                           BPLIB              
     I              APFTYP                          BPFTYP             
     I              APFILA                          BPFILA             
     I              APMXD                           BPMXD              
     I              APFATR                          BPFATR             
     I              APSYSN                          BPSYSN             
     I              APASP                           BPASP              
     I              APRES                           BPRES              
     I              APMANT                          BPMANT             
     I              APUNIQ                          BPUNIQ             
     I              APKEYO                          BPKEYO             
     I              APSELO                          BPSELO             
     I              APACCP                          BPACCP             
     I              APNSCO                          BPNSCO             
     I              APBOF                           BPBOF              
     I              APBOL                           BPBOL              
     I              APBOLF                          BPBOLF             
     I              APNKYF                          BPNKYF             
     I              APKEYF                          BPKEYF             
     I              APKSEQ                          BPKSEQ             
     I              APKSIN                          BPKSIN              
     I              APKZD                           BPKZD               
     I              APKASQ                          BPKASQ              
     I              APKEYN                          BPKEYN              
     I              APJOIN                          BPJOIN              
     I              APACPJ                          BPACPJ              
     I              APRIKY                          BPRIKY              
     I              APUUIV                          BPUUIV              
      * --------------------------------------------------------------- 
     IQWHFDACP                                                          
     I                                              APFILEL1            
     I                                              APLIB L1            
      * --------------------------------------------------------------- 
     IDS1         DS                                                    
     I                                        1 102 TODO                
     I                                    B   1   20CNT                 
     I                                        3 102 RESTO               
     I                                        3 102 CMP                 
     I                                        3  12 C01                 
     I                                       13  22 C02                 
     I                                       23  32 C03                      
     I                                       33  42 C04                 
     I                                       43  52 C05                 
     I                                       53  62 C06                 
     I                                       63  72 C07                 
     I                                       73  82 C08                 
     I                                       83  92 C09                 
     I                                       93 102 C10                 
      * --------------------------------------------------------------- 
     IDS2         DS                                                    
     I                                        1 100 FLD                 
      * --------------------------------------------------------------- 
     IDS3         DS                                                    
     I                                        3 102 CMP1                
     I                                        3  12 F01                 
     I                                       13  22 F02                 
     I                                       23  32 F03                 
     I                                       33  42 F04                 
     I                                       43  52 F05                 
     I                                       53  62 F06                 
     I                                       63  72 F07                 
     I                                       73  82 F08                      
     I                                       83  92 F09                 
     I                                       93 102 F10                 
      * --------------------------------------------------------------- 
     C         L1          CLEARFLD                                     
      *                                                                 
     C           APKEYN    IFLE CNT                                     
     C           APKEYN    ANDGT0                                       
     C                     Z-ADDAPKEYN    T       50                    
     C                     MOVELAPKEYF    FLD,T                         
     C                     ENDIF                                        
     CL1                   EXSR ANZFIL                                  
     CL1                   MOVE *ON       *IN77                         
     CLR                   EXSR DSPSFL                                  
      * --------------------------------------------------------------- 
     C           *INZSR    BEGSR                                        
     C           *ENTRY    PLIST                                        
     C                     PARM           FILE   10                     
     C                     PARM           LIBR   10                     
     C                     PARM           KYF   100                     
     C                     MOVELKYF       TODO                          
     C                     EXSR ANZFLD                                  
     C                     Z-ADD0         RECNO   60                 
     C                     MOVEA'00'      *IN,30                     
     C                     WRITEFOOT                                 
     C                     WRITECTL                                  
     C                     READ FDFP                     77          
      *                                                              
     C           *IN77     DOWEQ*OFF                                 
      *                                                              
     C           BPKEYN    IFGT 0                                    
     C                     Z-ADDBPKEYN    Z       50                 
     C                     MOVELBPKEYF    CMP1,Z                     
     C                     ENDIF                                     
     C                     READ FDFP                     77          
     C                     ENDDO                                     
     C                     ENDSR                                     
      * -------------------------------------------------------------
     C           ANZFLD    BEGSR                                     
     C                     MOVEARESTO     STR,1                      
     C                     Z-ADD1         P       50                 
      *                                                              
     C           1         DO   CNT       Y       40                      
     C                     MOVEASTR,P     DIEZ   10                  
     C                     MOVELDIEZ      FLD1,Y                     
     C                     ADD  10        P                          
     C                     ENDDO                                     
     C           CNT       ADD  1         Y                          
      *                                                              
     C           Y         DO   10        X       30                 
     C                     MOVEL*BLANKS   CMP,X                      
     C                     MOVEL*BLANKS   FLD1,X                     
     C                     ENDDO                                     
     C                     ENDSR                                     
      * -------------------------------------------------------------
     C           ANZFIL    BEGSR                                     
     C                     MOVEAFLD1,1    CIEN  100                  
     C                     MOVEAFLD,1     CIEN1 100                  
      *                                                              
     C           CIEN      IFEQ CIEN1                                
     C                     EXSR ANZCT1                               
      *                                                              
     C           CNTSEL    IFGT 0                                    
     C                     MOVE '+'       SUO                             
     C                     MOVE *OFF      *IN78                     
     C                     ELSE                                     
     C                     MOVE ' '       SUO                       
     C                     MOVE *ON       *IN78                     
     C                     ENDIF                                    
     C                     ADD  1         RECNO                     
     C                     WRITESFL                                 
     C                     ENDIF                                    
     C                     ENDSR                                    
      * ------------------------------------------------------------
     C           DSPSFL    BEGSR                                    
      *                                                             
     C           RECNO     IFGT 0                                   
     C                     MOVEA'11'      *IN,30                    
     C                     ELSE                                     
     C                     MOVEA'01'      *IN,30                    
     C                     ENDIF                                    
      *                                                             
     C           *IN12     DOWEQ*OFF                                
     C                     WRITEFOOT                                
     C        N30          WRITEMSG                                      
     C                     EXFMTCTL                              
     C                     EXSR ANZCTL                           
     C                     ENDDO                                 
     C                     ENDSR                                 
      * ---------------------------------------------------------
     C           ANZCT1    BEGSR                                 
     C                     Z-ADD0         CNTSEL 100             
     C           1         CHAINSELEC                77          
      *                                                          
     C           *IN77     DOWEQ*OFF                             
      *                                                          
     C           SOFILE    IFEQ APFILE                           
     C           SONVAL    ANDNE0                                
     C                     ADD  1         CNTSEL                 
     C                     ENDIF                                 
     C                     READ SELEC                    77      
     C                     ENDDO                                 
     C                     ENDSR                                 
      * ---------------------------------------------------------
     C           ANZCTL    BEGSR                                 
     C                     READCSFL                    9899            
     C           *IN98     DOWEQ*OFF                            
     C           *IN99     ANDEQ*OFF                            
      *                                                         
     C           OPCSFL    IFEQ '1'                             
     C                     MOVEA'00'      *IN,32                
     C                     Z-ADD0         RECNO1  60            
     C                     WRITEWDWCTL                          
     C                     EXSR DSPCTL                          
     C                     MOVE ' '       OPCSFL                
     C                     MOVE *OFF      *IN78                 
     C                     UPDATSFL                             
     C                     ENDIF                                
     C                     READCSFL                    9899     
     C                     ENDDO                                
     C                     ENDSR                                
      * --------------------------------------------------------
     C           DSPCTL    BEGSR                                
     C           1         CHAINSELEC                77         
      *                                                         
     C           *IN77     DOWEQ*OFF                                  
     C           SOFILE    IFEQ APFILE                              
     C                     ADD  1         RECNO1                    
     C                     WRITESFL1                                
     C                     ENDIF                                    
     C                     READ SELEC                    77         
     C                     ENDDO                                    
     C                     MOVE *OFF      *IN24                     
      *                                                             
     C           RECNO1    IFGT 0                                   
     C                     MOVEA'11'      *IN,32                  
     C                     ELSE                                     
     C                     MOVEA'01'      *IN,32                  
     C                     ENDIF                                    
      *                                                             
     C           *IN24     DOWEQ*OFF                                
     C                     EXFMTWDWCTL                              
     C                     ENDDO                                    
     C                     ENDSR                              

A*%%TS  SD  20010620  185051  VELARDEZV   REL-V4R4M0  5769-PW1             
A*%%EC                                                                     
A                                      DSPSIZ(24 80 *DS3)                  
A          R FOOT                                                          
A*%%TS  SD  20010613  194722  VELARDEZV   REL-V4R4M0  5769-PW1             
A                                      CLRL(*NO)                           
A                                      OVERLAY                             
A                                 23  3'F12=Cancelar'                    
A                                      COLOR(BLU)                          
A          R SFL                       SFL                                 
A*%%TS  SD  20010620  155030  VELARDEZV   REL-V4R4M0  5769-PW1             
A            OPCSFL         1A  I 13  3                                    
A  78                                  DSPATR(PR)                          
A                                      VALUES(' ' '1')                 
A            APLIB     R        O 13  5REFFLD(QWHFDACP/APLIB *LIBL/QAFDACC-
A                                      P)                                  
A            APFILE    R        O 13 16REFFLD(QWHFDACP/APFILE *LIBL/QAFDAC-
A                                      CP)                                 
A            SUO            1A  O 13 31DSPATR(HI)                          
A          R CTL                       SFLCTL(SFL)                         
A*%%TS  SD  20010620  155030  VELARDEZV   REL-V4R4M0  5769-PW1             
A                                      SFLSIZ(0017)                        
A                                      SFLPAG(0008)                        
A                                      CF12(12)                         
A                                      OVERLAY                          
A  30                                  SFLDSP                           
A  31                                  SFLDSPCTL                        
A N30                                  SFLCLR                           
A  30                                  SFLEND(*MORE)                    
A                                  1  2'TOL010'                         
A                                  1 28'Análisis de vías de accesos'    
A                                      DSPATR(HI)                       
A                                  1 72SYSNAME                          
A                                  3  2'Archivo. . . . :'               
A                                      COLOR(BLU)                       
A            FILE          10A  O  3 19DSPATR(HI)                       
A                                  4  4'Biblioteca . :'                 
A                                      COLOR(BLU)                       
A            LIBR          10A  O  4 22DSPATR(HI)                       
A                                  5  2'Acceso de Fisico'               
A                                      COLOR(BLU)                       
A            F01           10A  O  5 19DSPATR(HI)                       
A            F02           10A  O  5 30DSPATR(HI)                       
A            F03           10A  O  5 41DSPATR(HI)                       
A            F04           10A  O  5 52DSPATR(HI)                       
A            F05           10A  O  5 63DSPATR(HI)                       
A            F06           10A  O  6 19DSPATR(HI)                       
A            F07           10A  O  6 30DSPATR(HI)                         
A            F08           10A  O  6 41DSPATR(HI)                         
A            F09           10A  O  6 52DSPATR(HI)                         
A            F10           10A  O  6 63DSPATR(HI)                         
A                                  7  2'Acceso a buscar:'                 
A                                      COLOR(BLU)                         
A            C01           10A  O  7 19DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C02           10A  O  7 30DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C03           10A  O  7 41DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C04           10A  O  7 52DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C05           10A  O  7 63DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C06           10A  O  8 19DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C07           10A  O  8 30DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C08           10A  O  8 41DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C09           10A  O  8 52DSPATR(HI)                         
A                                      DSPATR(UL)                         
A            C10           10A  O  8 63DSPATR(HI)                              
A                                      DSPATR(UL)                              
A                                 12  3'O Libreria   Archivo     Omisión'      
A                                      COLOR(BLU)                              
A                                 11 27'Selección'                             
A                                      COLOR(BLU)                              
A                                 10  3'1=Ver Selec/Omit'                      
A                                      COLOR(BLU)                              
A          R MSG                                                               
A*%%TS  SD  20010620  140246  VELARDEZV   REL-V4R4M0  5769-PW1                 
A                                      CLRL(*NO)                               
A                                      OVERLAY                                 
A                                 10  2'                                  -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -    
A                                                                         -  
A                                                                         -  
A                                              '                             
A                                 16 20'(No existen vias de acceso coincid-  
A                                      entes)'                               
A                                 16 61'                                  -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                                         -  
A                                                  '                         
A          R SFL1                      SFL                                   
A*%%TS  SD  20010620  184808  VELARDEZV   REL-V4R4M0  5769-PW1               
A            SORULE    R        O  5 14REFFLD(QWHFDSO/SORULE *LIBL/SELEC)    
A            SOCOMP    R        O  5 16REFFLD(QWHFDSO/SOCOMP *LIBL/SELEC)    
A            SOVALU    R        O  5 19REFFLD(QWHFDSO/SOVALU *LIBL/SELEC)    
A            SOFLD     R        O  5  3REFFLD(QWHFDSO/SOFLD *LIBL/SELEC)     
A          R WDWCTL                    SFLCTL(SFL1)                          
A*%%TS  SD  20010620  185051  VELARDEZV   REL-V4R4M0  5769-PW1               
A                                      SFLSIZ(0012)                          
A                                      SFLPAG(0006)                          
A                                      WINDOW(2 25 12 50)                    
A                                      CF12(24)                              
A  32                                  SFLDSP                                
A  33                                  SFLDSPCTL                             
A N32                                  SFLCLR                                
A  32                                  SFLEND(*MORE)                         
A                                  1 38'F12=Cancelar'                        
A                                      COLOR(BLU)                            
A                                  3 14'S'                               
A                                      COLOR(BLU)                          
A                                  4  3'Campo      O  Op  Valor'         
A                                      COLOR(BLU)                          
A                                  1  1'Selección/Omisión'               
A                                      DSPATR(HI)                          

Tienes algún truco que quieras compartir con todos los profesionales de Recursos iSeries AS400?.Envianoslo y si resulta seleccionado te enviaremos un vale de Amazon por valor de 50$

Comentarios de usuarios