//BCHJOB JOB(JCLRRPG) 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:56 */ /* To File : "JCLRRPG" */ /* To Library : "NERONI2" */ /* To Text : "Clear RPG source. 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 "JCLRRPG.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:\JCLRRPG.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JCLRRPG.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(JCLRRPG) 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/JCLRRPG" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JCLRRPG) MBR(JCLRRPG.) 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/JCLRRPG) CRTSRCPF FILE(NERONI2/JCLRRPG) RCDLEN(112) + TEXT('Clear RPG source. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(BUTTA) TOFILE(NERONI2/JCLRRPG) + TOMBR(BUTTA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(BUTTA) + SRCTYPE(RPGLE) + TEXT('Clear RPG source. UpdRpg') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPG) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPG) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPG) + SRCTYPE(CMD) + TEXT('Clear RPG source. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPG.) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPG.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPG.) + SRCTYPE(CL) + TEXT('Clear RPG source. Cjs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPGC) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPGC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPGC) + SRCTYPE(CLLE) + TEXT('Clear RPG source. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPGCNN) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPGCNN) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPGCNN) + SRCTYPE(CLLE) + TEXT('Clear RPG source. Cpp con PF e LF') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPGD) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPGD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPGD) + SRCTYPE(RPGLE) + TEXT('Clear RPG source. UpdRpg') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPGE) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPGE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPGE) + SRCTYPE(RPGLE) + TEXT('Clear RPG source. UpdRpgle') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRRPGP) TOFILE(NERONI2/JCLRRPG) + TOMBR(JCLRRPGP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRRPG) MBR(JCLRRPGP) + SRCTYPE(PNLGRP) + TEXT('Clear RPG source. Help') /*---------------------------------------------------------------------*/ //DATA FILE(BUTTA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Clear RPG source. UpdRpg * Claudio Neroni 07/05/1985 Creato. * Pulisce source RPG da numeri e nome pgm. *--------------------------------------------------------------------- * File source. FJclrrpg uf f 95 disk *--------------------------------------------------------------------- * Caratteri permessi. D cp s 1 dim(11) ctdata perrcd(11) * Spezza i primi cinque caratteri. D nbr5 ds D sn 1 5 dim(5) *--------------------------------------------------------------------- * Record source. IJclrrpg no * Inizio tabelle. I 13 15 int * Numero 5. I 13 17 nbr5 * Numero 1. I 13 13 nbr1 * Specifica più asterisco. I 18 19 spcast * Specifica. I 18 18 spc * Nome. I 87 92 nam * External. I 93 95 ext *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve richiesta Forzatura 5 caratteri. C parm force5 5 * Riceve richiesta Forzatura 1 carattere. C parm force1 1 * Riceve richiesta Pulizia nome. C parm clrnam 5 * Riceve richiesta Pulizia sesta colonna commenti. C parm clrcmt 4 * Predispone il termine del programma. C seton lr * Si posiziona all'inizio del file. C 1 setll Jclrrpg * Elabora il file. C do *hival * Legge il prossimo record. C read Jclrrpg 50 * Se non ci sono altri record, salta a fine file. C 50 leave * Se corre inizio tabelle, rilascia e abbandona. C int ifeq '** ' C unlock Jclrrpg C leave C endif * Esamina il numero5 (i primi cinque caratteri). C do * Assume non sbiancamento del numero. C setoff 71 * Se il numero contiene solo blank, abbandona. C if nbr5=*blank C leave C endif * Se la forzatura5 è valorizzata * e se il numero5 è uguale alla forzatura5, * oppure * se la forzatura1 è valorizzata * e se il numero1 è uguale alla forzatura1, * prenota lo sbiancamento del numero5 e abbandona. C if (force5<>*blank and nbr5=force5) C or (force1<>*blank and nbr1=force1) C seton 71 C leave C endif * Se nel numero5 è presente un carattere * diverso da blank e cifra, abbandona. C do 5 x 5 0 C sn(x) lookup cp 50 C n50 leave C enddo C n50 leave * Prenota lo sbiancamento del numero5. C seton 71 * Esamina il numero5. C enddo * Esamina il nome (gli ultimi sei caratteri). C do * Assume non sbiancamento del nome. C setoff 72 * Se non è richiesta la pulizia del nome, abbandona. C if clrnam<>'*YES' C and clrnam<>'*YES4' C and clrnam<>'*EXT' C leave C endif * Se il nome contiene solo blank, abbandona. C if (clrnam='*YES' and nam =*blank) C or (clrnam='*YES4' and nam =*blank) C or (clrnam='*EXT' and ext =*blank) C leave C endif * Prenota lo sbiancamento del nome. C clrnam comp '*YES' 72 C n72clrnam comp '*YES4' 72 C clrnam comp '*EXT' 76 * Esamina il nome. C enddo * Esamina la specifica più asterisco. C do * Assume non sbiancamento della specifica. C setoff 75 * Se non è richiesta la pulizia della specifica, abbandona. C if clrcmt='*NO' C leave C endif * Se la richiesta di pulizia della specifica è uguale a *ALL * e se specifica più commento è diversa da tutti i valori * possibili nella richiesta, * abbandona. C if clrcmt='*ALL' C and spcast<>'H*' C and spcast<>'F*' C and spcast<>'E*' C and spcast<>'D*' C and spcast<>'I*' C and spcast<>'C*' C and spcast<>'O*' C leave C endif * Se la richiesta di pulizia della specifica è diversa da *ALL * e se specifica più commento è diversa dalla richiesta, * abbandona. C if clrcmt<>'*ALL' C and spcast<>clrcmt C leave C endif * Prenota lo sbiancamento della specifica. C seton 75 * Esamina la specifica più asterisco. C enddo * Se è prenotato uno sbiancamento. C if *in71 or *in72 or *in75 or *in76 * Se è prenotato lo sbiancamento dei primi cinque caratteri, * li sbianca. C 71 clear nbr5 * Se è prenotato lo sbiancamento degli ultimi sei caratteri, * li sbianca. C 72 clear nam * Se è prenotato lo sbiancamento della specifica sul commento, * la sbianca. C 75 clear spc * Se è prenotato lo sbiancamento del campo etichetta esterno, * lo pulisce. C 76 clear ext * Ricalca il record. C except $upd * Se non è prenotato uno sbiancamento. C else * Rilascia il record. C unlock Jclrrpg * Se non è prenotato uno sbiancamento. C endif * Elabora il file. C enddo * Ritorna. C return *--------------------------------------------------------------------- OJclrrpg E $upd O 71 nbr5 17 O 75 spc 18 O 72 nam 92 O 76 ext 95 *--------------------------------------------------------------------- ** ! Caratteri cancellabili nelle prime cinque posizioni. 0123456789! //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPG) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Clear RPG source. Cmd */ /* Claudio Neroni 08/05/1985 Creato. */ /* Pulisce source RPG da numeri e nome pgm. */ CMD PROMPT('Clear RPG source') PARM KWD(SRCFILE) TYPE(SRCFILE) MIN(1) + PROMPT('Source file') SRCFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('library') PARM KWD(SRCMBR) TYPE(*NAME) MIN(1) + PROMPT('Source member') PARM KWD(CLEAR5) TYPE(*CHAR) LEN(5) + PROMPT('String5 to clear First5') PARM KWD(CLEAR1) TYPE(*CHAR) LEN(1) + PROMPT('String1 to clear First5') PARM KWD(CLEARLAST) TYPE(*CHAR) LEN(5) RSTD(*YES) + DFT(*EXT) VALUES(*EXT *END *END4 *NO) + PROMPT('Clear last positions') PARM KWD(CLEARCMT) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES(*NO *ALL H* F* E* D* I* + C* O*) PROMPT('Clear 6th col on comments') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPG.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JCLRRPG.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 08/05/1985 Creato. */ /* JCLRRPG */ /* Clear RPG source. */ /* Prerequisiti: JAI, JCV, JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JCLRRPG) DLTPNLGRP PNLGRP(NERONI2/JCLRRPGP) DLTPGM PGM(NERONI2/JCLRRPGC) DLTPGM PGM(NERONI2/JCLRRPGD) DLTPGM PGM(NERONI2/JCLRRPGE) DLTMSGF MSGF(NERONI2/JCLRRPG) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JCLRRPGC) SRCFILE(JCLRRPG) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JCLRRPGD) SRCFILE(JCLRRPG) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JCLRRPGE) SRCFILE(JCLRRPG) DBGVIEW(*ALL) CRTPNLGRP PNLGRP(NERONI2/JCLRRPGP) SRCFILE(JCLRRPG) CRTCMD CMD(NERONI2/JCLRRPG) PGM(JCLRRPGC) SRCFILE(JCLRRPG) + MSGF(JCLRRPG) HLPPNLGRP(JCLRRPGP) HLPID(CMD) PRDLIB(NERONI2) CRTMSGF MSGF(NERONI2/JCLRRPG) TEXT('Clear RPG source. Msgf') /* Messaggi del Cpp. */ ADDMSGD MSGID(JCR0001) MSGF(NERONI2/JCLRRPG) MSG('Il file &2/&1 non + è di tipo source.') SECLVL('Il file &1 nella libreria + &2 contente il membro &3 non è un file source.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JCR0002) MSGF(NERONI2/JCLRRPG) MSG('Il membro &3 del + file &2/&1 è di tipo seu &4, diverso da RPG.') + SECLVL('Il membro &3 del file &1 nella libreria &2 ha + un tipo seu &4, diverso da RPG - RPG38 - RPGLE, + supportati dalla funzione richiesta.') FMT((*CHAR 10) + (*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JCR0003) MSGF(NERONI2/JCLRRPG) MSG('Il membro &3 del + file &2/&1 è vuoto.') SECLVL('Il membro &3 del file &1 + nella libreria &2 non contiene record. Perciò + l''attività richiesta su di esso non ha significato.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JCR0004) MSGF(NERONI2/JCLRRPG) MSG('Lunghezza record + insufficiente nel file &2/&1.') SECLVL('Il file &1 + nella libreria &2 è di lunghezza record &3, + insufficiente per contenere un tipo source &4.') + FMT((*CHAR 10) (*CHAR 10) (*DEC 5 0) (*CHAR 10)) ADDMSGD MSGID(JCR0009) MSGF(NERONI2/JCLRRPG) MSG('Il membro &3 del + file &2/&1 seu &4 è stato pulito.') SECLVL('Il membro + &3 del file &1 nella libreria &2 con tipo seu &4 è + stato pulito dalla numerazione specifiche. Se corre + RPG o RPG38 e se richiesto CLEARNAME(*YES), sono stati + puliti anche i 6 caratteri del nome programma. Se + corre RPGLE, che non prevede il nome del programma, + sono stati puliti gli ultimi 3 caratteri del commento + a fine riga per CLEARLAST(*YES) o gli ultimi 4 per + CLEARLAST(*YES4).') FMT((*CHAR 10) (*CHAR 10) (*CHAR + 10) (*CHAR 10)) /* Messaggi del Cmd. */ /* NESSUNO */ //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPGC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Clear RPG source. Cpp */ /* Claudio Neroni 08/05/1985 Creato. */ /* Pulisce source RPG da numeri e nome pgm. */ /* Claudio Neroni 14/10/1998 Modificato. */ /* Gestito anche RPG ILE. */ PGM PARM(&FILELIB &MBR &FORCE5 &FORCE1 &CLRNAME + &CLRCMT) /* File source qualificato. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Membro source da pulire. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Stringa da cancellare in modo forzato da campo numeri. */ DCL VAR(&FORCE5) TYPE(*CHAR) LEN(5) /* Byte iniziale che provoca la pulizia di tutto il campo numeri. */ DCL VAR(&FORCE1) TYPE(*CHAR) LEN(1) /* Pulisce il nome programma. */ DCL VAR(&CLRNAME) TYPE(*CHAR) LEN(5) /* Pulisce la sesta colonna dei commenti. */ DCL VAR(&CLRCMT) TYPE(*CHAR) LEN(4) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Tipo di seu. */ DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) /* Tipo di file. */ DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) /* Lunghezza record del File. */ DCL VAR(&MRL) TYPE(*DEC) LEN(5 0) DCL VAR(&MRLA) TYPE(*CHAR) LEN(5) /* Numero di record nel Membro. */ DCL VAR(&NR) TYPE(*DEC) LEN(10 0) /* 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(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Recupera le caratteristiche del File. */ JRTVFD FILE(&FILE) LIB(&LIB) MAXRCDLEN(&MRL) /* Controlla l'esistenza e recupera le caratteristiche */ /* del Membro da pulire. */ RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) + FILETYPE(&FILETYPE) SRCTYPE(&SRCTYPE) + NBRCURRCD(&NR) /* Se il file non è di tipo source, messaggia e rilascia. */ IF COND(&FILETYPE *NE *SRC) THEN(DO) SNDPGMMSG MSGID(JCR0001) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il tipo seu non è RPG, messaggia e rilascia. */ IF COND((&SRCTYPE *NE RPG) *AND (&SRCTYPE *NE + RPG38) *AND (&SRCTYPE *NE RPGLE)) THEN(DO) SNDPGMMSG MSGID(JCR0002) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR *CAT &SRCTYPE) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il Membro è vuoto, messaggia e rilascia. */ IF COND(&NR *EQ 0) THEN(DO) SNDPGMMSG MSGID(JCR0003) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se la Lunghezza del File non è sufficiente a contenere */ /* lo statement RPG, messaggia e rilascia. */ IF COND(((&SRCTYPE *EQ RPG *OR &SRCTYPE *EQ + RPG38) *AND (&MRL *LT 71)) *OR ((&SRCTYPE + *EQ RPGLE) *AND (&MRL *LT 92)) *OR + ((&SRCTYPE *EQ RPG *OR &SRCTYPE *EQ + RPG38) *AND (&CLRNAME *EQ *EXT) *AND + (&MRL *LT 95)) *OR ((&SRCTYPE *EQ RPGLE) + *AND (&CLRNAME *EQ *EXT) *AND (&MRL *LT + 115))) THEN(DO) CALL PGM(JCVPNPC) PARM(&MRL &MRLA 5) SNDPGMMSG MSGID(JCR0004) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MRLA *CAT &SRCTYPE) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Dealloca e alloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000) ALCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) WAIT(2) /* Ridirige la lettura sul Membro. */ OVRDBF FILE(JCLRRPG) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) /* Chiama la pulizia del source. */ IF COND((&SRCTYPE *EQ RPG) *OR (&SRCTYPE *EQ + RPG38)) THEN(DO) CALL PGM(JCLRRPGD) PARM(&FORCE5 &FORCE1 &CLRNAME + &CLRCMT) ENDDO IF COND(&SRCTYPE *EQ RPGLE) THEN(DO) CALL PGM(JCLRRPGE) PARM(&FORCE5 &FORCE1 &CLRNAME + &CLRCMT) ENDDO /* Manda messaggio di felice esecuzione. */ SNDPGMMSG MSGID(JCR0009) MSGF(JCLRRPG) MSGDTA(&FILELIB + *CAT &MBR *CAT &SRCTYPE) MSGTYPE(*COMP) /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JCLRRPG) + 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 /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPGCNN) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Clear RPG source. Cpp */ /* Claudio Neroni 08/05/1985 Creato. */ /* Pulisce source RPG da numeri e nome pgm. */ /* Claudio Neroni 14/10/1998 Modificato. */ /* Gestito anche RPG ILE. */ PGM PARM(&FILELIB &MBR &FORCE5 &FORCE1 &CLRNAME + &CLRCMT) /* File source qualificato. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Membro source da pulire. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Stringa da cancellare in modo forzato da campo numeri. */ DCL VAR(&FORCE5) TYPE(*CHAR) LEN(5) /* Byte iniziale che provoca la pulizia di tutto il campo numeri. */ DCL VAR(&FORCE1) TYPE(*CHAR) LEN(1) /* Pulisce il nome programma. */ DCL VAR(&CLRNAME) TYPE(*CHAR) LEN(5) /* Pulisce la sesta colonna dei commenti. */ DCL VAR(&CLRCMT) TYPE(*CHAR) LEN(4) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Tipo di seu. */ DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) /* Tipo di file. */ DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) /* Lunghezza record del File. */ DCL VAR(&MRL) TYPE(*DEC) LEN(5 0) DCL VAR(&MRLA) TYPE(*CHAR) LEN(5) /* Numero di record nel Membro. */ DCL VAR(&NR) TYPE(*DEC) LEN(10 0) /* 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(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Recupera le caratteristiche del File. */ JRTVFD FILE(&FILE) LIB(&LIB) MAXRCDLEN(&MRL) /* Controlla l'esistenza e recupera le caratteristiche */ /* del Membro da pulire. */ RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) + FILETYPE(&FILETYPE) SRCTYPE(&SRCTYPE) + NBRCURRCD(&NR) /* Se il file non è di tipo source, messaggia e rilascia. */ IF COND(&FILETYPE *NE *SRC) THEN(DO) SNDPGMMSG MSGID(JCR0001) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il tipo seu non è RPG, messaggia e rilascia. */ IF COND((&SRCTYPE *NE RPG) *AND (&SRCTYPE *NE + RPG38) *AND (&SRCTYPE *NE RPGLE) *AND + (&SRCTYPE *NE PF) *AND (&SRCTYPE *NE LF)) + THEN(DO) SNDPGMMSG MSGID(JCR0002) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR *CAT &SRCTYPE) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il Membro è vuoto, messaggia e rilascia. */ IF COND(&NR *EQ 0) THEN(DO) SNDPGMMSG MSGID(JCR0003) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se la Lunghezza del File non è sufficiente a contenere */ /* lo statement RPG, messaggia e rilascia. */ IF COND(((&SRCTYPE *EQ RPG *OR &SRCTYPE *EQ + RPG38) *AND (&MRL *LT 71)) *OR ((&SRCTYPE + *EQ RPGLE) *AND (&MRL *LT 92))) THEN(DO) CALL PGM(JCVPNPC) PARM(&MRL &MRLA 5) SNDPGMMSG MSGID(JCR0004) MSGF(JCLRRPG) MSGDTA(&FILE + *CAT &LIB *CAT &MRLA *CAT &SRCTYPE) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Dealloca e alloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000) ALCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) WAIT(2) /* Ridirige la lettura sul Membro. */ OVRDBF FILE(JCLRRPG) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) /* Chiama la pulizia del source. */ IF COND((&SRCTYPE *EQ RPG) *OR (&SRCTYPE *EQ + RPG38) *OR (&SRCTYPE *EQ PF) *OR + (&SRCTYPE *EQ LF)) THEN(DO) CALL PGM(JCLRRPGD) PARM(&FORCE5 &FORCE1 &CLRNAME + &CLRCMT) ENDDO IF COND(&SRCTYPE *EQ RPGLE) THEN(DO) CALL PGM(JCLRRPGE) PARM(&FORCE5 &FORCE1 &CLRNAME + &CLRCMT) ENDDO /* Manda messaggio di felice esecuzione. */ SNDPGMMSG MSGID(JCR0009) MSGF(JCLRRPG) MSGDTA(&FILELIB + *CAT &MBR *CAT &SRCTYPE) MSGTYPE(*COMP) /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JCLRRPG) + 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 /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPGD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Clear RPG source. UpdRpg * Claudio Neroni 07/05/1985 Creato. * Pulisce source RPG da numeri e nome pgm. *--------------------------------------------------------------------- * File source. FJclrrpg uf f 95 disk *--------------------------------------------------------------------- * Caratteri permessi. D cp s 1 dim(11) ctdata perrcd(11) * Spezza i primi cinque caratteri. D nbr5 ds D sn 1 5 dim(5) *--------------------------------------------------------------------- * Record source. IJclrrpg no * Inizio tabelle. I 13 15 int * Numero 5. I 13 17 nbr5 * Numero 1. I 13 13 nbr1 * Specifica più asterisco. I 18 19 spcast * Specifica. I 18 18 spc * Nome. I 87 92 nam * External. I 93 95 ext *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve richiesta Forzatura 5 caratteri. C parm force5 5 * Riceve richiesta Forzatura 1 carattere. C parm force1 1 * Riceve richiesta Pulizia nome. C parm clrnam 5 * Riceve richiesta Pulizia sesta colonna commenti. C parm clrcmt 4 * Predispone il termine del programma. C seton lr * Si posiziona all'inizio del file. C 1 setll Jclrrpg * Elabora il file. C do *hival * Legge il prossimo record. C read Jclrrpg 50 * Se non ci sono altri record, salta a fine file. C 50 leave * Se corre inizio tabelle, rilascia e abbandona. C int ifeq '** ' C unlock Jclrrpg C leave C endif * Esamina il numero5 (i primi cinque caratteri). C do * Assume non sbiancamento del numero. C setoff 71 * Se il numero contiene solo blank, abbandona. C if nbr5=*blank C leave C endif * Se la forzatura5 è valorizzata * e se il numero5 è uguale alla forzatura5, * oppure * se la forzatura1 è valorizzata * e se il numero1 è uguale alla forzatura1, * prenota lo sbiancamento del numero5 e abbandona. C if (force5<>*blank and nbr5=force5) C or (force1<>*blank and nbr1=force1) C seton 71 C leave C endif * Se nel numero5 è presente un carattere * diverso da blank e cifra, abbandona. C do 5 x 5 0 C sn(x) lookup cp 50 C n50 leave C enddo C n50 leave * Prenota lo sbiancamento del numero5. C seton 71 * Esamina il numero5. C enddo * Esamina il nome (gli ultimi sei caratteri). C do * Assume non sbiancamento del nome. C setoff 72 * Se non è richiesta la pulizia del nome, abbandona. C if clrnam<>'*END' C and clrnam<>'*END4' C and clrnam<>'*EXT' C leave C endif * Se il nome contiene solo blank, abbandona. C if (clrnam='*END' and nam =*blank) C or (clrnam='*END4' and nam =*blank) C or (clrnam='*EXT' and ext =*blank) C leave C endif * Prenota lo sbiancamento del nome. C clrnam comp '*END' 72 C n72clrnam comp '*END4' 72 C clrnam comp '*EXT' 76 * Esamina il nome. C enddo * Esamina la specifica più asterisco. C do * Assume non sbiancamento della specifica. C setoff 75 * Se non è richiesta la pulizia della specifica, abbandona. C if clrcmt='*NO' C leave C endif * Se la richiesta di pulizia della specifica è uguale a *ALL * e se specifica più commento è diversa da tutti i valori * possibili nella richiesta, * abbandona. C if clrcmt='*ALL' C and spcast<>'H*' C and spcast<>'F*' C and spcast<>'E*' C and spcast<>'D*' C and spcast<>'I*' C and spcast<>'C*' C and spcast<>'O*' C leave C endif * Se la richiesta di pulizia della specifica è diversa da *ALL * e se specifica più commento è diversa dalla richiesta, * abbandona. C if clrcmt<>'*ALL' C and spcast<>clrcmt C leave C endif * Prenota lo sbiancamento della specifica. C seton 75 * Esamina la specifica più asterisco. C enddo * Se è prenotato uno sbiancamento. C if *in71 or *in72 or *in75 or *in76 * Se è prenotato lo sbiancamento dei primi cinque caratteri, * li sbianca. C 71 clear nbr5 * Se è prenotato lo sbiancamento degli ultimi sei caratteri, * li sbianca. C 72 clear nam * Se è prenotato lo sbiancamento della specifica sul commento, * la sbianca. C 75 clear spc * Se è prenotato lo sbiancamento del campo etichetta esterno, * lo pulisce. C 76 clear ext * Ricalca il record. C except $upd * Se non è prenotato uno sbiancamento. C else * Rilascia il record. C unlock Jclrrpg * Se non è prenotato uno sbiancamento. C endif * Elabora il file. C enddo * Ritorna. C return *--------------------------------------------------------------------- OJclrrpg E $upd O 71 nbr5 17 O 75 spc 18 O 72 nam 92 O 76 ext 95 *--------------------------------------------------------------------- ** ! Caratteri cancellabili nelle prime cinque posizioni. 0123456789! //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPGE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Clear RPG source. UpdRpgle * Claudio Neroni 07/05/1985 Creato. * Pulisce source RPGLE da numeri e nome pgm. *--------------------------------------------------------------------- * File source. FJclrrpg uf f 115 disk *--------------------------------------------------------------------- * Caratteri permessi. D cp s 1 dim(11) ctdata perrcd(11) * Spezza i primi cinque caratteri. D nbr5 ds D sn 1 5 dim(5) *--------------------------------------------------------------------- * Upper case. D uc c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' * Lower case. D lc c 'abcdefghijklmnopqrstuvwxyz' *--------------------------------------------------------------------- * Record source. IJclrrpg no * Inizio tabelle. I 13 15 int * Numero 5. I 13 17 nbr5 * Numero 1. I 13 13 nbr1 * Specifica più asterisco. I 18 19 spcast * Specifica. I 18 18 spc * Nome 4. I 109 112 nam4 * Nome 3. I 110 112 nam3 * External. I 113 115 ext *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve richiesta Forzatura 5 caratteri. C parm force5 5 * Riceve richiesta Forzatura 1 carattere. C parm force1 1 * Riceve richiesta Pulizia nome. C parm clrnam 5 * Riceve richiesta Pulizia sesta colonna commenti. C parm clrcmt 4 * Predispone il termine del programma. C seton lr * Si posiziona all'inizio del file. C 1 setll Jclrrpg * Elabora il file. C do *hival * Legge il prossimo record. C read Jclrrpg 50 * Se non ci sono altri record, salta a fine file. C 50 leave * Se corre inizio tabelle, rilascia e abbandona. C int ifeq '** ' C unlock Jclrrpg C leave C endif * Esamina il numero5 (i primi cinque caratteri). C do * Assume non sbiancamento del numero. C setoff 71 * Se il numero contiene solo blank, abbandona. C if nbr5=*blank C leave C endif * Se la forzatura5 è valorizzata * e se il numero5 è uguale alla forzatura5, * oppure * se la forzatura1 è valorizzata * e se il numero1 è uguale alla forzatura1, * prenota lo sbiancamento del numero5 e abbandona. C if (force5<>*blank and nbr5=force5) C or (force1<>*blank and nbr1=force1) C seton 71 C leave C endif * Se nel numero5 è presente un carattere * diverso da blank e cifra, abbandona. C do 5 x 5 0 C sn(x) lookup cp 50 C n50 leave C enddo C n50 leave * Prenota lo sbiancamento del numero5. C seton 71 * Esamina il numero5. C enddo * Esamina il nome (gli ultimi 3-4 caratteri). C do * Assume non sbiancamento del nome 3-4. C setoff 737476 * Se non è richiesta la pulizia del nome 3-4, abbandona. C if clrnam<>'*END' C and clrnam<>'*END4' C and clrnam<>'*EXT' C leave C endif * Se il nome contiene solo blank, abbandona. C if (clrnam='*END' and nam3=*blank) C or (clrnam='*END4' and nam4=*blank) C or (clrnam='*EXT' and ext =*blank) C leave C endif * Prenota lo sbiancamento del nome 3-4. C clrnam comp '*END' 73 C clrnam comp '*END4' 74 C clrnam comp '*EXT' 76 * Esamina il nome. C enddo * Esamina la specifica più asterisco. C do * Assume non sbiancamento della specifica. C setoff 75 * Se non è richiesta la pulizia della specifica, abbandona. C if clrcmt='*NO' C leave C endif * Rialza il campo specifica più asterisco. C lc:uc xlate spcast spcast * Se la richiesta di pulizia della specifica è uguale a *ALL * e se specifica più commento è diversa da tutti i valori * possibili nella richiesta, * abbandona. C if clrcmt='*ALL' C and spcast<>'H*' C and spcast<>'F*' C and spcast<>'E*' C and spcast<>'D*' C and spcast<>'I*' C and spcast<>'C*' C and spcast<>'O*' C leave C endif * Se la richiesta di pulizia della specifica è diversa da *ALL * e se specifica più commento è diversa dalla richiesta, * abbandona. C if clrcmt<>'*ALL' C and spcast<>clrcmt C leave C endif * Prenota lo sbiancamento della specifica. C seton 75 * Esamina la specifica più asterisco. C enddo * Se è prenotato uno sbiancamento. C if *in71 or *in73 or *in74 or *in75 or *in76 * Se è prenotato lo sbiancamento del numero5, lo pulisce. C 71 clear nbr5 * Se è prenotato lo sbiancamento del nome3, lo pulisce. C 73 clear nam3 * Se è prenotato lo sbiancamento del nome4, lo pulisce. C 74 clear nam4 * Se è prenotato lo sbiancamento della specifica sul commento, * la pulisce. C 75 clear spc * Se è prenotato lo sbiancamento del campo etichetta esterno, * lo pulisce. C 76 clear ext * Ricalca il record. C except $upd * Se non è prenotato uno sbiancamento. C else * Rilascia il record. C unlock Jclrrpg * Se non è prenotato uno sbiancamento. C endif * Elabora il file. C enddo * Ritorna. C return *--------------------------------------------------------------------- OJclrrpg E $upd O 71 nbr5 17 O 75 spc 18 O 73 nam3 112 O 74 nam4 112 O 76 ext 115 *--------------------------------------------------------------------- ** ! Caratteri cancellabili nelle prime cinque posizioni. 0123456789! //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRRPGP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') :PNLGRP. .*--------------------------------------------------------------------- :HELP NAME=CMD. :H3.Comando JCLRRPG :H2.Pulisce sorgente RPG da numeri e nome programma :P.Il comando permette di eliminare i numeri presenti nelle prime 5 posizioni delle istruzioni di un sorgente RPG, RPG38 o RPGLE. :P.Se tali posizioni però contengono un carattere non numerico, le posizioni non vengono pulite. :P.Con le parole chiave :HP1.CLEAR5:EHP1. e :HP1.CLEAR1:EHP1. è possibile comunque forzare la pulizia di una stringa specifica o che ha in posizione 1 un valore specifico. :P.A richiesta inoltre, la parola chiave :HP1.CLEARLAST:EHP1. permette di pulire incondizionatamente le ultime posizioni delle istruzioni. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/srcfile'. :H3.Source file (SRCFILE) - file :P.Nome del file sorgente in cui risiede il membro da modificare. :P.Valori permessi: :PARML. :PT.nome-file-sorgente € :PD.Il valore è obbligatorio. :EPARML. :H3.Source file (SRCFILE) - library :P.Nome della libreria in cui risiede il file. :P.Valori permessi: :PARML. :PT.:PK DEF.*LIBL:EPK.€ :PD.Il file sorgente viene cercato in lista librerie. :PT.nome-libreria :PD.Il file sorgente viene cercato nella libreria richiesta. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/srcmbr'. :H3.Source member (SRCMBR) :P.Nome del membro sorgente da modificare. :P.Valori permessi: :PARML. :PT.nome-membro-sorgente € :PD.Il valore è obbligatorio. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/clear5'. :H3.String5 to clear First5 (CLEAR5) :P.Stringa di 5 caratteri che deve essere pulita forzatamente dalle prime 5 posizioni delle istruzioni. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/clear1'. :H3.String1 to clear First5 (CLEAR1) :P.Carattere che, presente nella posizione 1 dell'istruzione, provoca la pulizia forzata delle prime 5 posizioni delle istruzioni. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/clearlast'. :H3.Clear last positions (CLEARLAST) :P.Richiede la pulizia delle ultime posizioni delle istruzioni. :P.Valori permessi: :PARML. :PT.:PK DEF.*EXT:EPK. :PD.Se il tipo seu è RPGLE, richiede la pulizia delle 3 posizioni fuori statement (101-103). :PT.*END :PD.Se il tipo seu è RPG o RPG38, richiede la pulizia delle ultime 6 posizioni (75-80). In queste posizioni veniva a volte annotato il nome programma. :P.Se il tipo seu è RPGLE, richiede la pulizia delle ultime 3 posizioni (98-100). :PT.*END4 :PD.Se il tipo seu è RPGLE, richiede la pulizia delle ultime 4 posizioni (97-100). :PT.*NO :PD.Nessuna pulizia verrà eseguita nelle ultime posizioni delle istruzioni. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/clearcmt'. :H3.Clear 6th col on comments (CLEARCMT) :P.Richiede la pulizia della sesta colonna sui commenti che contengono il tipo specifica RPG o RPGLE. :P.Valori permessi: :PARML. :PT.:PK DEF.*NO:EPK.€ :PD.Nessuna pulizia della sesta colonna è richiesta. :PT.*ALL :PD.Tutte le seste colonne dei commenti vengono pulite. :PT.H* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica H. :PT.F* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica F. :PT.E* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica E. :PT.D* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica D. :PT.I* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica I. :PT.C* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica C. :PT.O* :PD.Vengono pulite le seste colonne dei soli commenti con tipo specifica O. :EPARML. :EHELP. .*--------------------------------------------------------------------- :EPNLGRP. //ENDSRC //ENDBCHJOB