En pratique, une gestion personalisée de spoules sert à offrir aux utilisateurs un accès personalisé -et en général restreint- à leurs états, ou pour alimenter un outil d'archivage.
WRKSPLF
CMD PROMPT('Traitement de spoules')
/* crtcmd WRKSPL pgm(WRKSPL1) hlppnlgrp(WRKSPLH) hlpid(*CMD) */
PARM KWD(USER) TYPE(*SNAME) LEN(10) DFT(*CURRENT) +
SPCVAL((*CURRENT) (*ALL)) PROMPT('Utilisateur')
PARM KWD(OUTQ) TYPE(OUTQ) PROMPT('File d''attente +
de sortie')
PARM KWD(FORM) TYPE(*CHAR) LEN(10) DFT(*ALL) +
PROMPT('Type de formulaire')
PARM KWD(USRDTA) TYPE(*CHAR) LEN(10) DFT(*ALL) +
PROMPT('Infos utilisateur')
OUTQ: QUAL TYPE(*NAME) LEN(10) DFT(*ALL) SPCVAL((*ALL))
QUAL TYPE(*NAME) LEN(10) SPCVAL((*LIBL) (*CURLIB) +
(' ')) PROMPT('bibliothèque')
|
:PNLGRP. :HELP NAME='WRKSPL'.Gestion de Spoules. :p.Cette commande est potentiellement équivalente à :pk.WRKSPLF.:epk. Elle met à disposition les informations relatives à une liste de spoules. :pc.Le traitement des options est réalisé par un programme utilisateur adaptable. :p.Les options de copie sont définies dans un écran accessible par la touche de fonction :pk.F15=Options Copie.:epk. :p.:pk.ATTENTION ::epk. avant d'utiliser cette commande, vous devez créer :pk.dans votre bibliothèque:epk. (pas dans une bibliothèque système) : :pc.* une dataarea :pk.WRKSPLDFT:epk. pour vos options de copie par défaut, taille 100. :pc.* un fichier physique multimembre :pk.CPYSPL:epk. (ou autre nom), taille 132 ou 198, pour contenir les copies de spoules :pc.* renseigner les valeurs de copie par défaut (F15 sur liste) :EHELP. :HELP NAME='WRKSPL/USER'.Utilisateur. - Aide. :XH2.Utilisateur :P.Saisir un nom d'utilisateur à sélectionner, ou :pk def.*CURRENT.:epk. :EHELP. :HELP NAME='WRKSPL/OUTQ'.File d'attente. - Aide. :XH2.File d'attente :P.Entrer le nom d'une file d'attente à sélectionner, ou :pk def.*ALL.:epk. :EHELP. :HELP NAME='WRKSPL/FORM'.Formulaire. - Aide. :XH2.Type de formulaire :P.Entrer le type de de formulaire à sélectionner, ou :pk def.*ALL:epk.. :EHELP. :HELP NAME='WRKSPL/USRDTA'.Infos utilisateur - Aide. :XH2.Infos utilisateur :P.Saisir le texte d'information outilisateur à sélectionner, ou :pk def.*ALL:epk.. :EHELP. :EPNLGRP. |
A DSPSIZ(24 80 *DS3)
A PRINT
A INDARA
A CA03(03)
A CF05(05)
A CF12(12)
A CF15(15)
A* Standard Message subfile
A R MSGS SFL
A SFLMSGRCD(24)
A MSGKEY SFLMSGKEY
A PGMNAM SFLPGMQ
A*
A R MSGC SFLCTL(MSGS)
A SFLSIZ(2)
A SFLPAG(1)
A OVERLAY
A SFLDSP
A SFLDSPCTL
A SFLINZ
A N34 SFLEND
A PGMNAM SFLPGMQ
A*
A R F1
A*
A 1 6'WRKSPL'
A 1 20'Traitement de Spoules'
A DSPATR(HI)
A 1 69DATE
A EDTCDE(Y)
A 3 5'3=copier'
A 3 17'5=Afficher'
A 5 3'Opt'
A DSPATR(HI)
A 5 7'Fichier'
A DSPATR(HI)
A 5 27'Travail'
A DSPATR(HI)
A 5 58'Pages'
A DSPATR(HI)
A 5 64'Impr.'
A DSPATR(HI)
A 5 70'File'
A DSPATR(HI)
A R F1S SFL
A*
A 39 SFLNXTCHG
A SCSPNM 10 H
A SCUDTA 10 H
A SCJBNM 10 H
A SCJBNB 6 H
A SCUSR 10 H
A S1SPNB 5 0H
A S1OPT 1 B 6 4
A 40 DSPATR(PC)
A 40 DSPATR(RI)
A S1SPL 19 O 6 7
A S1JOB 30 O 6 27
A S1PAGE 5 0O 6 58EDTCDE(4)
A S1PGPR 5 0O 6 64EDTCDE(4)
A S1OUTQ 10 O 6 70
A R F1C SFLCTL(F1S)
A*
A N35 ROLLUP(25)
A BLINK
A CSRLOC(C1LIN C1COL)
A OVERLAY
A 32 SFLDSP
A 33 SFLDSPCTL
A 34 SFLCLR
A 35 SFLEND(*MORE)
A SFLSIZ(0015)
A SFLPAG(0014)
A RNB1 4S 0H SFLRCDNBR
A C1LIN 3S 0H
A C1COL 3S 0H
A 22 4'F3=Exit'
A 22 14'F5=Réafficher'
A 22 30'F12=Retour'
A 22 43'F15=Options Copie'
A 22 63'F21=Print List'
A R F2
A*
A CHANGE(25)
A 1 6'WRKSPL'
A 1 20'Options de copie'
A DSPATR(HI)
A 1 69DATE
A EDTCDE(Y)
A 4 6'Copie vers Membre . . . . .'
A F1MBR 10A B 4 34
A 4 51'Nom, *SPL, *USRDTA'
A 5 8'Fichier . . . . . . . . .'
A F1SRC 10A B 5 37
A 5 51'Nom'
A 6 10'Bibliothèque. . . . . .'
A F1LIB 10A B 6 39
A 6 51'Nom'
A 8 6'Option de copie . . . . . .'
A F1OPTM 8 B 8 34
A 8 51'*ADD, *REPLACE'
A 9 6'Confirmer la demande. . . .'
A F1CONM 1 B 9 34
A 9 51'O=Oui, N=Non'
A 12 6'Copie vers dossier PC . . .'
A F1DOSS 30 B 12 34
A 13 8'Dans le document. . . . .'
A F1DOCU 12 B 13 37
A 13 51'Nom, *FROMMBR'
A 15 6'Remplacer document existant'
A F1RPLD 1 B 15 34
A 15 51'O=Oui, N=Non'
A 16 6'Confirmer la demande. . . .'
A F1COND 1 B 16 34
A 16 51'O=Oui, N=Non'
A 22 4'F3=Exit'
A 22 14'F12=Return'
|
H*------------------------------------------------------------ H* Traitement de spoules (1ère version, test) H* - création / suppression de User Space H* - affichage de liste H* - appel de programme de traitement d'options H* - écran de définition des options H* Voir System Programmer's Interface Ref, V2R2, A1. H* Patrick LARREYA, 1995-2000 H*------------------------------------------------------------ FWRKSPLFMCF E WORKSTN F KINFDS ECRDS F C1RN KSFILE F1S E TZA 5 1 Alpha 5 I* Data structure to retrieve cursor location IECRDS DS I B 370 3710D1CURS I B 378 3790D1RRN1 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* Options de copie par défaut IDEFAUT DS 100 I 1 10 F1MBR I 11 20 F1SRC I 21 30 F1LIB I 31 38 F1OPTM I 39 39 F1CONM I 40 69 F1DOSS I 70 81 F1DOCU I 82 82 F1RPLD I 83 83 F1COND 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* Compteurs binaires sur caractéristiques récupérées IUSINFO DS I B 1 40USDEPL I B 9 120USNBLS I B 13 160USSZLS I* Infos spoule récupérées dans le user space ISPINFO DS I 1 10 SPUSER I 11 30 SPOUTQ I 31 40 SPFORM I 51 66 SPJBID I 67 82 SPSPID I* Infos spoules complémentaire, 'QUSRSPLA' ISCINFO DS I 9 24 SCJBID I 25 40 SCSPID I 41 50 SCJBNM I 51 60 SCUSR I 61 66 SCJBNB I 67 76 SCSPNM I B 77 800SCSPNB I 81 90 SCFORM I 91 100 SCUDTA I 101 110 SCSTAT I 102 103 SCSTA2 I B 141 1440SCPAGE I B 145 1480SCPGPR I 208 209 SCDDAY I 271 290 SCPRTX I* Taille du User Space en binaire I DS I B 1 40USSIZ I* Constantes User space I 'USPSPL QTEMP 'C C1USP I 'SPLINF 'C C1ATR I 10000 C C1SIZ I '*ALL ' C C1AUT I 'Informations spoules'C C1TXT I 'dltusrspc qtemp/usps-C C1CMD I 'pl ' C*------------------------------------------------------------------------ C* Paramètres d'appel commande C *ENTRY PLIST C PARM P0USR 10 User C PARM P0OUTQ 20 Outq Qualifiée C PARM P0FORM 10 Formulaire C PARM P0UDTA 10 User Data C* First display : list form the beginning C Z-ADD12 C1SIZE 50 C MOVE 01 ECRAN 20 C MOVE *ALL'0' CLRIND 29 C MOVE '0' ERREUR 1 1<--C EXSR SET01 C CALL 'SFLCLR' C *NAMVAR DEFN WRKSPLDFT DEFAUT C IN DEFAUT C* Display Loop 1{ C ECRAN DOWNE99 C TIME TIMHR 2<--C ECRAN CASEQ01 TRT01 4<--C ECRAN CASEQ02 TRT02 2} C ENDCS 1} C ENDDO C SETON LR C*====================================================================== 1---C SET01 BEGSR C* Clear Subfile C MOVE '0' S1CHGD 1 C SETOF 3233 C SETON 34 C WRITEF1C C SETOF 34 C Z-ADD0 C1TRN 50 C* Remplissage de la liste des spoules 5<--C EXSR TRTSPL C MOVE '1' C1END 1 C Z-ADD1 RNB1 C ENDSR C*====================================================================== 2---C TRT01 BEGSR C* Use default positioning when error 1{ C ERREUR IFEQ '1' C Z-ADD0 C1LIN C Z-ADD0 C1COL 1} C END C* Display screen to select instrument C WRITEF1 C WRITEMSGC Messages C SETON 33 1{ C C1TRN IFNE 0 C SETON 32 1| C ELSE C SETOF 32 1} C END C MOVE C1END *IN35 C WRITEF1C C READ F1C 97 C READ F1 97 C Z-ADDD1RRN1 C1TOP 50 Top of screen C Z-ADDC1TOP RNB1 Sflrcdnbr C D1CURS DIV 256 C1LIN C MVR C1COL C* Clear error fields C MOVEACLRIND *IN,40 C CALL 'SFLCLR' C MOVE '0' ERREUR 1 C* F3 or F12 to exit program 1{ C SELEC 1| C *IN03 WHEQ '1' C Z-ADD99 ECRAN C MOVE '03' P1CRET 2 1| C *IN12 WHEQ '1' C Z-ADD99 ECRAN C MOVE '12' P1CRET C* F5=Options copie 1| C *IN15 WHEQ '1' C *LOCK IN DEFAUT C Z-ADD2 ECRAN C* Controle d'options 1| C C1TRN WHNE 0 3<--C EXSR CTR01 1} C END C* C ENDSR C*====================================================================== 3---C CTR01 BEGSR C* Appel de programme externe si nécessaire C READCF1S 97 1{ C *IN97 DOWEQ'0' C MOVE ' ' P2CRET C S1OPT IFNE ' ' C MOVE S1SPNB S1SPNA 4 C CALL 'WRKSPL5' C PARM S1OPT C PARM SCSPNM C PARM SCUDTA C PARM SCJBNM C PARM SCJBNB C PARM SCUSR C PARM S1SPNA C PARM P2CRET 2 C END C P2CRET IFEQ ' ' Ok C MOVE ' ' S1OPT C UPDATF1S C READCF1S 97 C ELSE Erreur C Z-ADDC1RN RNB1 C Z-ADD0 C1LIN C SETON 3940 C UPDATF1S C LEAVE C ENDIF Erreur / pas 1} C ENDDO Boucle C* C ENDSR C*====================================================================== 4---C TRT02 BEGSR C* Affiche C WRITEF2 C WRITEMSGC Messages C READ F2 97 C* Clear error fields C MOVEACLRIND *IN,40 C CALL 'SFLCLR' C MOVE '0' ERREUR 1 C* F3 or F12 to exit program 1{ C SELEC 1| C *IN03 WHEQ '1' C Z-ADD99 ECRAN C MOVE '03' P1CRET 1| C *IN12 WHEQ '1' C Z-ADD99 ECRAN C MOVE '12' P1CRET C* Validation si pas de modification 1| C *IN25 WHEQ '0' C OUT DEFAUT C Z-ADD1 ECRAN C ENDSL C* C ENDSR C*====================================================================== 5---C TRTSPL BEGSR C* Création du user space C Z-ADDC1SIZ USSIZ C CALL 'QUSCRTUS' API C PARM C1USP USUSP 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 C* Liste des spoules dans User Space C CALL 'QUSLSPL' C PARM USUSP User Space C PARM 'SPLF0100'USFMTN 8 Format API C PARM P0USR User C PARM P0OUTQ Outq Qualifiée C PARM P0FORM Formulaire C PARM P0UDTA User Data C* Recupération du formatage de la liste en début de userspace C CALL 'QUSRTVUS' C PARM USUSP User Space C PARM 125 USPOS Position C PARM 16 USLEN Longueur C PARM USINFO DS infos User Space C* Préparation des pointeurs pour récup de la liste des spoules C 1 ADD USDEPL USPOS Depuis C Z-ADDUSSZLS USLEN Taille infos spoule C* C*---------------------------------------- 1{ C DO USNBLS C1RN 50 Nombre de spoules C*---------------------------------------- C* Lecture infos spoule de base (les autres sont ailleurs) C CALL 'QUSRTVUS' C PARM USUSP User Space C PARM USPOS Position C PARM USLEN Longueur C PARM SPINFO DS Infos Spoule C ADD USSZLS USPOS ... décallage C* Récup d'infos complémentaires C CALL 'QUSRSPLA' C PARM SCINFO DS Infos complément. C PARM 300 SCLEN Longueur récup C PARM 'SPLA0100'SCFMTN 8 Format API C PARM '*INT' SCJOBI 26 Infos Job C PARM SPJBID SCJBID Identifiant Job C PARM SPSPID SCSPID Identifiant Job C PARM '*INT' SCSPN1 10 Ref 1 Spoule C PARM *ZERO SCSPN2 Ref 1 Spoule C* Mise en forme C Z-ADDSCSPNB S1SPNB 50 C Z-ADDSCPAGE S1PAGE 50 C Z-ADDSCPGPR S1PGPR 50 C* Préparation d'une ligne dans la liste C MOVE S1SPNB ZA5 5 C MOVEAZA5 TZA 2{ C DO 5 I 50 3{ C TZA,I IFNE '0' C LEAVE C ENDIF 3} C ENDDO C MOVEATZA,I ZA5 P C* Spoule et données utilisateur C SCSPNM CAT SCUDTA:1 S1SPL P Nom Spoule C* C SCJBNM CAT '/':0 S1JOB P Nom Job C CAT SCUSR:0 S1JOB Utilisateur C CAT '/':0 S1JOB C CAT SCJBNB:0 S1JOB N° Job C CAT ZA5:1 S1JOB N° spoule C SCSTA2 IFNE 'RE' *READY=standard C MOVE SCSTA2 S1JOB Etat C END C* C MOVELSPOUTQ S1OUTQ C* Ecriture d'une ligne dans la liste C Z-ADDC1RN C1TRN 50 Records C WRITEF1S C*---------------------------------------- 2} C ENDDO C*---------------------------------------- C CALL 'QCMDEXC' C PARM C1CMD CMD 40 C PARM 40 CMDLEN 155 C* C ENDSR |
PGM (&opt &splnam &usrdta &jobnam &jobnbr &usr &splnum &codret)
dcl &opt *char 1
dcl &splnam *char 10
dcl &usrdta *char 10
dcl &jobnam *char 10
dcl &jobnbr *char 6
dcl &usr *char 10
dcl &splnum *char 4
dcl &codret *char 2
DCL &msgid *char 7
DCL &msgf *char 10
DCL &msgdta *char 256
DCL &msgflib *char 10
DCL &err *LGL
DCL © *CHAR 100
DCL &src *CHAR 10
DCL &lib *CHAR 10
DCL &mbr *CHAR 10
DCL &cpyopt *CHAR 8
MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR)
CHGVAR &codret ' '
RTVDTAARA DTAARA(WRKSPLDFT (1 100)) RTNVAR(©)
/* 5=affichage */
if (&opt = '5') DO
DSPSPLF FILE(&SPLNAM) JOB(&JOBNBR/&USR/&JOBNAM) +
SPLNBR(&SPLNum)
RCVMSG MSGTYPE(*ANY) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&msgid *NE ' ') +
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
GOTO finfin
enddo
/* 3=Copie */
if (&opt = '3') DO
CHGVAR &mbr %sst(© 1 10)
CHGVAR &src %sst(© 11 10)
CHGVAR &lib %sst(© 21 10)
CHGVAR &cpyopt %sst(© 31 8)
if (&mbr = '*SPL') chgvar &mbr &splnam
if (&mbr = '*USRDTA') DO
if (&usrdta *NE ' ') chgvar &mbr &usrdta
else chgvar &mbr &splnam
enddo
? CPYSPLF ??FILE(&SPLNAM) ??TOFILE(&LIB/&SRC) +
??JOB(&JOBNBR/&USR/&JOBNAM) +
??SPLNBR(&SPLNUM) ??TOMBR(&MBR) +
??MBROPT(&CPYOPT) ??CTLCHAR(*FCFC)
GOTO finfin
enddo
/* Option invalide */
chgvar &codret '99'
SNDPGMMSG MSG('Option invalide')
GOTO finfin
erreur:
if &err sndpgmmsg msgid(cpf9999) msgf(qcpfmsg) msgtype(*ESCAPE)
chgvar &err '1'
chgvar &codret '99'
RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA)
finfin: endpgm
|
PGM (&file &lib &mbr)
dcl &file *char 10
dcl &lib *char 10
dcl &mbr *char 10
/* Une astuce serait de garder les infos OVR dans le texte du membre */
/* Créer une option PDM S7 : call wrkspl7 (&f &l &n) */
OVRPRTF FILE(QSYSPRT) CTLCHAR(*FCFC) SPLFNAME(&MBR)
CPYF FROMFILE(&LIB/&FILE) TOFILE(QSYSPRT) +
FROMMBR(&MBR)
DSPSPLF FILE(&MBR) SPLNBR(*LAST)
ENDPGM
|
Patrick Larreya, Septembre 2000.