//BCHJOB JOB(JLODTXT) 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: 2009-01-16 14:58 */ /* To File : "JLODTXT" */ /* To Library : "NERONI2" */ /* To Text : "Load Text. 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 "JLODTXT.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:\JLODTXT.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JLODTXT.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(JLODTXT) 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/JLODTXT" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JLODTXT) MBR(JLODTXT.) 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/JLODTXT) CRTSRCPF FILE(NERONI2/JLODTXT) RCDLEN(112) + TEXT('Load Text. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JLODTXT) TOFILE(NERONI2/JLODTXT) + TOMBR(JLODTXT) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JLODTXT) MBR(JLODTXT) + SRCTYPE(CMD) + TEXT('Load Text. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JLODTXT.) TOFILE(NERONI2/JLODTXT) + TOMBR(JLODTXT.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JLODTXT) MBR(JLODTXT.) + SRCTYPE(CL) + TEXT('Load Text. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JLODTXTC) TOFILE(NERONI2/JLODTXT) + TOMBR(JLODTXTC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JLODTXT) MBR(JLODTXTC) + SRCTYPE(CLLE) + TEXT('Load Text. Cpp') /*---------------------------------------------------------------------*/ //DATA FILE(JLODTXT) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 15-01-2009 Creato. */ CMD PROMPT('Load Text') PARM KWD(DIR) TYPE(*PNAME) LEN(256) + SPCVAL(('/home/neroni')) MIN(1) + PROMPT('Directory') PARM KWD(GEN) TYPE(*CHAR) LEN(256) + SPCVAL(('*.tx2')) MIN(1) PROMPT('Generic + File Name') PARM KWD(RQSNBR) TYPE(*DEC) LEN(9 0) DFT(10) + PROMPT('Request File Number') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JLODTXT.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JLODTXT.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 15-01-2009 Creato. */ /* JLODTXT */ /* Load Text. */ /* Prerequisiti: nessuno */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JLODTXT) DLTPGM PGM(NERONI2/JLODTXTC) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JLODTXTC) SRCFILE(JLODTXT) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JLODTXT) PGM(JLODTXTC) SRCFILE(JLODTXT) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JLODTXTC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 15-01-2009 Creato. */ /* Load Text. */ PGM PARM(&DIR &GEN &RQN) /* Riceve Indirizzario IFS da esaminare. */ DCL VAR(&DIR) TYPE(*CHAR) LEN(256) /* Riceve Espressione di scelta dei file nell'indirizzario. */ DCL VAR(&GEN) TYPE(*CHAR) LEN(256) /* Riceve Numero richiesto di file. */ DCL VAR(&RQN) TYPE(*DEC) LEN(9 0) DCL VAR(&RQNA) TYPE(*CHAR) LEN(9) /* Numero di file esistenti in indirizzario. */ DCL VAR(&EXN10) TYPE(*DEC) LEN(10 0) DCL VAR(&EXN) TYPE(*DEC) LEN(9 0) DCL VAR(&EXNA) TYPE(*CHAR) LEN(9) /* Contatore. */ DCL VAR(&CN1) TYPE(*DEC) LEN(9 0) DCL VAR(&CN1A) TYPE(*CHAR) LEN(9) /* File option. */ DCL VAR(&FILEOPT) TYPE(*CHAR) LEN(10) + VALUE(*REPLACE) /* Comodi per Indirizzo completo dei file da elaborare in vari comandi.*/ DCL VAR(&OBJ) TYPE(*CHAR) LEN(512) DCL VAR(&NEWOBJ) TYPE(*CHAR) LEN(512) /* Comodi per subroutine ALLINEA. */ DCL VAR(&ALLINEA) TYPE(*CHAR) LEN(9) /* Elenco dei file IFS individuati tramite i parametri. */ DCLF FILE(JLINK1) /* Compone l'indirizzo. */ CHGVAR VAR(&OBJ) VALUE(&DIR *TCAT '/' *TCAT &GEN) /* Riempie l'elenco dei file. */ JLINK FROMDIR(&OBJ) /* Recupera il numero di record nel file. */ RTVMBRD FILE(QTEMP/JLINKT) NBRCURRCD(&EXN10) /* Se numero esistente diverso da numero richiesto. */ IF COND(&EXN10 *NE &RQN) THEN(DO) /* Allinea a sinistra i numeri da esporre nel messaggio. */ CHGVAR VAR(&EXN) VALUE(&EXN10) CHGVAR VAR(&ALLINEA) VALUE(&EXN) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&EXNA) VALUE(&ALLINEA) CHGVAR VAR(&ALLINEA) VALUE(&RQN) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&RQNA) VALUE(&ALLINEA) /* Emette messaggio informativo. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Nr file + richiesto' *BCAT &RQNA *BCAT 'diverso da + nr presente' *BCAT &EXNA) /* Abbandona. */ GOTO CMDLBL(FINE) /* Se numero esistente diverso da numero richiesto. */ ENDDO /* Indirizza la lettura dell'elenco. */ OVRDBF FILE(JLINK1) TOFILE(QTEMP/JLINKT) /* Inizio Lettura. */ READBEG: /* Legge il nome di un file IFS. */ RCVF /* Se non ce ne sono altri, abbandona. */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(READEND)) /* Messaggia stato avanzamento. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&FILNAM) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Copia il file da IFS a database. */ JFROMTXT PROTOFILE(JFROMTXTG) TOFILE(JLODTXTDTA) + FROMFILE(&FILNAM) FROMEXT('') + FROMDIR(&DIR) FILEOPT(&FILEOPT) /* Messaggia avanzamento. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&FILNAM) /* Compone il nome completo del file IFS. */ CHGVAR VAR(&OBJ) VALUE(&DIR *TCAT '/' *TCAT &FILNAM) /* Compone il nome nuovo per il file IFS. */ CHGVAR VAR(&NEWOBJ) VALUE(&FILNEX *TCAT '.' *TCAT + &FILEXT *TCAT $) /* Rinomina il file IFS elabborato. */ REN OBJ(&OBJ) NEWOBJ(&NEWOBJ) /* Incrementa il contatore dei file elaborati. */ CHGVAR VAR(&CN1) VALUE(&CN1 + 1) /* Se corre il primo file, modifica da *REPLACE a *ADD. */ IF COND(&CN1 *EQ 1) THEN(CHGVAR VAR(&FILEOPT) + VALUE(*ADD)) /* Ricicla. */ GOTO CMDLBL(READBEG) /* Fine Lettura. */ READEND: /* Allinea a sinistra i numeri da esporre nel messaggio. */ CHGVAR VAR(&ALLINEA) VALUE(&CN1) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&CN1A) VALUE(&ALLINEA) /* Emette messaggio informativo. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) + MSGDTA('Elaborati' *BCAT &CN1A *BCAT 'file.') /* Fine. */ FINE: IF COND(1 = 1) /* Subroutine ALLINEA. */ /* Riceve in &ALLINEA la trascrizione alfa di un numero di 9 cifre. */ /* Restituisce nello stesso campo il numero allineato a sinistra */ /* e privato degli zeri non significativi. */ SUBR SUBR(ALLINEA) ALL1: IF COND((%SST(&ALLINEA 1 1) *EQ '0') *AND + (%SST(&ALLINEA 2 1) *NE ' ')) THEN(DO) CHGVAR VAR(&ALLINEA) VALUE(%SST(&ALLINEA 2 8)) GOTO CMDLBL(ALL1) ENDDO ENDSUBR /* Fine programma. */ ENDPGM //ENDSRC //ENDBCHJOB