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
| Hdatfmt(*eur)
HDEBUG(*YES)
DMQOPEN1 PR EXTPROC('MQOPEN')
D* Connection handle
D HCONN 10I 0 VALUE
D* Object descriptor
D OBJDSC 468A
D* Options that control the action of MQOPEN
D OPTS 10I 0 VALUE
D* Object handle
D HOBJ 10I 0
D* Completion code
D CMPCOD 10I 0
D* Reason code qualifying CMPCOD
D REASON 10I 0
DMQGET1 PR EXTPROC('MQGET')
D* Connection handle
D HCONN 10I 0 VALUE
D* Object handle
D HOBJ 10I 0 VALUE
D* Message descriptor
D MSGDSC 364A
D* Options that control the action of MQGET
D GMO 112A
D* Length in bytes of the Buffer area
D BUFLEN 10I 0 VALUE
D* Area to contain the message data
D BUFFER * VALUE
D* Length of the message
D DATLEN 10I 0
D* Completion code
D CMPCOD 10I 0
D* Reason code qualifying CMPCOD
D REASON 10I 0
DMQCLOSE1 PR EXTPROC('MQCLOSE')
D* Connection handle
D HCONN 10I 0 VALUE
D* Object handle
D HOBJ 10I 0
D* Options that control the action of MQCLOSE
D OPTS 10I 0 VALUE
D* Completion code
D CMPCOD 10I 0
D* Reason code qualifying CMPCOD
D REASON 10I 0
*-- Specification F ------------------------------------------------
FARC1999IN o e disk
*****12056 ******
// Connection handle
D HCONN S 10I 0
// Options
D OPTS S 10I 0
// Object handle
D HOBJ S 10I 0
// Completion codes
D OpenCode S 10I 0
// CompletionCode
D CCODE S 10I 0
// Reasons
D REASON S 10I 0
D ConnReason S 10I 0
// Buffer
D Buffer S 60A
// Buffer length
D BUFLEN S 10I 0 INZ(%LEN(Buffer))
// Actual Message length received
D MESLEN S 10I 0
*****12056 ******
*-- Specification D ------------------------------------------------
Das_erreur s 254
Dai_occurs s 8 0
* HAU Gestion du message ORDERS jusqu'à 3680 segments de 1000 caractères
* Das_cpt s 2 0
Das_cpt s 4 0
* HAU Fin
Das_dta s 1000
D/copy cmqr
D MQOD DS qualified
D/COPY CMQODG
*--- Message Descriptor --------------------------------------------
D MQMD DS qualified
D/copy cmqmdr
*--- Get message options -------------------------------------------
D mqgmo ds qualified
I/copy cmqgmor
*-- Parametre d'entree ---------------------------------------------
C *entry plist
C parm as_qmsg 16
C parm as_perreu 2
C parm as_reason 10
C parm as_IDEMET 20
C parm as_IDDEST 20
*-- MQCONN implicite sur AS400, utilisation handle par defaut ------
C* z-add HCDEFH HCONN
*-- Longueur du message --------------------------------------------
C z-add 4194304 BUFLEN
*-- Initialisation du code retour erreur ---------------------------
C eval as_perreu='00'
*-- Initialisation du header du message ----------------------------
C eval as_erreur =' '
C z-add 0 ai_occurs
*-- Ouverture de la QMSG -------------------------------------------
C exsr open_qmsg
C exsr gest_erreur
C if REASON<>RCNONE
C eval as_perreu='02'
C exsr fin_pgm
C endif
C exsr init_qmsg
*-- Boucle de lecture des messages ---------------------------------
C exsr get_qmsg
C exsr gest_erreur
C if REASON<>RCNONE
C eval as_perreu='03'
C exsr fin_pgm
C endif
*-- Fermeture de la QMSG -------------------------------------------
C exsr close_qmsg
C exsr gest_erreur
C if REASON<>RCNONE
C eval as_perreu='06'
C exsr fin_pgm
C endif
*-Fin du programme
C exsr fin_pgm
*-- Sous-routine ---------------------------------------------------
*--- Ouverture de la queue MSG sans option -------------------------
C open_qmsg begsr
C CALLP MQOPEN1(HCONN :
C MQOD :
C OPTS :
C HOBJ :
C CCODE :
C REASON)
C endsr
*--- Initialisation de la queue MSG --------------------------------
C init_qmsg begsr
C *like define HOBJ ab_hobjmsg
C *like define CCODE ab_compcodemsg
C z-add HOBJ ab_hobjmsg
C z-add CCODE ab_compcodemsg
C endsr
*--- GET dans la queue MSG -----------------------------------------
*--- Accept truncated, conversion and no sync point ----------------
C get_qmsg begsr
C CALLP MQGET1(HCONN :
C HOBJ :
C MQMD :
C mqgmo :
C BUFLEN :
C Buffer :
C MESLEN :
C CCODE :
C REASON)
C z-add 1 as_cpt
C eval as_IDEMET = %subst(as_dta:20:20)
C eval as_IDDEST = %subst(as_dta:40:20)
* HAU Gestion du message ORDRSP jusqu'à 3680 segments de 1000 caractères
* HAU Optimisation on s'arrête au premier enreg à blanc
C as_dta downe ' '
* HAU Fin
C eval Z1000I = as_dta
C write FIC1000IF
* Récup de la ligne suivante (1000 caractères)
C add 1 as_cpt
C* eval as_dta = BUFFER(as_cpt)
C enddo
C endsr
*--- Gestion des erreurs MQSERIES ----------------------------------
C gest_erreur begsr
C if REASON<>RCNONE
C movel REASON as_reason
C endif
C endsr
*--- Fermeture de la queue MSG -------------------------------------
C close_qmsg begsr
C CallP MQCLOSE1(HConn :
C HOBJ :
C OPTS :
C CCODE :
C REASON)
C endsr
*--- Sortie du programme -------------------------------------------
C fin_pgm begsr
C eval *inlr=*on
C dump
C return
C endsr |
Lecture de la MQ via la nouvelle LBMQM
Répondre avec citation
Partager