| 
* * EXEMPLE DE REQUETE SQL DYNAMIQUE (WHERE ET ORDER BY SAISIE PAR * L'UTILISATEUR) * * UTILISANT LES NOUVEAUTÉS V2R20 SUIVANTES: * * SELECT ... OPTIMIZE FOR XX ROWS * * FETCH C1 FOR XX ROWS INTO :DS <-- DS À OCCURENCES MULTIPLES * * CE PGM UTILISE AUSSI L'API QUSLFLD (LISTE DES ZONES DANS *USRSPC) * AFIN D'AFFICHER LA LISTE DES ZONES DU FICHIER VIA SOUS FICHIER. * * REMARQUE: COMPILER CE PGM AVEC : * ======== CRTSQLRPG .... COMMIT(*NONE) * * POUR REUTILISER CE PGM MODIFIER : FICCT (CONSTANTE/SPECIF I) * 18 PAR VOTRE SFLPAG * (DANS LA LIGNE SEU ==> " C 18 XX ALL ".) *------------------------------------------------------------------------- FSQLDYND CF E WORKSTN KINFDS INFODS F RZ KSFILE SFLZON F RC KSFILE SFLCRS * CONSTANTES I 'SELECT AF4MDL, AF4MB-C SEL1 I 'R, AF4TXT, DISPO FRO- I 'M AF400/AF4MBRP1' I 'ORDER BY' C SEL2 I 'OPTIMIZE FOR 18 ROWS'C SEL3 I 'SQLDYN QTEMP 'C SPCCT I 'AF4MBRP1 AF400 'C FICCT I 'LISTE DES ZONES' C CTX * DATA STRUCTURES * INFDS DU FICHIER ECRAN (RECUP. N° DE RANG DE LA PREMIERE LIGNE * DE LA PAGE AFFICHÉE) IINFODS DS I B 378 3790SFLRG * ENTETE USER SPACE IRTVINF DS I B 1 40FIN I B 5 80TAILLE I B 9 120NBPOST I B 13 160LGPOST * DECLARATION DE VARIABLES BINAIRES |
|
IBINDS DS I B 1 40DEBUT I B 5 80LG I B 9 120LGRCV * DEFINITION D'UNE ZONE ILIST DS 212 I 1 10 ZONE I 33 82 TEXTE * CODE ERREUR API IERRDS DS I I 16 B 1 40LGDS I B 5 80LGERR I 9 15 MSGID I 16 16 RESERV * VARIABLE CONTENANT LA REQUETE SQL (1024 C.) ISELVAR DS 1024 * DEFINITION D'UNE DS (POUR LECTURE DU CURSEUR/FETCH) * AVEC OCCURENCES MULTIPLES (SFLPAG = 18). IDSMULT DS 18 I 1 10 AF4MDL I 11 20 AF4MBR I 21 70 AF4TXT I 71 71 DISPO * DEBUT DU PGM * =============== * * CREATION DU USER SPACE(POUR LISTE DES ZONES) DANS QTEMP C EXSR CRTUS * REMPLISSAGE DU USER SPACE VIA API "LISTE DES ZONES". C CALL 'QUSLFLD' C PARM SPCCT USRSPC C PARM 'FLDL0100'FMT 8 C PARM FICCT FIC 20 C PARM 'AF4MBRF1'FMTDB 10 C PARM '0' OVRDBF 1 * EXTRACTION DES INFOS D'ENTETE C Z-ADD125 DEBUT C Z-ADD16 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVINF C NBPOST IFGT 0 |
|
C Z-ADD0 RZ 40 C MOVE *ON *IN30 C WRITECTLZON C MOVE *OFF *IN30 C Z-ADDLGPOST LG C FIN ADD 1 DEBUT 1ER POSITION * * BOUCLE SUR NOMBRE DE POSTES EXTRAITS (NBR DE ZONES) * C DO NBPOST * EXTRACTION D'UN POSTE PAR API QUSRTVUS (-> DONNE INFOS SUR UNE ZONE) C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM LIST * ECRITURE DANS SOUS FICHIER C ADD 1 RZ C WRITESFLZON * POSITIONNEMENT SUR PROCHAIN POSTE C ADD LG DEBUT C ENDDO * C WRITETITRE C *IN03 DOUEQ*ON C WRITECTLZON C EXFMTENTETE C *IN03 CASEQ*OFF SQLSR C ENDCS C ENDDO * C ENDIF * FIN DU PGM C MOVE *ON *INLR C EXSR DLTUS C RETRN * SOUS PROGRAMMES * =============== * REQUTE ET LECTURE DU CURSEUR DANS SOUS FICHIER C SQLSR BEGSR * MISE À BLANC DU SOUS FICHIER C Z-ADD0 RC 40 C MOVEA'101' *IN,31 C WRITECTLCRS |
|
C MOVE *OFF *IN31 * PREPARATION ET EXECUTION DE LA REQUETE C EXSR PREPAR C WRITEPIED * BOUCLE SUR AFFICHAGE SOUS FICHIER * (80 = ROLLUP, FORCÉ À '1' AU PREMIER PASSAGE) C MOVE *ON *IN80 C *IN03 DOUEQ*ON C *IN12 OREQ *ON C *IN80 IFEQ *ON C EXSR UNEPAG * DERNIER N° DE RANG DANS SFLRCDNBR = DERNIERE PAGE C Z-ADDRC LIGNE C ELSE * N° DE RANG (PREMIERE LIGNE) DANS SFLRCDNBR = MÊME PAGE C Z-ADDSFLRG LIGNE C ENDIF C EXFMTCTLCRS C ENDDO C EXSR CLOSC1 C ENDSR * * MISE EN FORME ET EXECUTION DE LA REQUETE C PREPAR BEGSR * MISE EN PLACE DU SELECT ... FROM ... C MOVELSEL1 SELVAR P P =MISE A BLANC * S'IL Y A DES SELECTION MISE EN PLACE DU WHERE ... C SELEC IFNE *BLANK C CAT 'WHERE':1 SELVAR C CAT SELEC:1 SELVAR C ENDIF * S'IL Y A DEMANDE DE CLASSEMENT MISE EN PLACE DU ORDER BY ... C MOVE 'N' ORDERB 1 C CLE1 IFNE *BLANK C MOVE 'O' ORDERB C CAT SEL2:1 SELVAR C CAT CLE1:1 SELVAR C ENDIF C CLE2 IFNE *BLANK C ORDERB IFNE 'O' C MOVE 'O' ORDERB C CAT SEL2:1 SELVAR C ELSE C CAT ',':0 SELVAR |
|
C ENDIF C CAT CLE2:1 SELVAR C ENDIF C CLE3 IFNE *BLANK C ORDERB IFNE 'O' C MOVE 'O' ORDERB C CAT SEL2:1 SELVAR C ELSE C CAT ',':0 SELVAR C ENDIF C CAT CLE3:1 SELVAR C ENDIF C CAT SEL3:1 SELVAR * * SELVAR CONTIENT LA REQUETE À EXECUTER * * PREPARATION DE LA REQUETE C/EXEC SQL C+ PREPARE P1 FROM :SELVAR C/END-EXEC * DECLARATION DU CURSEUR AVEC LE RESULTAT GÉNÉRÉ PAR "PREPARE". C/EXEC SQL C+ DECLARE C1 CURSOR FOR P1 C/END-EXEC * OUVERTURE DU CURSEUR = EXECUTION DE LA REQUETE ==> CURSEUR REMPLI C/EXEC SQL C+ OPEN C1 C/END-EXEC C ENDSR * FERMETURE DU CURSEUR C CLOSC1 BEGSR C/EXEC SQL C+ CLOSE C1 C/END-EXEC C ENDSR * CHARGEMENT D'UNE PAGE C UNEPAG BEGSR * EXTRACTION D'UNE PAGE (18 LIGNES PLACÉES DANS LA DS À OCCURENCES) C/EXEC SQL C+ FETCH NEXT FROM C1 FOR 18 ROWS INTO :DSMULT C/END-EXEC C SQLER3 IFLE 0 * AUCUNE LIGNE EXTRAITE ==> SFLEND (ROLLUP NON AUTORISÉ) C MOVE *OFF *IN33 |
|
C ELSE * 32 = SFLDSP (AFFICHAGE DU SOUS FICHIER) C MOVE *ON *IN32 C SQLER3 IFLT 18 * MOINS DE 18 LIGNES ==> SFLEND (ROLLUP NON AUTORISÉ) C MOVE *OFF *IN33 C ENDIF * SUIVANT NOMBRE DE LIGNES EXTRAITES C 1 DO SQLER3 RANG 20 * POSITIONNEMENT SUR L'OCCURENCE À TRAITER C RANG OCUR DSMULT * ECRITURE DANS SOUS FICHIER (LES VARIABLES AYANT LE MÊME NOM) C ADD 1 RC C WRITESFLCRS C ENDDO C ENDIF C ENDSR * CREATION DU USER SPACE C CRTUS BEGSR C MOVELSPCCT USRSPC 20 C MOVEL'LSTZONE 'EXT 10 C Z-ADD1024 TAILLE C MOVE ' ' INT 10 C MOVEL'*USE' AUT 10 C MOVELCTX TXT 50 * dlt du user space si présent dans QTEMP C EXSR DLTUS * CREATION USER SPACE PAR API QUSCRTUS C CALL 'QUSCRTUS' C PARM USRSPC C PARM EXT C PARM TAILLE C PARM INT C PARM AUT C PARM TXT C ENDSR * DLT DU USER SPACE C DLTUS BEGSR * DLT DU USER SPACE (Y COMPRIS EN CAS DE PLANTUS) API QUSDLTUS C CALL 'QUSDLTUS' 99 C PARM USRSPC C PARM ERRDS C ENDSR * GESTION DES ERREURS PGM |
|
* (SOUS PGM RECONNU PAR RPG EN TANT QUE GESTIONNAIRE D'ERREUR , * SUR SON NOM (*PSSR).) C *PSSR BEGSR * 98 = '1' SI ON EST DÉJA PASSÉ DANS CE SOUS PGM (RISQUE DE BOUCLE) C *IN98 IFEQ *ON C MOVE *ON *INLR C RETRN C ELSE C MOVE *ON *IN98 C EXSR DLTUS * RENVOI LE DERNIER MESSAGE *ESCAPE (API V2R20) C CALL 'QMHRSNEM' C PARM ' ' KEYC 4 C PARM ERRDS C ENDIF C ENDSR |
