//BCHJOB JOB(JZONL) 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-12-15 16:24 */ /* To File : "JZONL" */ /* To Library : "NERONI2" */ /* To Text : "Library Zoner. 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 "JZONL.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:\JZONL.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JZONL.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(JZONL) 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/JZONL" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JZONL) MBR(JZONL.) 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/JZONL) CRTSRCPF FILE(NERONI2/JZONL) RCDLEN(112) + TEXT('Library Zoner. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JZONL) TOFILE(NERONI2/JZONL) + TOMBR(JZONL) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JZONL) MBR(JZONL) + SRCTYPE(CMD) + TEXT('Library Zoner. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JZONL.) TOFILE(NERONI2/JZONL) + TOMBR(JZONL.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JZONL) MBR(JZONL.) + SRCTYPE(CL) + TEXT('Library Zoner. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JZONLTRAX) TOFILE(NERONI2/JZONL) + TOMBR(JZONLTRAX) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JZONL) MBR(JZONLTRAX) + SRCTYPE(PF) + TEXT('Library Zoner. FileFieldDesc') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JZONLTRAXF) TOFILE(NERONI2/JZONL) + TOMBR(JZONLTRAXF) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JZONL) MBR(JZONLTRAXF) + SRCTYPE(PF) + TEXT('Library Zoner. FileFieldDescFlat') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JZONL1) TOFILE(NERONI2/JZONL) + TOMBR(JZONL1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JZONL) MBR(JZONL1) + SRCTYPE(CLLE) + TEXT('Library Zoner. Cpp') /*---------------------------------------------------------------------*/ //DATA FILE(JZONL) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CMD PROMPT('Library Zoner') PARM KWD(FROMLIB) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('Libreria originale') PARM KWD(TODIR) TYPE(*PNAME) LEN(256) + DFT('/home/JZONL') PROMPT('To Directory') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JZONL.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JZONL.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 21/07/2008 Creato. */ /* JZONL */ /* Library Zoner. */ /* Crea un duplicato della libreria ricevuta dove i file */ /* hanno tutti i campi numerici zonati. */ /* Prerequisiti: JZONF, JTOCSV */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JZONL) DLTPGM PGM(NERONI2/JZONL1) DLTF FILE(NERONI2/JZONLTRAX) DLTF FILE(NERONI2/JZONLTRAXF) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/JZONLTRAX) SRCFILE(JZONL) SIZE(*NOMAX) CRTPF FILE(NERONI2/JZONLTRAXF) SRCFILE(JZONL) SIZE(*NOMAX) CRTBNDCL PGM(NERONI2/JZONL1) SRCFILE(JZONL) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JZONL) PGM(JZONL1) SRCFILE(JZONL) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JZONLTRAX) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Claudio Neroni 23-07-2008 Creato. * File di emissione di DSPFFD. A REF(QADSPFFD) A R TRAC A WHLIB R A WHFILE R A WHNAME R A WHFLDI R A WHFLDT R A WHFLDB R A WHFLDD R A WHFLDP R A WHFOBO R A WHFTXT R A WHCHD1 R A WHCHD2 R A WHCHD3 R //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JZONLTRAXF) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * Claudio Neroni 23-07-2008 Creato. * File di emissione di DSPFFD piatto. A R TRACFLAT A TRACFLD 165 //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JZONL1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Library Zoner. Cpp */ /* Roberto Ponti 21/07/2008 Creato. */ /* */ PGM PARM(&LIB &TODIR) /* Riceve libreria originale. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Riceve Nome indirizzario di destinazione. */ DCL VAR(&TODIR) TYPE(*CHAR) LEN(256) /* Libreria disimpaccata. */ DCL VAR(&$LIB) TYPE(*CHAR) LEN(10) /* Indirizzario equivalente alla libreria. */ DCL VAR(&LIB9) TYPE(*CHAR) LEN(10) /* Indirizzario libreria. */ DCL VAR(&DIR) TYPE(*CHAR) LEN(256) /* Indirizzari ifs. */ DCL VAR(&IFS0) TYPE(*CHAR) LEN(256) DCL VAR(&IFS1) TYPE(*CHAR) LEN(256) DCL VAR(&IFS2) TYPE(*CHAR) LEN(256) DCL VAR(&IFS3) TYPE(*CHAR) LEN(256) DCL VAR(&IFS4) TYPE(*CHAR) LEN(256) /* Testo. */ DCL VAR(&TEXT) TYPE(*CHAR) LEN(50) /* File precedente. */ DCL VAR(&MBFILEOLD) TYPE(*CHAR) LEN(10) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Prenotazione di esito parzialmente negativo. */ DCL VAR(&PARZIALE) TYPE(*LGL) VALUE('0') /* Elenco membri. */ DCLF FILE(QAFDMBR) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Segnala avanzamento. */ SNDPGMMSG MSG('Inizio libreria:' *BCAT &LIB) /* Segnala avanzamento. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Inizio + libreria:' *BCAT &LIB) TOPGMQ(*EXT) + MSGTYPE(*STATUS) /* Controlla l'esistenza della libreria originale. */ RTVOBJD OBJ(&LIB) OBJTYPE(*LIB) TEXT(&TEXT) /* Compone il nome dell'indirizzario equivalente alla libreria. */ CHGVAR VAR(&LIB9) VALUE(%SST(&LIB 1 9)) /* Compone il nome della libreria disimpaccata. */ CHGVAR VAR(&$LIB) VALUE('$' *TCAT %SST(&LIB 1 9)) /* Crea libreria disimpaccata. */ CHKOBJ OBJ(&$LIB) OBJTYPE(*LIB) MONMSG MSGID(CPF0000) EXEC(DO) CHGVAR VAR(&DIR) VALUE('/qsys.lib/' *TCAT &$LIB + *TCAT '.lib') MKDIR DIR(&DIR) CHGLIB LIB(&$LIB) TEXT(&TEXT) ENDDO /* Cancella gli eventuali file di lavoro precedenti. */ DLTF FILE(QTEMP/JZONL*) MONMSG MSGID(CPF0000 MCH0000) /* Compone i nomi degli indirizzari. */ CHGVAR VAR(&IFS0) VALUE(&TODIR) CHGVAR VAR(&IFS1) VALUE(&IFS0 *TCAT '/' *TCAT &LIB9) CHGVAR VAR(&IFS2) VALUE(&IFS1 *TCAT '/*') /* Cancella gli eventuali file di lavoro precedenti. */ MKDIR DIR(&IFS0) MONMSG MSGID(CPF0000 MCH0000) RMVLNK OBJLNK(&IFS2) MONMSG MSGID(CPF0000 MCH0000) RMVDIR DIR(&IFS1) MONMSG MSGID(CPF0000 MCH0000) MKDIR DIR(&IFS1) MONMSG MSGID(CPF0000 MCH0000) /* Scarica il Display File Description */ /* di tutti i membri della libreria. */ DSPFD FILE(&LIB/*ALL) TYPE(*MBR) OUTPUT(*OUTFILE) + FILEATR(*PF) OUTFILE(QTEMP/JZONLMBR) /* In assenza di file, abbandona. */ MONMSG MSGID(CPF3000) EXEC(GOTO CMDLBL(READEND)) /* Reindirizza l'elenco dei membri. */ OVRDBF FILE(QAFDMBR) TOFILE(QTEMP/JZONLMBR) + SHARE(*YES) /* Inizio lettura elenco membri. */ READBEG: /* Legge un nome di membro dall'elenco. */ RCVF /* Se non ce ne sono altri, abbandona. */ MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(READEND)) /* Se il file č senza membri, ricicla. */ IF COND(&MBNAME *EQ ' ') THEN(GOTO + CMDLBL(READBEG)) /* Se il file non č dati, ricicla. */ IF COND(&MBDTAT *NE 'D') THEN(GOTO + CMDLBL(READBEG)) /* Se il membro č vuoto, ricicla. */ IF COND(&MBNRCD *EQ 0) THEN(GOTO CMDLBL(READBEG)) /* Se il file corrente č diverso dal precedente, crea il disimpaccato. */ IF COND(&MBFILE *NE &MBFILEOLD) THEN(DO) JZONF FILE(&LIB/&MBFILE) OUTLIB(&$LIB) MONMSG MSGID(CPF0000 MCH0000) EXEC(DO) SNDPGMMSG MSG('File non trascritto (NEGATIVO):' *BCAT + &LIB *TCAT '/' *TCAT &MBFILE) CHGVAR VAR(&PARZIALE) VALUE('1') GOTO CMDLBL(READBEG) ENDDO CHGVAR VAR(&MBFILEOLD) VALUE(&MBFILE) ENDDO /* Copia i dati dal file originale al disimpaccato. */ ADDPFM FILE(&$LIB/&MBFILE) MBR(&MBNAME) TEXT(&MBMTXT) OVRDBF FILE(INPUT) TOFILE(&LIB/&MBFILE) + MBR(&MBNAME) NBRRCDS(1000) OVRDBF FILE(OUTPUT) TOFILE(&$LIB/&MBFILE) MBR(&MBNAME) CPYF FROMFILE(INPUT) TOFILE(OUTPUT) + MBROPT(*REPLACE) FMTOPT(*MAP *DROP) DLTOVR FILE(INPUT) DLTOVR FILE(OUTPUT) /* Copia i dati nel file piatto. */ CPYF FROMFILE(&$LIB/&MBFILE) + TOFILE(QTEMP/JZONFFLAT) FROMMBR(&MBNAME) + MBROPT(*REPLACE) FMTOPT(*NOCHK) /* Compone il nome del file su ifs e pc per i dati del membro. */ CHGVAR VAR(&IFS3) VALUE(&MBFILE) IF COND(&MBFILE *NE &MBNAME) THEN(CHGVAR + VAR(&IFS3) VALUE(&IFS3 *TCAT '-' *TCAT + &MBNAME)) CHGVAR VAR(&IFS3) VALUE(&IFS3 *TCAT '.txt') /* Riunisce indirizzario e nome file ifs. */ CHGVAR VAR(&IFS4) VALUE(&IFS1 *TCAT '/' *TCAT &IFS3) /* Copia i dati dal file piatto all'IFS. */ CPYTOIMPF FROMFILE(QTEMP/JZONFFLAT) TOSTMF(&IFS4) + MBROPT(*REPLACE) STMFCODPAG(*PCASCII) + RCDDLM(*CRLF) DTAFMT(*FIXED) STRDLM(*NONE) /* Fornisce autoritā pubblica sul file scaricato. */ CHGAUT OBJ(&IFS4) USER(*PUBLIC) DTAAUT(*RWX) + OBJAUT(*ALL) /* Ricicla. */ GOTO CMDLBL(READBEG) /* Fine lettura elenco membri. */ READEND: /* Duplica nella libreria il contenitore dei tracciati. */ DLTF FILE(&$LIB/JZONLTRAC) MONMSG MSGID(CPF0000 MCH0000) CPYF FROMFILE(JZONLTRAX) TOFILE(&$LIB/JZONLTRAC) + MBROPT(*REPLACE) CRTFILE(*YES) MONMSG MSGID(CPF0000 MCH0000) /* Duplica nella libreria il contenitore piatto dei tracciati. */ DLTF FILE(QTEMP/JZONLTRACF) MONMSG MSGID(CPF0000 MCH0000) CPYF FROMFILE(JZONLTRAXF) + TOFILE(QTEMP/JZONLTRACF) MBROPT(*REPLACE) + CRTFILE(*YES) MONMSG MSGID(CPF0000 MCH0000) /* Scarica i tracciati disimpaccati in libreria temporanea. */ DSPFFD FILE(&$LIB/*ALL) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JZONLFFD) /* Copia i tracciati nel contenitore. */ CPYF FROMFILE(QTEMP/JZONLFFD) + TOFILE(&$LIB/JZONLTRAC) MBROPT(*REPLACE) + FMTOPT(*MAP *DROP) /* Copia i tracciati nel contenitore piatto. */ CPYF FROMFILE(&$LIB/JZONLTRAC) + TOFILE(QTEMP/JZONLTRACF) MBROPT(*REPLACE) + FMTOPT(*NOCHK) /* Compone il nome del file su ifs e pc per i tracciati. */ CHGVAR VAR(&IFS3) VALUE('JZONLTRAC.txt') /* Riunisce indirizzario e nome file ifs. */ CHGVAR VAR(&IFS4) VALUE(&IFS1 *TCAT '/' *TCAT &IFS3) /* Copia i dati dal file all'IFS. */ CPYTOIMPF FROMFILE(QTEMP/JZONLTRACF) TOSTMF(&IFS4) + MBROPT(*REPLACE) STMFCODPAG(*PCASCII) + RCDDLM(*CRLF) DTAFMT(*FIXED) STRDLM(*NONE) /* Fornisce autoritā pubblica sul file scaricato. */ CHGAUT OBJ(&IFS4) USER(*PUBLIC) DTAAUT(*RWX) + OBJAUT(*ALL) /* Copia i tracciati nell'IFS anche in formato csv. */ JTOCSV FROMFILE(&$LIB/JZONLTRAC) TOCSV(JZONLTRAC) + TODIR(&IFS1) /* Messaggia esito positivo. */ IF COND(&PARZIALE) THEN(DO) SNDPGMMSG MSG('JZONL Esito parzialmente NEGATIVO per + la libreria' *BCAT &LIB) ENDDO ELSE CMD(DO) SNDPGMMSG MSG('JZONL Esito positivo per la libreria' + *BCAT &LIB) ENDDO /* Salta all'esecuzione delle attivitā finali. */ GOTO CMDLBL(RCLRSC) /* Label di esecuzione delle attivitā finali. */ RCLRSC: /* Cancella i file di lavoro. */ /* ... */ /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JZONL) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Messaggia esito negativo. */ SNDPGMMSG MSG('JZONL Esito NEGATIVO per la libreria' + *BCAT &LIB) MONMSG MSGID(CPF0000 MCH0000) /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG RMV(*NO) 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 //ENDBCHJOB