Fil d’Ariane du forum – Vous êtes ici :ForumForums techniques: AS/400Récupérer un message CPFnnnn dans …
Vous devez vous identifier pour créer des messages et des sujets.

Récupérer un message CPFnnnn dans un pgm Cobol

Mon programme Cobol fait un call QCMDEXC pour exécuter la commande SNDMSG afin d'envoyer des messages à un groupe d'utilisateurs dont j'ai les codes dans un fichier lu dans mon programme. La commande se trouve donc dans une boucle.
Mon problème : un des codes utilisateurs que j'ai dans le fichier n'existe plus en tant que USER AS400, et mon pgm se plante avec le msg CPF2469.
Comment puis-je intercepter cette erreur afin que ça ne plante pas si on oublie d'enlever le code utilisateur inconnu du fichier ?
Merci de votre réponse.

Au lieu d'utiliser QCMDEXC pour faire un "SNDMSG" dans ton programme, tu serais plus à l'aise et ça ferait plus "pro" si tu employais l'API QEZSNDMG (Send message) dans ton programme pour faire le SNDMSG et testais l'error code en retour.
On peut facilement t'aider ici si besoin.

Merci pour cette réponse. J'ai juste un peu de mal à comprendre comment fonctionne la zone 'error code' en retour de l'API.
Mon souci est d'envoyer un message à plusieurs utilisateurs. Si toutefois un des USER n'existe pas, il faut que je l'envoie au suivant, sans que cela pose problème.
Puis-je faire à la suite plusieurs appels de QEZSNDMG sans vérifier le code erreur en retour ?
Dois-je réinitialiser des paramètres entre chaque appel ?

Citation de JOPRI

J'ai juste un peu de mal à comprendre comment fonctionne la zone 'error code' en retour de l'API.

C'est vrai que ce n'est pas évident si on n'a jamais programmé avec les APIs. Lis le paragraphe "Gestion des erreurs" que j'ai publié sur cette page qui explique la gestion de l'error code de nombreuses APIs.

Puis-je faire à la suite plusieurs appels de QEZSNDMG sans vérifier le code erreur en retour ?

Oui mais, si j'ai bien compris ce que tu veux faire, ce n'est peut-être pas nécessaire compte tenu que l'API peut envoyer le message à plusieurs profils en un seul et même call (paramètre 5).

Dois-je réinitialiser des paramètres entre chaque appel ?

Non, ce n'est pas nécessaire.

Colle stp ici ton coding de l'API, c'est à dire la définition des paramètres, leur alimentation et l'appel à l'API QEZSNDMSG, ceci pour en faire bénéficier les lecteurs du forum. Merci.

Merci Philippe. J'ai enfin eu le temps de mettre en application.
Problème que j'ai rencontré : lorsqu'on appelle QEZSNDMG avec une liste de users, dès qu'un des users pose problème à l'API (user inconnu par exemple), l'API n'envoie pas de message aux autres users de la liste. J'ai donc dû appeler l'API plusieurs fois, en enlevant avant chaque appel le user posant problème.
Autre point : les temps de traitement avec appel de l'API sont plus élevés qu'avec le QCMDEXC comme je le faisais avant.
Voici l'extrait de mon pgm COCBOL avec l'appel de l'API :
en working :
01 MESSAGE-TYPE PIC X(10) VALUE '*INFO '.
01 DELIVERY-MODE PIC X(10) VALUE '*BREAK '.
01 MESSAGE-LENGTH PIC S9(06) VALUE 126 BINARY.
01 LINK-MESSAGE PIC X(126) VALUE SPACES.
01 LINK-USERID PIC X(2800) VALUE SPACES.
01 NUMBER-OF-USERS PIC S9(06) VALUE 1 BINARY.
01 MESSAGE-SENT PIC S9(06) VALUE +0 BINARY.
01 FUNCTION-REQUEST PIC S9(06) VALUE +0 BINARY.
01 SHOW-DISPLAY PIC X(01) VALUE 'N'.
01 MESSAGE-QUEUE-NAME PIC X(20) VALUE SPACES.
01 NAME-TYPE PIC X(04) VALUE '*USR'.
01 ERROR-STUFF.
05 BYTES-PROVIDED PIC S9(06) VALUE +116 BINARY.
05 BYTES-AVAILABLE PIC S9(06) VALUE +0 BINARY.
05 EXCEPTION-ID PIC X(07) VALUE SPACES.
05 RESERVED PIC X(01) VALUE SPACE.
05 EXCEPTION-DATA PIC X(100) VALUE SPACES.
et en procédure division, après avoir alimenté LINK-MESSAGE avec le texte du message, LINK-USERID avec une liste de users (10car. de long chacun) et NUMBER-OF-USERS avec le nombre de users :
CALL 'QEZSNDMG'USING
MESSAGE-TYPE
DELIVERY-MODE
LINK-MESSAGE
MESSAGE-LENGTH
LINK-USERID
NUMBER-OF-USERS
MESSAGE-SENT
FUNCTION-REQUEST
ERROR-STUFF
SHOW-DISPLAY
MESSAGE-QUEUE-NAME
NAME-TYPE.
et en retour, test de la donnée BYTES-AVAILABLE (erreur si > zero).
Le user en erreur se trouve dans EXCEPTION-DATA (1:10)

J'ai relu ta réponse et trouvé que tu t'étais très bien débrouillée avec l'API 😎

Cependant, si les temps de traitement sont plus élevés qu'avec QCMDEXC ( qui est aussi une API au passage 😉 ), c'est parce que tu appelles chaque fois l'API QEZSNDMG pour envoyer le message à un seul user au lieu de tous d'un seul coup. L'API peut être bien sûr employée pour envoyer un message à un seul user comme tu l'as fait, mais c'est plutôt fait pour les "bulk messages", c'est à dire pour une liste de users, un peu comme les e-mails de pub qui polluent nos BAL. C'est d'ailleurs bien ce que tu veux, n'est-il pas ? Donc, pour régler l'ennui du ou des users inconnus, charge le parametre LINK-USERID avec les "bons" users avant d'appeler l'API QEZSNDMG. Pour savoir si tu as affaire à un bon user, contrôle sa validité avec l'API (encore) access() de la façon que je montre dans le programme Cobol ILE ci-dessous.

**********************************************************
* Compiler comme suit :
*
* 1/ CRTCBLMOD MODULE(MaBib/SNDMULTMSG)
* SRCFILE(MaBib/QCBLLESRC)
* SRCMBR(SNDMULTMSG)
* DBGVIEW(*SOURCE)
*
* 2/ CRTPGM PGM(MaBib/SNDMULTMSG)
* ´BNDSRVPGM(QSYS/QP0LLIB1)
*
**********************************************************

PROCESS NOMONOPRC NOSTDTRUNC APOST.
IDENTIFICATION DIVISION.
Program-ID. SNDMULTMSG.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ISERIES.
OBJECT-COMPUTER. IBM-ISERIES.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
Select UsrFile Assign To DATABASE-UsrFile
Organization SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD UsrFile
LABEL RECORD STANDARD.
01 UsrFile-Enr.
05 UsrPrf pic x(10).

Working-Storage Section.
01 At-End pic x.
01 UsrPrf-Path pic x(255).
01 p-PathPtr Pointer Value Null.
01 F-OK pic s9(09) Value 0 Binary.
01 Null-Char pic x(1) Value x'00'.
01 Usrprf-Lu pic x(10).
01 RC pic s9(09) Value 0 Binary.
01 Nbr-UsrPrf-OK pic s9(09) Value 0 Binary.

01 QEZSNDMG-API.
05 MESSAGE-TYPE PIC X(10) VALUE '*INFO'.
05 DELIVERY-MODE PIC X(10) VALUE '*NORMAL'.
05 LINK-MESSAGE PIC X(126) VALUE SPACES.
05 MESSAGE-LENGTH PIC S9(09) BINARY.
05 LINK-USERID.
10 Link-UserPrf PIC X(10) Occurs 280.
05 NUMBER-OF-USERS PIC S9(09) BINARY.
05 MESSAGE-SENT PIC S9(09) VALUE +0 BINARY.
05 FUNCTION-REQUEST PIC S9(09) VALUE +0 BINARY.
05 SHOW-DISPLAY PIC X(01) VALUE 'N'.
05 MESSAGE-QUEUE-NAME PIC X(20) VALUE SPACES.
05 NAME-TYPE PIC X(04) VALUE '*USR'.
05 ERROR-STUFF.
10 BYTES-PROVIDED PIC S9(09) BINARY.
10 BYTES-AVAILABLE PIC S9(09) BINARY.
10 EXCEPTION-ID PIC X(07) VALUE SPACES.
10 RESERVED PIC X(01) VALUE SPACE.
10 EXCEPTION-DATA PIC X(100) VALUE SPACES.

Procedure Division.
Start-Proc.

* Initialisations
Move Length Of Error-Stuff To Bytes-Provided.

* Message a envoyer
Move 'Coucou' To Link-Message.
Move Length Of Link-Message To Message-Length.

* Ouverture table des users
Open Input UsrFile.

* Initialisation parametre LINK-USERID
* par lecture et controle des users
* dans la table des users destinataires
* du message à envoyer.
Move '0' to At-End.
Move 0 To Nbr-UsrPrf-OK.
Perform Read-Usrfile Thru Read-UsrFile-Exit
Until At-End = '1'.
Move Nbr-UsrPrf-Ok To Number-Of-Users.

* Envoi du message aux MSGQ(users)
Call 'QEZSNDMG' Using Message-Type
DELIVERY-MODE
LINK-MESSAGE
MESSAGE-LENGTH
LINK-USERID
NUMBER-OF-USERS
MESSAGE-SENT
FUNCTION-REQUEST
ERROR-STUFF
SHOW-DISPLAY
MESSAGE-QUEUE-NAME
NAME-TYPE
If Bytes-Available > 0
display 'Ya un os : ' exception-id, exception-data
End-If

Stop Run.

*******************
* Sous-programmes *
*******************
* Controle puis charge profils ok dans parametre LINK-USERID
Read-Usrfile.
Read UsrFile At End
Close UsrFile
Move '1' to At-End.

If At-End = '0'

* Controle existence user avec API Unix-Type "access()"
String '/QSYS.LIB/' Delimited By Size
UsrPrf Delimited By Space
'.USRPRF' Delimited By Size
Null-Char Delimited by Size
Into UsrPrf-Path

* Note. Respecter la casse du nom de l'API
Call Procedure 'access'
Using By Value Address Of UsrPrf-Path
By Value F-OK
Returning RC
If RC < 0 display 'User ' UsrPrf ' Not Found.' Else Add 1 To Nbr-UsrPrf-OK Move usrPrf To Link-UserPrf(Nbr-UsrPrf-OK) End-if End-if. Read-Usrfile-Exit. Exit.

IMPORTANT
Ce programme est à placer dans un membre source de type CBLLE. Au même titre, si tu emploies l'API access() dans ton programme, tu devras aussi indiquer un type de source CBLLE pour ton membre.

La compilation s'effectue alors en deux temps :
- création d'un module avec CRTCBLMOD... (PDM opt 15)
- puis création du programme avec CRTPGM...BNDSRVPGM(QSYS/QP0LLIB1).

Le nom de ce programme de service est indiqué au début de la page de l'API access() sur le site de Big Blue et, en Cobol (pas en RPG), il doit être indiqué sur la commande de création du programme sinon erreur au linkage. Cette méthode doit être employée s'il y a lieu par tout programme utilisant des APIs de type Unix car ces APIs sont des procédures dans les programmes de service indiqués sur la page de l'API concernée (note au passage que je fais un Call Procedure et non pas un Call Programme dans le programme ci-dessus).

Mon Cobol doit être un peu rouillé et n'est certainement pas conforme aux méthodes actuellement employées en programmation mais ça marche quand même. Tu es certainement mieux rodée que moi à ces méthodes. 😀