//BCHJOB JOB(JFREF) 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-19 13:09 */ /* To File : "JFREF" */ /* To Library : "NERONI2" */ /* To Text : "Free file. 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 "JFREF.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:\JFREF.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JFREF.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(JFREF) 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/JFREF" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JFREF) MBR(JFREF.) 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/JFREF) CRTSRCPF FILE(NERONI2/JFREF) RCDLEN(112) + TEXT('Free file. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFREF) TOFILE(NERONI2/JFREF) + TOMBR(JFREF) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFREF) MBR(JFREF) + SRCTYPE(CMD) + TEXT('Free file. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFREF.) TOFILE(NERONI2/JFREF) + TOMBR(JFREF.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFREF) MBR(JFREF.) + SRCTYPE(CL) + TEXT('Free file. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFREFC) TOFILE(NERONI2/JFREF) + TOMBR(JFREFC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFREF) MBR(JFREFC) + SRCTYPE(CLLE) + TEXT('Free file. Cpp') /*---------------------------------------------------------------------*/ //DATA FILE(JFREF) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Free file. Cmd */ /* Claudio Neroni 10-04-1997 Creato. */ /* Libera file. */ CMD PROMPT('Free file') PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('File to + free') FILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) + (*CURLIB)) PROMPT('library') PARM KWD(MSG) TYPE(*CHAR) LEN(256) EXPR(*YES) + PROMPT('Message text') PARM KWD(TOMSGQ) TYPE(TOMSGQ) DFT(*NONE) + SNGVAL((*NONE) (*SYSOPR)) PROMPT('To + message queue') TOMSGQ: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) + (*CURLIB)) PROMPT('library') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFREF.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JFREF.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 10-04-1997 Creato. */ /* JFREF */ /* Free file. */ /* Prerequisiti: JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JFREF) DLTPGM PGM(NERONI2/JFREFC) DLTF FILE(NERONI2/JFREF1) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/JFREF1) RCDLEN(133) TEXT('Free file. WrkFile') + RECOVER(*NO) SIZE(*NOMAX) CRTBNDCL PGM(NERONI2/JFREFC) SRCFILE(JFREF) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JFREF) PGM(JFREFC) SRCFILE(JFREF) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFREFC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Free file. Cpp */ /* Claudio Neroni 10-04-1997 Creato. */ /* Libera file. */ /* Informa gli interattivi che allocano un oggetto */ /* che l'utente corrente necessita della risorsa. */ /* */ PGM PARM(&FILEQ &MSG &TOMSGQQ) /* Riceve File da liberare qualificato. */ DCL VAR(&FILEQ) TYPE(*CHAR) LEN(20) /* Riceve Testo del messaggio. */ DCL VAR(&MSG) TYPE(*CHAR) LEN(256) /* Riceve Coda messaggi qualificata. */ DCL VAR(&TOMSGQQ) TYPE(*CHAR) LEN(20) /* Libreria del file da liberare. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* File da liberare. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Coda da messaggiare. */ DCL VAR(&TOMSGQ) TYPE(*CHAR) LEN(10) /* Libreria della Coda da messaggiare. */ DCL VAR(&TOMSGQLIB) TYPE(*CHAR) LEN(10) /* Testo del messaggio all'operatore. */ DCL VAR(&MSG2) TYPE(*CHAR) LEN(256) /* Ricevitore della stampa dei lavori occupanti. */ DCLF FILE(JFREF1) /* Identificazione del lavoro corrente. */ DCL VAR(&JOB) TYPE(*CHAR) LEN(10) DCL VAR(&USER) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) /* Tipo vincolo estratto dalla riga di stampa. */ DCL VAR(&LOCK) TYPE(*CHAR) LEN(7) /* Identificazione del lavoro bloccante. */ DCL VAR(&LCKJOB) TYPE(*CHAR) LEN(10) DCL VAR(&LCKUSR) TYPE(*CHAR) LEN(10) DCL VAR(&LCKNBR) TYPE(*CHAR) LEN(6) /* Numero di file esplorati nel run. */ DCL VAR(&NBR) TYPE(*DEC) LEN(7 0) /* Numero di file esplorati nel run. Alfa. */ DCL VAR(&NBRA) TYPE(*CHAR) LEN(8) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILEQ 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILEQ 11 10)) /* Estrae parametri. */ CHGVAR VAR(&TOMSGQ) VALUE(%SST(&TOMSGQQ 1 10)) CHGVAR VAR(&TOMSGQLIB) VALUE(%SST(&TOMSGQQ 11 10)) /* Se richiesta coda a cui messaggiare, ne controlla esistenza. */ IF COND((&TOMSGQ *NE *NONE) *AND (&TOMSGQ *NE + *SYSOPR)) THEN(DO) CHKOBJ OBJ(&TOMSGQLIB/&TOMSGQ) OBJTYPE(*MSGQ) ENDDO /* Se richiesta lista librerie, recupera libreria. */ IF COND((&LIB *EQ *LIBL) *OR (&LIB *EQ + *CURLIB)) THEN(DO) RTVOBJD OBJ(&LIB/&FILE) OBJTYPE(*FILE) RTNLIB(&LIB) ENDDO /* Emette un messaggio di stato di avanzamento lavoro. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Sto + chiedendo liberazione file' *BCAT &LIB + *TCAT '/' *CAT &FILE *TCAT '.') + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Recupera gli attributi del lavoro corrente. */ RTVJOBA JOB(&JOB) USER(&USER) NBR(&JOBNBR) /* Cancella il file di lavoro. */ DLTF FILE(QTEMP/JFREF1) MONMSG MSGID(CPF0000 MCH0000) /* Crea il file di lavoro. */ CRTPF FILE(QTEMP/JFREF1) RCDLEN(133) TEXT('Free + file. WorkFile') RECOVER(*NO) SIZE(*NOMAX) /* Ridirige la stampa dell'occupazione file. */ OVRPRTF FILE(QPDSPOLK) FORMTYPE(JFREF1) + SCHEDULE(*JOBEND) HOLD(*YES) /* Genera la stampa dell'occupazione file. */ WRKOBJLCK OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(*ALL) + OUTPUT(*PRINT) /* Copia la stampa nel file di comodo. */ CPYSPLF FILE(QPDSPOLK) TOFILE(QTEMP/JFREF1) + SPLNBR(*LAST) CTLCHAR(*FCFC) /* Cancella la stampa. */ DLTSPLF FILE(QPDSPOLK) SPLNBR(*LAST) /* Ridirige la lettura sul file di comodo. */ OVRDBF FILE(JFREF1) TOFILE(QTEMP/JFREF1) SECURE(*YES) /* Lettura del file. */ READ: /* Legge un record. */ RCVF /* Se non ci sono altri record, salta a Fine lettura del file. */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(READEND)) /* Estrae il tipo vincolo dalla riga di stampa. */ CHGVAR VAR(&LOCK) VALUE(%SST(&JFREF1 47 7)) /* Se il tipo vincolo č tale da identificare il record corrente */ /* non come riga dati, ma come riga di contorno della stampa. */ IF COND((&LOCK *NE MBR) *AND (&LOCK *NE DATA)) + THEN(DO) /* Salta a Lettura del file. */ GOTO CMDLBL(READ) /* End. */ ENDDO /* Estrae l'identificazione del lavoro bloccante dalla riga di stampa. */ CHGVAR VAR(&LCKJOB) VALUE(%SST(&JFREF1 16 10)) CHGVAR VAR(&LCKUSR) VALUE(%SST(&JFREF1 27 10)) CHGVAR VAR(&LCKNBR) VALUE(%SST(&JFREF1 38 6)) /* Se il nome del lavoro occupante č in bianco. */ IF COND(&LCKJOB *EQ ' ') THEN(DO) /* Salta a Lettura del file. */ GOTO CMDLBL(READ) /* End. */ ENDDO /* Conta il lavoro esaminato. */ CHGVAR VAR(&NBR) VALUE(&NBR + 1) /* Messaggia l'occupante. */ IF COND(&MSG *EQ ' ') THEN(CHGVAR VAR(&MSG) + VALUE('Libera urgentemente il file ' + *BCAT &LIB *TCAT '/' *TCAT &FILE)) SNDBRKMSG MSG(&MSG) TOMSGQ(&LCKJOB) MONMSG MSGID(CPF0000 MCH0000) /* Se richiesta coda a cui messaggiare, messaggia. */ IF COND(&TOMSGQ *NE *NONE) THEN(DO) CHGVAR VAR(&MSG2) VALUE('Il lavoro' *BCAT &JOBNBR + *TCAT '/' *TCAT &USER *TCAT '/' *TCAT + &JOB *BCAT 'chiede la liberazione urgente + del file' *BCAT &LIB *TCAT '/' *TCAT + &FILE *BCAT 'dal lavoro' *BCAT &LCKNBR + *TCAT '/' *TCAT &LCKUSR *TCAT '/' *TCAT + &LCKJOB) IF COND(&TOMSGQ *EQ *SYSOPR) THEN(DO) SNDMSG MSG(&MSG2) TOMSGQ(*SYSOPR) MONMSG MSGID(CPF0000 MCH0000) ENDDO ELSE CMD(DO) SNDMSG MSG(&MSG2) TOMSGQ(&TOMSGQLIB/&TOMSGQ) MONMSG MSGID(CPF0000 MCH0000) ENDDO ENDDO /* Salta a Lettura del file. */ GOTO CMDLBL(READ) /* Fine lettura del file. */ READEND: /* Salta all'esecuzione delle attivitā finali. */ GOTO CMDLBL(RCLRSC) /* Label di esecuzione delle attivitā finali. */ RCLRSC: /* Cancella i file di lavoro. */ DLTF FILE(QTEMP/JFREF1) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Pulisce il messaggio di stato. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) TOPGMQ(*EXT) + MSGTYPE(*STATUS) MONMSG MSGID(CPF0000 MCH0000) /* Trascrive numero lavori esaminati in alfanumerico. */ CHGVAR VAR(&NBRA) VALUE(&NBR) /* Allinea a sinistra il contenuto del campo numero lavori esaminati */ /* alfanumerico eliminando gli zeri non significativi. */ ALLINEA: IF COND(%SST(&NBRA 1 1) *EQ '0' *AND %SST(&NBRA + 2 1) *NE ' ') THEN(DO) CHGVAR VAR(&NBRA) VALUE(%SST(&NBRA 2 7)) GOTO CMDLBL(ALLINEA) /* End. */ ENDDO /* Segnala il numero di lavori esaminati. */ SNDPGMMSG MSG('Esaminati' *BCAT &NBRA *BCAT 'lavori.') + MSGTYPE(*COMP) MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JFREF) + 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 //ENDBCHJOB