//BCHJOB JOB(JCLSR) 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: 2014-06-26 13:57 */ /* To File : "JCLSR" */ /* To Library : "NERONI2" */ /* To Text : "CL Subroutine. 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 "JCLSR.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:\JCLSR.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JCLSR.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(JCLSR) 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/JCLSR" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JCLSR) MBR(JCLSR.) 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/JCLSR) CRTSRCPF FILE(NERONI2/JCLSR) RCDLEN(112) + TEXT('CL Subroutine. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLSRALLI) TOFILE(NERONI2/JCLSR) + TOMBR(JCLSRALLI) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLSR) MBR(JCLSRALLI) + SRCTYPE(CLLE) + TEXT('Sample ALLINEA') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLSRALLI2) TOFILE(NERONI2/JCLSR) + TOMBR(JCLSRALLI2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLSR) MBR(JCLSRALLI2) + SRCTYPE(CLLE) + TEXT('Sample ALLINEA variante2') /*---------------------------------------------------------------------*/ //DATA FILE(JCLSRALLI) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 05-06-2014. Creato. */ /* Sample ALLINEA. */ /* Allinea a sinistra il contenuto numerico di un campo alfanumerico */ /* fino a 20 caratteri con segno "-" a sinistra sopprimendo gli zeri */ /* non significativi. */ PGM PARM(&FILE) /* Nome del File. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Numero di record nel file. */ DCL VAR(&NCR) TYPE(*DEC) LEN(10 0) /* Comodo per subroutine ALLINEA. */ DCL VAR(&ALLI) TYPE(*CHAR) LEN(20) DCL VAR(&ALLIS) TYPE(*CHAR) LEN(1) /* Segnala in joblog il numero di record nel file. */ RTVMBRD FILE(&FILE) NBRCURRCD(&NCR) CHGVAR VAR(&ALLI) VALUE(&NCR) CALLSUBR SUBR(ALLINEA) SNDPGMMSG MSG('Nel file' *BCAT &FILE *BCAT 'ci sono' + *BCAT &ALLI *BCAT 'record.') RETURN /*---------------------------------------------------------------------*/ /* Subroutine ALLINEA. */ SUBR SUBR(ALLINEA) /* Allinea a sinistra il contenuto numerico di un campo alfanumerico */ /* fino a 20 caratteri con segno "-" a sinistra sopprimendo gli zeri */ /* non significativi. */ CHGVAR VAR(&ALLIS) VALUE(%SST(&ALLI 1 1)) IF COND(&ALLIS = '-') THEN(CHGVAR + VAR(%SST(&ALLI 1 1)) VALUE('0')) DOWHILE COND('1') IF COND(%SST(&ALLI 1 1) *NE '0' *OR %SST(&ALLI + 2 1) *EQ ' ') THEN(LEAVE) CHGVAR VAR(&ALLI) VALUE(%SST(&ALLI 2 19)) ENDDO IF COND(&ALLIS = '-') THEN(CHGVAR VAR(&ALLI) + VALUE(&ALLIS *TCAT &ALLI)) ENDSUBR /*---------------------------------------------------------------------*/ ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLSRALLI2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 05-06-2014. Creato. */ /* Sample ALLINEA variante2. */ /* Allinea a sinistra il contenuto numerico di un campo alfanumerico */ /* fino a 20 caratteri con segno "-" a sinistra sopprimendo gli zeri */ /* non significativi. */ PGM PARM(&FILE) /* Nome del File. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Numero di record nel file. */ DCL VAR(&NCR) TYPE(*DEC) LEN(10 0) /* Comodo per subroutine ALLINEA. */ DCL VAR(&ALLI) TYPE(*CHAR) LEN(20) /* Segnala in joblog il numero di record nel file. */ RTVMBRD FILE(&FILE) NBRCURRCD(&NCR) CHGVAR VAR(&ALLI) VALUE(&NCR) CALLSUBR SUBR(ALLINEA) SNDPGMMSG MSG('Nel file' *BCAT &FILE *BCAT 'ci sono' + *BCAT &ALLI *BCAT 'record.') RETURN /*---------------------------------------------------------------------*/ /* Subroutine ALLINEA. */ SUBR SUBR(ALLINEA) /* Allinea a sinistra il contenuto numerico di un campo alfanumerico */ /* fino a 20 caratteri con segno "-" a sinistra sopprimendo gli zeri */ /* non significativi. */ IF COND(%SST(&ALLI 1 1) *NE '-') THEN(DO) DOWHILE COND('1') IF COND(%SST(&ALLI 1 1) *NE '0' *OR %SST(&ALLI + 2 1) *EQ ' ') THEN(LEAVE) CHGVAR VAR(&ALLI) VALUE(%SST(&ALLI 2 19)) ENDDO ENDDO ELSE CMD(DO) DOWHILE COND('1') IF COND(%SST(&ALLI 2 1) *NE '0' *OR %SST(&ALLI + 3 1) *EQ ' ') THEN(LEAVE) CHGVAR VAR(%SST(&ALLI 2 19)) VALUE(%SST(&ALLI 3 18)) ENDDO ENDDO ENDSUBR /*---------------------------------------------------------------------*/ ENDPGM //ENDSRC //ENDBCHJOB