Discussion :

[a_karim_fr]

J’ai un fichier en entré et je veux insérer les données qui existe dans ce fichier dans une file d’attente MQSERIS, est ce que il y a un JCL qui permet d’insérer dans MQSERIS ?

[Homer-ac]

Bonjour,

Je n'ai pas regardé les dernières versions MQ, mais contrairement aux autres plates-formes, il ny a/avait ? rien en standard pour alimenter une queue en batch z/OS depuis un fichier séquentiel. A une époque, j'avais écrit un COBOL d'alimentation et un second d'extraction en m'appuyant sur les samples fournis par IBM. A mon avis toutes les sociétés se sont dotées de programmes du même genre. C'est trop ancien pour que je communique ces sources. Renseignes toi auprès de tes collèques pour savoir s'ils ont ça dans leur chapeau. Sinon au besoin, je derais retrouver ces sources pour en faire des programmes un peu moins spécifiques. Mais il me faudra réécrire et tester, ce qui pourra prendre un peu de temps. Pourquoi pas ? Mais à mon avis tu as déjà ça sur site.

[Homer-ac]

Bonjour,

Bien que le but de ce forum est plutôt d'aider à répondre à des problèmes que de programmer des sources complets, pour le coup, j'ai quand même pris le temps d'écrire et rapidement tester un COBOL d'alimentation d'une file Websphère MQ.
C'est juste un exemple rapide, qui peut être amélioré, et comme je suis parti d'un Sample IBM (CSQ*.SCSQCOBS : CSQ4BVK1), la programmation pourrait à l'évidence être mieux structurée. En tous cas, ça fonctionne, mais spécifiquement sur MVS.
D'autre part, quand on teste un programme, on s'assure de tous les cas d'erreurs, à commencer les cas de fichiers vides qui réservent souvent des surprises et je n'ai pas pris ce temps.
Ce qui m'intéressait dans cet exemple était que puisque les messages alimentés dans une file MQ sont de longueur variables, on lit un ficher QSAM fixe et non pas variable, de LRECL quelconque pour récupérer cette longueur et en déduire la lonqueur par défaut des messages à écrire par MQPUT.
Pas un truc que l'on fait normamement en COBOL, on prend le LRECL dans le DCB. En contrepartie ça ne peut fonctionner qu'en MVS
Tel que ce programme a peu d'utilité en MVS sans écrire son petit frère (dont je laisse le soin à ceux que ceci intéresseraient), le programme d'extraction des messages alimentés dans la file MQ. Il suffit de repartir d'un exemple de la SCSQCOBS d'install Websphère MQ z/OS (CSQ4BVJ1 en particulier), qu'il est assez facile de reprendre et adapter à ses besoins.
nb. malgré sa spécificité MVS, un tel utilitaire à beaucoup moins d'intérêt en distribué. Je connais bien moins, mais je sais que l'on a alors les outils qui vont bien pour ça.
Enfin, un programme MQ ne peut être compilé qu'avec un JCL de Linkédit particulier. Ceux qui ont le produit en MVS ont nécessairement prévu ceci sur le site.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
CBL NODYNAM
       Identification Division.
       Program-ID. MQWRITE.
      *****************************************************************
      *                   IBM WebSphere MQ for z/OS                   *
      *                                                               *
      *  Module Name      : MQWRITE                                   *
      *                                                               *
      *  Environment      : z/OS Batch; COBOL II                      *
      *                                                               *
      *  Description      : Ecriture de messages dans une queue       *
      *                     depuis un fichier QSAM lu en SYSIN de     *
      *                     LRECL quelconque.                         *
      *                                                               *
      *****************************************************************
      *                                                               *
      *                       Exemple JCL d'Appel                     *
      *                       -------------------                     *
      *                                                               *
      *  PARM D'APPEL (SEPARES PAR DES VIRGULES)                      *
      *  - 1ER   PARM (QMGR)   NOM QUEUE MANAGER                      *
      *  - 2EME  PARM (QUEUE)  NOM DE LA QUEUE                        *
      *  - 3EME  PARM (MSGS)   NOMBRE DE MESSAGE A ECRIRE A MAXIMUM   *
      *  - 4EME  PARM (LEN)    LONGUEUR DES MESSAGES (DEFAUT = LRECL) *
      *                        LONGUEUR MAXI : 65535                  *
      *  - 5EME  PARM (PERS)   MESSAGES (P)ERSISTENTS/(N)ON PERSISTENT*
      *---------------------------------------------------------------*
      * //PUTMSGS  EXEC PGM=MQWRITE,REGION=1024K,                     *
      * //  PARM=('CSQ7,TESTFILE,2,20,P')                                 *
      * //STEPLIB  DD   DSN=&SYSUID..COBOL.LOADLIB,DISP=SHR           *
      *            DD   DISP=SHR,DSN=CSQ700.SCSQAUTH                  *
      *            DD   DISP=SHR,DSN=CSQ700.SCSQANLE                  *
      * //SYSOUT   DD   SYSOUT=*                                      *
      * //SYSPRINT DD   SYSOUT=*                                      *
      * //SYSIN    DD   *                                             *
      * MESSAGE NO 000001                                             *
      * MESSAGE NO 000002                                             *
      *                                                               *
      *****************************************************************
      *                                                               *
      *                    Logique programme                          *
      *                    -----------------                          *
      *                                                               *
      *                                                               *
      *   Move paramètres dans les variables correspndantes           *
      *   si erreur -> Call USAGE-ERROR et retour                     *
      *                                                               *
      *   Open fichier SYSIN et chargement du LRECL depuis son DCB    *
      *   si erreur -> Call USAGE-ERROR et retour                     *
      *                                                               *
      *   Display des parametres reçus par le programme               *
      *                                                               *
      *   Connect Queue manager.                                      *
      *   si erreur -> Call DISPLAY-ERROR-MESSAGE et retour           *
      *                                                               *
      *   Affectation des options pour l'OPEN  .                      *
      *   MQOPEN de la file message                                   *
      *   si erreur -> Disconnect                                     *
      *             -> Call DISPLAY-ERROR-MESSAGE et retour           *
      *                                                               *
      *   Affectation des propriétés et options messages              *
      *                                                               *
      *   Display du nombre de messages écrits                        *
      *                                                               *
      *   Close puis Disconnect Queue manager                         *
      *   si erreur -> Call DISPLAY-ERROR-MESSAGE                     *
      *                                                               *
      *   Exit program.                                               *
      *                                                               *
      *                                                               *
      *****************************************************************
       Environment Division.
       Input-Output Section.
       File-Control.
           Select MYMESS Assign to SYSIN.
       Data Division.
       File Section.
       FD MYMESS
           Recording Mode is F
           Record 0.
       01  ENR-MYMESS                  Pic X(32760).
 
      * ------------------------------------------------------------- *
       Working-Storage Section.
      * ------------------------------------------------------------- *
 
      *    Données de travail général
 
       01  W0-PTRX                     Pic x(4)  Value Low-Value.
       01  W0-PTR  Redefines W0-PTRX             Pointer.
       01.
           05  W0-LRECL-MAXI           Pic S9(8) Binary Value 65535.
           05  W0-COUNT-LEC            Pic S9(4) Binary Value Zero.
           05  W0-LECT-FIN             Pic S9(4) Binary Value Zero.
           05  W0-RETURN-CODE          Pic S9(4) Binary.
           05  W0-LOOP                 Pic S9(4) Binary Value 0.
           05  W0-NUMPUTS              Pic S9(4) Binary Value 0.
           05  W0-ERROR-MESSAGE        Pic X(48) Value Spaces.
 
      *   Variables paramètres
 
       01  W0-QMGR                     Pic X(48).
       01  W0-QNAME                    Pic X(48).
       01  W0-NUMMSGS-NUM              Pic 9(04) Value 0.
       01  W0-NUMMSGS                  Pic S9(4) Binary.
       01  W0-MSGLENGTH-NUM            Pic 9(04) Value 0.
       01  W0-MSGLENGTH                Pic S9(9) Binary.
       01  W0-PERSISTANCE              Pic X(1)  Value 'N'.
           88 PERSISTENT                         Value 'P'.
           88 NOT-PERSISTENT                     Value 'N'.
 
      *    W03 - API fields
 
       01  W3-HCONN                    Pic S9(9) Binary Value 0.
       01  W3-HOBJ                     Pic S9(9) Binary Value 0.
       01  W3-OPENOPTIONS              Pic S9(9) Binary.
       01  W3-COMPCODE                 Pic S9(9) Binary.
       01  W3-REASON                   Pic S9(9) Binary.
 
      *    API control blocks
 
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV.
       01  MQM-PUT-MESSAGE-OPTIONS.
           COPY CMQPMOV.
 
      *    MQV : constantes de remplissage des blocs de controle
      *          et codes retours à tester après les oall (et finis)
 
       01  MQM-CONSTANTS.
      *  --COPY CMQV.
           COPY CMQV SUPPRESS.
 
      * ------------------------------------------------------------- *
       Linkage Section.
      * ------------------------------------------------------------- *
       01  PARM-RECU.
           05  PARM-LEN                Pic S9(03) Binary.
           05  PARM-DATA               Pic X(100).
 
 
      *    MACRO DCBD en ASM : CSECT IHADCB
       01  DCB-WORK.
           05                          Pic x(62).
           05  DCB-BLKSZ               Pic s9(4) Binary.
           05                          Pic x(18).
           05  DCB-LRECL               Pic s9(4) Binary.
           05                          Pic x(04).
           EJECT
 
      * ------------------------------------------------------------- *
       Procedure Division Using PARM-RECU.
      * ------------------------------------------------------------- *
 
           If PARM-LEN = 0 THEN
      *       parametres absents ! inutile de continuer.
              Display "* ==========================================="
              Display "* PARAMETRES NON COMMUNIQUES !"
              Display "* PARM='QMGR,QNAME,0,MSGLEN,P/N'  PERSISTANCE"
              Display "* ==========================================="
              Move 8            to W0-RETURN-CODE
              Go To RETOUR
           End-if
 
           Move 0             To   W0-RETURN-CODE
           Unstring PARM-DATA Delimited By All ','
                              Into W0-QMGR
                                   W0-QNAME
                                   W0-NUMMSGS-NUM
                                   W0-MSGLENGTH-NUM
                                   W0-PERSISTANCE
 
      * Contrôle des paramètres reçus et affectation des défauts
 
           If Not PERSISTENT
              Set  NOT-PERSISTENT  to true
           End-if
           If   W0-NUMMSGS-NUM    not numeric
            or  W0-NUMMSGS-NUM    = Zero
              Move 9999           to W0-NUMMSGS-NUM
           End-if
           Move W0-NUMMSGS-NUM    to W0-NUMMSGS
 
           If   W0-MSGLENGTH-NUM not Numeric
            or  W0-MSGLENGTH-NUM = Zero
              Move W0-LRECL-MAXI to W0-MSGLENGTH-NUM
 
           End-if
 
           Open  Input MYMESS
 
      *           Adressage du DCB pour avoir le LRECL du fichier lu
      *                LRECL = DCB + x'52'
           Call 'QUELDCB'        Using   MYMESS   W0-PTRX
           Set  Address of DCB-WORK to   W0-PTR
 
           If      DCB-LRECL  <    W0-MSGLENGTH-NUM
              Move DCB-LRECL  to   W0-MSGLENGTH-NUM
              if   W0-MSGLENGTH-NUM  = zero
      *            LRECL = 80 si non précisé (DD *)
                   Move 80    to   W0-MSGLENGTH-NUM
              end-if
           End-if
           If      W0-MSGLENGTH-NUM > W0-LRECL-MAXI
              And  W0-LRECL-MAXI    > Zero
              Move W0-LRECL-MAXI to W0-MSGLENGTH-NUM
           End-if
           Move W0-MSGLENGTH-NUM to W0-MSGLENGTH
 
 
           Display '* ==========================================='
           Display '* PARAMETRES TRAITES :'
           Display '*    QMGR        - ', W0-QMGR
           Display '*    QNAME       - ', W0-QNAME
           Display '*    NUMMSGS     - ', W0-NUMMSGS
           Display '*    MSGLENGTH   - ', W0-MSGLENGTH
           Display '*    PERSISTANCE - ', W0-PERSISTANCE
           Display '* ==========================================='
 
      *    Connect queue manager
 
           Call 'MQCONN' Using W0-QMGR
                               W3-HCONN
                               W3-COMPCODE
                               W3-REASON
 
      *    Vérification si MQ est bien lancé
 
           If W3-REASON   = MQRC-Q-MGR-not-AVAILABLE then
              Display '* ==========================================='
              Display "* WEBSPHERE-MQ N'EST PAS DISPONIBLE !"
              Display "* LE LANCER : /%" W0-QMGR(1:8) " START QMGR"
              Display "*             /%" W0-QMGR(1:8) " START CHINIT"
              Display "* PUIS RELANCER LE PROGRAMME MQWRITE"
              Display '* ==========================================='
              Move 8 to W0-RETURN-CODE
              Go to FIN-DU-PROGRAMME
           End-if
 
           If (W3-COMPCODE not = MQCC-OK) THEN
              Move 'MQCONN'   to W0-ERROR-MESSAGE
              Perform DISPLAY-ERROR-MESSAGE
              Move W3-REASON to W0-RETURN-CODE
              Go to FIN-DU-PROGRAMME
           End-if
 
      *    Open de la file en output. Erreur CALL si queue en quiesce
 
           Compute W3-OPENOPTIONS = MQOO-Output +
                                    MQOO-FAIL-If-QUIESCING
 
           Move W0-QNAME    to MQOD-OBJECTNAME
      *
           Call 'MQOPEN' Using W3-HCONN
                               MQOD
                               W3-OPENOPTIONS
                               W3-HOBJ
                               W3-COMPCODE
                               W3-REASON
 
      * Si Erreur OPEN, Message = Lecture forcée à zéro
           If (W3-COMPCODE not = MQCC-OK)
              Move 'MQOPEN'   to W0-ERROR-MESSAGE
              Perform DISPLAY-ERROR-MESSAGE
              Move  0         to W0-NUMMSGS
           End-if
 
           If PERSISTENT THEN
              Move MQPER-PERSISTENT     to MQMD-PERSISTENCE
           Else
              Move MQPER-not-PERSISTENT to MQMD-PERSISTENCE
           End-if
 
           Move MQFMT-String to MQMD-FORMAT
 
      *    put message options en erreur si queue manager quiescing
 
           Move MQPMO-FAIL-If-QUIESCING to MQPMO-OPTIONS
 
           Perform WITH TEST BEFORE Varying W0-LOOP From 0 By 1
                              Until (W0-LOOP >= W0-NUMMSGS)
 
               If W0-LECT-FIN = 0
                  Read MYMESS
                   AT End
                       Move W0-COUNT-LEC to W0-LECT-FIN
                       Add 1 W0-NUMMSGS  to W0-LOOP
                   not AT End
                       Add  1 to W0-COUNT-LEC
                  End-READ
               End-if
 
               If W0-LOOP not > W0-NUMMSGS
                  Move MQMI-NONE to MQMD-MSGID
                  Move MQCI-NONE to MQMD-CORRELID
 
                  Call 'MQPUT' Using W3-HCONN
                                     W3-HOBJ
                                     MQMD
                                     MQPMO
                                     W0-MSGLENGTH
                                     ENR-MYMESS
                                     W3-COMPCODE
                                     W3-REASON
 
      *           Si ERREUR MQPUT, Message d'erreur et sortie forcée
                  If W3-COMPCODE  = MQCC-OK
                     Add 1 to W0-NUMPUTS
                  Else
                     Move 'MQPUT'     to W0-ERROR-MESSAGE
                     Perform DISPLAY-ERROR-MESSAGE
                     Move W3-REASON   to W0-RETURN-CODE
                     Add 1 W0-NUMMSGS to W0-LOOP
                  End-if
               End-if
 
           End-Perform
 
      *    Close queue manager si on a écrit des messages
           If W0-NUMMSGS > 0
 
              Display  '* MESSAGES LUS = '    W0-COUNT-LEC
                      ' - MESSAGES ECRITS = ' W0-NUMPUTS
              Display '* ==========================================='
 
              Call 'MQCLOSE' Using W3-HCONN
                                   W3-HOBJ
                                   MQCO-NONE
                                   W3-COMPCODE
                                   W3-REASON
              If (W3-COMPCODE not = MQCC-OK) THEN
                 Move 'MQCLOSE'  to W0-ERROR-MESSAGE
                 Perform DISPLAY-ERROR-MESSAGE
                 Move W3-REASON to W0-RETURN-CODE
              End-if
 
           End-if
 
 
      *    Disconnect from the queue manager
 
           Call 'MQDISC' Using W3-HCONN
                               W3-COMPCODE
                               W3-REASON
 
           If (W3-COMPCODE not = MQCC-OK) THEN
              Move 'MQDISC'   to W0-ERROR-MESSAGE
              Perform DISPLAY-ERROR-MESSAGE
              Move W3-REASON to W0-RETURN-CODE
           End-if.
 
       FIN-DU-PROGRAMME.
 
           Close      MYMESS.
 
       RETOUR.
 
           Move W0-RETURN-CODE to Return-Code
           Goback.
      *
      * ------------------------------------------------------------- *
       DISPLAY-ERROR-MESSAGE.
      * ------------------------------------------------------------- *
      *
           Display '************************************************'
           Display '* ERREUR '             W0-ERROR-MESSAGE
           Display '* COMPLETION CODE : '  W3-COMPCODE
           Display '* REASON CODE     : '  W3-REASON
           Display '************************************************'
           .
      *
      * ===============================================================
 
       Identification Division.
       PROGRAM-ID. QUELDCB.
      *==============================================================*
      * module interne pour adressage d'une zone d'un Cobol hors de  *
      * la Working Storage. Rend l'adresse de la zone passée.        *
      *==============================================================*
       Data Division.
       Linkage Section.
      *================
       01  LS-INPUT                 pic x.
       01  LS-OUTPUT                pointer.
 
      *===================
       Procedure Division Using LS-INPUT LS-OUTPUT.
      *===================
           Set LS-OUTPUT             to address of LS-INPUT
           Goback.
       End Program QUELDCB.
 
       End Program MQWRITE.

[a_karim_fr]

Bonjour,

J’ai utilisé le principe de votre programme j’ai modifier que les copies et sa marche bien votre code merci pour la solution