Moderniser votre code RPG avec Agilité – Partie 2
mar 23 juin 2020Du RPG IV colonné au Free-form 1re étape la fonction intégrée à RDI
Pour passer du RPG IV issu de la partie 2 au Free-form, il est nécessaire de passer par plusieurs étapes : nous allons décrire ici celle de la fonction présente dans RDI
Dans Rdi, utiliser la fonction Source–>Convertir tout au format libre.
Contrairement à ce que le nom de la fonction pourrait nous faire penser, la conversion n’est pas complète. Seule les lignes « Calculation » sont convertis mais pas toutes. Les mot-clefs qui n’ont pas de correspondance en Free-form restent tel-que.
Si nous reprenons le source résultat du billet précédent :
C#
x
44
44
1
H2
* FICHIER CLIENT3
*---------------4
FBNCLTL01 IF E K DISK5
*6
* ADRESSE CLIENT7
*---------------8
FBACLTL02 IF E K DISK9
*----------------------------------------------------*10
* PARAMETRES 11
*----------------------------------------------------*12
C *ENTRY PLIST 13
C PARM $ODCLI 8 14
C MOVE $ODCLI CODCLI 15
*----------------------------------------------------16
* CLES 17
*----------------------------------------------------18
* 19
C CLTL02 KLIST 20
C KFLD CODCLI 21
C KFLD ACATEG 22
*----------------------------------------------------23
* INITIALISATIONS 24
*----------------------------------------------------25
C Z-ADD 20 SATJOU 26
C Z-ADD UYEAR AATJOU 27
C Z-ADD UMONTH MATJOU 28
C Z-ADD UDAY JATJOU 29
C MOVE '/' SLASH1 30
C MOVE '/' SLASH2 31
C MOVE '-' TIRET1 32
C MOVE '/' SLASH3 33
* RECHERCHE CLIENT I34
C CODCLI CHAIN BNCLTL01 60 35
* RECHERCHE ADRESSE CLI I36
C MOVE 'CLI' ACATEG 37
C CLTL02 CHAIN BACLTL02 60 38
C N60NIDEAD CHAIN BACISL01 60 39
C *IN60 IFEQ '0' 40
C MOVE ALIGN3 CLIGN3 41
C MOVE ALIGN4 CLIGN4 42
C MOVE ALIGN5 CLIGN5 43
C MOVE ALIGN6 CLIGN6 44
C ENDIF Cela donne
C#
1
54
54
1
H2
// FICHIER CLIENT3
//---------------4
FBNCLTL01 IF E K DISK5
//6
// ADRESSE CLIENT7
//---------------8
FBACLTL02 IF E K DISK9
//----------------------------------------------------*10
// PARAMETRES 11
//----------------------------------------------------*12
C *ENTRY PLIST 13
C PARM $ODCLI 8 14
C MOVE $ODCLI CODCLI 15
//----------------------------------------------------16
// CLES 17
//----------------------------------------------------18
// 19
C CLTL02 KLIST 20
C KFLD CODCLI 21
C KFLD ACATEG 22
//----------------------------------------------------23
// INITIALISATIONS 24
//----------------------------------------------------25
C Z-ADD 20 SATJOU 26
C Z-ADD UYEAR AATJOU 27
C Z-ADD UMONTH MATJOU 28
C Z-ADD UDAY JATJOU 29
C MOVE '/' SLASH1 30
C MOVE '/' SLASH2 31
C MOVE '-' TIRET1 32
C MOVE '/' SLASH3 33
// RECHERCHE CLIENT I34
/FREE35
CHAIN CODCLI BNCLTL01;36
*IN60 = NOT %FOUND;37
// RECHERCHE ADRESSE CLI I38
/END-FREE39
C MOVE 'CLI' ACATEG 40
/FREE41
CHAIN CLTL02 BACLTL02;42
*IN60 = NOT %FOUND;43
/END-FREE44
C N60NIDEAD CHAIN BACISL01 60 45
/FREE46
IF *IN60 = '0';47
/END-FREE48
C MOVE ALIGN3 CLIGN3 49
C MOVE ALIGN4 CLIGN4 50
C MOVE ALIGN5 CLIGN5 51
C MOVE ALIGN6 CLIGN6 52
/FREE53
ENDIF;54
/END-FREEComme vous pouvez le voir, certaines lignes ne sont pas convertis :
- les déclarations autre que « Calculations » (F, D, H etc…),
Pour les transformer en format libre, vous pouvez utiliser le plugin JCRCMDS pour RDI ou la version par commande.
- la déclaration des paramètres (*ENTRY), nous aurions dû avoir une « Procédure Interface Definition » (Dcl-pi),
- Ici nous aurions :
C#
1
3
1
Dcl-pi Liste_des_client Extpgm('LSTCLT');2
$Codcli Char(8);3
End-pi;- Les opérateurs MOVE, Z‑ADD,
- Move sera remplacé par des combinaisons d’Eval, Evalr et éventuellement une %BIF.
- L’usage d’indicateur dans les colonnes 9, 10 et 11 etc… pourra être remplacé par des indicateurs nommés, plus clair.
- Les déclarations de clef KLIST ne sont pas transformés
Nous verrons dans d’autres billets ces cas particuliers.
Autre exemple, la gestion d’un sous-fichier de clients
C#
1
378
378
1
H DEBUG DECEDIT('0,') DATEDIT(*DMY.)2
F**********************************************************************3
F* CC 01/01/20094
F* Liste du personnel5
F**********************************************************************6
F* Déclaration des fichiers7
FPGMF01FM CF E WORKSTN8
F SFILE(SFL01 :WRAN01)9
F INFDS(DSSFL1)10
FFIC02L IF E K DISK11
F INFDS(FIC)12
F* Déclaration des variables13
DWDAT S 814
DWHEU S 615
DW14 S 14 016
DWSNOM S 3517
DWSNOP S 3518
DI S 3 019
D* La DS du programme, noter le S indispensable20
DDSPROG SDS21
DWNPROG 1 1022
DWSTATP 11 15 023
DWSTAPR 16 20 024
DWSQSRC 21 2825
DWSBROU 29 3626
DWNPARM 37 39 027
DWTYEXC 40 4228
DWNMSGM 40 4629
DWNMEXC 43 4630
DWINSMC 47 5031
DWZOMSG 51 8032
DWLBPGM 81 9033
DWSFDTA 91 17034
DWCDERR 171 17435
DWLSFIL 201 20836
DWLSINF 209 24337
DWJOB 244 25338
DWUSER 254 26339
DWNJOB 264 269 040
D* La DS du sous=fichier41
DDSSFL1 DS42
DWPOSC 370 371B 043
DWRRNG 376 377B 044
DWRNGP 378 379B 045
DWNBRSF 380 381B 046
D* La DS du fichier47
DFIC DS48
DWNRC01 397 400B 049
DWDSFIC DS50
DWCDFIL 1 851
DWOPENF 9 952
DWSTSFI 11 15 053
DWOPCOD 16 2154
DWRPGSQ 30 3755
DWRPGNR 38 4556
DWERRFI 46 5257
DWNFICH 83 9258
DWNLIBR 93 10259
DWSPNAM 103 11260
DWSPLIB 113 12261
DWSPNUM 123 124B 062
DWLIMBR 129 13863
DWNBPUT 243 246B 064
DWNBGET 247 250B 065
DWNBPG 251 254B 066
DWNBIO 255 258B 067
DWRCDFT 261 27068
DWNBRCD 283 286B 069
DWNRCFI 397 400B 070
C* la clé d'accés au fichier71
C KEY001 KLIST72
C KFLD FIFON73
C KFLD FINOM74
C* le nombre de lignes afichables, déclaration a la volée75
C Z-ADD 14 NBLIS1 4 076
C* initialisation des variables générales77
C MOVEL WNPROG ZPGM78
C EXSR DATHEU79
C MOVE WDAT ZDATE80
C MOVE WHEU ZHEUR81
C MOVEL WUSER ZUSER82
C MOVEL WJOB ZJOB83
C* Initialisation du sous=fichier des messages84
C MOVEL '* ' WPGMQ85
C MOVEL 'CC01' WMGKEY86
C SETON 091087
C* Indicateur fin88
C SETON 5089
C* Debut du traitement,90
C EXSR INITSF91
C* Boucle d'attente de sortie92
C DOW *IN50 = '1'93
C EXSR TRTSFL94
C END95
C* Indicateur de fin de programme96
C SETON LR97
C* Les procédures98
C* Traitement de l'écran99
C TRTSFL BEGSR100
C* Effacement du sous=fichier de messages101
C MOVEL '3' PTYP102
C MOVEL *BLANK PFIM103
C MOVEL *BLANK PMID104
C CALL 'PGM001CL'105
C PARM PTYP 1106
C PARM PFIM 10107
C PARM PMID 7108
C PARM PMDT 99109
C WRITE WSFCTL110
C* Ecriture de l'écran111
C SETON 0405112
C WRITE FORE1 70113
C WRITE FORB1114
C* Attente lecture115
C READ FORE1 70116
C* Une touche a été actionnée117
C* Chargement de l'heure118
C TIME ZHEUR119
C* Indicateur pour ne pas tester d'autres actions120
C SETON 51121
C IF *IN02 = '1'122
C* page suivante123
C EXSR CHGPAG124
C SETOFF 51125
C END126
C*127
C 51 IF WSNOP <> ZSNOM128
C* Test si selection/ si changé on initialise129
C EXSR INITSF130
C SETOFF 51131
C END132
C* touches F3 et F12133
C IF *INKC = '1' OR134
C *INKL = '1'135
C* on met l'indicateur à Off = fin du programme136
C SETOFF 5051137
C END138
C*139
C IF *INKE = '1'140
C* F5 Rafraichissement de l'écran141
C EXSR INITSF142
C SETOFF 51143
C END144
C*145
C IF *INKF = '1'146
C* F6 création d'un nouveau matricule147
C MOVEL 'CR' PCHX148
C MOVEL *BLANK NREC149
C CALL 'PGMF02'150
C PARM PCHX 2151
C PARM NREC 10152
C EXSR INITSF153
C SETOFF 51154
C END155
C IF *INKH = '1'156
C* F8 impression du fichier157
C MOVEL *BLANK PMAT158
C* On appelle le CL de routage sans soumission, sinon PGMF20CL159
C CALL 'PGMF2SCL'160
C PARM PMAT 10161
C SETOFF 51162
C END163
C* On ne fait ceci que s'il n'y a eu rien d'autre164
C IF *IN51 = '1'165
C EXSR TRTOPT166
C END167
C* On recommence la boucle d'attente168
C ENDSR169
C* Initialisation du sous-fichier170
C INITSF BEGSR171
C* l'indicateur 20 conditionne la zone OPT (protection)172
C SETOFF 20173
C* Initialisation de la variable de sélection174
C MOVEL ZSNOM WSNOP175
C MOVEL *BLANK WSNOM176
C* Initialisation de la clé pour positionnement177
C MOVEL *BLANK FIFON178
C MOVEL *BLANK FINOM179
C SETOFF 8485180
C IF ZSNOM <> *BLANK181
C* Si différent de blank il y a selection182
C SETON 84183
C Z-ADD 0 I184
C '*' SCAN ZSNOM I 85185
C IF I > 0186
C I SUB 1 I187
C I SUBST (P) ZSNOM:1 WSNOM 90188
C* On est dans le cas d'une sélection générique189
C SETON 85190
C* On se positionnera juste au bon endroit dans le fichier191
C MOVEL WSNOM FINOM192
C END193
C END194
C* La dernière ligne écrite195
C Z-ADD 0 LSTLIG 4 0196
C* Le compteur de ligne par page197
C Z-ADD 0 NBRLIG 4 0198
C* Le fameux WRAN01199
C Z-ADD 0 WRAN01 4 0200
C* Effacement du sous=fichier201
C SETON 0607202
C SETOFF 0405203
C WRITE FORE1204
C SETOFF 06205
C SETON 0405206
C* Positionnement en début de fichier207
C KEY001 SETLL FICF 70208
C* Chargement de la première page209
C EXSR CHGPAG210
C ENDSR211
C* Traitement des options, on ne lit que les enregistrements modifiés212
C TRTOPT BEGSR213
C* Lecture des enregistrements modifiés214
C Z-ADD 1 WRAN01215
C* Top pour rafraichir l'écran, si besoin216
C SETOFF 86217
C N70 READC SFL01 7070218
C*219
C *IN70 DOWEQ '0'220
C MOVE HNREC NREC221
C IF HTOUT = '1'222
C IF ZOPT='2' OR ZOPT='3' OR ZOPT='4' OR ZOPT='99'223
C* Si l'employé à quitté on ne peut plus rien modifier224
C MOVE '5 ' ZOPT225
C END226
C END227
C SETON 85228
C* Selection en fonction du choix saisi229
C SELECT230
C WHEN (ZOPT = '2') OR (ZOPT = ' 2')231
C MOVEL 'MO' PCHX232
C WHEN (ZOPT = '3') OR (ZOPT = ' 3')233
C MOVEL 'CO' PCHX234
C WHEN (ZOPT = '4') OR (ZOPT = ' 4')235
C MOVEL 'SU' PCHX236
C WHEN (ZOPT = '5') OR (ZOPT = ' 5')237
C MOVEL 'AF' PCHX238
C WHEN (ZOPT = '6') OR (ZOPT = ' 6')239
C MOVE HMATR PMAT240
C CALL 'PGMF2SCL'241
C PARM PMAT 10242
C SETOFF 85243
C WHEN (ZOPT = '99')244
C MOVEL 'PE' PCHX245
C OTHER246
C* La saisie ne correspond à rien247
C SETOFF 85248
C* Envoyer un message pour dire que l'option n'existe pas249
C MOVEL '1' PTYP250
C MOVEL 'FICMSG ' PFIM251
C MOVEL 'MSG0002' PMID252
C CALL 'PGM001CL'253
C PARM PTYP 1254
C PARM PFIM 10255
C PARM PMID 7256
C PARM PMDT 99257
C ENDSL258
C IF HTOUT = '0'259
C* Pour ne pas perdre l'attribut couleur260
C SETOFF 30261
C ELSE262
C SETON 30263
C END264
C* Nettoyage265
C MOVEL *BLANK ZOPT266
C UPDATE SFL01 90267
C* On aurait pu aussi faire IF..., en tout cas le choix est bon268
C 85 CALL 'PGMF02'269
C PARM PCHX 2270
C PARM NREC 10271
C 85 SETON 86272
C* On continue de boucler si autre option273
C READC SFL01 7070274
C END275
C* Potentiellement il y a eu mise à jour, on pourrait affiner276
C 86 EXSR INITSF277
C ENDSR278
C* Chargement d'une page279
C CHGPAG BEGSR280
C* Il faut positionner correctement les indicateurs et les variables281
C SETOFF 08282
C* SETON 04283
C Z-ADD LSTLIG WRAN01284
C* Lexture de l'enregistrement suivant285
C READ FICF 70286
C* Remise à zéro du compteur de ligne, mais on pourrait faire autrement287
C Z-ADD 0 NBRLIG 4 0288
C*289
C *IN70 DOWEQ '0'290
C NBRLIG ANDLT 14291
C* Remplissage des zones écran292
C SETON 86293
C* Test s'il y a selection294
C IF *IN84 = '1' OR *IN85 = '1'295
C IF *IN84 = '1' AND *IN85 = '0'296
C* On recherche la stricte égalité de nom297
C IF FINOM <> ZSNOM298
C SETOFF 86299
C END300
C ELSE301
C* On recherche si le nom commence par la valeur avant le '*'302
C I SUBST (P) FINOM:1 WXNOM 35 90303
C* Petite entorse de flemmard WXNOM est déclarée au fil de l'eau304
C IF WXNOM <> WSNOM305
C SETOFF 86306
C END307
C END308
C END309
C* L'indicateur est à '1' si sélection OK ou pas de sélection310
C IF *IN86 = '1'311
C MOVEL FINOM ZNOM312
C MOVEL FIPR1 ZPR1313
C MOVEL FIFON ZFONC314
C Z-ADD FIMAT ZMATR315
C MOVEL FICPO ZCPO316
C MOVEL FIC WDSFIC317
C Z-ADD WNRCFI HNREC318
C MOVE FIMAT HMATR319
C IF FIDAS = 0320
C* Top salarié licencié321
C MOVE '0' HTOUT322
C SETOFF 30323
C ELSE324
C MOVE '1' HTOUT325
C SETON 30326
C END327
C* Les compteurs, attention au WRAN01328
C ADD 1 NBRLIG329
C ADD 1 LSTLIG330
C ADD 1 WRAN01331
C* Ecriture de la ligne332
C WRITE SFL01333
C END334
C* Lecture du suivant335
C READ FICF 70336
C END337
C* On quitte la boucle soit en fin de page338
C* soit en fin de fichier339
C *IN70 IFEQ '1'340
C* Le caractère de suite, on est en fin de fichier341
C SETON 07342
C ELSE343
C SETOFF 07344
C END345
C* Si le fichier est vide346
C WRAN01 IFEQ 0347
C Z-ADD 1 NBRLIG348
C Z-ADD 1 LSTLIG 4 0349
C* Un petit message350
C Z-ADD 1 WRAN01351
C* Pas de saisie d'option352
C SETON 20353
C IF ZSNOM = *BLANK354
C* Si on a un vieil AS400 du siècle dernier355
C MOVEL 'Fic. Vide' ZNOM356
C ELSE357
C* En RPG ILE358
C eval ZNOM = 'Sélection Vide'359
C END360
C* Ne pas oublier de remettre à blanc361
C MOVEL *BLANK ZPR1362
C MOVEL *BLANK ZFONC363
C Z-ADD 0 ZMATR364
C MOVEL *BLANK ZCPO365
C MOVEL *BLANK WDSFIC366
C Z-ADD 0 HNREC367
C* Ecriture du message sur la première ligne368
C WRITE SFL01369
C END370
C* le WRAN01 à 1 pour afficher le premier enregistrement371
C* Z-ADD LSTLIG WRAN01372
C ENDSR373
C* Lecture date et heure systeme374
C DATHEU BEGSR375
C TIME W14376
C MOVE W14 WDAT377
C MOVEL W14 WHEU378
C ENDSR Après application de l’option de conversion en format libre de RDI, nous obtenons :
C#
1
466
466
1
H DEBUG DECEDIT('0,') DATEDIT(*DMY.)2
//*********************************************************************3
// CC 01/01/20094
// Liste du personnel5
//*********************************************************************6
// Déclaration des fichiers7
FPGMF01FM CF E WORKSTN8
F SFILE(SFL01 :WRAN01)9
F INFDS(DSSFL1)10
FFIC02L IF E K DISK11
F INFDS(FIC)12
// Déclaration des variables13
DWDAT S 814
DWHEU S 615
DW14 S 14 016
DWSNOM S 3517
DWSNOP S 3518
DI S 3 019
// La DS du programme, noter le S indispensable20
DDSPROG SDS21
DWNPROG 1 1022
DWSTATP 11 15 023
DWSTAPR 16 20 024
DWSQSRC 21 2825
DWSBROU 29 3626
DWNPARM 37 39 027
DWTYEXC 40 4228
DWNMSGM 40 4629
DWNMEXC 43 4630
DWINSMC 47 5031
DWZOMSG 51 8032
DWLBPGM 81 9033
DWSFDTA 91 17034
DWCDERR 171 17435
DWLSFIL 201 20836
DWLSINF 209 24337
DWJOB 244 25338
DWUSER 254 26339
DWNJOB 264 269 040
// La DS du sous=fichier41
DDSSFL1 DS42
DWPOSC 370 371B 043
DWRRNG 376 377B 044
DWRNGP 378 379B 045
DWNBRSF 380 381B 046
// La DS du fichier47
DFIC DS48
DWNRC01 397 400B 049
DWDSFIC DS50
DWCDFIL 1 851
DWOPENF 9 952
DWSTSFI 11 15 053
DWOPCOD 16 2154
DWRPGSQ 30 3755
DWRPGNR 38 4556
DWERRFI 46 5257
DWNFICH 83 9258
DWNLIBR 93 10259
DWSPNAM 103 11260
DWSPLIB 113 12261
DWSPNUM 123 124B 062
DWLIMBR 129 13863
DWNBPUT 243 246B 064
DWNBGET 247 250B 065
DWNBPG 251 254B 066
DWNBIO 255 258B 067
DWRCDFT 261 27068
DWNBRCD 283 286B 069
DWNRCFI 397 400B 070
// la clé d'accés au fichier71
C KEY001 KLIST72
C KFLD FIFON73
C KFLD FINOM74
// le nombre de lignes afichables, déclaration a la volée75
C Z-ADD 14 NBLIS1 4 076
// initialisation des variables générales77
C MOVEL WNPROG ZPGM78
/FREE79
EXSR DATHEU;80
/END-FREE81
C MOVE WDAT ZDATE82
C MOVE WHEU ZHEUR83
C MOVEL WUSER ZUSER84
C MOVEL WJOB ZJOB85
// Initialisation du sous=fichier des messages86
C MOVEL '* ' WPGMQ87
C MOVEL 'CC01' WMGKEY88
/FREE89
*IN09 = *ON;90
*IN10 = *ON;91
// Indicateur fin92
*IN50 = *ON;93
// Debut du traitement,94
EXSR INITSF;95
// Boucle d'attente de sortie96
DOW *IN50 = '1';97
EXSR TRTSFL;98
ENDDO;99
// Indicateur de fin de programme100
*INLR = *ON;101
// Les procédures102
// Traitement de l'écran103
BEGSR TRTSFL;104
// Effacement du sous=fichier de messages105
/END-FREE106
C MOVEL '3' PTYP107
C MOVEL *BLANK PFIM108
C MOVEL *BLANK PMID109
C CALL 'PGM001CL'110
C PARM PTYP 1111
C PARM PFIM 10112
C PARM PMID 7113
C PARM PMDT 99114
/FREE115
WRITE WSFCTL;116
// Ecriture de l'écran117
*IN04 = *ON;118
*IN05 = *ON;119
WRITE FORE1;120
*IN70 = %EOF;121
WRITE FORB1;122
// Attente lecture123
READ FORE1;124
*IN70 = %EOF;125
// Une touche a été actionnée126
// Chargement de l'heure127
/END-FREE128
C TIME ZHEUR129
// Indicateur pour ne pas tester d'autres actions130
/FREE131
*IN51 = *ON;132
IF *IN02 = '1';133
// page suivante134
EXSR CHGPAG;135
*IN51 = *OFF;136
ENDIF;137
//138
/END-FREE139
C 51 IF WSNOP <> ZSNOM140
// Test si selection/ si changé on initialise141
/FREE142
EXSR INITSF;143
*IN51 = *OFF;144
ENDIF;145
// touches F3 et F12146
IF *INKC = '1' OR147
*INKL = '1';148
// on met l'indicateur à Off = fin du programme149
*IN50 = *OFF;150
*IN51 = *OFF;151
ENDIF;152
//153
IF *INKE = '1';154
// F5 Rafraichissement de l'écran155
EXSR INITSF;156
*IN51 = *OFF;157
ENDIF;158
//159
IF *INKF = '1';160
// F6 création d'un nouveau matricule161
/END-FREE162
C MOVEL 'CR' PCHX163
C MOVEL *BLANK NREC164
C CALL 'PGMF02'165
C PARM PCHX 2166
C PARM NREC 10167
/FREE168
EXSR INITSF;169
*IN51 = *OFF;170
ENDIF;171
IF *INKH = '1';172
// F8 impression du fichier173
/END-FREE174
C MOVEL *BLANK PMAT175
// On appelle le CL de routage sans soumission, sinon PGMF20CL176
C CALL 'PGMF2SCL'177
C PARM PMAT 10178
/FREE179
*IN51 = *OFF;180
ENDIF;181
// On ne fait ceci que s'il n'y a eu rien d'autre182
IF *IN51 = '1';183
EXSR TRTOPT;184
ENDIF;185
// On recommence la boucle d'attente186
ENDSR;187
// Initialisation du sous-fichier188
BEGSR INITSF;189
// l'indicateur 20 conditionne la zone OPT (protection)190
*IN20 = *OFF;191
// Initialisation de la variable de sélection192
/END-FREE193
C MOVEL ZSNOM WSNOP194
C MOVEL *BLANK WSNOM195
// Initialisation de la clé pour positionnement196
C MOVEL *BLANK FIFON197
C MOVEL *BLANK FINOM198
/FREE199
*IN84 = *OFF;200
*IN85 = *OFF;201
IF ZSNOM <> *BLANK;202
// Si différent de blank il y a selection203
*IN84 = *ON;204
/END-FREE205
C Z-ADD 0 I206
C '*' SCAN ZSNOM I 85207
/FREE208
IF I > 0;209
/END-FREE210
C I SUB 1 I211
C I SUBST (P) ZSNOM:1 WSNOM 90212
// On est dans le cas d'une sélection générique213
/FREE214
*IN85 = *ON;215
// On se positionnera juste au bon endroit dans le fichier216
/END-FREE217
C MOVEL WSNOM FINOM218
/FREE219
ENDIF;220
ENDIF;221
// La dernière ligne écrite222
/END-FREE223
C Z-ADD 0 LSTLIG 4 0224
// Le compteur de ligne par page225
C Z-ADD 0 NBRLIG 4 0226
// Le fameux WRAN01227
C Z-ADD 0 WRAN01 4 0228
// Effacement du sous=fichier229
/FREE230
*IN06 = *ON;231
*IN07 = *ON;232
*IN04 = *OFF;233
*IN05 = *OFF;234
WRITE FORE1;235
*IN06 = *OFF;236
*IN04 = *ON;237
*IN05 = *ON;238
// Positionnement en début de fichier239
SETLL KEY001 FICF;240
*IN70 = %EQUAL;241
// Chargement de la première page242
EXSR CHGPAG;243
ENDSR;244
// Traitement des options, on ne lit que les enregistrements modifiés245
BEGSR TRTOPT;246
// Lecture des enregistrements modifiés247
/END-FREE248
C Z-ADD 1 WRAN01249
// Top pour rafraichir l'écran, si besoin250
/FREE251
*IN86 = *OFF;252
/END-FREE253
C N70 READC SFL01 7070254
//255
/FREE256
DOW *IN70 = '0';257
/END-FREE258
C MOVE HNREC NREC259
/FREE260
IF HTOUT = '1';261
IF ZOPT='2' OR ZOPT='3' OR ZOPT='4' OR ZOPT='99';262
// Si l'employé à quitté on ne peut plus rien modifier263
/END-FREE264
C MOVE '5 ' ZOPT265
/FREE266
ENDIF;267
ENDIF;268
*IN85 = *ON;269
// Selection en fonction du choix saisi270
SELECT;271
WHEN (ZOPT = '2') OR (ZOPT = ' 2');272
/END-FREE273
C MOVEL 'MO' PCHX274
/FREE275
WHEN (ZOPT = '3') OR (ZOPT = ' 3');276
/END-FREE277
C MOVEL 'CO' PCHX278
/FREE279
WHEN (ZOPT = '4') OR (ZOPT = ' 4');280
/END-FREE281
C MOVEL 'SU' PCHX282
/FREE283
WHEN (ZOPT = '5') OR (ZOPT = ' 5');284
/END-FREE285
C MOVEL 'AF' PCHX286
/FREE287
WHEN (ZOPT = '6') OR (ZOPT = ' 6');288
/END-FREE289
C MOVE HMATR PMAT290
C CALL 'PGMF2SCL'291
C PARM PMAT 10292
/FREE293
*IN85 = *OFF;294
WHEN (ZOPT = '99');295
/END-FREE296
C MOVEL 'PE' PCHX297
/FREE298
OTHER;299
// La saisie ne correspond à rien300
*IN85 = *OFF;301
// Envoyer un message pour dire que l'option n'existe pas302
/END-FREE303
C MOVEL '1' PTYP304
C MOVEL 'FICMSG ' PFIM305
C MOVEL 'MSG0002' PMID306
C CALL 'PGM001CL'307
C PARM PTYP 1308
C PARM PFIM 10309
C PARM PMID 7310
C PARM PMDT 99311
/FREE312
ENDSL;313
IF HTOUT = '0';314
// Pour ne pas perdre l'attribut couleur315
*IN30 = *OFF;316
ELSE;317
*IN30 = *ON;318
ENDIF;319
// Nettoyage320
/END-FREE321
C MOVEL *BLANK ZOPT322
/FREE323
UPDATE(E) SFL01;324
*IN90 = %ERROR;325
// On aurait pu aussi faire IF..., en tout cas le choix est bon326
/END-FREE327
C 85 CALL 'PGMF02'328
C PARM PCHX 2329
C PARM NREC 10330
C 85 SETON 86331
// On continue de boucler si autre option332
/FREE333
READC(E) SFL01;334
*IN70 = %ERROR OR %EOF;335
ENDDO;336
// Potentiellement il y a eu mise à jour, on pourrait affiner337
/END-FREE338
C 86 EXSR INITSF339
/FREE340
ENDSR;341
// Chargement d'une page342
BEGSR CHGPAG;343
// Il faut positionner correctement les indicateurs et les variables344
*IN08 = *OFF;345
// SETON 04346
/END-FREE347
C Z-ADD LSTLIG WRAN01348
// Lexture de l'enregistrement suivant349
/FREE350
READ FICF;351
*IN70 = %EOF;352
// Remise à zéro du compteur de ligne, mais on pourrait faire autrement353
/END-FREE354
C Z-ADD 0 NBRLIG 4 0355
//356
/FREE357
DOW *IN70 = '0'358
AND NBRLIG < 14;359
// Remplissage des zones écran360
*IN86 = *ON;361
// Test s'il y a selection362
IF *IN84 = '1' OR *IN85 = '1';363
IF *IN84 = '1' AND *IN85 = '0';364
// On recherche la stricte égalité de nom365
IF FINOM <> ZSNOM;366
*IN86 = *OFF;367
ENDIF;368
ELSE;369
// On recherche si le nom commence par la valeur avant le '*'370
/END-FREE371
C I SUBST (P) FINOM:1 WXNOM 35 90372
// Petite entorse de flemmard WXNOM est déclarée au fil de l'eau373
/FREE374
IF WXNOM <> WSNOM;375
*IN86 = *OFF;376
ENDIF;377
ENDIF;378
ENDIF;379
// L'indicateur est à '1' si sélection OK ou pas de sélection380
IF *IN86 = '1';381
/END-FREE382
C MOVEL FINOM ZNOM383
C MOVEL FIPR1 ZPR1384
C MOVEL FIFON ZFONC385
C Z-ADD FIMAT ZMATR386
C MOVEL FICPO ZCPO387
C MOVEL FIC WDSFIC388
C Z-ADD WNRCFI HNREC389
C MOVE FIMAT HMATR390
/FREE391
IF FIDAS = 0;392
// Top salarié licencié393
/END-FREE394
C MOVE '0' HTOUT395
/FREE396
*IN30 = *OFF;397
ELSE;398
/END-FREE399
C MOVE '1' HTOUT400
/FREE401
*IN30 = *ON;402
ENDIF;403
// Les compteurs, attention au WRAN01404
/END-FREE405
C ADD 1 NBRLIG406
C ADD 1 LSTLIG407
C ADD 1 WRAN01408
// Ecriture de la ligne409
/FREE410
WRITE SFL01;411
ENDIF;412
// Lecture du suivant413
READ FICF;414
*IN70 = %EOF;415
ENDDO;416
// On quitte la boucle soit en fin de page417
// soit en fin de fichier418
IF *IN70 = '1';419
// Le caractère de suite, on est en fin de fichier420
*IN07 = *ON;421
ELSE;422
*IN07 = *OFF;423
ENDIF;424
// Si le fichier est vide425
IF WRAN01 = 0;426
/END-FREE427
C Z-ADD 1 NBRLIG428
C Z-ADD 1 LSTLIG 4 0429
// Un petit message430
C Z-ADD 1 WRAN01431
// Pas de saisie d'option432
/FREE433
*IN20 = *ON;434
IF ZSNOM = *BLANK;435
// Si on a un vieil AS400 du siècle dernier436
/END-FREE437
C MOVEL 'Fic. Vide' ZNOM438
/FREE439
ELSE;440
// En RPG ILE441
ZNOM = 'Sélection Vide';442
ENDIF;443
// Ne pas oublier de remettre à blanc444
/END-FREE445
C MOVEL *BLANK ZPR1446
C MOVEL *BLANK ZFONC447
C Z-ADD 0 ZMATR448
C MOVEL *BLANK ZCPO449
C MOVEL *BLANK WDSFIC450
C Z-ADD 0 HNREC451
// Ecriture du message sur la première ligne452
/FREE453
WRITE SFL01;454
ENDIF;455
// le WRAN01 à 1 pour afficher le premier enregistrement456
// Z-ADD LSTLIG WRAN01457
ENDSR;458
// Lecture date et heure systeme459
BEGSR DATHEU;460
/END-FREE461
C TIME W14462
C MOVE W14 WDAT463
C MOVEL W14 WHEU464
/FREE465
ENDSR;466
/END-FREEDans les prochains billets, ce source va continuer d’être travaillé pour observer ensemble l’évolution vers la forme libre que j’appelle complète.
[…] Moderniser votre code RPG avec Agilité – Partie 2 […]
[…] Moderniser votre code RPG avec Agilité – Partie 2 […]