Le programme de génération est très compact et utilise les API, ainsi que de nombreuses petites astuces d'impression. Les caractéristiques d'impression (OVRPRTF) peuvent nécessiter de petites adaptations en fonction du modèle d'imprimante.
Le programme CLP se contente de reformater les paramètres et de gérer les messages d'information et d'erreur.
Le panneau d'aide n'est pas vraiment indispensable mais peut servir de modèle pour des cas simples.
| Source | Type | Texte et commentaires |
|---|---|---|
| FD | CMD | Description de fichier Compiler avec PGM(FFD1C) HLPPNLGRP(*LIBL/FFDH) HLPID(*CMD)
|
| FDH | PNLGRP | Aide en ligne (compiler par option 14) |
| FFD1C | CLP | Programme lié à la commande |
| FFD1 | RPG | Programme principal, fait tout le travail. L'utilisation des API donne un programme unique et compact (400 lignes avec les commentaires). Il est auto documenté. |
CMD PROMPT('Description de fichier')
/* compiler avec PGM(FFD1C) HLPPNLGRP(*LIBL/FFDH) HLPID(*CMD) */
PARM KWD(FILE) TYPE(FILE) PROMPT('Fichier')
FILE: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURRENT) (*USRLIBL)) +
PROMPT('Bibliothèque')
:PNLGRP. :HELP NAME='FD'. :p.Cette commande imprime proprement et affiche à l'écran une description de fichier. :p.Elle utilise des API, un panneau d'aide simple, et tout un tas de petites astuces en liaison avec une impression, ce qui lui permet de servir de modèle dans beaucoup de cas. :EHELP. :HELP NAME='FD/FILE'.Fichier. - Aide. :XH2.Fichier :p.Entrer le nom du fichier et de la bibliothèque. :EHELP. :EPNLGRP.
/* FFD1C - Description de fichier Patrick LARREYA, 1990-2000 */
PGM &libfile
dcl &libfile *char 20
dcl &lib *char 10
dcl &file *char 10
DCL &ERR *CHAR 1 VALUE('0')
DCL &MSGID *CHAR 7
DCL &MSGF *CHAR 10
DCL &MSGLIB *CHAR 10
DCL &MSGDTA *CHAR 256
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERREUR))
chgvar &file %sst(&libfile 1 10)
chgvar &lib %sst(&libfile 11 10)
chkobj &lib/&file *file
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('Traitement de' !> &LIB !< '/' !< +
&FILE !> 'en cours. . .') TOPGMQ(*EXT) +
MSGTYPE(*STATUS)
CALL ffd1 (&file &lib)
GOTO FINFIN
ERREUR: IF (&ERR = '1') GOTO FINFIN
CHGVAR &ERR '1'
RCVMSG MSGTYPE(*LAST) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
FINFIN: ENDPGM
Il utilise des user Spaces créés dans QTEMP. Consulter la documentation de API pour plus de précisions.
Positionner les attributs de spoules par QCMDEXC évite de créer des sources séparés, qui posent souvent problème lors des recompilations ou installations. QCMDEXC ne permet pas de gérer correctement les erreurs et ne doit être utilisé que si elles sont improbables et sans conséquences.
Il est important de noter que l'AS400 gère en général ses passages de paramètres par référence, et que de nombreux programmes de bas niveau ont besoin de connaître la longueur des paramètres transmis pour ne pas déborder. Le système vérifie qu'aucun débordement ne se produit hors de la zone dévolue aux données, mais ne fait pas de vérification individuelle. Les paramètres peuvent empiéter les uns sur les autres en cas d'erreur de programmation.
H D
F*===================================================================
F* FFD1 : DSPFFD directement par API.
F*
F* Patrick LARREYA, 1990-2000
F*===================================================================
F* Comment celà marche-t-il ?
F*
F* Les API récupèrent leurs informations dans des Data Area
F* si l'information est fixe, dans un User Space si l'information
F* est une liste.
F*
F* Les users spaces liste comprennent une information fixes et une
F* information liste.
F*
F* L'information fixe comprend (entre autres choses)
F* - la position du début de la liste
F* - le nombre de postes de la liste
F* - la taille de chaque poste de la liste.
F*
F* Un API permet de récupérer une portion de User Space et de la
F*
F* La récupération des clés utilisa un autre API, qui pourrait
F* en fait servir pour récupérer toutes les informations de base.
F*
F*
F* mettre dans une Data Area.
F*===================================================================
F* Détail des API utilisés.
F*
F* API Format DS/UsrSpc Descriptif
F* --------- -------- ------ --------------------------------
F* Plusieurs ERRCOD Récup codes erreur API.
F* QUSROBJD OBJD0200 D1INFO Description d'objet, tous types
F* QUSCRTUS USP1 Création UserSpace Formats
F* QUSLRCD RCDL0100 USP1 Récup Liste de Formats d'un fichier
F* QUSCRTUS USP2 Création UserSpace Champs
F* QUSLFLD FLDL0100 USP2 Récup Liste de Champs d'un format
F* QDBRTVFD FILD0300
F*===================================================================
FQSYSPRT O F 132 OA PRINTER UC
E CMD 1 3 80 Qsysprt
E TK 6400 1 Infos clé
I* Infos clé
IINFOK DS
I 16400 TK
I B 11 120TKNBRK
I B 23 240TKNBFM
I* Erreurs d'appel API
IERRCOD DS
I B 1 40BYTPRO
I B 5 80BYTAVA
I 9 15 EXCID
I 16 16 RSRVD
I* Compteurs binaires sur récup caractéristiques User Space
I DS
I B 1 40USLEN
I B 5 80USPOS
I B 9 120USSPSQ
I B 13 160SCSPN2
I B 17 200SCLEN
I B 21 240U2LEN
I B 25 280U2POS
I B 29 320U3LEN
I B 33 360U3POS
I* Compteurs binaires sur caractéristiques récupérées
I* Ces informations sont récupérées dans la portion fixe
I* du User Space. La technique est standard pour tous les API
I* utilisant une liste.
IUSINFO DS
I B 1 40USDEPL
I B 9 120USNBLS
I B 13 160USSZLS
IU2INFO DS
I B 1 40U2DEPL
I B 9 120U2NBLS
I B 13 160U2SZLS
IU3INFO DS
I B 1 40U3DEPL
I B 9 120U3NBLS
I B 13 160U3SZLS
I* Infos QDBLDBR, Infos fichier, format DBLR0100 (Longueur 320)
IWHINFO DS
I 1 10 WHRFI
I 11 20 WHRLI
I 21 30 WHREFI
I 31 40 WHRELI
I 41 41 WHTYPE
I* Taille du User Space en binaire
I DS
I B 1 40USSIZ
I* Binary values values for API
I DS
I B 1 40INFOLN
I* User Space and Object information
ID1INFO DS
I 9 18 D1OBJ
I 19 28 D1LIB1
I 29 38 D1TYPE
I 39 48 D1LIBO
I 101 150 D1TXT
I 151 160 D1SRC
I 161 170 D1LIB
I 171 180 D1MBR
I* L'information Format la plus simple ne contient que le format.
ID2INFO DS
I 1 10 D2FMT
I 33 82 D2TXT
I* Prefix D2
I*
I* Fields information. FLDL0100 is lengh 285
ID3INFO DS
I 1 10 D3NAME
I 11 11 D3TYP
I 12 12 D3TYPE
I B 13 160D3POS
I B 21 240D3BYTS
I B 25 280D3DIGS
I B 29 320D3DECP
I 33 82 D3TXT
I 153 171 D3CH1
I 173 191 D3CH2
I 193 211 D3CH3
I SDS
I 1 10 PGMNAM
I 244 253 WS
I 254 263 USER
I DS
I 1 120TIMHR
I 1 60H1TIME
I 7 120H1DATE
I* Constantes User space
I 'USPFFD1 QTEMP 'C C1USP
I 'FFDFMT 'C C1ATR
I 2000 C C1SIZ
I 'USPFFD2 QTEMP 'C C2USP
I 'FFDFLD 'C C2ATR
I 10000 C C2SIZ
I '*ALL ' C C1AUT
I 'Database Relations 'C C1TXT
C*------------------------------------------------------------------------
C* Paramètres d'appel commande
C *ENTRY PLIST
C PARM P0FILE 10 File
C PARM P0LIB 10 Library
C* Taille zone erreur gérée
C Z-ADD16 BYTPRO
C* Configurer le fichier imprimante
C MOVELCMD,1 CMDX P
1{ C P0FILE IFEQ *BLANK
C CAT 'Qui ?':0 CMDX
1| C ELSE
C CAT P0FILE:0 CMDX
1} C END
C CAT CMD,2:0 CMDX
C*
C CALL 'QCMDEXC'
C PARM CMDX 120
C PARM 120 CMDLEN 155
C OPEN QSYSPRT
C*-----------------------------------------------------------------
1<--C EXSR INIT Initialisation
C*
C TIME TIMHR
C Z-ADD1 H1PAGE 40
2<--C EXSR GETFIL Infos fichier
C P0FILE CAT '/':0 H1FILE 20 P
C CAT H1LIB:0 H1FILE
C EXCPTH1
C* Recherche des infos clé
C P0FILE CAT H1LIB P1FILE
C CALL 'QDBRTVFD'
C PARM INFOK DS récup
C PARM 6400 INFOLN Taille
C PARM P1FILR 20 Fichier renvoyé
C PARM 'FILD0300'F1APIF 8 Format API
C PARM P1FILE 20 Fichier Qualifié
C PARM ' ' P1FMT 10 Format
C PARM '0' P1OVR 1 Override
C PARM '*LCL' P1SYST 10 Systeme
C PARM '*EXT' P1FMTT 10 Format *INT/*EXT
C PARM ERRCOD
C*
1{ C EXCID IFEQ ' '
C 32 MULT TKNBFM PK 50 Info Format sur 32
C ADD 25 PK Deplacement fixe 25
C Z-ADD25 PF 50 Fmt commence en 25
2{ C DO TKNBFM Boucle sur format
C MOVEATK,PF D1KFM 10 Nom du format
C MOVE *BLANK D1CLES 70
C ADD 32 PF
3{ C DO TKNBRK Boucle sur clés
C MOVEATK,PK A10 10 Clé sur 10
C CAT A10:1 D1CLES Concaténée
C ADD 64 PK Poste 64 de long
3} C ENDDO
C EXCPTD1CLE Impr. Format
2} C ENDDO
1} C ENDIF
C*
C* Boucle sur les formats du fichier
C*--------------------------------------
1{ C DO U2NBLS N2 50 Pour chaque format
C*--------------------------------------
3<--C EXSR GETFMT Infos format
C EXCPTD1FMT Infos format
C* Boucle sur les champs du format
C*---------------------------
2{ C DO U3NBLS N3 50 Pour chaque champ
C*---------------------------
4<--C EXSR GETFLD
C Z-ADDD3POS X3POS 50
C Z-ADDD3BYTS X3LEN 40
C Z-ADDD3DIGS X3DIG 40
C Z-ADDD3DECP NUM2 20
3{ C X3DIG IFEQ 0
C MOVE ' ' X3DECA
C Z-ADDX3LEN X3DIG
C Z-ADD0 X3LEN
3| C ELSE
4{ C D3TYP IFEQ 'S'
C Z-ADD0 X3LEN
4} C END
C MOVE NUM2 X3DECA 1
3} C ENDIF
3{ C *INOA IFEQ '1'
C ADD 1 H1PAGE
C EXCPTH1
C EXCPTD1FMT
3} C ENDIF
C EXCPTD1FLD Infos zones
C*---------------------------
2} C ENDDO
C*---------------------------
C*--------------------------------------
1} C ENDDO
C*--------------------------------------
C CLOSEQSYSPRT
C*
C CALL 'QCMDEXC'
C PARM CMD,3 CMDY 80
C PARM 80 CMDLEN 155
C*
C SETON LR
C*====================================================================
1---C INIT BEGSR
C* Vérification de présence du Userspace Format
C MOVE ' ' EXCID
C*
C CALL 'QUSROBJD'
C PARM D1INFO
C PARM 180 INFOLN
C PARM 'OBJD0200'FORMAT 8
C PARM C1USP OBJLIB 20
C PARM '*USRSPC' OBJTYP 10
C PARM ERRCOD
C* ... Création si absent
1{ C EXCID IFNE ' '
C Z-ADDC1SIZ USSIZ
C CALL 'QUSCRTUS' API
C PARM C1USP USP1 20 Nom qualifié
C PARM C1ATR USATR 10 Attribut
C PARM USSIZ Taille en binaire
C PARM ' ' USINI 1 Remplissage
C PARM C1AUT USAUT 10 Droits
C PARM C1TXT USTXT 50 Description
1} C ENDIF
C* Vérification de présence du Userspace Zones
C MOVE ' ' EXCID
C*
C CALL 'QUSROBJD'
C PARM D1INFO
C PARM 180 INFOLN
C PARM 'OBJD0200'FORMAT 8
C PARM C2USP OBJLIB 20
C PARM '*USRSPC' OBJTYP 10
C PARM ERRCOD
C* ... Création si absent
1{ C EXCID IFNE ' '
C Z-ADDC2SIZ USSIZ
C CALL 'QUSCRTUS' API
C PARM C2USP USP2 20 Nom qualifié
C PARM C2ATR USATR 10 Attribut
C PARM USSIZ Taille en binaire
C PARM ' ' USINI 1 Remplissage
C PARM C1AUT USAUT 10 Droits
C PARM C1TXT USTXT 50 Description
1} C ENDIF
C*
C ENDSR
C*====================================================================
2---C GETFIL BEGSR
C* Description du fichier
C P0FILE CAT P0LIB P1FILQ 20
C*
C MOVE ' ' EXCID
C*
C CALL 'QUSROBJD'
C PARM D1INFO
C PARM 180 INFOLN
C PARM 'OBJD0200'FORMAT 8
C PARM P1FILQ OBJLIB 20
C PARM '*FILE ' OBJTYP 10
C PARM ERRCOD
C*
C MOVE D1LIBO H1LIB 10
C MOVE D1TXT H1TXT 50
C* Info en cas de problème
1{ C EXCID IFNE ' '
C EXCID CAT P1FILQ:1 H1TXT
1} C ENDIF
C*
C* Description des formats du fichier
C CALL 'QUSLRCD'
C PARM C1USP USP1
C PARM 'RCDL0200'FORMAT 8
C PARM P1FILQ OBJLIB 20
C PARM '0' FILOVR 1
C PARM ERRCOD
C* Recupération du formatage de la liste en début de userspace
C CALL 'QUSRTVUS'
C PARM C1USP USP1 User Space
C PARM 125 USPOS Position
C PARM 16 USLEN Longueur
C PARM U2INFO DS infos User Space
C* Préparation des pointeurs pour récup de la liste
C 1 ADD U2DEPL U2POS Depuis
C** $$ 10 est pris Z-ADDU2SZLS U2LEN Taille poste liste
C* Si U2LEN ne fait pas 10, problèmes
C ENDSR
C*====================================================================
3---C GETFMT BEGSR
C* Récupération du nom de format et de la liste des zones
C*
C* Nom du format dans user space format, nom + texte
C CALL 'QUSRTVUS'
C PARM C1USP USP1 User Space
C PARM U2POS USPOS Position
C PARM 82 USLEN Longueur
C PARM D2INFO DS infos Format
1{ C D2TXT IFEQ *BLANK
C MOVELH1TXT D2TXT P
1} C ENDIF
C* Positionnement sur le format suivant dans le User Space.
C ADD U2SZLS U2POS
C* Récupération de la liste des champs du format
C CALL 'QUSLFLD'
C PARM C2USP USP2 Destination Info
C PARM 'FLDL0100'FORMAT 8 Format récupéré
C PARM P1FILQ OBJLIB 20 Fichier / Bib
C PARM D2FMT W2FMT 10 Format
C PARM '0' FILOVR 1 Pas d'override
C PARM ERRCOD En cas d'erreur.
C* Recupération du formatage de la liste des champs
C CALL 'QUSRTVUS'
C PARM C2USP USP2 User Space
C PARM 125 USPOS Position
C PARM 16 USLEN Longueur
C PARM U3INFO DS infos User Space
C* Préparation des pointeurs pour récup du premier champ
C 1 ADD U3DEPL U3POS Depuis
C** Z-ADDU3SZLS U3LEN Taille poste liste
C*
C ENDSR
C*====================================================================
4---C GETFLD BEGSR
C* Récupération des infos concernant un champ
C CALL 'QUSRTVUS'
C PARM C2USP USP2 User Space
C PARM U3POS USPOS Position
C PARM 211 USLEN Longueur DS
C PARM D3INFO DS infos Champs
C* Positionnement sur le champ suivant
C ADD U3SZLS U3POS
C*
C ENDSR
C*====================================================================
OQSYSPRT E 03 H1
O H1FILE 20
O H1TXT 71
O H1DATE 79 ' / / '
O 84 'Page'
O H1PAGE 88 ' '
O* 12345678901234567890'
O E 11 H1
O P0LIB 10
O H1TIME 79 ' : : '
O USER 90
O* 12345678901234567890'
O E 1 D1CLE
O D1KFM 10
O 12 ':'
O D1CLES 83
O*
O E 1 D1FMT
O 20 '--------------------'
O 40 '--------------------'
O 60 '--------------------'
O 80 '--------------------'
O 90 '----------'
O E 1 D1FMT
O D2FMT 10
O 20 '* Format *'
O D2TXT 80
O E 1 D1FMT
O 20 '--------------------'
O 40 '--------------------'
O 60 '--------------------'
O 80 '--------------------'
O 90 '----------'
O E 1 D1FLD
O D3NAME 10
O X3DIG 14 ' 0'
O D3TYP 16
O X3DECA 18
O X3LEN 22 ' 0'
O X3POS 27 ' 0'
O D3TXT 80
** CMD : caractéristiques et affichage du spoule
OVRPRTF QSYSPRT USRDTA('
') LPI(8) CPI(15) PAGESIZE(88 90) OVRFLW(80) PAGRTT(0)
DSPSPLF QSYSPRT * *LAST
Patrick Larreya, Septembre 2000.
Ce site a été créé avant l'an 2000, et à quelques détail près volontairement conservé en l'état.
Curieusement, de nombreux éléments techniques restent d'actualité.
Cette commande est toujours aussi utile, mais facile à réédrire en RPG IV ou pour générer du HTML.