API QWTSETP

RPG (3 et 4, free), CL, SQL, etc...
Répondre
E.jarry
Messages : 3
Enregistré le : jeu. 15 juin 2017, 10:31:44

Message par E.jarry »

Bonjour,

Dans un programme RPGLE, j'utilise l' API QWTSETP, pour changer de profil.
Dans un programme RPG (3) appelé , je retrouver bien dans la SDS en position 254 à 263 le nom de ce nouveau profil.
Par contre dans un programme RPGLE(4), je ne retrouve pas dans la SDS en position 254 à 263 le nom de ce nouveau profil, je ne le trouve pas non plus en position 358 à 367.
J'ai essayé de jouer avec les options de contrôle dftactgrp & actgrp mais ça n'a rien changé.

Est-ce qu'il y a un moyen de retrouver le profil initialiser par l'API QWTSETP dans un programme RPGLE appelé ?

Merci de votre aide.
Cordialement

cmasse
Site Admin
Messages : 802
Enregistré le : mer. 14 févr. 2007, 18:00:03
Localisation : Nantes
Contact :

SDS

Message par cmasse »

Bizzare.

avec la SDS trouvée ici http://www.volubis.fr/bonus/RpgdsF.htm

ce code

Code : Tout sélectionner

 dcl-ds *N PSDS;
         JOB CHAR(10)  POS(244);
         init_user  CHAR(10) POS(254);             
....
         current_user CHAR(10)POS(358);
 end-ds;

       dsply (%trim(init_user) + '-' + %trim(current_user));
       *INLR = *ON;                                                    
affiche
call af4test/sds_user
DSPLY CM-QSECOFR
Modifié en dernier par cmasse le sam. 24 juin 2017, 14:18:14, modifié 1 fois.
Christian Massé (Volubis.fr)

E.jarry
Messages : 3
Enregistré le : jeu. 15 juin 2017, 10:31:44

Message par E.jarry »

Merci pour votre réponse,
effectivement ça fonctionne en programme "normal",
par contre via une fonction table ça ne fonctionne pas
Voici un exemple :

PGM1-Fonction table

Code : Tout sélectionner


       //Ctl-opt dftactgrp(*no) actgrp(*caller);
       Ctl-opt dftactgrp(*yes) debug(*dump);

       // CREATE FUNCTION TSTEJ/PGM1
       //   (
       //   EXUSER VARCHAR( 10)
       //   )
       //   RETURNS TABLE (
       //   RTpgm    CHAR( 10),
       //   RTUSER   CHAR( 10),
       //   RTCurUsr CHAR( 10)
       //   )
       //   LANGUAGE RPGLE
       //   SPECIFIC PGM1
       //   NOT DETERMINISTIC
       //   READS SQL DATA
       //   CALLED ON NULL INPUT
       //   EXTERNAL NAME  PGM1
       //   PARAMETER STYLE DB2SQL

      // Déclarations....
       Dcl-ds ds_psds PSDS;
         ZTPROG  *PROC;
         NbrParms *parms;
         ZtPgmStatus *status;
         ZtPgmRoutin *routine;
         ZtPgmMsgId char(7)  pos(040);
         ZtPgmMs    char(4)  pos(047);
         ZtPgmAra   char(30) pos(051);
         ZtPgmLib   char(10) pos(061);
         ZtPgmMsg   char(80) pos(091);
         ZTUSER   char(10) pos(254);
         ZTJOB    char(10) pos(244);
         ZTjobnbr char(6)  pos(264);
         ZTName   char(10) pos(334);
         ZTCurUsr char(10) pos(358);
       End-DS;

       dcl-pi ENTRY extpgm('PGM1');
       //.........................................
       // Les colonnes SQL de 1 a N
         // Zone en entrées ............
         ExUSER        varchar(10);
         // Zone en sorties ............
         RtPGM         char(10);
         RtUSER        char(10);
         RtCurUsr      char(10);
       //.........................................
       // Les indicateurs de colonnes SQL de 1 a N (Autant que de colonnes)
         ExUSERi       int(5);
         RtPGMi        int(5);
         RtUSERi       int(5);
         RtCurUsri     int(5);
       //.........................................
       // Parametre Echange SQL (Fixe)
         SQLSTAT       char(5);
         fonction_qual varchar(139);
         fonction_nom  varchar(128);
         msg_diag      varchar(70);
         call_type     int(5);
       End-Pi;

       Dcl-PR Pgm2 Extpgm('PGM2');
         *n char(10);
         *n char(10);
       End-Pr;

       Dcl-PR Pgm3 Extpgm('PGM3');
         *n char(10);
         *n char(10);
       End-Pr;

       Dcl-PR QSYGETPH Extpgm('QSYGETPH');
         *n char(10);
         *n char(10);
         *n char(12);
       End-Pr;
       Dcl-PR QWTSETP Extpgm('QWTSETP');
         *n char(12);
       End-Pr;
       Dcl-PR QSYRLSPH Extpgm('QSYRLSPH');
         *n char(12);
       End-Pr;
       dcl-s ZtQ_Prf char(10);
       dcl-s ZtQ_Pwd char(10);
       dcl-s ZtCURCOD char(12);
       dcl-s ZtPRFCOD char(12);
       Dcl-s Flg_Prf ind;
       Dcl-s WtPGM char(10);
       Dcl-s WtUSER char(10);
       Dcl-s WtCurUsr char(10);
       //=======================================================================
       exec sql Set Option
        Naming    = *Sys,
        Commit    = *None,
        UsrPrf    = *User,
        DynUsrPrf = *User,
        Datfmt    = *iso,
        CloSqlCsr = *EndActGrp;

       // ========================
       // Gestion des demandes SQL
       // ========================
       // Sql appel le programme
          if       call_type < 0;
                   EXSR TRAITEMENT1P; // Traitement 1er passage
                   RETURN;
       // Demande de ligne suivante
          elseif   call_type = 0;
                   EXSR TRAITEMENT;   // Lecture ligne suivante
                   RETURN;
       // Demande de fin
          else;
                   EXSR FINFICHIER;   // Traitement fin de fichier
          ENDIF;
       //===========================================================
       // ========================
       // Traitement du 1er passage
       // ========================
          BEGSR TRAITEMENT1P;
            // Traitement particulier
            EXSR TRTAITEMENT1P_PART;
          ENDSR;

       // ============================
       // Traitement pour retour ligne
       // ============================
          BEGSR TRAITEMENT;
            If WtPGM = 'PGM1';
              WtUSER = ZTUSER;
              WtCurUsr = ZTCurUsr;
              EXSR TRANSFERTZONE;
              WtPGM ='PGM2';
            elseIf WtPGM = 'PGM2';
              callp Pgm2&#40;WtUSER&#58;WtCurUsr&#41;;
              EXSR TRANSFERTZONE;
              WtPGM ='PGM3';
            elseIf WtPGM = 'PGM3';
              callp Pgm3&#40;WtUSER&#58;WtCurUsr&#41;;
              EXSR TRANSFERTZONE;
              WtPGM =' ';
            else;
              EXSR FINFICHIER;
            endif;
          ENDSR;

       // ============================
       //Transfert vers zone de retour
       // ============================
          BEGSR TRANSFERTZONE;
            sqlstat = '00000';
            RtPGM   = WtPGM;
            RtUSER  = WtUSER;
            RtCurUsr  = WtCurUsr;

          ENDSR;

       // ============================
       // Fin de fichier
       // ============================
          BEGSR FINFICHIER;
            sqlstat  = '02000';
            // Mettre a blanc toutes les zones
            clear ExUSER;
            clear RtPGM;
            clear RtUSER;
            clear RtCurUsr;
            // Mettre a -1 tous les indicateurs
            msg_diag = 'Fin de fichier.';
            ExUSERi = -1;
            RtPGMi = -1;
            RtUSERi = -1;
            RtCurUsri = -1;

          // Retour au profil courrant
          If Flg_Prf;
            QWTSETP&#40;ZtCURCOD&#41;;
            QSYRLSPH&#40;ZtPRFCOD&#41;;
            QSYRLSPH&#40;ZtCURCOD&#41;;
            Flg_Prf = *off;
       // dsply &#40;'PGM1&#58; ' + %trim&#40;ZTUSER&#41; + '-' + %trim&#40;ZTCurUsr&#41;&#41;;
          endif;

            RETURN;
          ENDSR;

       // ===================================================================
       // Traitement particulier au programme
       // ===================================================================
       // Traitement particulier 1er passage
          BEGSR TRTAITEMENT1P_PART;  //Création du fichier


       // dsply &#40;'PGM1&#58; ' + %trim&#40;ZTUSER&#41; + '-' + %trim&#40;ZTCurUsr&#41;&#41;;
       // Chagement profil de traitement

         // Contrôle profil en cours
         ZtQ_Prf = '*CURRENT';
         ZtQ_Pwd = *blank;
         QSYGETPH&#40;ZtQ_Prf&#58;ZtQ_Pwd&#58;ZtCURCOD&#41;;

         // Contrôle profil de traitement
         Flg_Prf = *on;
         ZtQ_Prf = ExUSER;
         ZtQ_Pwd = '*NOPWD';
         monitor;
           QSYGETPH&#40;ZtQ_Prf&#58;ZtQ_Pwd&#58;ZtPRFCOD&#41;;
         on-error;
         Flg_Prf = *off;
           // dsply &#40;'PGM1&#58; ' +%trim&#40;ZtQ_Prf&#41;+', Invalide.'&#41;;
           *inLR = *on;
           return;
         endmon;

       // Affectation profil de traitement
       QWTSETP&#40;ZtPRFCOD&#41;;


       // dsply &#40;'PGM1&#58; ' + %trim&#40;ZTUSER&#41; + '-' + %trim&#40;ZTCurUsr&#41;&#41;;

       WtPGM = 'PGM1';

          Endsr;
PGM2-RPG(3) ok

Code : Tout sélectionner

      * Définition du status du programme
     I           SDS
     I                                     *PROGRAM WKPROG
     I                                     *PARMS   £PARMS
     I                                      244 253 ZTECRA
     I                                      244 253 ZTJOB
     I                                      254 263 ZTUSER
     I                                      264 269 ZTNJOB
     I                                      358 367 ZTCURU
     C           *ENTRY    PLIST
     C                     PARM           EXUSER 10
     C                     PARM           EXCURU 10
      *
     C                     MOVEL'PGM2&#58;'   ZTMSG  50 P
     C                     CAT  ZTUSER&#58;1  ZTMSG
     C                     CAT  '-'&#58;0     ZTMSG
     C                     CAT  ZTCURU&#58;0  ZTMSG
     C*          ZTMSG     DSPLY
     C                     MOVELZTUSER    EXUSER    P
     C                     MOVELZTCURU    EXCURU    P
      *
     C                     MOVE *ON       *INLR
PGM3-RPG(4)

Code : Tout sélectionner

       ctl-opt option&#40;*nodebugio&#58;*srcstmt&#41;;
       ctl-opt dftactgrp&#40;*yes&#41;;

       Dcl-ds ds_psds PSDS;
         ZTPROG  *PROC;
         ZTECRP char&#40;3&#41; pos&#40;244&#41;;
         £parms   *parms;
         ZtPgmStatus *status;
         ZtPgmRoutin *routine;
         ZtPgmMsgId char&#40;7&#41;  pos&#40;040&#41;;
         ZtPgmMs    char&#40;4&#41;  pos&#40;047&#41;;
         ZtPgmAra   char&#40;30&#41; pos&#40;051&#41;;
         ZtPgmLib   char&#40;10&#41; pos&#40;061&#41;;
         ZtPgmMsg   char&#40;80&#41; pos&#40;091&#41;;
         ZTJobUsr char&#40;10&#41; pos&#40;254&#41;;
         ZTJOB    char&#40;10&#41; pos&#40;244&#41;;
         ZTjobnbr char&#40;6&#41;  pos&#40;264&#41;;
         ZTName   char&#40;10&#41; pos&#40;334&#41;;
         ZTCurUsr char&#40;10&#41; pos&#40;358&#41;;
       End-DS;

       dcl-pi ENTRY extpgm&#40;'PGM3'&#41;;
         ExUSER        char&#40;10&#41;;
         ExCurUsr      char&#40;10&#41;;
       end-pi;

       // Dsply &#40;'PGM3&#58; ' + %trim&#40;ZTJobUsr&#41; + '-' + %trim&#40;ZTCurUsr&#41;&#41;;
       ExUSER   = ZTJobUsr;
       ExCurUsr = ZTCurUsr;

       *inLR = *on;
résultat de la fonction
  • RTPGM RTUSER RTCURUSR
    PGM1 JARRYE JARRYE
    PGM2 ALAING
    PGM3 JARRYE JARRYE

cmasse
Site Admin
Messages : 802
Enregistré le : mer. 14 févr. 2007, 18:00:03
Localisation : Nantes
Contact :

NOT FENCED

Message par cmasse »

et en ajoutant NOT FENCED au CREATE FUNCTION.

sans ce paramètre la fonction est lancée dans un JOB à part.....
Christian Massé (Volubis.fr)

E.jarry
Messages : 3
Enregistré le : jeu. 15 juin 2017, 10:31:44

Message par E.jarry »

Bonjour,

avec NOT FENCED dans le CREATE FUNCTION

Merci...

Répondre