//BCHJOB JOB(JDSPSRC) 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-23 17:58 */ /* To File : "JDSPSRC" */ /* To Library : "NERONI2" */ /* To Text : "Display 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 "JDSPSRC.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:\JDSPSRC.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JDSPSRC.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(JDSPSRC) 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/JDSPSRC" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JDSPSRC) MBR(JDSPSRC.) 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/JDSPSRC) CRTSRCPF FILE(NERONI2/JDSPSRC) RCDLEN(112) + TEXT('Display Source. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRC) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRC) + SRCTYPE(CMD) + TEXT('Display Source. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRC.) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRC.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRC.) + SRCTYPE(CL) + TEXT('Display Source. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRCC) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRCC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRCC) + SRCTYPE(CLLE) + TEXT('Display Source. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRCD) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRCD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRCD) + SRCTYPE(RPGLE) + TEXT('Display Source. DspSrcOnSfl') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRCE) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRCE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRCE) + SRCTYPE(CLLE) + TEXT('Display Source. AddMbr') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRCT) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRCT) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRCT) + SRCTYPE(TXT) + TEXT('PROVA') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDSPSRCW) TOFILE(NERONI2/JDSPSRC) + TOMBR(JDSPSRCW) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDSPSRC) MBR(JDSPSRCW) + SRCTYPE(DSPF) + TEXT('Display Source. DspSrcOnSfl') /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CMD §DSPSRC. */ /* */ /* Visualizza source su subfile e la gestisce. */ /* */ CMD PROMPT('Visualizza e gestisce source') PARM KWD(SRCFILE) TYPE(SRCFILE) SNGVAL((*ON) + (*OFF)) MIN(1) PROMPT('File origine') SRCFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('nella libreria') PARM KWD(SRCMBR) TYPE(*NAME) DFT(*CALLERPGM) + SPCVAL((*CALLERPGM)) PROMPT('Membro origine') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRC.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JDSPSRC.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 05-06-1982 Creato. */ /* JDSPSRC */ /* Display Source. */ /* Prerequisiti: JRSNMSG, JHEXSRC, JPRTSRC */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JDSPSRC) DLTPNLGRP PNLGRP(NERONI2/JDSPSRCP) DLTPGM PGM(NERONI2/JDSPSRCC) DLTPGM PGM(NERONI2/JDSPSRCD) DLTPGM PGM(NERONI2/JDSPSRCE) DLTF FILE(NERONI2/JDSPSRCW) /* Crea gli oggetti. */ CRTDSPF FILE(NERONI2/JDSPSRCW) SRCFILE(JDSPSRC) CRTBNDCL PGM(NERONI2/JDSPSRCC) SRCFILE(JDSPSRC) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JDSPSRCE) SRCFILE(JDSPSRC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JDSPSRCD) SRCFILE(JDSPSRC) DBGVIEW(*ALL) CRTPNLGRP PNLGRP(NERONI2/JDSPSRCP) SRCFILE(JDSPSRC) CRTCMD CMD(NERONI2/JDSPSRC) PGM(JDSPSRCC) SRCFILE(JDSPSRC) + ALLOW(*INTERACT *IPGM *EXEC) HLPPNLGRP(JDSPSRCP) + HLPID(CMD) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRCC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §DSPSRC. */ /* */ /* Visualizza su subfile e gestisce un membro source. */ /* */ PGM PARM(&FILELIB &MBR) /* File source e libreria ove risiede. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Membro source da visualizzare. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria ove risiede il file source. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* L'utente è un programmatore: permessi edit source e hexadecimal. */ DCL VAR(&PROGRAMMER) TYPE(*LGL) /* Comando premuto nel programma chiamato. */ DCL VAR(&CMD) TYPE(*CHAR) LEN(2) /* Chiave del messaggio. */ DCL VAR(&MRK) TYPE(*CHAR) LEN(4) /* Identificazione del mittente di un messaggio. */ DCL VAR(&SENDER) TYPE(*CHAR) LEN(80) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 EDT0000 MCH0000 RPG0000) + EXEC(GOTO CMDLBL(ERRORE)) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Se il primo parametro contiene "*ON", crea l'area dati JDSPSRC */ /* e termina subito. */ IF COND(&FILE *EQ *ON) THEN(DO) CRTDTAARA DTAARA(QTEMP/JDSPSRC) TYPE(*CHAR) LEN(1) + TEXT('JDSPSRC.Autorizza manipolazioni con + JDSPSRC.') MONMSG MSGID(CPF0000) GOTO CMDLBL(RCLRSC1) ENDDO /* Se il primo parametro contiene "*OFF", cancella l'area dati JDSPSRC */ /* e termina subito. */ IF COND(&FILE *EQ *OFF) THEN(DO) DLTDTAARA DTAARA(QTEMP/JDSPSRC) MONMSG MSGID(CPF0000) GOTO CMDLBL(RCLRSC1) ENDDO /* Se il nome della libreria è blank, */ /* lo sostituisce con *LIBL. */ IF COND(&LIB *EQ ' ') THEN(DO) CHGVAR VAR(&LIB) VALUE(*LIBL) CHGVAR VAR(%SST(&FILELIB 11 10)) VALUE(*LIBL) ENDDO /* Se il nome del membro source è "*CALLERPGM" o "*CALLER", */ /* recupera il nome del programma chiamante e lo sostituisce */ /* al nome del membro source. */ IF COND((&MBR *EQ *CALLERPGM) *OR (&MBR *EQ + *CALLER)) THEN(DO) /* Cerca il nome del programma padre. */ /* Manda un messaggio al padre e lo riceve rimuovendolo. */ /* Quindi, dal parametro opportuno, estrae il nome del ricevente. */ SNDPGMMSG MSG('Messaggio di comodo per + l''individuazione del programma padre.') + KEYVAR(&MRK) RCVMSG PGMQ(*PRV) MSGTYPE(*INFO) MSGKEY(&MRK) + SENDER(&SENDER) CHGVAR VAR(&MBR) VALUE(%SST(&SENDER 56 10)) ENDDO /* Ridirige le due letture del programma sul membro. */ OVRDBF FILE(JDSPSRCA) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) OVRDBF FILE(JDSPSRCK) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) /* Se in QTEMP esiste l'area dati JDSPSRC, */ /* assume che l'utente corrente sia un programmatore. */ CHGVAR VAR(&PROGRAMMER) VALUE('1') CHKOBJ OBJ(QTEMP/JDSPSRC) OBJTYPE(*DTAARA) MONMSG MSGID(CPF0000) EXEC(DO) CHGVAR VAR(&PROGRAMMER) VALUE('0') ENDDO /* Label di inizio visualizzazione. */ INIZIO: /* Se l'utente è un programmatore. */ IF COND(&PROGRAMMER) THEN(DO) /* Controlla l'esistenza del membro da visualizzare. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR) /* Se il membro non esiste. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Chiama l'aggiunta del membro. */ CALL PGM(JDSPSRCE) PARM(&LIB &FILE &MBR) /* End. */ ENDDO /* End. */ ENDDO /* Se l'utente non è un programmatore. */ ELSE CMD(DO) /* Controlla l'esistenza del membro da visualizzare. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR) /* End. */ ENDDO /* Dealloca e alloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *SHRRD &MBR)) ALCOBJ OBJ((&LIB/&FILE *FILE *SHRRD &MBR)) WAIT(0) /* Chiama la visualizzazione su subfile del membro. */ CALL PGM(JDSPSRCD) PARM(&PROGRAMMER &CMD) DLCOBJ OBJ((&LIB/&FILE *FILE *SHRRD &MBR)) /* Se è stato premuto command 10, chiama il seu sul membro. */ /* e quindi ritorna a visualizzare il membro. */ IF COND(&CMD *EQ '10') THEN(DO) STRSEU SRCFILE(&LIB/&FILE) SRCMBR(&MBR) MONMSG MSGID(CPF0000 EDT0000) GOTO CMDLBL(INIZIO) ENDDO /* Se è stato premuto command 12, chiama il manipolatore esadecimali */ /* e quindi ritorna a visualizzare il membro. */ IF COND(&CMD *EQ '12') THEN(DO) JHEXSRC SRCFILE(&LIB/&FILE) SRCMBR(&MBR) MONMSG MSGID(CPF0000) GOTO CMDLBL(INIZIO) ENDDO /* Se è stato premuto command 15, chiama la stampa comunicazione */ /* e quindi ritorna a visualizzare il membro. */ IF COND(&CMD *EQ '15') THEN(DO) JPRTSRC ?*SRCFILE(&LIB/&FILE) ?*SRCMBR(&MBR) + ??OUTQ(*N) ??FORMTYPE(*N) ??COPIES(*N) + ??LPI(*N) ??RPLUNPRT(*N) /* STRSEU ?*SRCFILE(&LIB/&FILE) ?*SRCMBR(&MBR) + ?*OPTION(6) */ MONMSG MSGID(CPF0000) GOTO CMDLBL(INIZIO) ENDDO /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *SHRRD &MBR)) MONMSG MSGID(CPF0000 MCH0000) /* Label di esecuzione delle attività finali senza deallocazione. */ RCLRSC1: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se previsto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JDSPSRC) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Rispedisce gli errori al chiamante come diagnostici. */ JRSNMSG RMV(*NO) MONMSG MSGID(CPF0000 MCH0000) /* Label di prenotazione del CPF0001. */ CPF0001: /* Prenota il rilascio del CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRCD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Visualizza source su subfile. * * RPG §DSPSRC1. * * Visualizza i record di un file source su un subfile * a riempimento graduale. * FJDSPSRCA IF F 92 DISK * File source aperto in sequenza d'arrivo. F INFDS(AIDS) * File information data structure. FJDSPSRCK IF F 92 6AIDISK KEYLOC(1) F USROPN * File source aperto per chiavi. FJDSPSRCW CF E WORKSTN * Source su subfile. F SFILE(S1:N1) D AIDS DS * File information data structure. D WFILE 83 92 * File. D WLIB 93 102 * Libreria. D WMBR 129 138 * Membro. D AIDSAT 160 161 * Tipo di accesso. D AIDSSO 163 163 * Current subfile record number. IJDSPSRCA NO I 1 6 2SRCSEQ I 7 12 0SRCDAT I 13 92 SRCDTA IJDSPSRCK NO I 1 6 2SRCSEQ I 7 12 0SRCDAT I 13 92 SRCDTA * Flag di file source. * Scambia parametri. C *ENTRY PLIST C *IN60 PARM PPGMR 1 I Programmatore C PARM PCMD 2 O Comando prem * Definisce. C Z-ADD N1 N1 4 0 * Predispone il termine del programma. C SETON LR * Lascia che l'RPG apra il file in sequenza d'arrivo * Se il file non è di tipo source, esegue apposita routine. C AIDSSO COMP 'Y' 5050 C 50 EXSR NOSR * Se il file source possiede tipo di accesso uguale ad AR, * prenota il trattamento per i file in sequenza d'arrivo. C AIDSAT IFEQ 'AR' C SETON 55 * Altrimenti, chiude il file, lo riapre per chiave e * prenota il trattamento per i file con chiave. C ELSE C CLOSE JDSPSRCA C OPEN JDSPSRCK C SETOFF 55 C END * Scrive il piede del video. C WRITE P1 * Inizializza il numero di record contenuti in una pagina. C Z-ADD 20 PGSIZ 5 0 * Inizializza inizio e fine della prima pagina. C Z-ADD 1 PGIN 5 0 C Z-ADD PGSIZ PGFI 5 0 C GOTO PAGINA * Label. C NUOVA TAG * Inizializza inizio e fine della nuova pagina. C ADD PGSIZ PGIN C ADD PGSIZ PGFI * Label. C PAGINA TAG * Spegne l'indicatore di rinuncia alla lettura e di riempimento * in bianco. C SETOFF 58 * Esegue il riempimento di una pagina di subfile (20 record). * Scrive tutti i record compresi tra il primo e l'ultimo * della pagina stessa con i dati letti dal file o con righe bianche. C PGIN DO PGFI N1 * Se non è già impedito dall'indicatore di rinuncia, * legge un record dal file. C N58 EXSR READ * Riempie la riga di subfile con dati o con blank * in accordo con l'indicatore di rinuncia. C N58 MOVEL READTA WDTA C 58 MOVE *BLANK WDTA * Scrive il record di subfile. C WRITE S1 * Se ha trovato fine file o richiesta di nuova pagina, * accende l'indicatore di rinuncia alla lettura * e di riempimento in bianco. C N58 CAN 56 CORN58 CAN 57 SETON 58 C END * Prenota l'emissione dell'ultima pagina riempita. C Z-ADD PGIN WSRN * Se è a fine file, prenota subfile end. C MOVE *IN56 *IN40 * Label. C EMIS TAG * Emette il subfile. C SETON 3839 C EXFMT C1 C SETOFF 3839 * Ritorna. C 01 DO C MOVE '01' PCMD C RETURN C END * Ritorna con indicazione di richiesto edit source. C 10 DO C MOVE '10' PCMD C RETURN C END * Ritorna con indicazione di richiesto hexadecimal on source. C 12 DO C MOVE '12' PCMD C RETURN C END * Ritorna con indicazione di richiesta stampa. C 15 DO C MOVE '15' PCMD C RETURN C END * Gestisce rollup di sfondamento. C 29 DO C 56 SETON 70 C 56 GOTO EMIS C GOTO NUOVA C END * Gestisce enter. * Ritorna. C MOVE '01' PCMD C RETURN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C READ BEGSR * Legge un record dal file source. *------------------------------------------------------------------- * Restituisce: * READTA Campo dati. * 56 on Il record restituito nel campo dati * è l'ultimo del file. * 57 on Nella prima posizione del prossimo record * c'è % (richiesta di nuova pagina). * Alla prima chiamata, * esegue la lettura preliminare del primo record nel file. C READFL IFNE '1' C MOVE '1' READFL 1 C 55 READ JDSPSRCA 56 C N55 READ JDSPSRCK 56 * Se la prima lettura fallisce, esegue una routine apposita. C 56 EXSR NORC * Salva il campo dati appena letto. C MOVE SRCDTA SAVDTA C *LIKE DEFINE SRCDTA SAVDTA C *LIKE DEFINE SRCDTA READTA C END * Spegne le risposte. C SETOFF 5657 * Se è prenotata la lettura del file in sequenza d'arrivo, * legge un record da quello. * Altrimenti legge un record dal file in sequenza per chiave. * In entrambi i casi restituisce l'indicazione di fine file. C 55 READ JDSPSRCA 56 C N55 READ JDSPSRCK 56 * Se il primo carattere dell'ultimo record letto è %, * annota la richiesta di nuova pagina. C N56 MOVEL SRCDTA READ1 1 C N56READ1 COMP '%' 57 * Trascrive nel campo dati il penultimo record cercato * pulendo l'eventuale % nella prima posizione. C MOVEL SAVDTA READTA C MOVE SRCDTA SAVDTA C MOVEL READTA READ1 C READ1 IFEQ '%' C MOVEL ' ' READTA C END C READEN TAG C ENDSR *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C NOSR BEGSR * Emette la nota di file non source e ritorna. *------------------------------------------------------------------- * Emette il subfile control. C SETON 39 C WRITE C1 C SETOFF 39 * Emette la nota. C EXFMT NOSOURCE * Ritorna. C RETURN C ENDSR *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C NORC BEGSR * Emette la nota di membro vuoto e ritorna. *------------------------------------------------------------------- * Emette il subfile control. C SETON 39 C WRITE C1 C SETOFF 39 * Emette la nota. C EXFMT EMPTY * Ritorna. C 01 DO C MOVE '01' PCMD C RETURN C END * Ritorna con indicazione di richiesto edit source. C 10 DO C MOVE '10' PCMD C RETURN C END * Ritorna. C MOVE '01' PCMD C RETURN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRCE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §DSPSRC2. */ /* */ /* Aggiunge membro documentazione. */ /* */ PGM PARM(&LIB &FILE &MBR) /* Libreria ove risiede il file source. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Membro source da aggiungere. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Chiave del messaggio. */ DCL VAR(&MRK) TYPE(*CHAR) LEN(4) /* Identificazione del mittente di un messaggio. */ DCL VAR(&SENDER) TYPE(*CHAR) LEN(80) /* Output di DSPOBJD. */ DCLF FILE(QADSPOBJ) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Scrive in libreria temporanea la descrizione del programma */ /* omonimo del membro da aggiungere cercando in lista librerie. */ /* PROSSIMA IMPLEMENTAZIONE: */ /* TENTA DI LEGGERE DALL'INVOCATION STACK LA LIBRERIA */ /* DEL PGM IN CORSO DI CHIAMATA. TANTO NATURALMENTE VALE SE */ /* IL PGM CORRENTE NE E' A VALLE (SE CHIAMATO CON IL PARAMETRO */ /* *CALLERPGM IL PGM JDSPSRC). */ DSPOBJD OBJ(&MBR) OBJTYPE(*PGM) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JDSPSRC2) /* Ridirige la lettura del file di lavoro. */ OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/JDSPSRC2) + SECURE(*YES) /* Legge un record dal file di lavoro. */ RCVF /* Aggiunge il membro facendo uso del testo trovato. */ ADDPFM FILE(&LIB/&FILE) MBR(&MBR) TEXT(&ODOBTX) /* Label di errore. */ ERRORE: /* Legge un record dal file di lavoro per portarlo a fine file. */ RCVF MONMSG MSGID(CPF0000 MCH0000) /* Cancella i file di lavoro. */ DLTF FILE(QTEMP/JDSPSRC2) MONMSG MSGID(CPF0000 MCH0000) /* Se il file o la libreria non esistono, salta a fine. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(FINE)) /* Se il membro non esiste. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR) MONMSG MSGID(CPF0000) EXEC(DO) /* Aggiunge il membro estemporaneamente. */ ADDPFM ?*FILE(&LIB/&FILE) ?*MBR(&MBR) ??TEXT(*N) MONMSG MSGID(CPF0000 MCH0000) /* End. */ ENDDO /* Label di fine. */ FINE: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRCT) FILETYPE(*SRC) ENDCHAR('//ENDSRC') cd\ rem›ATTENZIONE: l'estensione del presente file DEVE ESSERE ".bat". rem Claudio Neroni 01-08-2008 Creato. rem Passa mano alla copia dopo impostata password. rem Vedi i commenti in testa al chiamato. rem Annota Parametri utente. echo off call E:\UP\UPCS echo on rem Ricava in drive il drive del presente ".bat". set drive=%~d0 rem Chiama la copia. call "%drive%\IFS\FROMIFS" %1 //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDSPSRCW) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A*%%TS SD 19930623 161622 NERONI REL-V2R2M0 5738-PW1 A* 11:40:23 QPGMR REL-R04M00 5714-UT1 A* A* DSPF §DSPSRCW. A* A*%%EC A DSPSIZ(24 80 *DS3) A CHGINPDFT A MSGLOC(24) A PRINT A INDTXT(01 'Return.') A INDTXT(10 'Edit source.') A INDTXT(12 'Hexadecimal on source.') A INDTXT(15 'Print file.') A INDTXT(29 'Roll up.') A INDTXT(38 'Subfile display.') A INDTXT(39 'Subfile display control.- A ') A INDTXT(40 'Subfile end.') A INDTXT(60 'Permessi CMD 10 & 12.') A INDTXT(70 'Rollup impedito.') A R S1 SFL A TEXT('Statement source.') A WDTA 78 O 3 2 A TEXT('Statement source.') A* 11:40:23 QPGMR REL-R04M00 5714-UT1 A R C1 SFLCTL(S1) A*%%TS SD 19930623 161622 NERONI REL-V2R2M0 5738-PW1 A SFLSIZ(0100) A SFLPAG(0020) A TEXT('Controllo del subfile.') A CA01(01) A CA03(01) A 60 CA10(10) A 60 CA12(12) A CA15(15) A ROLLUP(29) A SETOF(70) A 38 SFLDSP A 39 SFLDSPCTL A 40 SFLEND A OVERLAY A WSRN 4S 0H TEXT('Subfile record number.') A SFLRCDNBR A 60 1 3'Visualizzato su subfile membro' A WMBR 10 O 1 34DSPATR(HI) A N60 DSPATR(ND) A TEXT('Membro.') A 70 ERRMSGID(CPF5203 *LIBL/QCPFMSG) A 60 1 45'file' A 60 WFILE 10A O 1 50DSPATR(HI) A TEXT('File.') A 60 1 61'lib' A 60 WLIB 10A O 1 65DSPATR(HI) A TEXT('Libreria.') A 60 1 76'.' A 60 2 3'CA10' A DSPATR(HI) A 60 2 8'Edit source' A 60 2 21'CA12' A DSPATR(HI) A 60 2 26'Hexadecimal on source' A R EMPTY A* 14:59:42 QPGMR REL-03.0 5714-UT1 A TEXT('Nota di membro vuoto.') A CA01(01) A CA03(01) A 60 CA10(10) A OVERLAY A 4 4'(Non ci sono record nel membro.)' A R NOSOURCE A* 14:59:42 QPGMR REL-03.0 5714-UT1 A TEXT('Nota di file non source.') A CA01(01) A CA03(01) A 60 CA10(10) A OVERLAY A 4 4'(Il file non è di tipo source.)' A R P1 A*%%TS SD 19930623 161622 NERONI REL-V2R2M0 5738-PW1 A TEXT('Piede.') A OVERLAY A 24 2'Cmd15' A DSPATR(HI) A 24 8'Stampa' //ENDSRC //ENDBCHJOB