Page 1 sur 1
Posté : lun. 19 juin 2017, 16:09:28
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
SDS
Posté : mar. 20 juin 2017, 10:45:16
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
Posté : mar. 20 juin 2017, 15:06:41
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 tableCode : 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(WtUSER:WtCurUsr);
EXSR TRANSFERTZONE;
WtPGM ='PGM3';
elseIf WtPGM = 'PGM3';
callp Pgm3(WtUSER:WtCurUsr);
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(ZtCURCOD);
QSYRLSPH(ZtPRFCOD);
QSYRLSPH(ZtCURCOD);
Flg_Prf = *off;
// dsply ('PGM1: ' + %trim(ZTUSER) + '-' + %trim(ZTCurUsr));
endif;
RETURN;
ENDSR;
// ===================================================================
// Traitement particulier au programme
// ===================================================================
// Traitement particulier 1er passage
BEGSR TRTAITEMENT1P_PART; //Création du fichier
// dsply ('PGM1: ' + %trim(ZTUSER) + '-' + %trim(ZTCurUsr));
// Chagement profil de traitement
// Contrôle profil en cours
ZtQ_Prf = '*CURRENT';
ZtQ_Pwd = *blank;
QSYGETPH(ZtQ_Prf:ZtQ_Pwd:ZtCURCOD);
// Contrôle profil de traitement
Flg_Prf = *on;
ZtQ_Prf = ExUSER;
ZtQ_Pwd = '*NOPWD';
monitor;
QSYGETPH(ZtQ_Prf:ZtQ_Pwd:ZtPRFCOD);
on-error;
Flg_Prf = *off;
// dsply ('PGM1: ' +%trim(ZtQ_Prf)+', Invalide.');
*inLR = *on;
return;
endmon;
// Affectation profil de traitement
QWTSETP(ZtPRFCOD);
// dsply ('PGM1: ' + %trim(ZTUSER) + '-' + %trim(ZTCurUsr));
WtPGM = 'PGM1';
Endsr;
PGM2-RPG(3) okCode : 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:' ZTMSG 50 P
C CAT ZTUSER:1 ZTMSG
C CAT '-':0 ZTMSG
C CAT ZTCURU: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(*nodebugio:*srcstmt);
ctl-opt dftactgrp(*yes);
Dcl-ds ds_psds PSDS;
ZTPROG *PROC;
ZTECRP char(3) pos(244);
£parms *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);
ZTJobUsr 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('PGM3');
ExUSER char(10);
ExCurUsr char(10);
end-pi;
// Dsply ('PGM3: ' + %trim(ZTJobUsr) + '-' + %trim(ZTCurUsr));
ExUSER = ZTJobUsr;
ExCurUsr = ZTCurUsr;
*inLR = *on;
résultat de la fonction
- RTPGM RTUSER RTCURUSR
PGM1 JARRYE JARRYE
PGM2 ALAING
PGM3 JARRYE JARRYE
NOT FENCED
Posté : mar. 20 juin 2017, 15:18:34
par cmasse
et en ajoutant NOT FENCED au CREATE FUNCTION.
sans ce paramètre la fonction est lancée dans un JOB à part.....
Posté : mer. 21 juin 2017, 10:03:41
par E.jarry
Bonjour,
avec NOT FENCED dans le CREATE FUNCTION
Merci...