//BCHJOB JOB(JSRCDRV) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it */ /* LA JOB DESCRIPTION "NERONI2/NERONI2" DEVE PREESISTERE. PUO' ESSERE */ /* IDENTICA A QBATCH E PUO' ESSERE SOSTITUITA DA QBATCH O SIMILE. */ /* From System: "S65D69DA" */ /* From Library: "NERONI2" */ /* Unload Time: 2015-05-19 11:56 */ /* To File : "JSRCDRV" */ /* To Library : "NERONI2" */ /* To Text : "Source driver. Src" */ /********* INIZIO ISTRUZIONI *******************************************/ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI RICARICARE I SORGENTI. */ /* 1) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* CREARE UN FILE SORGENTE DI LUNGHEZZA RECORD 112: */ /* CRTSRCPF FILE(NERONI2/STRINGHE) RCDLEN(112) */ /* 2) SPOSTARE IL FILE "JSRCDRV.txt" NELL'INDIRIZZARIO */ /* DI UN PC CONNESSO IN RETE CON L'AS400 RICEVENTE */ /* (AD ES.: "c:\"). */ /* 3) DAL VIDEO COMANDI DEL PC CHIAMARE FTP: */ /* ftp nomeas400 */ /* 4) DIGITARE UTENTE E PASSWORD. */ /* 5) ESEGUIRE IL COMANDO DI COPIA DA FILE PC A MEMBRO AS400: */ /* put "c:\JSRCDRV.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JSRCDRV.mbr" */ /* 6) ABBANDONARE FTP: */ /* quit */ /* 7) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA COPIATA NEL MEMBRO SORGENTE: */ /* SBMDBJOB FILE(NERONI2/STRINGHE) MBR(JSRCDRV) JOBQ(QBATCH) */ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI CREARE L'UTILITY. */ /* 8) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA O LE STRINGHE SORGENTE DI TIPO SEU "CL" */ /* (IL CUI NOME TERMINA SEMPRE CON ".") */ /* PRESENTI NEL FILE RICARICATO "NERONI2/JSRCDRV" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JSRCDRV) MBR(JSRCDRV.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Utility di Claudio Neroni') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JSRCDRV) CRTSRCPF FILE(NERONI2/JSRCDRV) RCDLEN(112) + TEXT('Source driver. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(AAA) TOFILE(NERONI2/JSRCDRV) + TOMBR(AAA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(AAA) + SRCTYPE(CLLE) + TEXT('Source driver. CompileCpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRV) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRV) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRV) + SRCTYPE(CMD) + TEXT('Source driver. CrtListCmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRV.) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRV.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRV.) + SRCTYPE(CL) + TEXT('Source driver. Cjs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVC) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVC) + SRCTYPE(CLLE) + TEXT('Source driver. CrtListCpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVD) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVD) + SRCTYPE(RPGLE) + TEXT('Source driver. DltServiceInMain') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVK) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVK) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVK) + SRCTYPE(CMD) + TEXT('Source driver. CompileCmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVKC) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVKC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVKC) + SRCTYPE(CLLE) + TEXT('Source driver. CompileCpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVKO) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVKO) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVKO) + SRCTYPE(RPGLE) + TEXT('Source driver. CompileOmitter') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVT) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVT) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVT) + SRCTYPE(CMD) + TEXT('Source driver. Create/Refresh DB in TargetLib. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRVTC) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRVTC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRVTC) + SRCTYPE(CLLE) + TEXT('Source driver. Create/Refresh DB in TargetLib. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRV1) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRV1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRV1) + SRCTYPE(PF) + TEXT('Source driver. MainList') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSRCDRV2) TOFILE(NERONI2/JSRCDRV) + TOMBR(JSRCDRV2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSRCDRV) MBR(JSRCDRV2) + SRCTYPE(PF) + TEXT('Source driver. ServiceList') /*---------------------------------------------------------------------*/ //DATA FILE(AAA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ PGM PARM(&NUMERO) DCL VAR(&NUMERO) TYPE(*DEC) LEN(7 0) DCL VAR(&CHA4) TYPE(*CHAR) LEN(4) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) JDECCHA FROMDEC(&NUMERO) TOCHAR4(&CHA4) CHGVAR VAR(&MSGDTA) VALUE(&CHA4 *CAT &CHA4 *CAT + &CHA4 *CAT &CHA4 *CAT &CHA4 *CAT &CHA4 + *CAT &CHA4 *CAT &CHA4) /* SNDPGMMSG MSGID(AAA0001) MSGF(JSRCDRV) + */ /* MSGDTA(X'0001235FC8') */ SNDPGMMSG MSGID(JSDB101) MSGF(JSRCDRV) MSGDTA(&MSGDTA) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRV) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Source driver. CrtListCmd */ /* Claudio Neroni 28-04-2015 Creato. */ /* Crea un elenco membri sorgente in vista della loro compilazione. */ /* Il file esaminato nel primo run viene caricato in elenco. */ /* Il file esaminato in un run successivo viene aggiunto all'elenco */ /* preesistente dopo aver eliminato dall'elenco stesso i membri */ /* già presenti nel file nel file corrente. */ /* In sostanza, si compone una lista di membri che contiene tutti */ /* i membri di tutti i file ma, per i membri omonimi, conserva solo */ /* quello aggiunto cronologicamente per ultimo. */ /* */ CMD PROMPT('SrcDriver: Add file to list') PARM KWD(SRCFILE) TYPE(SRCFILE) MIN(1) + PROMPT('Source file to be listed') SRCFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('library') PARM KWD(LISTOPT) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*REPLACE) VALUES(*REPLACE *ADD) + PROMPT('Replace or add to list') PARM KWD(TOPGMQ) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*SAME) VALUES(*SAME *PRV) PROMPT('To + program queue') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRV.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JSRCDRV.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 28-04-2015 Creato. */ /* JSRCDRV */ /* Source driver. Cmd */ /* Prerequisiti: JCPYCLR, JRSNMSG, JRTVFD, JDECCHA */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTF FILE(NERONI2/JSRCDRV1) DLTF FILE(NERONI2/JSRCDRV2) DLTCMD CMD(NERONI2/JSRCDRV) DLTCMD CMD(NERONI2/JSRCDRVK) DLTCMD CMD(NERONI2/JSRCDRVT) DLTPNLGRP PNLGRP(NERONI2/JSRCDRVP) DLTPGM PGM(NERONI2/JSRCDRVC) DLTPGM PGM(NERONI2/JSRCDRVKC) DLTPGM PGM(NERONI2/JSRCDRVTC) DLTPGM PGM(NERONI2/JSRCDRVD) DLTPGM PGM(NERONI2/JSRCDRVKO) DLTMSGF MSGF(NERONI2/JSRCDRV) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/JSRCDRV1) SRCFILE(JSRCDRV) SIZE(*NOMAX) CRTPF FILE(NERONI2/JSRCDRV2) SRCFILE(JSRCDRV) SIZE(*NOMAX) CRTBNDCL PGM(NERONI2/JSRCDRVC) SRCFILE(JSRCDRV) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JSRCDRVKC) SRCFILE(JSRCDRV) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JSRCDRVD) SRCFILE(JSRCDRV) DBGVIEW(*ALL) + TGTRLS(*CURRENT) CRTBNDRPG PGM(NERONI2/JSRCDRVKO) SRCFILE(JSRCDRV) DBGVIEW(*ALL) + TGTRLS(*CURRENT) CRTPNLGRP PNLGRP(NERONI2/JSRCDRVP) SRCFILE(JSRCDRV) CRTCMD CMD(NERONI2/JSRCDRV) PGM(JSRCDRVC) SRCFILE(JSRCDRV) + MSGF(JSRCDRV) HLPPNLGRP(JSRCDRVP) HLPID(CMD) PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JSRCDRVK) PGM(JSRCDRVKC) SRCFILE(JSRCDRV) + MSGF(JSRCDRV) HLPPNLGRP(JSRCDRVP) HLPID(CMD) + PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JSRCDRVT) PGM(JSRCDRVTC) SRCFILE(JSRCDRV) + MSGF(JSRCDRV) HLPPNLGRP(JSRCDRVTP) HLPID(CMD) + PRDLIB(NERONI2) CRTBNDCL PGM(NERONI2/JSRCDRVTC) SRCFILE(JSRCDRV) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTMSGF MSGF(NERONI2/JSRCDRV) TEXT('Source driver. Msgf') /* Messaggi del Cpp JSRCDRVC */ ADDMSGD MSGID(JSDA001) MSGF(NERONI2/JSRCDRV) MSG('Il file &2/&1 + non è di tipo source.') SECLVL('Il file &1 nella + libreria &2 non è un file source.') FMT((*CHAR 10) + (*CHAR 10)) ADDMSGD MSGID(JSDA002) MSGF(NERONI2/JSRCDRV) MSG('File &2/&1 + inesistente.') SECLVL('Il file &1 nella libreria &2 + non esiste.') FMT((*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JSDA003) MSGF(NERONI2/JSRCDRV) MSG('LISTOPT(*ADD) + possibile solo dopo un run con LISTOPT(*REPLACE)') + SECLVL('Il file &1 nella libreria &2 non può essere + inserito nell''elenco membri QTEMP/JSRCDRV1T perchè + l''azione corrente in aggiunta deve essere preceduta + da una azione che crei l''elenco.') FMT((*CHAR 10) + (*CHAR 10)) ADDMSGD MSGID(JSDA101) MSGF(NERONI2/JSRCDRV) MSG('File &2/&1 + sostituisce elenco membri QTEMP/JSRCDRV1T') + SECLVL('L''elenco dei membri del file sorgente &1 + nella libreria &2 è stato sostituito nel file guida + per le ricompilazioni JSRCDRV1T in libreria + temporanea.') FMT((*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JSDA102) MSGF(NERONI2/JSRCDRV) MSG('File &2/&1 + aggiunto a elenco membri QTEMP/JSRCDRV1T') + SECLVL('L''elenco dei membri del file sorgente &1 + nella libreria &2 è stato aggiunto nel file guida per + le ricompilazioni JSRCDRV1T in libreria temporanea.') + FMT((*CHAR 10) (*CHAR 10)) /* Messaggi del Cpp JSRCDRVKC */ ADDMSGD MSGID(JSDB001) MSGF(NERONI2/JSRCDRV) MSG('Non esiste il + file guida per le compilazioni QTEMP/JSRCDRV1T') + SECLVL('Il file JSRCDRV1T nella libreria QTEMP non + esiste. Prima di eseguire il comando corrente JSRCDRVK + occorre eseguire il comando JSRCDRV eventualmente più + volte per costruire in libreria temporanea il detto + elenco dei membri da ricompilare.') ADDMSGD MSGID(JSDB002) MSGF(NERONI2/JSRCDRV) MSG('Letto Mbr:&1 + File:&2 Lib:&3 Seu:&4') FMT((*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JSDB003) MSGF(NERONI2/JSRCDRV) MSG('TipoSeu "&4" + non gestito') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) + (*CHAR 10)) ADDMSGD MSGID(JSDB004) MSGF(NERONI2/JSRCDRV) MSG('Membro "&1" + Tipo "&4" omesso') FMT((*CHAR 10) (*CHAR 10) (*CHAR + 10) (*CHAR 10)) ADDMSGD MSGID(JSDB005) MSGF(NERONI2/JSRCDRV) MSG('Membro "&1" + Tipo "&4" non creato') FMT((*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JSDB006) MSGF(NERONI2/JSRCDRV) MSG('Membro "&1" + Tipo "&4" non modificato') FMT((*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JSDB007) MSGF(NERONI2/JSRCDRV) MSG('Non esiste la + libreria &1 che deve ricevere le compilazioni.') + SECLVL('La libreria &1 non esiste. La procedura non + puo'' proseguire se manca la libreria di destinazione + delle compilazioni.ì') FMT((*CHAR 10)) ADDMSGD MSGID(JSDB101) MSGF(NERONI2/JSRCDRV) MSG('Elaborati &1, + omessi &2 record. Crea fisici &3, &4 in errore. + Modifica fisici &5, &6 in errore. Crea logici &7, &8 + in errore.') SECLVL('Elaborati &1, omessi &2 record. + Creazione fisici &3, &4 in errore. Modifica fisici &5, + &6 in errore. Creazione logici &7, &8 in errore.') + FMT((*DEC 7) (*DEC 7) (*DEC 7) (*DEC 7) (*DEC 7) (*DEC + 7) (*DEC 7) (*DEC 7)) ADDMSGD MSGID(JSDB102) MSGF(NERONI2/JSRCDRV) MSG('Errori nella + creazione di fisici e/o logici.') /* Messaggi del Cmd. */ ADDMSGD MSGID(JSD1001) MSGF(NERONI2/JSRCDRV) MSG('niente') //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Source driver. CrtListCpp */ /* Claudio Neroni 28-04-2015 Creato. */ /* Crea un elenco membri sorgente in vista della loro compilazione. */ /* Il primo file esaminato viene caricato in elenco. */ /* Ogni successivo file viene aggiunto progressivamente all'elenco */ /* dopo aver eliminato dall'elenco stesso i membri già presenti */ /* nel file in corso di esame. */ /* */ PGM PARM(&FILELIB &LISTOPT &TOPGMQ) /* Riceve File source qualificato. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Riceve Opzione di generazione della lista. */ DCL VAR(&LISTOPT) TYPE(*CHAR) LEN(10) /* Riceve Coda di programma a cui segnalare. */ DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Programma chiamante. */ DCL VAR(&CALLER) TYPE(*CHAR) LEN(10) VALUE(*) /* Tipo file. */ DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Trova il nome del chiamante. */ IF COND(&TOPGMQ *EQ *PRV) THEN(DO) JCALLER CALLER(&CALLER) ENDDO /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Controlla l'esistenza del file da esaminare. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) /* Se il file non esiste, messaggia e rilascia. */ MONMSG MSGID(CPF0000) EXEC(DO) SNDPGMMSG MSGID(JSDA002) MSGF(JSRCDRV) MSGDTA(&FILE + *CAT &LIB) TOPGMQ(*PRV (&CALLER)) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Recupera il tipo file. */ JRTVFD FILE(&FILE) LIB(&LIB) FILETYPE(&FILETYPE) /* Se il file non è di tipo source, messaggia e rilascia. */ IF COND(&FILETYPE *NE *SRC) THEN(DO) SNDPGMMSG MSGID(JSDA001) MSGF(JSRCDRV) MSGDTA(&FILE + *CAT &LIB) TOPGMQ(*PRV (&CALLER)) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Controlla l'esistenza dell'elenco finale. */ CHKOBJ OBJ(QTEMP/JSRCDRV1T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) /* Se corre aggiunta e non è trascorsa una sostituzione, */ /* messaggia e rilascia. */ IF COND(&LISTOPT *NE *REPLACE) THEN(DO) SNDPGMMSG MSGID(JSDA003) MSGF(JSRCDRV) MSGDTA(&FILE + *CAT &LIB) TOPGMQ(*PRV (&CALLER)) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO ENDDO /* Prepara i file di lavoro. */ IF COND(&LISTOPT *EQ *REPLACE) THEN(DO) JCPYCLR FROMFILE(JSRCDRV1) TOFILE(JSRCDRV1T) ENDDO JCPYCLR FROMFILE(JSRCDRV2) TOFILE(JSRCDRV2T) /* Elenca i membri del file in esame. */ DSPFD FILE(&LIB/&FILE) TYPE(*MBRLIST) + OUTPUT(*OUTFILE) OUTFILE(QTEMP/JSRCDRV2T) + OUTMBR(*FIRST *REPLACE) /* Se corre *REPLACE. */ IF COND(&LISTOPT *EQ *REPLACE) THEN(DO) /* Sostituisce il contenuto dell'elenco. */ CPYF FROMFILE(QTEMP/JSRCDRV2T) + TOFILE(QTEMP/JSRCDRV1T) MBROPT(*REPLACE) /* Messaggia felice conclusione. */ SNDPGMMSG MSGID(JSDA101) MSGF(JSRCDRV) MSGDTA(&FILE + *CAT &LIB) TOPGMQ(*PRV (&CALLER)) + MSGTYPE(*COMP) /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) /* Se corre *REPLACE. */ ENDDO /* Reindirizza i file in libreria temporanea. */ OVRDBF FILE(JSRCDRV1) TOFILE(QTEMP/JSRCDRV1T) + SECURE(*YES) OVRDBF FILE(JSRCDRV2) TOFILE(QTEMP/JSRCDRV2T) + SECURE(*YES) /* Cancella da Main i membri citati in Service. */ CALL PGM(JSRCDRVD) /* Cancella i reindirizzamenti. */ DLTOVR FILE(*ALL) /* Compatta i cancellati di Main. */ RGZPFM FILE(QTEMP/JSRCDRV1T) /* Aggiunge Service a Main. */ CPYF FROMFILE(QTEMP/JSRCDRV2T) + TOFILE(QTEMP/JSRCDRV1T) MBROPT(*ADD) /* Messaggia felice conclusione. */ SNDPGMMSG MSGID(JSDA102) MSGF(JSRCDRV) MSGDTA(&FILE + *CAT &LIB) TOPGMQ(*PRV (&CALLER)) + MSGTYPE(*COMP) /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca ... */ /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JSRCDRV) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Label di prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Source driver. DltServiceInMain * Claudio Neroni 28-04-2015 Creato. * Cancella dall'elenco Main i record presenti nell'elenco Service. * Se un nome membro è presente nell'elenco Service, * cancella tutti i record dall'elenco Main che portano * lo stesso nome membro. * Fjsrcdrv1 up e k disk F rename(QWHFDML:MAI) F prefix(MAI) Fjsrcdrv2 if e k disk F rename(QWHFDML:SRV) F prefix(SRV) C MAImlname chain SRV C if %found C delete MAI C endif //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVK) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Source driver. CompileCmd */ /* Claudio Neroni 29-04-2015 Creato. */ /* Compila i membri dell'elenco costruito con il comando */ /* JSRCDRV SRCFILE(LIBRARY1/SOURCE1) */ /* seguito da eventuali altri elenchi. */ /* JSRCDRV SRCFILE(LIBRARY2/SOURCE2) LISTOPT(*ADD) */ /* L'elenco contiene un nome di membro una volta sola alla versione */ /* dell'ultimo file che lo contiene in ordine di aggiunta. */ /* Claudio Neroni 30-04-2015 Creato. */ /* Inserito elenco di nomi membro da omettere dalla compilazione. */ /* */ CMD PROMPT('SrcDriver: Compile from list') PARM KWD(LIB) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('Compile Library') PARM KWD(OMITMBR) TYPE(*GENERIC) LEN(10) + DFT(*NONE) SNGVAL((*NONE)) MAX(10) + PROMPT('Members to be omitted') PARM KWD(TOPGMQ) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*SAME) VALUES(*SAME *PRV) PROMPT('To + program queue') PARM KWD(ENDMSGTO) TYPE(*NAME) LEN(10) RSTD(*NO) + DFT(*NULL) SPCVAL((*NULL)) PROMPT('End + msg also to prv of pgm') /* Ampiezza membro: SIZE */ /* Numero iniziale record . . . . > 2147483646 *INT4 *NOMAX */ /* Numero di incremento record . > 32767 *INT2 */ /* Numero massimo incrementi . . > 32767 *INT2 */ /* Member size: */ /* Initial number of records . . */ /* Increment number of records . */ /* Maximum increments . . . . . . */ PARM KWD(SIZE) TYPE(SIZE) PROMPT('Member size') SIZE: ELEM TYPE(*INT4) DFT(*NOMAX) SPCVAL((*NOMAX -1) + (10000000)) PROMPT('Initial number of + records') ELEM TYPE(*INT2) DFT(0) SPCVAL((32000)) + PROMPT('Increment number of records') ELEM TYPE(*INT2) DFT(0) SPCVAL((3)) + PROMPT('Maximum increments') /* Controllo livello form. record LVLCHK *NO *YES/*NO */ PARM KWD(LVLCHK) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) PROMPT('Level + check') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVKC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Source driver. CompileCpp */ /* Claudio Neroni 28-04-2015 Creato. */ /* Il comando rilegge il file guida generato dall'esecuzione, */ /* eventualmente in più run, del comando prerequisito JSRCDRV. */ /* Il file guida contiene una lista di membri sorgente che degli */ /* omonimi conserva solo l'ultimo aggiunto. */ /* Per ogni record riguardante un membro con tipo seu PF o LF, */ /* esegue una routine di creazione o modifica adeguata. */ /* La compilazione avviene nella libreria richiesta creando i file */ /* fisici mancanti e modificando i file fisici già presenti. */ /* I file logici vengono invece cancellati se già presenti e */ /* comunque ricreati. */ /* Il comando può quindi essere eseguito su una libreria dati */ /* di produzione per aggiornare i tracciati seza perdita di dati */ /* (naturalmente salvo eliminazione di campi nei nuovi sorgenti). */ /* Claudio Neroni 30-04-2015 Modificato. */ /* Inserito elenco di nomi membro da omettere dalla compilazione. */ /* Claudio Neroni 12-05-2015 Modificato. */ /* Affioramento di qualche parametro di compilazione. */ /* */ PGM PARM(&LIB &OMITMBRL &TOPGMQ &ENDMSGTO + &SIZE123 &LVLCHK) /* Riceve Libreria di compilazione. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Riceve Elenco Membri da omettere. */ /* 10 elementi lunghi 10 (100 char) + numero ricorrenze binario (2 char). */ DCL VAR(&OMITMBRL) TYPE(*CHAR) LEN(102) /* Riceve Coda di programma a cui segnalare. */ DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10) /* Riceve Coda di programma al cui chiamante mandare un duplicato */ /* del messaggio finale. */ DCL VAR(&ENDMSGTO) TYPE(*CHAR) LEN(10) /* Riceve Size per la compilazione dei file fisici nei tre parametri. */ DCL VAR(&SIZE123) TYPE(*CHAR) LEN(10) /* Riceve Level check per la compilazione di fisici e logici. */ DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(4) /* Tre elementi del parametro Size. */ DCL VAR(&SIZE1) TYPE(*DEC) LEN(10 0) DCL VAR(&SIZE2) TYPE(*DEC) LEN(5 0) DCL VAR(&SIZE3) TYPE(*DEC) LEN(5 0) /* Programma chiamante. */ DCL VAR(&CALLER) TYPE(*CHAR) LEN(10) VALUE(*) /* Record da omettere. */ DCL VAR(&OMIT) TYPE(*LGL) /* Contatore record elaborati. */ DCL VAR(&CNTELAB) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTELABA) TYPE(*CHAR) LEN(4) /* Contatore record omessi. */ DCL VAR(&CNTOMIT) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTOMITA) TYPE(*CHAR) LEN(4) /* Contatore creazione fisici. */ DCL VAR(&CNTCRPF) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTCRPFA) TYPE(*CHAR) LEN(4) /* Contatore errori creazione fisici. */ DCL VAR(&CNTERPF) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTERPFA) TYPE(*CHAR) LEN(4) /* Contatore modifica fisici. */ DCL VAR(&CNTCHPF) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTCHPFA) TYPE(*CHAR) LEN(4) /* Contatore errori modifica fisici. */ DCL VAR(&CNTCEPF) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTCEPFA) TYPE(*CHAR) LEN(4) /* Contatore creazione logici. */ DCL VAR(&CNTCRLF) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTCRLFA) TYPE(*CHAR) LEN(4) /* Contatore errori creazione logici. */ DCL VAR(&CNTERLF) TYPE(*DEC) LEN(7 0) DCL VAR(&CNTERLFA) TYPE(*CHAR) LEN(4) /* Libreria corrente */ DCL VAR(&LIBCUR) TYPE(*CHAR) LEN(10) /* Dati messaggio. */ DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) /* Riceve l'elenco dei membri da ricompilare. */ DCLF FILE(JSRCDRV1) /* Errore in creazione. */ DCL VAR(&CRTERR) TYPE(*LGL) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Recupera la libreria corrente. */ RTVJOBA CURLIB(&LIBCUR) /* Estrae i tre elementi del parametro Size. */ CHGVAR VAR(&SIZE1) VALUE(%BIN(&SIZE123 3 4)) CHGVAR VAR(&SIZE2) VALUE(%BIN(&SIZE123 7 2)) CHGVAR VAR(&SIZE3) VALUE(%BIN(&SIZE123 9 2)) /* Trova il nome del chiamante. */ IF COND(&TOPGMQ *EQ *PRV) THEN(DO) JCALLER CALLER(&CALLER) ENDDO /* Controlla l'esistenza della libreria di compilazione. */ CHKOBJ OBJ(&LIB) OBJTYPE(*LIB) /* Se la libreria di compilazione non esiste, messaggia e rilascia. */ MONMSG MSGID(CPF0000) EXEC(DO) SNDPGMMSG MSGID(JSDB007) MSGF(JSRCDRV) MSGDTA(&LIB) + TOPGMQ(*PRV (&CALLER)) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Mette la libreria dati come libreria corrente in modo che */ /* la creazione dei logici trovi sicuramente in lista per primi */ /* i fisici appena creati. */ CHGCURLIB CURLIB(&LIB) /* Controlla l'esistenza dell'elenco di guida per le compilazioni. */ CHKOBJ OBJ(QTEMP/JSRCDRV1T) OBJTYPE(*FILE) /* Se manca il file, messaggia e rilascia. */ MONMSG MSGID(CPF0000) EXEC(DO) SNDPGMMSG MSGID(JSDB001) MSGF(JSRCDRV) TOPGMQ(*PRV + (&CALLER)) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Reindirizza l'elenco sul file in libreria temporanea. */ OVRDBF FILE(JSRCDRV1) TOFILE(QTEMP/JSRCDRV1T) + SECURE(*YES) /* Cicla sull'elenco. */ DOWHILE COND('1') /* Legge un record dall'elenco. */ RCVF /* Se non ce ne sono altri, abbandona. */ MONMSG MSGID(CPF0864) EXEC(LEAVE) /* Documenta il record in elaborazione. */ SNDPGMMSG MSGID(JSDB002) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MLNAME + *CAT ' ' *CAT &MLFILE *CAT ' ' *CAT + &MLLIB *CAT ' ' *CAT &MLSEU2) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Valuta le condizioni di omissione. */ CALL PGM(JSRCDRVKO) PARM(&MLNAME &OMITMBRL &OMIT) /* Se il membro va omesso, conta, messaggia e ricicla. */ IF COND(&OMIT) THEN(DO) CHGVAR VAR(&CNTOMIT) VALUE(&CNTOMIT + 1) SNDPGMMSG MSGID(JSDB004) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) ITERATE ENDDO /* Incrementa il Contatore record elaborati. */ CHGVAR VAR(&CNTELAB) VALUE(&CNTELAB + 1) /* Sceglie la routine di trattamento del record di elenco. */ SELECT WHEN COND(&MLSEU2 *EQ PF) THEN(CALLSUBR SUBR(SRPF)) WHEN COND(&MLSEU2 *EQ LF) THEN(CALLSUBR SUBR(SRLF)) OTHERWISE CMD(DO) SNDPGMMSG MSGID(JSDB003) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) ENDDO ENDSELECT /* Cicla sull'elenco. */ ENDDO /* Messaggia felice conclusione. */ JDECCHA FROMDEC(&CNTELAB) TOCHAR4(&CNTELABA) JDECCHA FROMDEC(&CNTOMIT) TOCHAR4(&CNTOMITA) JDECCHA FROMDEC(&CNTCRPF) TOCHAR4(&CNTCRPFA) JDECCHA FROMDEC(&CNTERPF) TOCHAR4(&CNTERPFA) JDECCHA FROMDEC(&CNTCHPF) TOCHAR4(&CNTCHPFA) JDECCHA FROMDEC(&CNTCEPF) TOCHAR4(&CNTCEPFA) JDECCHA FROMDEC(&CNTCRLF) TOCHAR4(&CNTCRLFA) JDECCHA FROMDEC(&CNTERLF) TOCHAR4(&CNTERLFA) CHGVAR VAR(&MSGDTA) VALUE(&CNTELABA *CAT &CNTOMITA + *CAT &CNTCRPFA *CAT &CNTERPFA *CAT + &CNTCHPFA *CAT &CNTCEPFA *CAT &CNTCRLFA + *CAT &CNTERLFA) SNDPGMMSG MSGID(JSDB101) MSGF(JSRCDRV) MSGDTA(&MSGDTA) + TOPGMQ(*PRV (&CALLER)) MSGTYPE(*COMP) IF COND(&ENDMSGTO *NE *NULL) THEN(DO) SNDPGMMSG MSGID(JSDB101) MSGF(JSRCDRV) MSGDTA(&MSGDTA) + TOPGMQ(*PRV (&ENDMSGTO)) MSGTYPE(*INFO) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca ... */ /* Ripristina la libreria corrente salvata. */ IF COND(&LIBCUR *EQ *NONE) THEN(CHGVAR + VAR(&LIBCUR) VALUE(*CRTDFT)) CHGCURLIB CURLIB(&LIBCUR) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se errori in creazione, messaggia. */ IF COND(&CRTERR) THEN(DO) SNDPGMMSG MSGID(JSDB102) MSGF(JSRCDRV) TOPGMQ(*PRV + (&CALLER)) MSGTYPE(*COMP) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) + MSGDTA(JSRCDRVK) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Label di prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) /*----------------------------------------------------------------------------*/ /* Subroutine SRPF */ SUBR SUBR(SRPF) /* Messaggia. */ /* SNDPGMMSG MSG('Subroutine file fisico') */ /* Controlla l'esistenza del file fisico. */ CHKOBJ OBJ(&LIB/&MLNAME) OBJTYPE(*FILE) /* Se il file non esiste. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Se richiesta size *NOMAX */ IF COND(&SIZE1 *EQ -1) THEN(DO) /* Crea il file fisico. */ CHGVAR VAR(&CNTCRPF) VALUE(&CNTCRPF + 1) CRTPF FILE(&LIB/&MLNAME) SRCFILE(&MLLIB/&MLFILE) + OPTION(*NOSRC *NOLIST) SIZE(*NOMAX) + LVLCHK(&LVLCHK) /* Se errore in creazione, messaggia e annota. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) CHGVAR VAR(&CNTERPF) VALUE(&CNTERPF + 1) SNDPGMMSG MSGID(JSDB005) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) CHGVAR VAR(&CRTERR) VALUE('1') /* Se errore in creazione, messaggia e annota. */ ENDDO /* Se richiesta size *NOMAX */ ENDDO /* Se richiesta size specifica. */ ELSE CMD(DO) /* Crea il file fisico. */ CHGVAR VAR(&CNTCRPF) VALUE(&CNTCRPF + 1) CRTPF FILE(&LIB/&MLNAME) SRCFILE(&MLLIB/&MLFILE) + OPTION(*NOSRC *NOLIST) SIZE(&SIZE1 &SIZE2 + &SIZE3) LVLCHK(&LVLCHK) /* Se errore in creazione, messaggia e annota. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) CHGVAR VAR(&CNTERPF) VALUE(&CNTERPF + 1) SNDPGMMSG MSGID(JSDB005) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) CHGVAR VAR(&CRTERR) VALUE('1') /* Se errore in creazione, messaggia e annota. */ ENDDO /* Se richiesta size specifica. */ ENDDO /* Abbandona. */ GOTO CMDLBL(ENDSR) /* Se il file non esiste. */ ENDDO /* Modifica il file. */ CHGVAR VAR(&CNTCHPF) VALUE(&CNTCHPF + 1) CHGPF FILE(&LIB/&MLNAME) SRCFILE(&MLLIB/&MLFILE) + OPTION(*NOSRC *NOLIST) LVLCHK(&LVLCHK) /* Se errore in modifica, messaggia e annota. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) CHGVAR VAR(&CNTCEPF) VALUE(&CNTCEPF + 1) SNDPGMMSG MSGID(JSDB006) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) CHGVAR VAR(&CRTERR) VALUE('1') ENDDO /* Fine subroutine. */ ENDSR: ENDSUBR /*----------------------------------------------------------------------------*/ /* Subroutine SRLF */ SUBR SUBR(SRLF) /* Messaggia. */ /* SNDPGMMSG MSG('Subroutine file logico') */ /* Cancella il file logico. */ DLTF FILE(&LIB/&MLNAME) MONMSG MSGID(CPF0000) /* Crea il file logico. */ CHGVAR VAR(&CNTCRLF) VALUE(&CNTCRLF + 1) CRTLF FILE(&LIB/&MLNAME) SRCFILE(&MLLIB/&MLFILE) + OPTION(*NOSRC *NOLIST) LVLCHK(&LVLCHK) /* Se errore in creazione, messaggia e annota. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) CHGVAR VAR(&CNTERLF) VALUE(&CNTERLF + 1) SNDPGMMSG MSGID(JSDB005) MSGF(JSRCDRV) MSGDTA(&MLNAME + *CAT &MLFILE *CAT &MLLIB *CAT &MLSEU2) + TOPGMQ(*PRV (&CALLER)) CHGVAR VAR(&CRTERR) VALUE('1') ENDDO /* Fine subroutine. */ ENDSR: ENDSUBR /*----------------------------------------------------------------------------*/ ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVKO) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Source driver. CompileOmitter * Claudio Neroni 30-04-2015 Creato. * Giudica se il membro è da omettere. * *--------------------------------------------------------------------------------------------- * Parametro lista membri da omettere. D omitmbrl ds * Numero elementi. D mbrln 1 2b 0 * Elementi. D mbrl 3 102 dim(10) *--------------------------------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve nome del membro in esame. C parm mbr 10 I Membro * Riceve il parametro lista nomi da omettere. C parm omitmbrl 102 I Lista membri omit * Ritorna flag di omissione. C parm omit 1 O Flag omissione *--------------------------------------------------------------------------------------------- * Prenota chiusura. C seton lr * Assume nome da includere. C eval omit = *off * Esegue. C do * Se il primo elemento della lista vale *NONE, abbandona. C if mbrl(1) = '*NONE' C leave C endif * Esamina gli elementi passati nella lista. C do mbrln ix 5 0 * Se l'elemento della lista è uguale al nome del membro, * prenota omissione e abbandona. C if mbrl(ix) = mbr C eval omit = *on C leave C endif * Cerca la posizione dell'asterisco lungo l'elemento in esame. C clear ax 5 0 C movel(p) mbrl(ix) ele 10 C eval ax=%scan('*':ele) * Se non trova asterisco, ricicla. C if ax = *zero C iter C endif * Pasticcia il membro. C movel(p) mbr pas 10 C movel(p) '*' ast 10 C eval pas=%replace(ast:pas:ax:(11-ax)) * Se l'elemento della lista è uguale al nome del pasticcio, * prenota omissione e abbandona. C if mbrl(ix) = pas C eval omit = *on C leave C endif * Esamina gli elementi passati nella lista. C enddo * Esegue. C enddo * Ritorna. C return *--------------------------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVT) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Source driver. Create/Refresh DB in TargetLib. Cmd */ /* Claudio Neroni 08-05-2015 Creato. */ /* Crea o ricrea a nuovo livello */ /* i file fisici e logici in una libreria dati */ /* usando fino a 10 librerie sorgente. */ CMD PROMPT('Create/Refresh DB in TargetLib') PARM KWD(SRCLIB) TYPE(*NAME) LEN(10) + SPCVAL((*NULL)) MIN(1) MAX(10) + PROMPT('Source Libraries old..new') PARM KWD(TRGLIB) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('Target Library') PARM KWD(SIZE) TYPE(SIZE) PROMPT('Member size') SIZE: ELEM TYPE(*INT4) DFT(*NOMAX) SPCVAL((*NOMAX -1) + (10000000)) PROMPT('Initial number of + records') ELEM TYPE(*INT2) DFT(0) SPCVAL((32000)) + PROMPT('Increment number of records') ELEM TYPE(*INT2) DFT(0) SPCVAL((3)) + PROMPT('Maximum increments') PARM KWD(LVLCHK) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) PROMPT('Level + check') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRVTC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Source driver. Create/Refresh DB in TargetLib. Cpp */ /* Claudio Neroni 08-05-2015 Creato. */ /* Crea o ricrea a nuovo livello */ /* i file fisici e logici in una libreria dati */ /* usando fino a 10 librerie sorgente. */ PGM PARM(&SRCLIBL &TRGLIB &SIZE123 &LVLCHK) /* Riceve Source Libraries old..new (10 elem lunghi 10) */ DCL VAR(&SRCLIBL) TYPE(*CHAR) LEN(102) /* Riceve Target Library. */ DCL VAR(&TRGLIB) TYPE(*CHAR) LEN(10) /* Riceve Size per la compilazione dei file fisici nei tre parametri. */ DCL VAR(&SIZE123) TYPE(*CHAR) LEN(10) /* Riceve Level check per la compilazione di fisici e logici. */ DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(4) /* Tre elementi del parametro Size. */ DCL VAR(&SIZE1) TYPE(*DEC) LEN(10 0) DCL VAR(&SIZE2) TYPE(*DEC) LEN(5 0) DCL VAR(&SIZE3) TYPE(*DEC) LEN(5 0) /* Elemento dell'elenco Source Libraries. */ DCL VAR(&SRCLIB) TYPE(*CHAR) LEN(10) /* Numero di valori ricevuti. */ DCL VAR(&SRCLIB§) TYPE(*INT) /* Indice di dofor. */ DCL VAR(&IX) TYPE(*INT) /* Displacement per la lettura dell'elenco librerie sorgente. */ DCL VAR(&ID) TYPE(*INT) /* Opzione di lista membri sorgente. */ DCL VAR(&LISTOPT) TYPE(*CHAR) LEN(10) /* Interpreta il numero di parametri ricevuti. */ CHGVAR VAR(&SRCLIB§) VALUE(%BIN(&SRCLIBL 1 2)) /* Estrae i tre elementi del parametro Size. */ CHGVAR VAR(&SIZE1) VALUE(%BIN(&SIZE123 3 4)) CHGVAR VAR(&SIZE2) VALUE(%BIN(&SIZE123 7 2)) CHGVAR VAR(&SIZE3) VALUE(%BIN(&SIZE123 9 2)) /* Assume sostituzione per il primo run dell'elenco membri source. */ CHGVAR VAR(&LISTOPT) VALUE(*REPLACE) /* PRIMO GIRO */ /* Percorre la lista estraendo tutte le librerie sorgente da esaminare. */ DOFOR VAR(&IX) FROM(1) TO(&SRCLIB§) /* Calcola il displacement del nome libreria lungo la lista. */ CHGVAR VAR(&ID) VALUE((&IX - 1) * 10 +3) /* Estrae il nome dell'elemento dalla lista. */ CHGVAR VAR(&SRCLIB) VALUE(%SST(&SRCLIBL &ID 10)) /* Se valore nullo, ricicla. */ IF COND(&SRCLIB *EQ *NULL) THEN(ITERATE) /* Controlla l'esistenza della libreria source. */ CHKOBJ OBJ(&SRCLIB) OBJTYPE(*LIB) /* Se non esiste la libreria sorgente. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Segnala. */ SNDPGMMSG MSG('Libreria sorgente' *BCAT &SRCLIB *BCAT + 'non esiste') /* Abbandona. */ GOTO CMDLBL(FINE) /* Se non esiste la libreria sorgente. */ ENDDO /* Elenca i sorgenti dei fisici dalla libreria sorgente. */ JSRCDRV SRCFILE(&SRCLIB/QDDSPF) LISTOPT(&LISTOPT) + TOPGMQ(*PRV) /* Se manca il file, ricicla. */ MONMSG MSGID(CPF0000) EXEC(ITERATE) /* Annota aggiunta per i successivi run dell'elenco membri sorgente. */ CHGVAR VAR(&LISTOPT) VALUE(*ADD) /* Percorre la lista estraendo tutte le librerie sorgente da esaminare. */ ENDDO /* SECONDO GIRO */ /* Percorre la lista estraendo tutte le librerie sorgente da esaminare. */ DOFOR VAR(&IX) FROM(1) TO(&SRCLIB§) /* Calcola il displacement del nome libreria lungo la lista. */ CHGVAR VAR(&ID) VALUE((&IX - 1) * 10 +3) /* Estrae il nome dell'elemento dalla lista. */ CHGVAR VAR(&SRCLIB) VALUE(%SST(&SRCLIBL &ID 10)) /* Se valore nullo, ricicla. */ IF COND(&SRCLIB *EQ *NULL) THEN(ITERATE) /* Controlla l'esistenza della libreria source. */ CHKOBJ OBJ(&SRCLIB) OBJTYPE(*LIB) /* Se non esiste la libreria sorgente. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Segnala. */ SNDPGMMSG MSG('Libreria source' *BCAT &SRCLIB *BCAT + 'non esiste') /* Abbandona. */ GOTO CMDLBL(FINE) /* Se non esiste la libreria sorgente. */ ENDDO /* Elenca i sorgenti dei logici dalla libreria sorgente. */ JSRCDRV SRCFILE(&SRCLIB/QDDSLF) LISTOPT(&LISTOPT) + TOPGMQ(*PRV) /* Se manca il file, ricicla. */ MONMSG MSGID(CPF0000) EXEC(ITERATE) /* Annota aggiunta per i successivi run dell'elenco membri sorgente. */ CHGVAR VAR(&LISTOPT) VALUE(*ADD) /* Percorre la lista estraendo tutte le librerie sorgente da esaminare. */ ENDDO /* Crea tutti i fisici e i logici in elenco. */ /* Evita solo le strutture dati che iniziano con "DS". */ JSRCDRVK LIB(&TRGLIB) OMITMBR(DS*) TOPGMQ(*PRV) + SIZE(&SIZE1 &SIZE2 &SIZE3) LVLCHK(&LVLCHK) MONMSG MSGID(CPF0000) FINE: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRV1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHFDML FORMAT(QAFDMBRL) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSRCDRV2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHFDML A FORMAT(QAFDMBRL) A K MLNAME A K MLFILE A K MLLIB //ENDSRC //ENDBCHJOB