Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter
[z/OS-Cobol2] Utilisation de fichiers "génériques"
Bonjour,
Je souhaiterai savoir comment, en COBOL, il est possible de traiter des fichiers non déclarés distinctement.
Je m'explique :
Le fichier A contient une liste de fichiers.
Je lis le fichier A et récupère un nom de fichier.
Je souhaite ouvrir et lire le fichier dont je viens de récupérer le nom.
(J'ai aperçu un article ces derniers jours sur un site mais je n'arrive pas à mettre la main dessus.)
Quelqu'un peut-il m'aider, s'il vous plaît ?
Merci.
Quelle plateforme ?
On parle d'allocation dynamique de fichiers : pas beaucoup de possibilités COBOL sans passer par des services externes, très dépendant du système d'exploitation.
Bonjour.
Effectivement, l'OS est très important à connaître pour que la solution soit la plus précise. Le Cobol, à la compilation, associe les noms symboliques internes (dans les progs) aux noms externes supposés exister sur le disque. A l'exécution, donc à l'OPEN, le système va utiliser ces noms externes pour créer son chemin d'ouverture. Si rien ne vient contredire (pas de substitutions) cette association, le système ouvrira le fichier indiqué dans le "System Name" (à la fin de l'ASSIGN). C'est plus compliqué quand il s'agit de fichiers externes ou globaux.
Donc si tu veux substituer un fichier à un autre, il faut le demander au système et non pas au prog Cobol.
Sur les iSeries/AS400, grosso modo la même chose existe sur les autres OS, deux possibilités :
- lire le fichier qui contient les noms des fichiers dans un prog CL, faire un OVRDBF et lancer le prog Cobol.
- ou lire le fichier qui contient les noms des fichiers dans le prog Cobol, faire appel à un prog CL en lui passant le nom du fichier à traiter en paramètre, ce prog CL fera juste le OVRDBF du fichier avant que le prog Cobol ne l'ouvre.
Je suppose que tous tes fichiers de la liste ont grossièrement la même structure.
Sous Z-os en batch, le nom externe correspond au DDName du JCL, qui lui établi le lien avec le DSName (le nom Catalogue du fichier). Mais le problème reste le même : utiliser un service système qui permet de modifier ce lien DDN->DSN, car le programme COBOL n'a pas connaissance du DSN.Envoyé par Hédhili Jaïdane
J'ai même vu des programmes dans lesquels le DDN était "retravaillé" car différent du DDN dans le JCL. Je pense que c'était effectué au niveau du JES, mais je n'en sais pas plus.
Re,
Il y a une exception tout de même pour le Cobol/2, MF, MS où le nom externe du fichier peut être une variable pouvant être initialisée avant l'OPEN dans le prog Cobol, exemple :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
sous z/OS on peut faire de l'allocation dynamique en passant par une routine C : PUTENV. Explications détaillées d'une utilation COBOL avec le lien suivant :
http://www.naspa.com/files/CDKIT/CD0...5/T0501004.pdf
Je n'ai pas essayé via du dynamique mais il est vraissemblable que la FD pointe quand même sur le DCB, on peut donc lire un séquentiel de longueur quelconque avec RECORD 0 et récuperer le LRECL dans le DCB juste après l'open. Je peux communiquer un exemple si besoin
Merci Homer-ac pour cette info !
Bonsoir
Effectivement, mon mail initial manquait singulièrement de précision ... Désolé.
Ceci étant dit, je vous remercie tous pour vos réponses.
Concernant mon cas précis, c'est sur z/OS, en COBOL-2 et la solution que j'avais entrevue et sur laquelle je n'arrive pas à remettre la main semble correspondre aux cas évoqués par Homer-ac (super, le pdf !). Si, en plus des explications fournies dans le fichier, un exemple pouvait m'être fourni, ce serait top (et me ferait sans doute gagner du temps ...).
Merci en tout cas pour toutes vos contributions.
(Le principe que je souhaite adopter :
1 - Faire un LISTCAT pour récupérer les fichiers du type A.B.C.*
2 - Formatter le résultat du LISTCAT avec un SORT (include & outrec) pour ne conserver que la liste des fichiers
3 - Dans le programme COBOL, lire le fichier issu du LISTCAT
4 - Pour chaque enregistrement, ouvrir le fichier correspondant puis le traiter puis le fermer.
Après un nouveau parcours de vos réponses, l'exemple fournir par Hédhili Jaïdane me paraît utilisable dans mon cas.
Une question cependant : comment doit être déclaré le fichier dans le JCL ?
Merci par avance pour votre réponse.
Attention ! j'ai peur que la solution proposée ne s'applique pas au z/OS ...
Si le programme alloue dynamiquement le fichier, alors il n'y a plus de carte DD pour le décrire ...Une question cependant : comment doit être déclaré le fichier dans le JCL ?
C'est la définition même de l'allocation dynamique ...
Exemple DYNALLOC Enterprise Cobol
Curieux, j'ai relu le PDF pour me rendre compte qu'il a beau être bien présenté,
l'exemple est buggué :
Il ne faut pas écraser QUERIES=DSN(dsname qui fait le lien DDNAME de la clause ASSIGN avec le DSNAME.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
2
3
4
5
6string in-name delimited by space ')' delimited by size into file-name Ce devrait être : string in-name delimited by space ')' delimited by size into DSNAME
Bon, perso ça me rassure de n'être pas seul à saisir avec des moufles.
Sans quoi, explications et exemples sont clairs et ça mérite d'être reconnu.
Puisqu'un exemple m'a été demandé, j'ai testé le code joint pour vérifier que l'on avait bien accès au DCB. Fonctionne, mais comme déjà indiqué, il s'agit d'alloc dynamique, dépendant de l'environnement .
L'exemple vaut donc uniquement pour z/OS, compilateur Enterprise COBOL, option NODYNAM obligatoire.
J'ai changé les noms des données et le mode d'alimentation du DSN. La comparaison avec le sample PDF, montrera mieux la logique du truc.
Pour corser, on fait l'open, on adresse le DCB (via une programme contenu) pour récupérer le LRECL du fichier.
Utile, si on veut recopier le fichier lu sur un autre fichier.
Ce code n'est pas un modèle de programmation (l'utilisation des notations déplacement:longueur peut faire débat)
mais celui-ci permet un condensé assez minimaliste, suffisant pour un exemple. Pas de gestion File status pour les mêmes raisons
* Ici on récupère le DATASET NAME du fichier à lire via le champ PARM de l'EXEC PGM.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
121CBL NODYNAM * NODYMAM : PUTENV IN CEE.SEELKED DE Language Environment Identification Division. PROGRAM-ID. COBDYNR0. *=============================================================== * Ce pgm fait un OPEN dynamique de fichier dont le DSN est reçu * en PARM= après avoir défini un Environment variable via PUTENV * Récupère le LRECL du fichier après l'OPEN pour lire * ensuite le premier enregisrtrement sur un buffer maxi * (RECORD 0, c'est à dire sans en connaitre la longueur). * Fait un Display du LRECL et BLKSIZE du fichier QSAM * Fait un Display de 1er enrg. jusqu'à un LRECL de 133 * Passe par PUTENF pour définition variable environnement fichier * Passe par un module intégré pour addresser le DCB du fichier *=============================================================== * Open a faire avant restitution pour que le DCB soit chargé ! *=============================================================== * JCL DE TEST : * //TEST1 EXEC PGM=COBDYNR0,REGION=2M, * // PARM='MY.FICHIER.PS' * //STEPLIB DD DISP=SHR,DSN=MY.LOADLIB * //* fichier lu sur DDNAME DDNAMED (alloucation dynamique COBOL) * //SYSOUT DD SYSOUT=* *=============================================================== Environment Division. Input-Output Section. File-Control. Select ENTREE Assign TO DDNAMED. Data Division. File Section. FD ENTREE record 0. 01 ENR-ENTREE pic x(32700). *======================== Working-Storage Section. *======================== 01 WS-COBDYNR0 pic x(16) VALUE '* WSS COBDYNR0 *'. 01 WS-LGD pic s9(4) Binary Value Zero. 01 WS-PTRX pic x(4) Value Low-Value. 01 WS-PTR Redefines WS-PTRX Pointer. 01 WS-VAR. 05 pic x(12) Value 'DDNAMED=DSN('. 05 WS-DSN pic x(55). 05 pic x(05) Value ' SHR '. 05 pic x Value x'00'. *================ Linkage Section. *================ * PARM= DSN RECU 01 LS-PARM. 05 LS-PARM-LG pic s9(4) Binary. 05 LS-PARM-DATA pic x(32700). * 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(4). *================================= Procedure Division Using LS-PARM. *================================= DEBUT-PGM. * Acquisition du DSN depuis le PARM Move LS-PARM-DATA(1:LS-PARM-LG) to WS-DSN ADD 1 LS-PARM-LG to WS-LGD MOVE ')' TO WS-DSN(WS-LGD:1) * Acquisition Environment variable Move Zero to WS-LGD Set WS-PTR to address of WS-VAR Call 'PUTENV' Using by value WS-PTR Returning WS-LGD if WS-LGD not = zero then Display 'Erreur appel PUTENV. RC=' WS-LGD ' Abandon !' Move 16 to Return-code Goback End-if Open Input ENTREE * Adressage du DCB Call 'COBWMDCB' Using ENTREE WS-PTRX Set Address of DCB-WORK to WS-PTR * BLKSIZE = DCB + x'3E' et LRECL = DCB + x'52' Display 'Fichier Lu : LRECL=' DCB-LRECL ' BLKSZ=' DCB-BLKSZ ' !' Read ENTREE if DCB-LRECL > 133 Display ENR-ENTREE(1:133) Else Display ENR-ENTREE(1:DCB-LRECL) End-if Close ENTREE Goback. Identification Division. PROGRAM-ID. COBWMDCB. *==============================================================* * 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 address of LS-ADDRESS to address of LS-INPUT Set LS-OUTPUT to address of LS-INPUT * display WS-COBWMDCB ' ' LS-OUTPUT Goback. End Program COBWMDCB. End Program COBDYNR0.
Lors de mon développement, je me suis effectivement rendu-compte de l'erreur présente dans le pdf. Vous avez été plus rapide que moi pour alerter ...
Bon, où en suis-je ? J'ai suivi vos conseils, j'ai appliqué certains des principes évoqués dans la doc, je me suis inspiré de votre exemple ... Et j'ai réussi ce que je voulais faire : à partir d'une liste de fichiers, accéder à chacun des fichiers de cette liste pour les utiliser dans un programme cobol. L'accès est ok, la boucle de lecture est ok (le comptage des enregistrements est ok) mais, car il y a évidemment un mais, les enregistrements auxquels j'accède sont vides !!! Aurais-je oublié quelque chose ?
Je vous remercie déjà pour les conseils déjà fournis et par avance pour les remarques que vous pourrez m'adresser pour m'indiquer à quel moment je pêche ...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
240000100* ---------------------------------------------------------------* 000200* Programme : ALLOCDYN 000300* -------------------- 000400* . Allocation dynamique de fichiers 000500* 000600* Cartouche de maintenance 000700* ------------------------ 000800* Creation : DV 17/12/2007 000900* 001000* Mises a jour : xxxxxxxxxxx dd/mm/aaaa 001100* . 001200* ---------------------------------------------------------------* 001300 Identification division. 001400*----------------------------------------------------------------* 001500 001600 Program-id. allocdyn. 001700********************** 001800 Environment division. 001900********************** 002000 Configuration section. 002100 002200 Special-names. 002300 Input-output section. 002400 File-control. 002500 Select listefic 002600 access sequential 002700 assign to listefic. 002800 002900 Select ficaldyn 003000* access sequential 003100 assign to queries. 003200 003300 Select cmprto 003400 access sequential 003500 assign to cmprto. 003600 003700*************** 003800 Data division. 003900*************** 004000 File section. 004100 004200 Fd listefic 004300 label record standard 004400 recording mode is f 004500 data record is listefic-rcd. 004600 004700 01 listefic-rcd. 004800 05 filler pic x(80). 004900 005000 Fd ficaldyn 005100 label record standard 005200 recording mode is v 005300 data record is ficaldyn-rcd. 005400 005500 01 ficaldyn-rcd. 005600 02 ficaldyn-rcd-unit occurs 1 to 7936 005700 depending on vli pic x(01). 005800 005900 Fd cmprto 006000 label record standard 006100 recording mode is v 006200 data record is cmprto-rcd. 006300 006400 01 cmprto-rcd. 006500 02 cmprto-rcd-unit occurs 1 to 7936 006600 depending on ws-vli pic x(01). 006700 006800************************* 006900 Working-storage section. 007000************************* 007100* Nom du fichier a allouer dynamiquement 007200 01 File-name. 007300 02 filler pic x(12) 007400 value 'QUERIES=DSN('. 007500 02 dsname pic x(55) 007600 value spaces. 007700 02 filler pic x(06) 007800 value z' SHR '. 007900 008000 01 file-ptr pointer. 008100 01 rc pic s9(09) binary 008200 value zero. 008300 008400* Variables pour lecture du fichier Listefic 008500 01 Fin-listefic pic 9(01) VALUE 0. 008600 01 Cpt-listefic pic 9(09) VALUE 0. 008700 008800* Variables pour lecture du fichier Ficaldyn 008900 01 Fin-ficaldyn pic 9(01) VALUE 0. 009000 01 Cpt-ficaldyn pic 9(09) VALUE 0. 009100 01 Ficaldyn-ws. 009200 02 ficaldyn-ws-unit occurs 1 to 7936 009300 depending on vli pic x(01). 009400 009500* Variables pour ecriture dans fichier cmprto 009600 01 Cpt-cmprto pic 9(09) VALUE 0. 009700 009800* Variables specifiques. 009900 01 Ws-variables. 010000 02 xx-progid pic x(08) 010100 value 'ALLOCDYN'. 010200 02 vli pic 9(05). 010300 02 ws-vli pic 9(05). 010400 010500 01 ws-ptrx pic x(04) 010600 value low-value. 010700 01 ws-ptr redefines ws-ptrx pointer. 010800 010900************************* 011000 Linkage Section. 011100************************* 011200* PARM= DSN RECU 011300 01 Ls-parm. 011400 05 Ls-parm-lg pic s9(4) binary. 011500 05 Ls-parm-data pic x(32700). 011600 011700* MACRO DCBD en ASM : CSECT IHADCB 011800 01 Dcb-work. 011900 05 pic x(62). 012000 05 Dcb-blksz pic s9(4) binary. 012100 05 pic x(18). 012200 05 Dcb-lrecl pic s9(4) binary. 012300 05 pic x(4). 012400 012500******************** 012600 Procedure division. 012700******************** 012800 012900 Depart section. 013000 013100 open input listefic 013200 output cmprto. 013300 013400 read listefic at end 013500 move 1 to fin-listefic. 013600 013700 perform until fin-listefic = 1 013800 add 1 to cpt-listefic 013900 014000 display xx-progid ' Enregistrement lu : ' listefic-rcd 014100 014200 string listefic-rcd delimited by space 014300 ')' delimited by size 014400 into dsname 014500 end-string 014600 014700 set file-ptr to address of file-name 014800 call 'putenv' using by value file-ptr 014900 returning rc 015000 015100 if rc = -1 015200 display xx-progid ' Erreur Putenv - Arret du programme' 015300 move 100 to return-code 015400 stop run 015500 else 015600 display xx-progid ' Acces a : ' file-name 015700 015800 initialize fin-ficaldyn 015900 cpt-ficaldyn 016000 016100 open input ficaldyn 016200 016300 Call 'COBWMDCB' Using ficaldyn ws-ptrx 016400 Set Address of dcb-work to ws-ptr 016500 016600 display xx-progid ' > Lrecl : ' dcb-lrecl 016700 display xx-progid ' > Blksz : ' dcb-blksz 016800 016900 read ficaldyn 017000 at end 017100 move 1 to fin-ficaldyn 017200 end-read 017300 017400 perform until fin-ficaldyn = 1 017500 add 1 to cpt-ficaldyn 017600 display ficaldyn-rcd 017700 017800* move vli to ws-vli 017900* display '**01**vli : ' vli ' : ' ws-vli 018000* ' ' length of ficaldyn-rcd 018100 018200* write cmprto-rcd 018300* from ficaldyn-rcd 018400 018500* display '**02**' 018600 add 1 to cpt-cmprto 018700 018800 read ficaldyn 018900 at end 019000 move 1 to fin-ficaldyn 019100 end-read 019200 019300 end-perform 019400 019500 display xx-progid ' > Lus : ' cpt-ficaldyn 019600 display xx-progid ' > Total : ' cpt-cmprto 019700 019800 close ficaldyn 019900 020000 end-if 020100 020200 read listefic at end 020300 move 1 to fin-listefic 020400 end-read 020500 020600 end-perform. 020700 020800 close listefic 020900 cmprto. 021000 021100 stop run. 021200 021300*----------------------------------------------------------------------- 021400/ 021500*----------------------------------------------------------------- 021600 Identification Division. 021700 PROGRAM-ID. COBWMDCB. 021800*=======================================================* 021900* module interne pour adressage d'une zone d'un Cobol hors de * 022000* la Working Storage. Rend l'adresse de la zone passée. * 022100*=======================================================* 022200 Data Division. 022300 Linkage Section. 022400*================ 022500 01 LS-INPUT pic x. 022600 01 LS-OUTPUT pointer. 022700 022800*=================== 022900 Procedure Division Using LS-INPUT LS-OUTPUT. 023000*=================== 023100* Set address of LS-ADDRESS to address of LS-INPUT 023200 Set LS-OUTPUT to address of LS-INPUT 023300* display WS-COBWMDCB ' ' LS-OUTPUT 023400 Goback. 023500 023600 End Program COBWMDCB. 023700 023800 End Program ALLOCDYN. 023900
Après une lecture 'tranverse', je n'ai pas de réponse certaine. Il me faudrait tester. Une chose au moins me pertube dans ce code, le depending on vers une zone externe. Normalement dans un COBOL celle-ci devrait être dans le buffer de lecture ou en amont. Ce n'est qu'une intuition, encore une fois il me faudrait tester (je suis en vacances). Pour avoir eu un certain nombre d'aléas avec ce type de code, je conseillerais plutôt une déclaration du type 'record is varying in size' pour les fichiers variables dans la FD, avec un 01 associé, au maxi possible, de tester à nouveau et voir ce que l'on obtient dans ce cas. Je regarderai et testerai ce code quand j'aurai un peu de temps, en attendant il y a une chance raisonnable que cette simple modif fasse 'réapparaître' les données.
Et au final ...
Bonjour
Grâce à vos réponses, vos remarques et indications (notamment la dernière intervention de Homer-ac, pour une fonctionnalité que je ne connaissais pas !), je suis parvenu au résultat attendu.
Rappel : à partir d'une liste de fichiers, dont le nombre peut atteindre à ce jour 60, je souhaite n'en générer qu'un seul pour ne soumettre qu'une seule fois le traitement d'analyse de ces fichiers.
D'où le JCL comprenant : un LISTCAT des fichiers, un formattage du résultat du LISTCAT, un programme COBOL reprenant cette liste de fichiers pour n'en faire qu'un seul au final (avec lecture de la liste, accès aux fichiers contenus dans la liste, lecture de ces fichiers, écriture dans un seul fichier en sortie)
Merci à tous pour vos contributions.
A charge de revanche ...
Le programme :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
235000100* ---------------------------------------------------------------------* 000200* Programme : ALLOCDYN 000300* -------------------- 000400* . Allocation dynamique de fichiers 000500* 000600* Cartouche de maintenance 000700* ------------------------ 000800* Creation : DV 17/12/2007 000900* 001000* Mises a jour : xxxxxxxxxxx dd/mm/aaaa 001100* . 001200* ---------------------------------------------------------------------* 001300 Identification division. 001400*----------------------------------------------------------------* 001500 001600 Program-id. allocdyn. 001700********************** 001800 Environment division. 001900********************** 002000 Configuration section. 002100 002200 Special-names. 002300 Input-output section. 002400 File-control. 002500 Select listefic 002600 access sequential 002700 assign to listefic. 002800 002900 Select ficaldyn 003000* access sequential 003100 assign to queries. 003200 003300 Select cmprto 003400 access sequential 003500 assign to cmprto. 003600 003700*************** 003800 Data division. 003900*************** 004000 File section. 004100 004200 Fd listefic 004300 label record standard 004400 recording mode is f 004500 data record is listefic-rcd. 004600 004700 01 listefic-rcd. 004800 05 filler pic x(80). 004900 005000 Fd ficaldyn 005100 label record standard 005200 recording mode is v 005300 record is varying in size 005400 depending on ficaldyn-input-record-length 005500 data record is ficaldyn-rcd. 005600 005700 01 ficaldyn-rcd. 005800 02 ficaldyn-rcd-unit occurs 1 to 7936 005900 depending on ficaldyn-input-record-length 006000 pic x(01). 006100 006200 Fd cmprto 006300 label record standard 006400 recording mode is v 006500 record is varying in size 006600 depending on cmprto-output-record-length 006700 data record is cmprto-rcd. 006800 006900 01 cmprto-rcd. 007000 02 cmprto-rcd-unit occurs 1 to 7936 007100 depending on cmprto-output-record-length 007200 pic x(01). 007300 007400************************* 007500 Working-storage section. 007600************************* 007700* Nom du fichier a allouer dynamiquement 007800 01 File-name. 007900 02 filler pic x(12) 008000 value 'QUERIES=DSN('. 008100 02 dsname pic x(55) 008200 value spaces. 008300 02 filler pic x(06) 008400 value z' SHR '. 008500 008600 01 file-ptr pointer. 008700 01 rc pic s9(09) binary 008800 value zero. 008900 009000* Variables pour lecture du fichier Listefic 009100 01 Fin-listefic pic 9(01) VALUE 0. 009200 01 Cpt-listefic pic 9(09) VALUE 0. 009300 009400* Variables pour lecture du fichier Ficaldyn 009500 01 Fin-ficaldyn pic 9(01) value 0. 009600 01 Cpt-ficaldyn pic 9(09) value 0. 009700 01 Ficaldyn-input-record-length pic 9(05) comp 009800 value 0. 009900* Variables pour ecriture dans fichier cmprto 010000 01 Cpt-cmprto pic 9(09) VALUE 0. 010100 01 Cmprto-output-record-length pic 9(05) comp 010200 value 0. 010300 010400* Variables specifiques. 010500 01 Ws-variables. 010600 02 xx-progid pic x(08) 010700 value 'ALLOCDYN'. 010800 010900 01 ws-ptrx pic x(04) 011000 value low-value. 011100 01 ws-ptr redefines ws-ptrx pointer. 011200 011300************************* 011400 Linkage Section. 011500************************* 011600* PARM= DSN RECU 011700 01 Ls-parm. 011800 05 Ls-parm-lg pic s9(4) binary. 011900 05 Ls-parm-data pic x(32700). 012000 012100* MACRO DCBD en ASM : CSECT IHADCB 012200 01 Dcb-work. 012300 05 pic x(62). 012400 05 Dcb-blksz pic s9(4) binary. 012500 05 pic x(18). 012600 05 Dcb-lrecl pic s9(4) binary. 012700 05 pic x(4). 012800 012900******************** 013000 Procedure division. 013100******************** 013200 013300 Depart section. 013400 013500 open input listefic 013600 output cmprto. 013700 013800 read listefic at end 013900 move 1 to fin-listefic. 014000 014100 perform until fin-listefic = 1 014200 add 1 to cpt-listefic 014300 014400 string listefic-rcd delimited by space 014500 ')' delimited by size 014600 into dsname 014700 end-string 014800 014900 set file-ptr to address of file-name 015000 call 'putenv' using by value file-ptr 015100 returning rc 015200 015300 if rc = -1 015400 display xx-progid ' Erreur Putenv - Arret du programme' 015500 move 100 to return-code 015600 stop run 015700 else 015800 display xx-progid ' Acces a : ' file-name 015900 016000 initialize fin-ficaldyn 016100 cpt-ficaldyn 016200 016300 open input ficaldyn 016400 016500 Call 'COBWMDCB' Using ficaldyn ws-ptrx 016600 Set Address of dcb-work to ws-ptr 016700 016800 read ficaldyn 016900 at end 017000 move 1 to fin-ficaldyn 017100 end-read 017200 017300 perform until fin-ficaldyn = 1 017400 add 1 to cpt-ficaldyn 017500 017600 move ficaldyn-input-record-length 017700 to cmprto-output-record-length 017800 017900 write cmprto-rcd 018000 from ficaldyn-rcd 018100 018200 add 1 to cpt-cmprto 018300 018400 read ficaldyn 018500 at end 018600 move 1 to fin-ficaldyn 018700 end-read 018800 018900 end-perform 019000 019100 display xx-progid ' > Lus : ' cpt-ficaldyn 019200 display xx-progid ' > Total : ' cpt-cmprto 019300 019400 close ficaldyn 019500 019600 end-if 019700 019800 read listefic at end 019900 move 1 to fin-listefic 020000 end-read 020100 020200 end-perform. 020300 020400 close listefic 020500 cmprto. 020600 020700 stop run. 020800 020900*----------------------------------------------------------------------- 021000/ 021100*----------------------------------------------------------------------- 021200 Identification Division. 021300 PROGRAM-ID. COBWMDCB. 021400*==============================================================* 021500* module interne pour adressage d'une zone d'un Cobol hors de * 021600* la Working Storage. Rend l'adresse de la zone passée. * 021700*==============================================================* 021800 Data Division. 021900 Linkage Section. 022000*================ 022100 01 LS-INPUT pic x. 022200 01 LS-OUTPUT pointer. 022300 022400*=================== 022500 Procedure Division Using LS-INPUT LS-OUTPUT. 022600*=================== 022700* Set address of LS-ADDRESS to address of LS-INPUT 022800 Set LS-OUTPUT to address of LS-INPUT 022900 023000 Goback. 023100 023200 End Program COBWMDCB. 023300 023400 End Program ALLOCDYN. 023500
Le JCL :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Répondre avec citation
Partager