Home page

 

Récupérer le nom des QUERY/400 qui utilisent un fichier ou un fichier générique* donné

Ce qui peut être intéressant pour savoir quels queries recompiler et éviter un plantage en prod suite à modification du fichier, n'est-ce pas ?

Utilisation de la commande QRYFIC :

QRYFIC FILE(MONFIC*)  OUTFILE(MABIB/MONFICHIER)

Remarquez qu'on ne précise pas de bibliothèques de recherche  dans la paramètre FILE.
Tous les QUERY/400 (objets de type *QRYDFN) seront analysés dans toutes les bibliothèques utilisateur (*USRLIBL) auxquelles le profil est autorisé.

Dans l'exemple ci-dessus, le programme QRYFIC placera dans le fichier MABIB/MONFICHIER le nom des queries qui utilisent le fichier générique MONFIC* en entrée ou en sortie du query.

Le traitement risque d'être long, voire très long; c'est pourquoi je l'ai autosoumis dans le CL QRYFIC (voir ci-dessous).
Planifiez son passage plutôt de nuit pour éviter de pénaliser les traitements en journée.
Analysez la joblog du traitement pour repérer les queries non autorisés et les anomalies le cas échéant.


1.    Commande QRYFIC pour lancer la recherche

/*     CRTCMD CMD(MYLIB/QRYFIC)    +         */
/*     PGM(MYLIB/QRYFICC)          +         */
/*     SRCFILE(MYLIBSRC/QCMDSRC)   +         */ 
/*     SRCMBR(*CMD)                          */ 

CMD PROMPT('Query/400 utilisant fichier*')

  PARM KWD(FILE) TYPE(*GENERIC) LEN(10) MIN(1) +
  PROMPT('Fichier ou nom generique')

  PARM KWD(OUTFILE) TYPE(Q1) MIN(1) PROMPT('Fichier +
          en sortie') 

  Q1: QUAL TYPE(*NAME) LEN(10) REL(*NE RTVQRYPH) MIN(1) 
      QUAL TYPE(*NAME) LEN(10) DFT(*CURLIB) + 
           SPCVAL((*CURLIB)) MIN(0) 
 

2.    Fichier RTVQRYPH pour obtenir le format du fichier OUTFILE

Remarque : Vous devez créer ce fichier sous le nom RTVQRYPH dans la bibliothèque de votre choix et cette dernière doit se trouver en *LIBL lors de l'exécution de la commande.
 

Field Length Dec Type From To Text
QRYSYSN 8   A 1 8 System name
QRYNAME 10   A 9 18 Query name
QRYLIB 10   A 19 28 Qury Library
QRYUSER 10   A 29 38 Creation User
ODUCNTA 5   A 39 43 Days used
ODCDAT 6   A 44 49 Creation Date
ODUDAT 6   A 50 55 Last Used Date
ODOBTX 50   A 56 105 Text description
QRYFICI 10   A 106 115 Input file name
QRYLIBI 10   A 116 125 Input file library name
QRYMBRI 10   A 126 135 Input file member name
QRYFMTI 10   A 136 145 Input file format name
QRYFICO 10   A 146 155 Output file name
QRYLIBO 10   A 156 165 Output file library name
QRYMBRO 10   A 166 175 Output file member name
QRYSIZO 15   A 176 190 Output file size

 

Vous pouvez aussi le créer avec SQL. Voici la commande.

CREATE TABLE MYLIB/RTVQRYPH (
QRYSYSN CHAR(8) CCSID 297 NOT NULL DEFAULT '' ,
QRYNAME CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYLIB CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYUSER CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
ODUCNTA CHAR(5) CCSID 297 NOT NULL DEFAULT '' ,
ODCDAT CHAR(6) CCSID 297 NOT NULL DEFAULT '' ,
ODUDAT CHAR(6) CCSID 297 NOT NULL DEFAULT '' ,
ODOBTX CHAR(50) CCSID 297 NOT NULL DEFAULT '' ,
QRYFICI CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYLIBI CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYMBRI CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYFMTI CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYFICO CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYLIBO CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYMBRO CHAR(10) CCSID 297 NOT NULL DEFAULT '' ,
QRYSIZO CHAR(15) CCSID 297 NOT NULL DEFAULT '' ) ;

LABEL ON TABLE MYLIB/RTVQRYPH
IS 'Resultats RTVQRYF' ;

LABEL ON COLUMN MYLIB/RTVQRYPH
( QRYSYSN IS 'Nom du systeme' ,
QRYNAME IS 'Nom du query' ,
QRYLIB IS 'Bib.du query' ,
QRYUSER IS 'Nom du createur du qry' ,
ODUCNTA IS 'Nbr jours utilisation' ,
ODCDAT IS 'Date de creation',
ODUDAT IS 'Derniere utilse Date' ,
ODOBTX IS 'Text description' ,
QRYFICI IS 'Fichier input' ,
QRYLIBI IS 'Bib. Fichier input' ,
QRYMBRI IS 'Mbr Fichier input' ,
QRYFMTI IS 'Fmt Fichier input' ,
QRYFICO IS 'Fichier output' ,
QRYLIBO IS 'Bib. Fichier output' ,
QRYMBRO IS 'Mbr Fichier output' ,
QRYSIZO IS 'Taille fichier output' ) ;

LABEL ON COLUMN MYLIB/RTVQRYPH
( QRYSYSN TEXT IS 'Nom du systeme' ,
QRYNAME TEXT IS 'Nom du query' ,
QRYLIB TEXT IS 'Bib.du query' ,
QRYUSER TEXT IS 'Nom du createur du qry' ,
ODUCNTA TEXT IS 'Nbr jours utilisation' ,
ODCDAT TEXT IS 'Creation date (MMDDYY)' ,
ODUDAT TEXT IS 'Last used date (MMDDYY)' ,
ODOBTX TEXT IS 'Text description' ,
QRYFICI TEXT IS 'Fichier input' ,
QRYLIBI TEXT IS 'Bib. Fichier input' ,
QRYMBRI TEXT IS 'Mbr Fichier input' ,
QRYFMTI TEXT IS 'Fmt Fichier input' ,
QRYFICO TEXT IS 'Fichier output' ,
QRYLIBO TEXT IS 'Bib. Fichier output' ,
QRYMBRO TEXT IS 'Mbr Fichier output' ,
QRYSIZO TEXT IS 'Taille fichier output' ) ;


 

3.    Programme CL QRYFICC pour traiter la recherche :
          Remarque : il faut avoir installé l'utilitaire UTSQL sur la machine pour que ce programme fonctionne correctement.

 

/**********************************************************************/
/* Ce programme permet de lister les QRY/400 qui utilisent le fichier */
/* passe en parametre au programme                                    */
/**********************************************************************/
/* Parametres a passer au programme:                                  */
/*   - Nom fichier (logique ou physique) ou nom generique             */
/*   - Nom fichier en sortie                                          */
/**********************************************************************/

PGM PARM(&FILE &OUTFILE)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&OUTFILE) TYPE(*CHAR) LEN(20)

DCL VAR(&INQMSGRPY) TYPE(*CHAR) LEN(10)
DCL VAR(&LOGCLPGM) TYPE(*CHAR) LEN(10)

DCL VAR(&WFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&LIBO) TYPE(*CHAR) LEN(10)
DCL VAR(&FILEO) TYPE(*CHAR) LEN(10)

DCL VAR(&QRYNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYLIB ) TYPE(*CHAR) LEN(10)
DCL VAR(&INPSTR) TYPE(*CHAR) LEN(1280)
DCL VAR(&OUTSTR) TYPE(*CHAR) LEN(30)
DCL VAR(&CR) TYPE(*CHAR) LEN(1)

DCL VAR(&QRYFICI) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYLIBI) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYMBRI) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYFMTI) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYFICO) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYLIBO) TYPE(*CHAR) LEN(10)
DCL VAR(&QRYMBRO) TYPE(*CHAR) LEN(10)

DCL VAR(&UTSQLCR) TYPE(*DEC) LEN(1 0)
DCL VAR(&I) TYPE(*DEC) LEN(4 0)
DCL VAR(&J) TYPE(*DEC) LEN(4 0)
DCL VAR(&K) TYPE(*DEC) LEN(4 0)
DCL VAR(&L) TYPE(*DEC) LEN(4 0)
DCL VAR(&P) TYPE(*DEC) LEN(4 0)
DCL VAR(&T) TYPE(*DEC) LEN(4 0)

DCL VAR(&PRMSQL) TYPE(*CHAR) LEN(2000)
DCL VAR(&QUOTE) TYPE(*CHAR) LEN(1) VALUE(X'7D') +
/* Caractere "quote" (apostrophe) */
DCL VAR(&ODUCNTA) TYPE(*CHAR) LEN(5)

DCL VAR(&SIZE) TYPE(*DEC) LEN(15 0)
DCL VAR(&QRYSIZO) TYPE(*CHAR) LEN(15)
DCL VAR(&OK) TYPE(*LGL)

DCL VAR(&QRYSYSN) TYPE(*CHAR) LEN(8)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)

DCL VAR(&MSG) TYPE(*CHAR) LEN(80)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)

DCLF FILE(QADSPOBJ)

/* Autosoumission */
RTVJOBA TYPE(&TYPE)
IF COND(&TYPE = '1') THEN(DO) /* Inter */
  SBMJOB CMD(CALL PGM(QRYFICC) PARM(&FILE &OUTFILE)) JOB(QRYFIC)
  GOTO CMDLBL(Z900)
ENDDO

/* *** Batch *** */

RTVJOBA LOGCLPGM(&LOGCLPGM) INQMSGRPY(&INQMSGRPY)
CHGJOB LOGCLPGM(*NO) INQMSGRPY(*SYSRPYL) /* +
           *SYSRPYL entrainera un dump automatique +
                                            si plantage */

RTVNETA SYSNAME(&QRYSYSN) /* Nom du systeme */

/* 1. Recherche si nom fichier complet ou generique */
/* 2. Formatage du nom du fichier trouve dans "WFILE" */

CHGVAR VAR(&P) VALUE(0)

A005: CHGVAR VAR(&P) VALUE(&P +1)

IF COND(&P > 10) THEN(DO)
  CHGVAR VAR(&L) VALUE(10)
  CHGVAR VAR(&WFILE) VALUE(&FILE)
ENDDO
ELSE CMD(DO)
 IF COND(%SST(&FILE &P 1) *EQ '*') THEN(DO)
    CHGVAR VAR(&L) VALUE(&P - 1)
    CHGVAR VAR(&WFILE) VALUE(%SST(&FILE 1 &L))
 ENDDO
 ELSE CMD(DO)
    GOTO CMDLBL(A005)
 ENDDO
ENDDO

/* Création fichier sortie */
CHGVAR VAR(&FILEO) VALUE(%SST(&OUTFILE 1 10))
CHGVAR VAR(&LIBO)  VALUE(%SST(&OUTFILE 11 10))

DLTF FILE(&LIBO/&FILEO)
MONMSG MSGID(CPF0000)

RTVMBRD FILE(RTVQRYPH) RTNLIB(&RTNLIB)
CRTDUPOBJ OBJ(RTVQRYPH) FROMLIB(&RTNLIB) +
          OBJTYPE(*FILE) TOLIB(&LIBO) NEWOBJ(&FILEO)

/* Depot des description de queries pour leur nom */
DSPOBJD OBJ(*ALLUSR/*ALL) OBJTYPE(*QRYDFN) +
        OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ) +
        OUTMBR(*FIRST *REPLACE) /* Retrieve all +
                               qrydef objects in library *ALLUSR    */
MONMSG MSGID(CPF2123) EXEC(GOTO CMDLBL(Z800))

OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/QADSPOBJ)

/* Exploitation nom des queries pour retrouver le fichier requis    */
A010: RCVF
      MONMSG CPF0864 EXEC(GOTO Z800)

CHGVAR VAR(&QRYNAME) VALUE(&ODOBNM)
CHGVAR VAR(&QRYLIB ) VALUE(&ODLBNM)

/* Recup des noms fichiers utilises par le query en entree et sortie */
/*===================================================================*/
/* Description des parametres Type Longueur                          */
/* ----------------------------------------------------------------- */
/* Parametres en entree:                                             */
/* Nom du query (requis) Char 10                                     */
/* Biblio contenant le query (requis) Char 10                        */
/* ----------------------------------------------------------------- */
/* Parametres en sortie:                                             */
/* Structure de liste fichiers entree du Query Char 1280 */
/* Cette liste de 1280 caracteres est utilisee                       */
/* pour retourner la liste des fichiers en entree                    */
/* du query. La structure se compose d'une table de                  */
/* 32 postes de 40 caracteres de long chaque:                        */
/* 10 pour le nom du fichier, 10 pour la bibliotheque,               */
/* 10 pour le nom du membre et 10 pour le format.                    */
/* Le nom du membre peut etre egal a la valeur speciale *FIRST.      */

/* Structure de liste du fichier sortie Char 30                      */
/* La structure de liste du fichier sortie est utilisee pour         */
/* retourner le nom du fichier sortie utilise par                    */
/* le query. Son format se compose de 10 caracteres                  */
/* pour le nom du fichier, 10 pour le nom de la bibliotheque         */
/* et 10 caracteres pour le nom du membre.                           */
/* Le nom du membre peut tre egal a la valeur speciale *FIRST.       */
/* Si le query ne cree pas de fichier sortie,                        */
/* le pgm indiquera la valeur *NONE au debut de                      */
/* la structure.                                                     */

/* Code retour (0=OK, <>0=Abandon) Char 1                            */
/* ------------------------------------------------------------------*/
/*===================================================================*/
CHGVAR VAR(&INPSTR) VALUE( ' ' )
CHGVAR VAR(&OUTSTR) VALUE( ' ' )
CHGVAR VAR(&CR) VALUE('0')
CALL PGM(RTVQRYF) PARM(&QRYNAME &QRYLIB &INPSTR +
     &OUTSTR &CR) /* Pgm de recuperation +
                        des fichiers du query */

IF COND(&CR = '1') THEN(DO) /* Erreur */
  SNDPGMMSG MSGID(CPF2123) MSGF(QCPFMSG) MSGDTA(&FILE +
                 *CAT '''*ALLUSR''') MSGTYPE(*ESCAPE)
ENDDO

IF COND(&CR = '2') THEN(GOTO CMDLBL(A010)) /* +
                                       Non autorise */

/* Recup du fichier sortie */
CHGVAR &QRYFICO %SST(&OUTSTR 1 10)
IF COND(&QRYFICO = ' ') THEN(CHGVAR +
   VAR(&QRYFICO) VALUE('*NONE'))

CHGVAR &QRYLIBO %SST(&OUTSTR 11 10)
IF COND(&QRYLIBO = ' ') THEN(CHGVAR +
   VAR(&QRYLIBO) VALUE('*NONE'))

CHGVAR &QRYMBRO %SST(&OUTSTR 21 10)
IF COND(&QRYMBRO = ' ') THEN(CHGVAR +
   VAR(&QRYMBRO) VALUE('*NONE'))

/* Recup taille du fichier sortie */
CHGVAR VAR(&QRYSIZO) VALUE('*NONE')

IF COND(&QRYFICO *NE '*NONE') THEN(DO)
   CHGVAR VAR(&OK) VALUE('1')
   RTVOBJD OBJ(&QRYLIBO/&QRYFICO) OBJTYPE(*FILE) +
            SIZE(&SIZE) /* Recupere la taille du +
                                fichier en sortie */
   MONMSG MSGID(CPF0000) EXEC(DO)
      CHGVAR VAR(&QRYSIZO) VALUE('Recup.impossib.')
      CHGVAR VAR(&OK) VALUE('0')
   ENDDO
   IF COND(&OK) THEN(CHGVAR VAR(&QRYSIZO) +
                VALUE(&SIZE)) /* Conv.en alpha pour +
                                         concatenation */

ENDDO

/* Recup. du ou des fichier(s) en entree du query (32 maxi) */
CHGVAR VAR(&I) VALUE(0)
CHGVAR VAR(&J) VALUE(-39)

A01010: CHGVAR VAR(&I) VALUE(&I +1)
IF COND(&I > 32) THEN(GOTO CMDLBL(A010))

CHGVAR VAR(&J) VALUE(&J + 40)
IF COND(&J > 1240) THEN(GOTO CMDLBL(A010))

CHGVAR VAR(&K) VALUE(&J)
CHGVAR &QRYFICI %SST(&INPSTR &K 10)
IF COND(&QRYFICI = ' ') THEN(GOTO CMDLBL(A010))

CHGVAR VAR(&K) VALUE(&K + 10)
CHGVAR &QRYLIBI %SST(&INPSTR &K 10)

CHGVAR VAR(&K) VALUE(&K + 10)
CHGVAR &QRYMBRI %SST(&INPSTR &K 10)

CHGVAR VAR(&K) VALUE(&K + 10)
CHGVAR &QRYFMTI %SST(&INPSTR &K 10)

/* L'argument de recherche est trouve */

IF COND(%SST(&QRYFICI 1 &L) = &WFILE *OR +
        %SST(&QRYFICO 1 &L) = &WFILE) THEN(DO)
/* Remplacement de la quote (') par guillemet anglais (") dans la zone */
/* texte "&ODOBTX" car le caractere quote n'est pas supporte par SQL   */
/* a l'intérieur des variables.                                        */

CHGVAR VAR(&T) VALUE(0)

A020:CHGVAR VAR(&T) VALUE(&T + 1)
IF COND(&T <= 50) THEN(DO)
   IF COND(%SST(&ODOBTX &T 1) = &QUOTE) +
      THEN(CHGVAR VAR(%SST(&ODOBTX &T 1)) +
                  VALUE('"'))
   GOTO CMDLBL(A020)
ENDDO

/* Insertion dans fichier sortie */

CHGVAR VAR(&PRMSQL) VALUE('INSERT INTO '  *CAT +
           &LIBO *TCAT '/' *CAT &FILEO)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ' (+
					QRYSYSN, +
					QRYNAME, +
					QRYLIB,  +
					QRYUSER, +
					ODUCNTA, +
					ODCDAT,  +
					ODUDAT,  +
					ODOBTX,  +
					QRYFICI, +
					QRYLIBI, +
					QRYMBRI, +
					QRYFMTI, +
					QRYFICO, +
					QRYLIBO, +
					QRYMBRO, +
					QRYSIZO)')

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ' VALUES(')

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYSYSN)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYNAME)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYLIB)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &ODOBOW)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&ODUCNTA) VALUE(&ODUCNT) /* Conv.en +
alpha pour concatenation */
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &ODUCNTA)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &ODCDAT)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &ODUDAT)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &ODOBTX)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYFICI)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYLIBI)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYMBRI)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYFMTI)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYFICO)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYLIBO)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYMBRO)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ', ')
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QRYSIZO)
CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT &QUOTE)

CHGVAR VAR(&PRMSQL) VALUE(&PRMSQL *TCAT ')')

CHGVAR VAR(&UTSQLCR) VALUE(0)
CALL PGM(UTSQL) PARM(&PRMSQL &UTSQLCR)

IF COND(&UTSQLCR < 0) THEN(DO)
   DMPCLPGM
   GOTO CMDLBL(Z900)
ENDDO
ENDDO /* Test des fichiers in et out */

GOTO CMDLBL(A01010)

Z800: /* Affichage des resultats */

/*** RUNQRY *n &LIBO/&FILEO ***/

CHGJOB LOGCLPGM(&LOGCLPGM) INQMSGRPY(&INQMSGRPY)

RETURN  /* Fin du programme */

Z900:
RCVMSG MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
       MSGF(&MSGF)
IF COND(&MSG *NE ' ') THEN(DO)
   SNDPGMMSG MSGID(&MSGID) MSGF(&MSGF) MSGDTA(&MSGDTA) +
             MSGTYPE(*COMP)
   GOTO CMDLBL(Z900)
ENDDO

ENDPGM
 

4.  Programme RPG IV RTVQRYF appelé par le programme QRYFICC :
Principe : dump du contenu binaire du query sauvegardé spécifié dans un espace utilisateur puis analyse de cet espace.
En procédant ainsi, Jeff Yanoviak nous a affranchi du problème du niveau de sécurité qui existait dans l'ancien programme RTVQRYF écrit en langage machine.  J'ai mis à jour ce programme pour insérer la sous-procédure DmpQry de Jeff qui traite le SAVF.
 


      *****************************************************************
      *                                                               *
      * Desc: This program retreives the input and output file        *
      *       information from a query definition.                    *
      *                                                               *
      * Pgm:  RTVQRYF                                                 *
      * Date created : 21/04/00                                       *
      * Date updated : 15/02/07.                                      *
      * Created by Jeff Yanoviak                                      *
      * Updated by Philippe Soriano to position the save file on      *
      *         the number of lines to skip depending on i5 release.  *
      *                                                               *
      * Input Parameters:                                             *
      *  QryName - 10 character query name                            *
      *  QryLib  - 10 character library name where query exists       *
      * Output Parameters:                                            *
      *  QryIn - 1280 character "array" of input files (32 elements)  *
      *    QryInFile    - 10 character input file name                *
      *    QryInFileLib - 10 character input file library             *
      *    QryInFileMbr - 10 character input file member              *
      *    QryInFileFmt - 10 character input file format              *
      *  QryOut  - 30 character "data structure" of output file       *
      *    QryOutFile    - 10 character output file name              *
      *      Special value *NONE if query outputs to Display or Print *
      *      Special value *DFT if query outputs to QQRYOUT in QryLib *
      *    QryOutFileLib - 10 character output file library           *
      *    QryOutFileMbr - 10 character output file member            *
      *  ErrCode - 1 character completion code (0=Normal, 1=Error)    *
      *****************************************************************

     h DftActGrp(*No)
     h Option( *SrcStmt: *NoDebugIO )

      * Working file
     fDmpFil    IF   F  528        DISK    UsrOpn

      * Program Status Data Structure
     d Psds           SDS
     d  Excp_MsgId            40     46
     d  Excp_Data             91    170

      *****************************************************************
      * Data Definitions
      *****************************************************************
      * These constants define the offsets in the query object (dump)
      * where the pertinent information is stored.  All offsets are
      * adjusted by +1 for the QUsRtvUs API.
     d QryOutTypeOff   c                   Const(261)
     d QryOutOffOff    c                   Const(381)
     d QryInCountOff   c                   Const(559)
     d QryInOff        c                   Const(563)

      * Entry Parameters
     d QryName         S             10a
     d QryLib          S             10a
     d QryIn           S           1280a
     d QryOut          DS
     d  QryOutFile                   10a
     d  QryOutFileLib                10a
     d  QryOutFileMbr                10a
     d ErrCode         S              1a

      * Working Variables
     d QUsName         S             20a
     d Idx             S             10i 0

      * User Space Variables
     d QUsQName        S             20a   Inz('QRYDMP    QTEMP     ')
     d QUsExtAtr       S             10a   Inz('QryDump')
     d QUsInzSiz       S             10i 0 Inz(x'1000')
     d QUsInzVal       S              1a   Inz(x'00')
     d QUsAut          S             10a   Inz('*ALL')
     d QUsTxt          S             50a   Inz('User Space for RtvQryF')
     d QUsLib          S             10a
     d QUsErrCode      S               *   Inz(*Null)

      * Messaging Variables
     d QMhErrCode      S               *   Inz(*Null)

      * Query Variables
     d QryOutType      S              1a
     d QryOutTmp       S             34a
     d QryInTmp        S             80a
     d QryAut          S              1N   Inz( *Off )

      * The following numeric query variables are declared as data structures to
      * conform to the QUsRtvUs prototype (DS type is passed as character data)
     d QryOutOffDS     DS
     d  QryOutOff                    10U 0
     d QryInCountDS    DS
     d  QryInCount                    5U 0

      * Working data structure for QUsChgUsa API
     d QUsAttr         DS
     d  QUsNumRec                    10i 0 Inz(1)
     d  QUsKey                       10i 0 Inz(3)
     d  QUsRecLen                    10i 0 Inz(1)
     d  QUsRecData                    1a   Inz('1')

      * Prototypes
      * This program dumps a Query object to a user space
     d DmpQry          PR
     d  QueryName                    10a   Const
     d  QueryLib                     10a   Const
     d  QualUSName                   20a   Const
     d  QryAut                        1N

      * Retrieve User Space
     d QUsRtvUs        PR                  ExtPgm('QUSRTVUS')
     d  QualifiedName                20a   Const
     d  StartingPos                  10i 0 Const
     d  DataRcvLength                10i 0 Const
     d  DataRcv                    9999a   Options(*Varsize)

      * Receive Message
     d QMhRmvPm        PR                  ExtPgm('QMHRMVPM')
     d  CSE                          16a   Const
     d  CSECtr                       10i 0 Const
     d  MessageKey                    4a   Const
     d  MsgToRmv                     10a   Const
     d  ErrCode                        *

      * Working file field definition
     IDmpFil    NS  01
     I                                  1  512  SavfDta
     I                                257  512  NoOMH
     I                                513  528  ChkSum

      *****************************************************************
      * Main Line Calculations
      *****************************************************************
      * Entry Parms
     c     *Entry        PList
     c                   Parm                    QryName
     c                   Parm                    QryLib
     c                   Parm                    QryIn
     c                   Parm                    QryOut
     c                   Parm                    ErrCode

      * Dump query to user space
     c                   CallP     DmpQry(QryName : QryLib : QUsQName :
     c                                                       QryAut )

      * Authorisation granted
     c                   If        QryAut

      * Retreive the output type
     c                   CallP     QUsRtvUs(QUsQName : QryOutTypeOff :
     c                                      %Size(QryOutType) : QryOutType)

      * Check if an outfile is defined for this query
     c                   If        QryOutType <> '3'
     c                   Eval      QryOutFile = '*NONE'
     c                   Else

      * Get the offset  for the outfile information in the query
     c                   CallP     QUsRtvUs(QUsQName : QryOutOffOff :
     c                                      %Size(QryOutOffDS) : QryOutOffDS)

      * Check if this query uses the default output file (denoted by a
      * null offset)
     c                   If        QryOutOff = 0
     c                   Eval      QryOutFile = '*DFT'
     c                   Else

      * If the program reaches this point, there is an outfile.  Get it's info
      * from the 5th position after the specified offset to account for padding
      * and the adjustment for QUsRtvUS.
     c                   CallP     QUsRtvUs(QUsQName : QryOutOff + 5 :
     c                                      %Size(QryOutTmp) : QryOutTmp)
     c                   Eval      QryOutFile    = %Subst(QryOutTmp :  1 : 10)
     c                   Eval      QryOutFileLib = %Subst(QryOutTmp : 13 : 10)
     c                   Eval      QryOutFileMbr = %Subst(QryOutTmp : 25 : 10)

     c                   EndIf
     c                   EndIf

      * Get the number of input files
     c                   CallP     QUsRtvUs(QUsQName : QryInCountOff :
     c                                      %Size(QryInCountDS) : QryInCountDS)

      * Loop once for each input file
     c                   For       Idx = 0 To QryInCount - 1

      * The input file information is stored in 80 byte blocks, but this program
      * only returnes four 10 byte file input characteristics.  So, retreive the
      * block represented by Idx and substring it's contents into the "array"
      * element represented by Idx.
     c                   CallP     QUsRtvUs(QUsQName : QryInOff + (Idx * 80) :
     c                                      %Size(QryInTmp) : QryInTmp)
     c                   Eval      %Subst(QryIn    :  1 + (Idx * 40) : 40) =
     c                             %Subst(QryInTmp :  1 : 10) +
     c                             %Subst(QryInTmp : 13 : 10) +
     c                             %Subst(QryInTmp : 25 : 10) +
     c                             %Subst(QryInTmp : 37 : 10)

     c                   EndFor

      * Delete any completion messages from called programs
     c                   CallP     QMhRmvPm( '*ALLINACT' : 0 : '    '
     c                                     : '*ALL' : QMhErrCode)

     c                   Endif
      *                           QryAut *On

      * Check authority, cleanup and exit

      *   if authority not granted
     c                   if        Not QryAut

     c                   if        ErrCode = '0'
     c                   Eval      ErrCode = '2'
     c                   Endif

     c                   Endif

     c                   ExSr      Cleanup

     c                   Eval      *InLr = *On
     c                   Return

      **************************************************************************
     c     *InzSr        BegSr
      *    Initialize program
      **************************************************************************

      * Assume normal end
     c                   Eval      ErrCode = '0'

      * Create a working user space (parms are defined and initialized above)
     c                   Call      'QUSCRTUS'
     c                   Parm                    QUsQName
     c                   Parm                    QUsExtAtr
     c                   Parm                    QUsInzSiz
     c                   Parm                    QUsInzVal
     c                   Parm                    QUsAut
     c                   Parm                    QUsTxt

      * Change the user space size to grow automatically (parms are defined and
      * initialized above)
     c                   Call      'QUSCUSAT'
     c                   Parm                    QUsLib
     c                   Parm                    QUsQName
     c                   Parm                    QUsAttr
     c                   Parm                    QUsErrCode

     c                   EndSr

      **************************************************************************
     c     Cleanup       BegSr
      *    Cleanup program
      **************************************************************************

      * Delete the user space
     c                   Call(e)   'QUSDLTUS'
     c                   Parm                    QUsQName
     c                   Parm                    QUsErrCode

     c                   EndSr

      **************************************************************************
     c     *PSSR         BegSr
      *    Error Handler
      **************************************************************************
      * Cleanup
     c                   Exsr      Cleanup

      * Abnormal end
     c                   Eval      QryIn   = *Blank
     c                   Eval      QryOut  = *Blank
     c                   Eval      ErrCode = '1'
     c                   Dump(a)

     c                   Eval      *InLr = *On
     c                   Return

     c                   EndSr

      ****************************************************************
      *                                                              *
      * Proc: DmpQry                                                 *
      * Auth: Jeff Yanoviak                                          *
      * Desc: This procedure dumps the binary internal contents of   *
      *       the specified query to the specified user space.       *
      *                                                              *
      * Input Parameters:                                            *
      *  QryName - 10 character query name                           *
      *  QryLib  - 10 character library name where query exists      *
      *  QUsName - 20 character qualified user space name            *
      *  QryAut  -  1 character authorization                        *
      * Output Parameters:                                           *
      *  None                                                        *
      ****************************************************************
     P DmpQry          B
     d DmpQry          PI
     d  QueryName                    10a   Const
     d  QueryLib                     10a   Const
     d  QUSName                      20a   Const
     d  QryAut                        1N

      *****************************************************************
      * Data Definitions
      *****************************************************************
      * Working Variables
     d Cmd             S            100a
     d VerRelMod       S             10i 0
     d OSPlatform      S             10i 0
     d RcdNbr          S             10i 0

      * Message Handling Variables
     d QMhErrCode      S               *   Inz(*Null)

      * User Space Variables
     d QUsStrPos       S             10i 0 Inz(1)
     d QUsDataForce    S              1a   Inz('1')

      * Prototypes
      * Change User Space (update user space contents)
     d QUsChgUs        PR                  ExtPgm('QUSCHGUS')
     d  QualifiedName                20a   Const
     d  StartingPos                  10i 0 Const
     d  DataLength                   10i 0 Const
     d  Data                       9999    Options(*VarSize)
     d  ForceChanges                  1a

      * Resend Exception Message
     D/COPY QSYSINC/QRPGLESRC,QMHRSNEM
     d ReSndMsg        PR                  ExtPgm('QMHRSNEM')
     d  MessageKey                    4a   Const
     d  ErrCode                        *
     d  DS_ToCSE                   9999    Options(*VarSize)
     d  ToCSELen                     10i 0 Const
     d  ToCSEFmt                      8a   Const
     d  FromCSE                        *   Const
     d  FromCSECtr                   10i 0 Const

     d SysCmd          PR                  ExtPgm('QCMDEXC')
     d  CmdString                   300a   Options(*VarSize) Const
     d  CmdStringSize                15P 5 Const
     d  CmdOptions                    3a   Options(*NoPass) Const

      *****************************************************************
      * Main Line Calculations
      *****************************************************************

      * Create a working savf file and save the *QRYDFN to it.
     c                   Eval      Cmd = 'CRTSAVF FILE(QTEMP/DMPFIL)'
     c                   CallP     SysCmd(Cmd:%Size(Cmd))

     c                   Eval      Cmd = 'SAVOBJ OBJ(' + %Trim(QryName) + ') ' +
     c                                   'LIB( ' + %Trim(QryLib) + ') '        +
     c                                   'DEV(*SAVF) OBJTYPE(*QRYDFN) '        +
     c                                   'SAVF(QTEMP/DMPFIL)'
     c                   CallP(e)  SysCmd(Cmd:%Size(Cmd))

     c                   if        Not %Error
     c                   Eval      QryAut = *On
      * Check OS Version
     c                   CallB     'CEEGPID'
     c                   Parm                    VerRelMod
     c                   Parm                    OSPlatform

      * Calculate the # of records to skip the MI header
     c                   If        VerRelMod < 530
     c                   Eval      RcdNbr = 33
     c                   Else
     c                   Eval      RcdNbr = 48
     c                   Endif

      * Override to the save file and open it.
     c                   Eval      Cmd = 'OVRSAVF FILE(DMPFIL) EXTEND(*NO) '   +
     c                                   'POSITION(*RRN ' +
     c                                    %char(RcdNbr) + ') '                 +
     c                                   'WAITFILE(*IMMED) SHARE(*NO) '        +
     c                                   'OPNSCOPE(*ACTGRPDFN)'
     c                   CallP     SysCmd(Cmd:%Size(Cmd))
     c                   Open      DmpFil

      * Prime the read loop.  The first 256 bytes of the first record contain
      * the Object Management Header (OMH), which is not part of the query
      * definition object.
     c                   Read      DmpFil

      * if OS Version < 5.3 skip the first 256 bytes (OMH)
     c                   If        VerRelMod < 530
     c                   CallP     QUsChgUs(QUsName : QUsStrPos : %Size(NoOMH)
     c                                      : NoOMH : QUsDataForce)
     c                   Eval      QUsStrPos = QUsStrPos + %Size(NoOMH)

     c                   Endif

      * Read the rest of the file, and write it to the user space.
     c                   DoU       %Eof(DmpFil)
     c                   Read      DmpFil

     c                   CallP     QUsChgUs(QUsName : QUsStrPos : %Size(SavfDta)
     c                                      : SavfDta : QUsDataForce)
     c                   Eval      QUsStrPos = QUsStrPos + %Size(SavfDta)

     c                   EndDo

     c                   Else
      *                              if %Error

     c                   Eval      QryAut = *Off
     c                   EndIf

      * Cleanup and exit
     c                   ExSr      Cleanup
     c                   Return

      **************************************************************************
     c     Cleanup       BegSr
      *    Cleanup working file
      **************************************************************************
     c                   Close     DmpFil

     c                   Eval      Cmd = 'DLTF FILE(QTEMP/DMPFIL)'
     c                   CallP(e)  SysCmd(Cmd:%Size(Cmd))

     c                   EndSr

      **************************************************************************
     c     *PSSR         BegSr
      *    Error Handler - Cleanup working objects and pass exception to the
      *                    caller.
      **************************************************************************
      * Cleanup
     c                   Exsr      Cleanup

      * Pass error message to caller
     c                   Eval      QMHCSE00 = *Null
     c                   Eval      QMHCC00  = 2
     c                   Eval      QMHPQ    = '*NONE'
     c                   CallP     ReSndMsg(*Blank: QMhErrCode: QMHM020001:
     c                                      %Size(QMHM020001): 'RSNM0200':
     c                                      *Null: 0)

      * Exit Program
     c                   Return

     c                   EndSr

     P DmpQry          E

N'hésitez pas à m'écrire si besoin. Je m'efforcerai de vous répondre le plus tôt possible si je le peux .