| 
FCHXCMDD CF E WORKSTN INFDS(INFODS)
F SFILE(FMTSFL:RANG)
D CTX C CONST('LISTE DES CDES')
D MTX C CONST('Liste en cours..')
D MTX2 C CONST('Liste terminée ')
* RANG DU PREMIER ENREG AFFICHé (==> SFLRCDNBR)
D INFODS DS
D L2 378 379B 0
* ENTETE USER SPACE
D RTVINF DS
D FIN 1 4B 0
D TAILLE 5 8B 0
D NBOBJ 9 12B 0
D LGPOST 13 16B 0
* DECLARATION DE VARIABLES BINAIRES
D BINDS DS
D DEBUT 1 4B 0
D LG 5 8B 0
D LGRCV 9 12B 0
* QUALIF/ USER SPACE ET CMDE
D QUALDS DS
D SPCNAM 1 10
D SPCLIB 11 20
D USRSPC 1 20
D CMDE 21 30
D BIBLI 31 40
D CMDQ 21 40
* DEFINITION D'UN OBJET
D LIST DS
D OBJNAM 1 10
D OBJLIB 11 20
D OBJQ 1 20
D OBJTYP 21 30
D TEXTE 42 91
D FILLER 92 108
* CODE ERREUR API
D ERRDS DS
D LGDS 1 4B 0
D LGERR 5 8B 0
D MSGID 9 15
D RESERV 16 16
* VAR POUR API ENVOI DE MESSAGE
D MSGDS DS
D MSGF 1 10
|
|
D MSGL 11 20 D MSGFL 1 20 D LENTXT 21 24B 0 D STACK 25 28B 0 D KEY 29 32B 0 C *ENTRY PLIST C CMDQ PARM OBJBIB 20 * C CMDE IFEQ *BLANK C MOVEL '*ALL' CMDE C ENDIF C BIBLI IFEQ *BLANK C MOVEL '*USRLIBL' BIBLI C ENDIF C MOVEL '*CMD' OBJTYP * C WRITE CDE * ENVOI MESSAGE STATUS "LISTE EN COURS" C Z-ADD 16 LGDS C MOVEL 'QCPFMSG' MSGF C MOVEL '*LIBL' MSGL C MOVEL MTX MSGTXT C CALL 'QMHSNDPM' C PARM 'CPF9898' ID 7 C PARM MSGFL C PARM MSGTXT 50 C PARM 50 LENTXT C PARM '*STATUS' MSGTYP 10 C PARM '*EXT' PGMQ 10 C PARM 0 STACK C PARM KEY C PARM ERRDS * CHARGEMENT SOUS FICHIER C EXSR CHGT * C NBOBJ IFGT 0 * ENVOI MESSAGE STATUS "LISTE TERMINEE" C MOVEL MTX2 MSGTXT C CALL 'QMHSNDPM' C PARM 'CPF9898' ID 7 C PARM MSGFL C PARM MSGTXT 50 C PARM 50 LENTXT C PARM '*STATUS' MSGTYP 10 |
|
C PARM '*EXT' PGMQ 10 C PARM 0 STACK C PARM KEY C PARM ERRDS * C MOVE *ON *IN40 C MOVEL '*' SFLQ * C *IN03 DOUEQ *ON C WRITE ERRCTL C EXFMT FMTCTL C *IN03 IFEQ *OFF C Z-ADD L2 LIGNE * REMOVE DES MESSAGES RECUS C CALL 'QMHRMVPM' C PARM '*' PGMQ C PARM 0 STACK C PARM ' ' KEYC 4 C PARM '*OLD' RMVTYP 10 C PARM ERRDS C EXSR TRT C ENDIF C ENDDO C* USER SPACE NON VIDE C ENDIF C MOVE *ON *INLR C EXSR DLTUS * C CHGT BEGSR C MOVEL 'CHXCMD' SPCNAM C MOVEL 'QTEMP' SPCLIB C MOVEL 'LISTFMT ' EXT 10 C Z-ADD 1024 TAILLE C MOVE ' ' INT 10 C MOVEL '*USE' AUT 10 C MOVEL CTX TXT 50 * dlt du user space si présent dans QTEMP C EXSR DLTUS * CREATION USER SPACE PAR API QUSCRTUS C CALL 'QUSCRTUS' C PARM USRSPC C PARM EXT C PARM TAILLE C PARM INT |
|
C PARM AUT C PARM TXT * REMPLISSAGE DU USER SPACE VIA API (LISTE DES OBJETS) C CALL 'QUSLOBJ' 99 C PARM USRSPC C PARM 'OBJL0200' FMT 8 C PARM CMDQ C PARM OBJTYP C *IN99 IFEQ *ON C Z-ADD 0 NBOBJ C ELSE * EXTRACTION DES INFOS D'ENTETE (POUR RETROUVER DEBUT DE LA LISTE) C Z-ADD 125 DEBUT C Z-ADD 16 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVINF C ENDIF C NBOBJ IFGT 0 C Z-ADD 0 RANG 4 0 C MOVEA '00' *IN(30) C WRITE FMTCTL C MOVE *ON *IN30 C Z-ADD 1 LIGNE C Z-ADD LGPOST LG C FIN ADD 1 DEBUT * * BOUCLE SUR NOMBRE DE MEMBRES EXTRAITS * C DO NBOBJ * EXTRACTION D'UN POSTE PAR API QUSRTVUS (-> DONNE LE NOM ) C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM LIST C MOVE *ON *IN31 C ADD 1 RANG C WRITE FMTSFL * POSITIONNEMENT SUR PROCHAIN POSTE C ADD LG DEBUT C ENDDO |
|
* C ENDIF C ENDSR * * C TRT BEGSR C READC FMTSFL 41 C *IN41 DOWEQ *OFF C SELECT C OPT WHENEQ '1' C '?' CAT(P) OBJLIB:1 EXEC 256 C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CALL 'QCMDEXC' 97 C PARM EXEC C PARM 256 EXECL 15 5 C OPT WHENEQ '5' C '?' CAT(P) OBJLIB:1 EXEC 256 C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CALL 'QCMDCHK' 97 C PARM EXEC C PARM 256 EXECL 15 5 C OPT WHENEQ '8' C 'DSPCMD' CAT(P) OBJLIB:1 EXEC 256 C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CALL 'QCMDEXC' 97 C PARM EXEC C PARM 256 EXECL 15 5 C ENDSL C MOVE ' ' OPT C UPDATE FMTSFL C READC FMTSFL 41 C ENDDO C ENDSR * C DLTUS BEGSR * DLT DU USER SPACE (Y COMPRIS EN CAS DE PLANTUS) API QUSDLTUS C Z-ADD 16 LGDS C CALL 'QUSDLTUS' 99 C PARM USRSPC C PARM ERRDS C ENDSR |
|
* C *PSSR BEGSR C *IN98 IFEQ *ON C MOVE *ON *INLR C RETURN C ELSE C MOVE *ON *IN98 C EXSR DLTUS * RENVOI LE DERNIER MESSAGE *ESCAPE C CALL 'QMHRSNEM' C PARM ' ' KEYC C PARM ERRDS C ENDIF C ENDSR |
