| 
FCHKRLSD CF E WORKSTN KINFDS INFODS F RANG KSFILE FMTSFL I 'VERIF VERSION' C CTX I 'Liste en cours..' C MTX I 'Liste terminée ' C MTX2 I '? STRSEU' C SEU1 I '?*OPTION(2)' C SEU2 I '?*OPTION(5)' C SEU5 I '??TGTRLS(*PRV)' C TGTRLS I 'vrm' C MI I 'VRM' C MA * RANG DU PREMIER ENREG AFFICHé (==> SFLRCDNBR) IINFODS DS I B 378 3790L2 * ENTETE USER SPACE IRTVINF DS I B 1 40FIN I B 5 80TAILLE I B 9 120NBOBJ I B 13 160LGPOST * DECLARATION DE VARIABLES BINAIRES IBINDS DS I B 1 40DEBUT I B 5 80LG I B 9 120LGRCV I I 273 B 13 160LGPGMI * QUALIF/ USER SPACE ET PGME IQUALDS DS I 1 10 SPCNAM I 11 20 SPCLIB I 1 20 USRSPC I 21 30 PGME I 31 40 BIBLI I 21 40 PGMQUA * DEFINITION D'UN OBJET ILIST DS I 1 10 OBJNAM I 11 20 OBJLIB I 1 20 OBJQ I 21 30 OBJTYP I 42 91 TEXTE I 42 66 TEXT1 I 67 91 TEXT2 * CODE ERREUR API |
|
IERRDS DS I B 1 40LGDS I B 5 80LGERR I 9 15 MSGID I 16 16 RESERV * VAR POUR API ENVOI DE MESSAGE IMSGDS DS I 1 10 MSGF I 11 20 MSGL I 1 20 MSGFL I B 21 240LENTXT I B 25 280STACK I B 29 320KEY I**************************************************************** IRCVVAR DS I B 1 40BYTRTN I B 5 80BYTAVA I 9 18 PGMNAM I 19 28 PGMLIB I 29 38 PGMOWN I 39 48 ATTR I 49 61 CRTDT I 50 550DATCRT I 62 71 SRCFIC I 72 81 SRCLIB I 82 91 SRCMBR I 92 104 SRCUDT I 105 105 OBSINF I 106 106 USRPRF I 107 107 ADPAUT I 108 108 LOGCMD I 109 109 ALWRTV I 268 273 VER C *ENTRY PLIST C PARM RCVBIB 10 C PARM RCVVER 6 C PARM RCVOBS 5 * C MOVEL'*ALL' PGME C MOVELRCVBIB BIBLI C BIBLI IFEQ *BLANK C MOVEL'*USRLIBL'BIBLI C ENDIF C MOVEL'*PGM' OBJTYP |
|
C MI:MA XLATERCVVER RCVVER * C WRITECDE * ENVOI MESSAGE STATUS "LISTE EN COURS" C Z-ADD16 LGDS C MOVEL'QCPFMSG' MSGF C MOVEL'*LIBL' MSGL C MOVELMTX 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 MOVELMTX2 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 *IN31 IFEQ *OFF C EXFMTRIEN C ELSE C *IN03 DOUEQ*ON C WRITEERRCTL C EXFMTFMTCTL |
|
C *IN03 IFEQ *OFF C Z-ADDL2 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 ENDIF C MOVE *ON *INLR C EXSR DLTUS * C CHGT BEGSR C MOVEL'CHKVER' SPCNAM C MOVEL'QTEMP' SPCLIB C MOVEL'LISTPGM 'EXT 10 C Z-ADD1024 TAILLE C MOVE ' ' INT 10 C MOVEL'*USE' AUT 10 C MOVELCTX 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 C CALL 'QUSLOBJ' 99 C PARM USRSPC C PARM 'OBJL0200'FMT 8 C PARM PGMQUA C PARM OBJTYP C *IN99 IFEQ *ON C Z-ADD0 NBOBJ |
|
C ELSE * EXTRACTION DES INFOS D'ENTETE C Z-ADD125 DEBUT C Z-ADD16 LG C CALL 'QUSRTVUS' C PARM USRSPC C PARM DEBUT C PARM LG C PARM RTVINF C ENDIF C NBOBJ IFGT 0 C Z-ADD0 RANG 40 C MOVEA'00' *IN,30 C WRITEFMTCTL C MOVE *ON *IN30 C Z-ADD1 LIGNE C Z-ADDLGPOST LG C FIN ADD 1 DEBUT 1ER POSITION * * 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 91 LGDS C PARM LIST * RECHERCHE INFOS / PGM C CALL 'QCLRPGMI' C PARM RCVVAR C PARM LGPGMI C PARM 'PGMI0100'FMT C PARM OBJQ C PARM ERRDS C SELEC C OBSINF WHEQ 'A' C MOVEL'*ALL' OBS P C OBSINF WHEQ 'N' C MOVEL'*NONE' OBS P C OTHER C MOVELOBSINF OBS P C ENDSL C MOVE 'O' LISTER 1 |
|
* VERSION CIBLE > À VERSION DEMANDÉE C RCVVER IFNE '*ANY' C VER ANDLERCVVER C MOVE 'N' LISTER C ENDIF C RCVOBS IFNE '*ANY' C OBS ANDNERCVOBS C MOVE 'N' LISTER C ENDIF C LISTER IFEQ 'O' C MOVE *ON *IN31 C ADD 1 RANG C WRITEFMTSFL C ENDIF * POSITIONNEMENT SUR PROCHAIN POSTE C ADD LG DEBUT C ENDDO * C ENDIF C ENDSR * * C TRT BEGSR C READCFMTSFL 41 C *IN41 DOWEQ*OFF C MOVE *BLANK EXEC C SELEC C OPT WHEQ '2 ' C OPT OREQ ' 2' C SEU1 CAT SRCLIB:1 EXEC 256 P C CAT '/':0 EXEC C CAT SRCFIC:0 EXEC C CAT SRCMBR:1 EXEC C CAT SEU2:1 EXEC C OPT WHEQ '5 ' C OPT OREQ ' 5' C SEU1 CAT SRCLIB:1 EXEC 256 P C CAT '/':0 EXEC C CAT SRCFIC:0 EXEC C CAT SRCMBR:1 EXEC C CAT SEU5:1 EXEC C OPT WHEQ '14' C ATTR IFEQ 'CLP' C MOVEL'CRTCLPGM'COMPIL 10 P |
|
C ELSE C 'CRT' CAT ATTR:0 COMPIL P C 'SQL' SCAN ATTR 96 C *IN96 IFEQ *OFF C CAT 'PGM':0 COMPIL C ENDIF C ENDIF C '?' CAT COMPIL:1 EXEC 256 P C CAT OBJLIB:1 EXEC C CAT '/':0 EXEC C CAT OBJNAM:0 EXEC C CAT SRCLIB:1 EXEC C CAT '/':0 EXEC C CAT SRCFIC:0 EXEC C CAT SRCMBR:1 EXEC C CAT TGTRLS:1 EXEC C ENDSL C EXEC IFNE *BLANK C CALL 'QCMDEXC' 97 C PARM EXEC C PARM 256 EXECL 155 C MOVE ' ' OPT C ENDIF C UPDATFMTSFL C READCFMTSFL 41 C ENDDO C ENDSR * C DLTUS BEGSR * DLT DU USER SPACE (Y COMPRIS EN CAS DE PLANTUS) API QUSDLTUS C Z-ADD16 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 RETRN 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 |
