//BCHJOB JOB(JOLD) JOBD(QBATCH) OUTQ(QPRINT) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it di Claudio Neroni */ /* SE L'USO DELLA JOB DESCRIPTION "QBATCH" TI E' IMPEDITO, */ /* UTILIZZANE UNA DIVERSA. */ /* From System: "IUBICSVI" */ /* From Library: "UTI" */ /* Unload Time: 2008-10-24 17:12 */ /* To File : "JOLD" */ /* To Library : "NERONI2" */ /* To Text : "Delta old. 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 "JOLD.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:\JOLD.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JOLD.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(JOLD) 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/JOLD" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JOLD) MBR(JOLD.) 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/JOLD) CRTSRCPF FILE(NERONI2/JOLD) RCDLEN(112) + TEXT('Delta old. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD) TOFILE(NERONI2/JOLD) + TOMBR(JOLD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD) + SRCTYPE(CMD) + TEXT('Delta old. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD.) TOFILE(NERONI2/JOLD) + TOMBR(JOLD.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD.) + SRCTYPE(CL) + TEXT('Delta old. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLDA) TOFILE(NERONI2/JOLD) + TOMBR(JOLDA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLDA) + SRCTYPE(CLLE) + TEXT('Delta old. Cpp *ALL') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLDELET) TOFILE(NERONI2/JOLD) + TOMBR(JOLDELET) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLDELET) + SRCTYPE(PF) + TEXT('Delta old. Elenco file') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD1) TOFILE(NERONI2/JOLD) + TOMBR(JOLD1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD1) + SRCTYPE(CLLE) + TEXT('Delta old. ProcessFile') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD2) TOFILE(NERONI2/JOLD) + TOMBR(JOLD2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD2) + SRCTYPE(RPGLE) + TEXT('Delta old. MatchList') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD3) TOFILE(NERONI2/JOLD) + TOMBR(JOLD3) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD3) + SRCTYPE(CLLE) + TEXT('Delta old. ChoOpt') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD4) TOFILE(NERONI2/JOLD) + TOMBR(JOLD4) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD4) + SRCTYPE(CLLE) + TEXT('Delta old. ExeOpt') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD5) TOFILE(NERONI2/JOLD) + TOMBR(JOLD5) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD5) + SRCTYPE(RPGLE) + TEXT('Delta old. InsInfo') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JOLD6) TOFILE(NERONI2/JOLD) + TOMBR(JOLD6) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JOLD) MBR(JOLD6) + SRCTYPE(RPGLE) + TEXT('Delta old. ReadDtaType') /*---------------------------------------------------------------------*/ //DATA FILE(JOLD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CMD PROMPT('Delta old') PARM KWD(SRCF) TYPE(*NAME) SPCVAL((*ALL)) MIN(1) + PROMPT('Source file') PARM KWD(OLD) TYPE(*NAME) MIN(1) PROMPT('Old + library') PARM KWD(NEW) TYPE(*NAME) MIN(1) PROMPT('New + library') PARM KWD(DELTA) TYPE(*NAME) MIN(1) PROMPT('Delta + library') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JOLD.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 00 + *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 06/11/2007 Creato. */ /* JOLD */ /* Delta old */ /* Prerequisiti: nessuno */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTF FILE(NERONI2/JOLDELET) DLTPGM PGM(NERONI2/JOLDA) DLTPGM PGM(NERONI2/JOLD1) DLTPGM PGM(NERONI2/JOLD2) DLTPGM PGM(NERONI2/JOLD3) DLTPGM PGM(NERONI2/JOLD4) DLTPGM PGM(NERONI2/JOLD5) DLTPGM PGM(NERONI2/JOLD6) DLTCMD CMD(NERONI2/JOLD) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/JOLDELET) SRCFILE(JOLD) CRTBNDCL PGM(NERONI2/JOLDA) SRCFILE(JOLD) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JOLD1) SRCFILE(JOLD) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JOLD3) SRCFILE(JOLD) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JOLD4) SRCFILE(JOLD) DBGVIEW(*ALL) /**/ OVRDBF FILE(JOLDOLD) TOFILE(QAFDMBR) OVRDBF FILE(JOLDNEW) TOFILE(QAFDMBR) CRTBNDRPG PGM(NERONI2/JOLD2) SRCFILE(JOLD) DBGVIEW(*ALL) DLTOVR FILE(*ALL) /**/ CRTBNDRPG PGM(NERONI2/JOLD5) SRCFILE(JOLD) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JOLD6) SRCFILE(JOLD) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JOLD) PGM(JOLDA) SRCFILE(JOLD) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLDA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Delta old. Cpp *ALL */ /* Claudio Neroni 06/11/2007 Creato. */ /* */ /* Riceve File sorgente, */ /* Libreria del file sorgente vecchio, */ /* Libreria del file sorgente nuovo, */ /* Libreria del file sorgente delta di emissione. */ PGM PARM(&SRCFP &OLD &NEW &DELTA) /* Elenco dei file da esaminare. */ DCLF FILE(JOLDELET) /* File sorgente parametro. */ DCL VAR(&SRCFP) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente vecchio. */ DCL VAR(&OLD) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente nuovo. */ DCL VAR(&NEW) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente delta di emissione. */ DCL VAR(&DELTA) TYPE(*CHAR) LEN(10) /* File sorgente. */ DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) /* Testo libreria delta. */ DCL VAR(&TEXTLIB) TYPE(*CHAR) LEN(50) /* Testo file delta. */ DCL VAR(&TEXTFILE) TYPE(*CHAR) LEN(50) /* Non esiste file vecchio. */ DCL VAR(&NOOLD) TYPE(*LGL) /* Non esiste file nuovo. */ DCL VAR(&NONEW) TYPE(*LGL) /* Tipo dati. */ DCL VAR(&DTATYPE) TYPE(*CHAR) LEN(1) /* Lunghezza record old. */ DCL VAR(&LENOLD) TYPE(*DEC) LEN(5 0) /* Lunghezza record new. */ DCL VAR(&LENNEW) TYPE(*DEC) LEN(5 0) /* Lunghezza record. */ DCL VAR(&LEN) TYPE(*DEC) LEN(5 0) /* Se i nomi delle librerie sono uguali, errore. */ IF COND((&OLD *EQ &NEW) *OR (&OLD *EQ &DELTA) + *OR (&NEW *EQ &DELTA)) THEN(DO) SNDPGMMSG MSG('I nomi delle librerie devono essere + tutti diversi') GOTO CMDLBL(FINE) ENDDO /* Controlla l'esistenza della libreria vecchia. */ CHKOBJ OBJ(&OLD) OBJTYPE(*LIB) /* Se la libreria vecchia non esiste, errore. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) SNDPGMMSG MSG('La libreria vecchia' *BCAT &OLD *BCAT + 'non esiste') GOTO CMDLBL(FINE) ENDDO /* Controlla l'esistenza della libreria nuova. */ CHKOBJ OBJ(&NEW) OBJTYPE(*LIB) /* Se la libreria nuova non esiste, errore. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) SNDPGMMSG MSG('La libreria nuova' *BCAT &NEW *BCAT + 'non esiste') GOTO CMDLBL(FINE) ENDDO /* Se richiesto un solo file, esegue e abbandona. */ IF COND(&SRCFP *NE *ALL) THEN(DO) CHGVAR VAR(&SRCF) VALUE(&SRCFP) CALL PGM(JOLD1) PARM(&SRCF &OLD &NEW &DELTA) GOTO CMDLBL(FINE) ENDDO /* Elenca i file sorgente della libreria vecchia. */ DSPFD FILE(&OLD/*ALL) TYPE(*ATR) OUTPUT(*OUTFILE) + FILEATR(*PF) OUTFILE(QTEMP/JOLDELE) + OUTMBR(*FIRST *REPLACE) /* Elenca i file sorgente della libreria nuova. */ DSPFD FILE(&NEW/*ALL) TYPE(*ATR) OUTPUT(*OUTFILE) + FILEATR(*PF) OUTFILE(QTEMP/JOLDELE) + OUTMBR(*FIRST *ADD) /* Reindirizza l'elenco di dettaglio dei file.. */ OVRDBF FILE(JOLDELE) SHARE(*YES) /* Genera l'elenco totalizzato dei file da esaminare. */ /* Usa il tracciato di totale. */ /* Usa solo i file sorgente. */ /* Raggruppa e ordina per nome file. */ OPNQRYF FILE((QTEMP/JOLDELE)) FORMAT(JOLDELET) + QRYSLT('PHDTAT = "S"') KEYFLD((PHFILE)) + GRPFLD(PHFILE) /* Fotografa il file per maggiore chiarezza. */ CPYFRMQRYF FROMOPNID(JOLDELE) TOFILE(QTEMP/JOLDELET) + MBROPT(*REPLACE) CRTFILE(*YES) /* Chiude il file. */ CLOF OPNID(JOLDELE) /* Elimina i reindirizzamenti. */ DLTOVR FILE(*ALL) /* Elabora l'elenco totalizzato. */ /* Per ogni file, chiama l'esecuzione. */ OVRDBF FILE(JOLDELET) TOFILE(QTEMP/JOLDELET) READBEG: RCVF MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(READEND)) CHGVAR VAR(&SRCF) VALUE(&PHFILE) CALL PGM(JOLD1) PARM(&SRCF &OLD &NEW &DELTA) GOTO CMDLBL(READBEG) READEND: /* Elimina i reindirizzamenti. */ DLTOVR FILE(*ALL) /* Emette messaggio di fine felice. */ SNDPGMMSG MSG('Comparate le liste membri del file' + *BCAT &SRCFP *BCAT 'tra libreria vecchia' + *BCAT &OLD *BCAT 'e nuova' *BCAT &NEW + *BCAT 'generando file delta old in' *BCAT + &DELTA) GOTO CMDLBL(FINE) ERRORE: /* Emette messaggio di fallimento. */ SNDPGMMSG MSG('Fallita la comparazione delle liste + membri del file' *BCAT &SRCFP *BCAT 'tra + libreria vecchia' *BCAT &OLD *BCAT 'e + nuova' *BCAT &NEW *BCAT 'generando file + delta old in' *BCAT &DELTA) GOTO CMDLBL(FINE) FINE: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLDELET) FILETYPE(*SRC) ENDCHAR('//ENDSRC') cn00 * Claudio Neroni Creato 08-11-2007. A R JOLDELETR A TEXT('Delta old. Elenco file') A PHFILE 10 A COLHDG('File') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Delta old. ProcessFile */ /* Claudio Neroni 06/11/2007 Creato. */ /* */ /* Elabora un file. */ /* */ /* Riceve File sorgente, */ /* Libreria del file sorgente vecchio, */ /* Libreria del file sorgente nuovo, */ /* Libreria del file sorgente delta di emissione. */ PGM PARM(&SRCF &OLD &NEW &DELTA) /* File sorgente. */ DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente vecchio. */ DCL VAR(&OLD) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente nuovo. */ DCL VAR(&NEW) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente delta di emissione. */ DCL VAR(&DELTA) TYPE(*CHAR) LEN(10) /* Testo libreria delta. */ DCL VAR(&TEXTLIB) TYPE(*CHAR) LEN(50) /* Testo file delta. */ DCL VAR(&TEXTFILE) TYPE(*CHAR) LEN(50) /* Non esiste file vecchio. */ DCL VAR(&NOOLD) TYPE(*LGL) /* Non esiste file nuovo. */ DCL VAR(&NONEW) TYPE(*LGL) /* Tipo dati. */ DCL VAR(&DTATYPE) TYPE(*CHAR) LEN(1) /* Lunghezza record old. */ DCL VAR(&LENOLD) TYPE(*DEC) LEN(5 0) /* Lunghezza record new. */ DCL VAR(&LENNEW) TYPE(*DEC) LEN(5 0) /* Lunghezza record. */ DCL VAR(&LEN) TYPE(*DEC) LEN(5 0) /* Se i nomi delle librerie sono uguali, errore. */ IF COND((&OLD *EQ &NEW) *OR (&OLD *EQ &DELTA) + *OR (&NEW *EQ &DELTA)) THEN(DO) SNDPGMMSG MSG('I nomi delle librerie devono essere + tutti diversi') GOTO CMDLBL(FINE) ENDDO /* Controlla l'esistenza della libreria vecchia. */ CHKOBJ OBJ(&OLD) OBJTYPE(*LIB) /* Se la libreria vecchia non esiste, errore. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) SNDPGMMSG MSG('La libreria vecchia' *BCAT &OLD *BCAT + 'non esiste') GOTO CMDLBL(FINE) ENDDO /* Controlla l'esistenza della libreria nuova. */ CHKOBJ OBJ(&NEW) OBJTYPE(*LIB) /* Se la libreria nuova non esiste, errore. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) SNDPGMMSG MSG('La libreria nuova' *BCAT &NEW *BCAT + 'non esiste') GOTO CMDLBL(FINE) ENDDO /* Controlla l'esistenza del File vecchio. */ CHKOBJ OBJ(&OLD/&SRCF) OBJTYPE(*FILE) MONMSG MSGID(CPF0000 MCH0000) EXEC(CHGVAR + VAR(&NOOLD) VALUE('1')) /* Controlla l'esistenza del File nuovo. */ CHKOBJ OBJ(&NEW/&SRCF) OBJTYPE(*FILE) MONMSG MSGID(CPF0000 MCH0000) EXEC(CHGVAR + VAR(&NONEW) VALUE('1')) /* Se entrambi i file non esistono, errore. */ IF COND(&NOOLD *AND &NONEW) THEN(DO) SNDPGMMSG MSG('Il file' *BCAT &SRCF *BCAT 'non esiste + né nella libreria vecchia' *BCAT &OLD + *BCAT 'né nella nuova' *BCAT &NEW) GOTO CMDLBL(FINE) ENDDO /* Se esiste il file vecchio. */ IF COND(*NOT &NOOLD) THEN(DO) /* Scarica l'elenco membri. */ DSPFD FILE(&OLD/&SRCF) TYPE(*MBR) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JOLDOLD) /* Legge l'elenco scaricato alla ricerca del tipo dati. */ OVRDBF FILE(QAFDMBR) TOFILE(JOLDOLD) CALL PGM(JOLD6) PARM(&DTATYPE &LENOLD) DLTOVR FILE(*ALL) /* Se il tipo dati non è source, errore. */ IF COND(&DTATYPE *NE S) THEN(DO) SNDPGMMSG MSG('Il file' *BCAT &OLD *TCAT '/' *TCAT + &SRCF *BCAT 'non è sorgente') GOTO CMDLBL(FINE) ENDDO /* Se esiste il file vecchio. */ ENDDO /* Se non esiste il file vecchio, scarica un elenco membri vuoto. */ ELSE CMD(DO) DSPFD FILE(&NEW/&SRCF) TYPE(*MBR) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JOLDOLD) CLRPFM FILE(QTEMP/JOLDOLD) ENDDO /* Se esiste il file nuovo. */ IF COND(*NOT &NONEW) THEN(DO) /* Scarica l'elenco membri. */ DSPFD FILE(&NEW/&SRCF) TYPE(*MBR) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JOLDNEW) /* Legge l'elenco scaricato alla ricerca del tipo dati. */ OVRDBF FILE(QAFDMBR) TOFILE(JOLDNEW) CALL PGM(JOLD6) PARM(&DTATYPE &LENNEW) DLTOVR FILE(*ALL) /* Se il tipo dati non è source, errore. */ IF COND(&DTATYPE *NE S) THEN(DO) SNDPGMMSG MSG('Il file' *BCAT &NEW *TCAT '/' *TCAT + &SRCF *BCAT 'non è sorgente') GOTO CMDLBL(FINE) ENDDO /* Se esiste il file nuovo. */ ENDDO /* Se non esiste il file nuovo, scarica un elenco membri vuoto. */ ELSE CMD(DO) DSPFD FILE(&OLD/&SRCF) TYPE(*MBR) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JOLDNEW) CLRPFM FILE(QTEMP/JOLDNEW) ENDDO /* Compone il testo della libreria delta. */ CHGVAR VAR(&TEXTLIB) VALUE('DeltaOld:' *BCAT &OLD + *BCAT '-' *BCAT &NEW) /* Compone il testo del file delta. */ CHGVAR VAR(&TEXTFILE) VALUE('DeltaOld:' *BCAT &OLD + *BCAT '-' *BCAT &NEW) /* Se esiste il file nuovo ne annota la lunghezza. */ /* Altrimenti annota quella del vecchio. */ IF COND(*NOT &NONEW) THEN(CHGVAR VAR(&LEN) + VALUE(&LENNEW)) ELSE CMD(CHGVAR VAR(&LEN) VALUE(&LENOLD)) /* Controlla l'esistenza della libreria del File delta. */ CHKOBJ OBJ(&DELTA) OBJTYPE(*LIB) /* Se la libreria delta non esiste, la crea. */ MONMSG MSGID(CPF0000) EXEC(DO) CRTLIB LIB(&DELTA) TYPE(*TEST) TEXT(&TEXTLIB) ENDDO /* Controlla l'esistenza del File delta. */ CHKOBJ OBJ(&DELTA/&SRCF) OBJTYPE(*FILE) /* Se il file delta non esiste, lo crea. */ MONMSG MSGID(CPF0000) EXEC(DO) CRTSRCPF FILE(&DELTA/&SRCF) RCDLEN(&LEN) + TEXT(&TEXTFILE) SIZE(*NOMAX) ENDDO /* Reindirizza e ordina l'elenco membri vecchi. */ OVRDBF FILE(JOLDOLD) SHARE(*YES) OPNQRYF FILE((QTEMP/JOLDOLD)) KEYFLD((MBNAME)) /* Reindirizza e ordina l'elenco membri nuovi. */ OVRDBF FILE(JOLDNEW) SHARE(*YES) OPNQRYF FILE((QTEMP/JOLDNEW)) KEYFLD((MBNAME)) /* Elabora i due elenchi per ricavare i delta. */ CALL PGM(JOLD2) PARM(&SRCF &OLD &NEW &DELTA) /* Chiude gli elenchi. */ CLOF OPNID(JOLDOLD) CLOF OPNID(JOLDNEW) /* Elimina i reindirizzamenti. */ DLTOVR FILE(*ALL) /* Emette messaggio di fine felice. */ SNDPGMMSG MSG('Comparate le liste membri del file' + *BCAT &SRCF *BCAT 'tra libreria vecchia' + *BCAT &OLD *BCAT 'e nuova' *BCAT &NEW + *BCAT 'generando file delta old in' *BCAT + &DELTA) GOTO CMDLBL(FINE) ERRORE: /* Emette messaggio di fallimento. */ SNDPGMMSG MSG('Fallita la comparazione delle liste + membri del file' *BCAT &SRCF *BCAT 'tra + libreria vecchia' *BCAT &OLD *BCAT 'e + nuova' *BCAT &NEW *BCAT 'generando file + delta old in' *BCAT &DELTA) GOTO CMDLBL(FINE) FINE: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') Fjoldold ip ae disk rename(QWHFDMBR:old) prefix(old) Fjoldnew is ae disk rename(QWHFDMBR:new) prefix(new) Iold 01 I oldmbname l1m1 Inew 02 I newmbname l1m1 C *entry plist C parm ppsrcf 10 C parm ppold 10 C parm ppnew 10 C parm ppdelta 10 C if *in01 and not *inmr C exsr oldnmr C endif C if *in02 and not *inmr C exsr newnmr C endif Cl1 mr exsr mr *------------------------------------------------------------------------- C oldnmr begsr C if oldmbname<>*blank C call 'JOLD3' C parm 'OLDNMR' qqopz 10 C parm oldmbname qqmbr 10 C parm ppsrcf qqsrcf 10 C parm ppold qqold 10 C parm ppnew qqnew 10 C parm ppdelta qqdelta 10 C endif C endsr *------------------------------------------------------------------------- C newnmr begsr C if newmbname<>*blank C call 'JOLD3' C parm 'NEWNMR' qqopz 10 C parm newmbname qqmbr 10 C parm ppsrcf qqsrcf 10 C parm ppold qqold 10 C parm ppnew qqnew 10 C parm ppdelta qqdelta 10 C endif C endsr *------------------------------------------------------------------------- C mr begsr C if newmbname<>*blank C if oldmbupdd<>newmbupdd C or oldmbupdt<>newmbupdt C call 'JOLD3' C parm 'MR' qqopz 10 C parm newmbname qqmbr 10 C parm ppsrcf qqsrcf 10 C parm ppold qqold 10 C parm ppnew qqnew 10 C parm ppdelta qqdelta 10 C endif C endif C endsr *------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD3) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Delta old. ChoOpt */ /* Claudio Neroni 06/11/2007 Creato. */ /* Sceglie quale esecuzione per l'opzione. */ /* */ /* Riceve Opzione, */ /* Membro, */ /* File sorgente, */ /* Libreria del file sorgente vecchio, */ /* Libreria del file sorgente nuovo, */ /* Libreria del file sorgente delta di emissione. */ PGM PARM(&OPT &MBR &SRCF &OLD &NEW &DELTA) /* Opzione. */ DCL VAR(&OPT) TYPE(*CHAR) LEN(10) /* Membro. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* File sorgente. */ DCL VAR(&SRCF) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente vecchio. */ DCL VAR(&OLD) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente nuovo. */ DCL VAR(&NEW) TYPE(*CHAR) LEN(10) /* Libreria del file sorgente delta di emissione. */ DCL VAR(&DELTA) TYPE(*CHAR) LEN(10) /* Esegue opzione OLD NO MR */ /* Esiste solo membro vecchio. */ IF COND(&OPT *EQ OLDNMR) THEN(DO) CALL PGM(JOLD4) PARM(DLT &MBR &SRCF &OLD &DELTA) ENDDO /* Esegue opzione NEW NO MR */ /* Esiste solo membro nuovo. */ IF COND(&OPT *EQ NEWNMR) THEN(DO) ENDDO /* Esegue opzione MR */ /* Esistono membro vecchio e nuovo con tempo modifica diverso. */ IF COND(&OPT *EQ MR) THEN(DO) CALL PGM(JOLD4) PARM(CHG &MBR &SRCF &OLD &DELTA) ENDDO ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD4) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Delta old. ExeOpt */ /* 09-02-2007 Creato. */ /* Riceve Opzione, */ /* Nome membro in produzione, */ /* Nome file in produzione, */ /* Nome libreria in produzione, */ /* Nome libreria di salvataggio. */ PGM PARM(&OPT3 &PRDMBR &PRDFIL &PRDLIB &SAVLIB) /* Opzione di 3 caratteri (NEW=New CHG=Changed DLT=Deleted). */ DCL VAR(&OPT3) TYPE(*CHAR) LEN(3) /* Nome membro in produzione. */ DCL VAR(&PRDMBR) TYPE(*CHAR) LEN(10) /* Nome file in produzione. */ DCL VAR(&PRDFIL) TYPE(*CHAR) LEN(10) /* Nome libreria in produzione. */ DCL VAR(&PRDLIB) TYPE(*CHAR) LEN(10) /* Nome libreria di salvataggio. */ DCL VAR(&SAVLIB) TYPE(*CHAR) LEN(10) /* Numero progressivo di salvataggio. */ DCL VAR(&NBR) TYPE(*DEC) LEN(9) DCL VAR(&NBRA) TYPE(*CHAR) LEN(9) /* Nome membro di salvataggio. */ DCL VAR(&SAVMBR) TYPE(*CHAR) LEN(10) /* Testo del membro di salvataggio. */ DCL VAR(&SAVTXT) TYPE(*CHAR) LEN(50) /* Anno, Mese, Giorno, Ora, Minuto. */ DCL VAR(&Y) TYPE(*CHAR) LEN(2) DCL VAR(&M) TYPE(*CHAR) LEN(2) DCL VAR(&D) TYPE(*CHAR) LEN(2) DCL VAR(&H) TYPE(*CHAR) LEN(2) DCL VAR(&P) TYPE(*CHAR) LEN(2) /* Testo del membro in produzione. */ DCL VAR(&PRDTXT) TYPE(*CHAR) LEN(50) /* Data di modifica del membro in produzione. */ DCL VAR(&PRDCHGDAT) TYPE(*CHAR) LEN(13) /* Data di creazione del membro in produzione. */ DCL VAR(&PRDCRTDAT) TYPE(*CHAR) LEN(13) /* Tipo seu del membro in produzione. */ DCL VAR(&PRDSRCTYPE) TYPE(*CHAR) LEN(10) /* Numero di record del membro in produzione. */ DCL VAR(&PRDNBRRCD) TYPE(*DEC) LEN(10) /* Intercetta tutti gli errori saltando ad errore. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Recupera Anno, Mese, Giorno, Ora, Minuto. */ RTVSYSVAL SYSVAL(QYEAR) RTNVAR(&Y) RTVSYSVAL SYSVAL(QMONTH) RTNVAR(&M) RTVSYSVAL SYSVAL(QDAY) RTNVAR(&D) RTVSYSVAL SYSVAL(QHOUR) RTNVAR(&H) RTVSYSVAL SYSVAL(QMINUTE) RTNVAR(&P) /* Se librerie uguali, errore. */ IF COND(&PRDLIB *EQ &SAVLIB) THEN(DO) SNDPGMMSG MSG('Prod e Sav library devono essere + diverse.') GOTO CMDLBL(FINE) ENDDO /* Recupera gli attributi del membro datore. */ RTVMBRD FILE(&PRDLIB/&PRDFIL) MBR(&PRDMBR) + SRCTYPE(&PRDSRCTYPE) SRCCHGDATE(&PRDCHGDAT) + CRTDATE(&PRDCRTDAT) TEXT(&PRDTXT) + NBRCURRCD(&PRDNBRRCD) /* Se manca la libreria di salvataggio, la crea. */ CHKOBJ OBJ(&SAVLIB) OBJTYPE(*LIB) MONMSG MSGID(CPF0000) EXEC(DO) CRTLIB LIB(&SAVLIB) TEXT('Sorgenti salvati.') ENDDO /* Se manca l'area dati del numeratore dei salvataggi, la crea. */ CHKOBJ OBJ(&SAVLIB/JOLDNBR) OBJTYPE(*DTAARA) MONMSG MSGID(CPF0000) EXEC(DO) CRTDTAARA DTAARA(&SAVLIB/JOLDNBR) TYPE(*DEC) LEN(9 + 0) VALUE(0) TEXT('Numeratore delle copie + di salvataggio.') ENDDO /* Preleva un progressivo di salvataggio. */ RTVDTAARA DTAARA(&SAVLIB/JOLDNBR) RTNVAR(&NBR) CHGVAR VAR(&NBR) VALUE(&NBR + 1) CHGDTAARA DTAARA(&SAVLIB/JOLDNBR) VALUE(&NBR) /* Compone il nome del membro di salvataggio. */ CHGVAR VAR(&NBRA) VALUE(&NBR) CHGVAR VAR(&SAVMBR) VALUE(S *CAT &NBRA) /* Compone un testo da inserire nel membro salvato. */ CHGVAR VAR(&SAVTXT) VALUE(&PRDMBR *CAT ' ' *CAT + &opt3 *CAT ' ' *CAT &Y *CAT '-' *CAT &M + *CAT '-' *CAT &D *CAT ' ' *CAT &H *CAT + ':' *CAT &P *CAT ' ' *CAT &PRDLIB) /* Se il membro contiene record. */ IF COND(&PRDNBRRCD *GT 0) THEN(DO) /* Copia il membro nel file di salvataggio, un solo record. */ /* Serve a creare il membro. */ CPYF FROMFILE(&PRDLIB/&PRDFIL) + TOFILE(&SAVLIB/&PRDFIL) FROMMBR(&PRDMBR) + TOMBR(&SAVMBR) MBROPT(*REPLACE) + NBRRCDS(1) FMTOPT(*MAP) /* Se il membro contiene record. */ ENDDO /* Se il membro non contiene record. */ ELSE CMD(DO) /* Aggiunge il membro nel file di salvataggio. */ ADDPFM FILE(&SAVLIB/&PRDFIL) MBR(&SAVMBR) + TEXT(&PRDTXT) SRCTYPE(&PRDSRCTYPE) /* Se il membro non contiene record. */ ENDDO /* Pulisce il membro nel file di salvataggio. */ CLRPFM FILE(&SAVLIB/&PRDFIL) MBR(&SAVMBR) /* Aggiunge i record di servizio contenenti informazioni sul datore. */ OVRDBF FILE(JOLDS) TOFILE(&SAVLIB/&PRDFIL) + MBR(&SAVMBR) CALL PGM(JOLD5) PARM(&PRDTXT &SAVTXT &PRDCRTDAT + &PRDCHGDAT) DLTOVR FILE(JOLDS) /* Se il membro contiene record. */ /* Copia il membro nel file di salvataggio. */ IF COND(&PRDNBRRCD *GT 0) THEN(DO) CPYF FROMFILE(&PRDLIB/&PRDFIL) + TOFILE(&SAVLIB/&PRDFIL) FROMMBR(&PRDMBR) + TOMBR(&SAVMBR) MBROPT(*ADD) FMTOPT(*MAP) ENDDO /* Modifica il testo del membro di salvataggio. */ CHGPFM FILE(&SAVLIB/&PRDFIL) MBR(&SAVMBR) + TEXT(&SAVTXT) /* Messaggio di fine felice. */ SNDPGMMSG MSG('Salvato sorgente' *BCAT &PRDMBR) GOTO CMDLBL(FINE) ERRORE: /* Messaggio di fallimento. */ SNDPGMMSG MSG('Salvataggio sorgente' *BCAT &PRDMBR + *BCAT 'fallito.') GOTO CMDLBL(FINE) FINE: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD5) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Delta old. InsInfo * Claudio Neroni 27-03-2007. Creato * Inserisce record di informazioni prelevate dal membro originale * in testa al membro salvato. *------------------------------------------------------------------------- Fjolds o a f 92 disk C *entry plist C parm txt1 50 C parm txt2 50 C parm crtdat 13 C parm chgdat 13 C move(p) crtdat crtdatx 14 0 C move(p) chgdat chgdatx 14 0 C clear crtdatz 19 C clear chgdatz 19 C if crtdatx<>*zero C eval crtdatx=crtdatx+19000000000000 C endif C if chgdatx<>*zero C eval chgdatx=chgdatx+19000000000000 C endif C eval crtdatz=%editw(crtdatx: C ' - - & : : ') C eval chgdatz=%editw(chgdatx: C ' - - & : : ') C except rcd C seton lr Ojolds eadd rcd O '000001' O UYEAR O UMONTH O UDAY O '/******* ' O txt1 O ' *************/' O eadd rcd O '000002' O UYEAR O UMONTH O UDAY O '/******* ' O txt2 O ' *************/' O eadd rcd O '000003' O UYEAR O UMONTH O UDAY O '/******* ' O 'CrtDat: ' O crtdatz O ' ChgDat: ' O chgdatz O ' *******/' //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JOLD6) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Delta old. ReadDtaType * Claudio Neroni 07-11-2007. Creato * Legge un elenco membri di Display File Description * e restituisce il primo flag di tipo dati che incontra. *------------------------------------------------------------------------- * Scarico di DSPFD TYPE(*MBR) FQAFDMBR ip e disk *------------------------------------------------------------------------- * Scambia parametri. C *entry plist * Restituisce Tipo dati D=Dati S=Source C parm ppdtat 1 * Restituisce Massima lunghezza record. C parm ppmxrl 5 0 * Pulisce i parametri di ritorno. C clear ppdtat C clear ppmxrl * Trascrive le caratteristiche trovate sul primo record. C movel(p) mbdtat ppdtat C z-add mbmxrl ppmxrl * Chiude. C seton lr *------------------------------------------------------------------------- //ENDSRC //ENDBCHJOB