| 
Création de commande / pgm associés
1/ CHOICEPGM pgm d'affichage de la liste des valeurs possibles
/*------------------------------------------------------------------*/
/* */
/* Essai de pgm avec programme de choix paramètre CHOICE(*PGM) */
/* et CHOICEPGM(Bib/Nompgm) */
/* */
/*------------------------------------------------------------------*/
/* */
CMD PROMPT('Essai CHOICEPGM')
/* Nom de fichier */
PARM KWD(FILE) TYPE(*CHAR) LEN(10) MIN(1) +
CHOICE(*PGM) CHOICEPGM(*LIBL/A002P1) +
PROMPT('Nom du fichier')
CPP
PGM PARM(&FIC) /* AFFICHAGE D'UN FICHIER PGM CPP */
DCL &FIC *CHAR 10 /* NOM DU FICHIER */
DSPPFM FILE(&FIC)
|
|
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Fichier' *bcat &fic *bcat +
'inexistant') MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
CHOICEPGM
/*--------------------------------------------------------------*/
/* PGM POUR CHOIX PAR LISTE */
/*--------------------------------------------------------------*/
PGM PARM(&PARM1 &PARM2)
DCL VAR(&PARM1) TYPE(*CHAR) LEN(21)
DCL VAR(&PARM2) TYPE(*CHAR) LEN(2000)
/* */
/* PARM1 : PREMIER PARAMETRE */
/* 1 A 10 NOM DE COMMANDE */
/* 11 A 20 NOM DU PARAMETRE DE LA COMMANDE */
/* 21 A 21 TYPE (P) LISTE DE VALEURS ? */
/* (C) TEXTE D'INVITE F11 */
/* */
|
|
/* PARM2 : DEUXIEME PARAMETRE */ /* ------>si liste */ /* 1 A 2 NOMBRE DE PARAMETRES TRANSMIS EN BINAIRE */ /* 3 A 4 TAILLE DE LA PREMIERE VALEUR EN BINAIRE */ /* 5 A N PREMIERE VALEUR */ /* N+1 A N+2 TAILLE DE LA DEUXIEME VALEUR EN BINAIRE */ /* N+3 A M DEUXIEME VALEUR */ /* ETC... 2000 */ /* */ /* ------>si texte */ /* 1 A 30 TEXTE A AFFICHER */ /* 31 A 2000 INUTILISER */ /* */ /****************************************************************/ /* */ /* Déclaration des zones de travail */ /* */ DCL VAR(&BIN) TYPE(*CHAR) LEN(2) DCL VAR(&DEC) TYPE(*DEC) LEN(5 0) DCL VAR(&SIGN) TYPE(*CHAR) LEN(1) /* */ |
|
/* Initialisation de la zone paramètre à retourner */
/* attention elle peut contenir n'importe quoi a l'arrivée */
/* */
CHGVAR VAR(&PARM2) VALUE(' ')
/* */
/* Test de la demande P = liste de paramètres */
/* */
IF COND(%SST(&PARM1 21 1) *EQ 'P') THEN(DO)
/*--------------------------------------------------------------*/
/* */
/* 1er cas pos 21 = P demande d'une liste de valeurs */
/* */
/*--------------------------------------------------------------*/
/* */
/* Formatage de la variable à retourner */
|
|
/* Position 3 à 4 en binaire longueur de la première valeur */ /* Position 5 à 11 premiére Valeur à afficher */ /* Position 12 à 16 en binaire longueur de la deuxième valeur */ /* Position 17 à 11 Deuxième Valeur à afficher */ |
|
2/ PMTCTLPGM pgm de contrôle d'apparition d'un paramètre
/*------------------------------------------------------------------*/
/* */
/* Essai de pgm avec programme de contrôle d'affichage paramètre */
/* PMTCTLPGM(Bib/Nompgm) */
/* */
/*------------------------------------------------------------------*/
/* */
CMD PROMPT('Essai PMTCTLPGM')
/* Nom du fichier */
PARM KWD(FIC) TYPE(*CHAR) LEN(10) MIN(1) +
PMTCTLPGM(CTL001) PROMPT('Nom du fichier')
/* Paramétre a afficher si contrôle non vérifié */
|
|
CPP
PGM PARM(&FIC &BIB) /* AFFICHAGE D'UN FICHIER PGM CPP A002 */
DCL &FIC *CHAR 10 /* NOM DU FICHIER */
DCL &BIB *CHAR 10 /* NOM DE LA BIBLIOTHEQUE */
DSPPFM &BIB/&FIC
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('Fichier' *bcat &fic *bcat +
'inexistant dans la bibliothèque' *bcat &bib) +
MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
PMTCTLPGM
/*--------------------------------------------------------------*/
/* PGM POUR contrôle D'AFFICHAGE */
/*--------------------------------------------------------------*/
PGM PARM(&PARM1 &PARM2 &PARM3)
DCL VAR(&PARM1) TYPE(*CHAR) LEN(20)
DCL VAR(&PARM2) TYPE(*CHAR) LEN(10)
|
|
DCL VAR(&PARM3) TYPE(*CHAR) LEN(32)
/* */
/* PARM1 : PARAMETRE 1 */
/* 1 A 10 NOM DE COMMANDE */
/* 11 A 20 NOM DU PARAMETRE */
/* */
/* PARM2 : PARAMETRE 2 */
/* 1 A N VALEUR DU PARAMETRE PASSE */
/* */
/* PARM3 : PARAMETRE */
/* 1 A 32 CODE RETOUR */
/* */
/*--------------------------------------------------------------*/
/* */
/* contrôle de l'existence si erreur valeur de retours à * */
/* */
CHKOBJ OBJ(&PARM2) OBJTYPE(*FILE)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR VAR(&PARM3) VALUE('*')
ENDDO
ENDPGM
|
|
3/ POP/PROMPT OVERIDE PGM pgm de substitution d'invite
/*---------------------------------------------------------------*/
/* */
/* Essai de pgm avec programme d'Overide */
/* Les paramètres affichés avant l'overide = KEYPARM(*yes) */
/* (à compiler avec le paramètre PMTOVRPGM(bib/pgmovr).) */
/*---------------------------------------------------------------*/
/* */
CMD PROMPT('Modification du prop. d''un obj')
/* Bibliothèque/OBJET */
PARM KWD(OBJ) TYPE(QUAL1) KEYPARM(*YES) MIN(1) +
PROMPT('OBJET')
QUAL1: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) +
PROMPT('Bibliothèque')
/* TYPE */
PARM KWD(TYPE) TYPE(*CHAR) LEN(10) MIN(1) +
KEYPARM(*YES) PROMPT('TYPE')
/* PROPRIETAIRE */
PARM KWD(NEWOWN) TYPE(*NAME) LEN(10) MIN(1) +
PROMPT('NOUVEAU PROP.')
|
|
CPP PGM PARM(&FULLOBJ &OBJTYPE &NEWOWN) /* DECLARATION DES PARAMETRES RECUS */ DCL &FULLOBJ *CHAR 20 DCL &OBJTYPE *CHAR 10 DCL &RESTE *CHAR 20 DCL &NEWOWN *CHAR 10 /* DECLARATION DES ZONES DE TRAVAIL*/ DCL &OBJ *CHAR 10 DCL &LIB *CHAR 10 |
|
POP
PGM PARM(&CMD &FULLOBJ &OBJTYPE &RESTE)
/* DECLARATION DES PARAMETRES RECUS */
DCL &CMD *CHAR 10 /* NOM DE LA COMMANDE */
DCL &FULLOBJ *CHAR 20 /* NOM QUALIFIE OBJET */
DCL &OBJTYPE *CHAR 10 /* TYPE DE L'OBJET */
DCL &RESTE *CHAR 20 /* VARIABLE DE RETOURS */
/* DECLARATION DES ZONES DE TRAVAIL */
DCL &BIN *CHAR 02 X'0014' /* ZONE BIN, LONGUEUR A PASSER */
DCL &OBJ *CHAR 10 /* OBJET */
DCL &LIB *CHAR 10 /* BIBLIOTHEQUE */
DCL &OWN *CHAR 10 /* PROPRIETAIRE ACTUEL */
CHGVAR VAR(&LIB) VALUE(%SST(&FULLOBJ 11 10))
CHGVAR VAR(&OBJ) VALUE(%SST(&FULLOBJ 01 10))
RTVOBJD OBJ(&LIB/&OBJ) OBJTYPE(&OBJTYPE) OWNER(&OWN)
MONMSG MSGID(CPF0000) EXEC(DO)
CHGVAR &OWN 'ERREUR'
ENDDO
/* FORMATAGE DU RESTE */
|
