¿ Quieres imprimir esta página ? Volver a la página principal de Recursos iSeries AS400 ¿ Necesitas ayuda ? En pruebas
Recursos iSeries AS400. Compartiendo generamos conocimiento
Novedades en Recursos iSeries AS400
Últimas noticias del iSeries AS400
SAVRSTLISTV5

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')
Programa TOL010C (llamado por COmando ANZKEYF )
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
Pantalla TOO010W (DSPF )
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

Nombre:
Mail:
Comentario:
 

Subir a la parte superior de la web

Symtrax
Dossiers técnicos iSeries y AS400
- Dossier de seguridad
- Alta disponibilidad.
¿Buscas trabajo ?
Inscríbete en nuestra lista laboral y recibirás las ofertas de trabajo en tu buzón de correo electrónico.
Nuestros links preferidos
- Tendencias tecnologías de la información
Expertos en materías relacionadas con las tecnologías de la información, nos dan su punto de vista sobre las tendencias actuales y futuras
- Los últimos anuncios sobre hardware-software para iSeries AS400 realizados por IBM
- Freeware. Software gratuito para el iSeries AS400
- Utilidades para el iSeries AS400 realizadas por profesionales
- Documentos. Trucos e ideas para resolver tus problemas
- Manuales. Los manuales y links más interesantes del iSeries AS400

  Links patrocinados
  •  
  •  

[ Soy nuevo |   Profesionales |   AS qué |   Empresas |    Foros |   Recomiéndanos |    Productos ]
 
Recursos iSeries AS400 es una web de: Poliedric, s.c.p. CIF:G63005011 Urgell 143 1º1ª 08036 - Barcelona - Tel.+34.902.361.344