//BCHJOB JOB(JHEXSRC) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source from 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: 2016-04-05 10:26 */ /* To File : "JHEXSRC" */ /* To Library : "NERONI2" */ /* To Text : "Hexadecimal on 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 "JHEXSRC.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:\JHEXSRC.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JHEXSRC.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(JHEXSRC) 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/JHEXSRC" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JHEXSRC) MBR(JHEXSRC.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Claudio Neroni Utility') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JHEXSRC) CRTSRCPF FILE(NERONI2/JHEXSRC) RCDLEN(112) + TEXT('Hexadecimal on source. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JHEXSRC) TOFILE(NERONI2/JHEXSRC) + TOMBR(JHEXSRC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JHEXSRC) MBR(JHEXSRC) + SRCTYPE(CMD) + TEXT('Hexadecimal on source. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JHEXSRC.) TOFILE(NERONI2/JHEXSRC) + TOMBR(JHEXSRC.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JHEXSRC) MBR(JHEXSRC.) + SRCTYPE(CL) + TEXT('Hexadecimal on source. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JHEXSRCC) TOFILE(NERONI2/JHEXSRC) + TOMBR(JHEXSRCC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JHEXSRC) MBR(JHEXSRCC) + SRCTYPE(CLLE) + TEXT('Hexadecimal on source. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JHEXSRCD) TOFILE(NERONI2/JHEXSRC) + TOMBR(JHEXSRCD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JHEXSRC) MBR(JHEXSRCD) + SRCTYPE(RPGLE) + TEXT('Hexadecimal on source. InsHex') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JHEXSRCDW) TOFILE(NERONI2/JHEXSRC) + TOMBR(JHEXSRCDW) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JHEXSRC) MBR(JHEXSRCDW) + SRCTYPE(DSPF) + TEXT('Hexadecimal on source. InsHex') /*---------------------------------------------------------------------*/ //DATA FILE(JHEXSRC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Hexadecimal on source. Cmd */ /* Claudio Neroni 27-04-1982 Creato. */ /* Mette esadecimali su statement source. */ /* */ CMD PROMPT('Hexadecimal on 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') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JHEXSRC.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JHEXSRC.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 27-04-1982 Creato. */ /* JHEXSRC */ /* Hexadecimal on source. */ /* Prerequisiti: JCV, JTBL, JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JHEXSRC) DLTPGM PGM(NERONI2/JHEXSRCC) DLTPGM PGM(NERONI2/JHEXSRCD) DLTF FILE(NERONI2/JHEXSRCDW) DLTMSGF MSGF(NERONI2/JHEXSRC) /* Crea gli oggetti. */ CRTDSPF FILE(NERONI2/JHEXSRCDW) SRCFILE(JHEXSRC) CRTBNDCL PGM(NERONI2/JHEXSRCC) SRCFILE(JHEXSRC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JHEXSRCD) SRCFILE(JHEXSRC) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JHEXSRC) PGM(JHEXSRCC) SRCFILE(JHEXSRC) PRDLIB(NERONI2) CRTPRXCMD CMD(QGPL/JHEXSRC) TGTCMD(NERONI2/JHEXSRC) AUT(*USE) + REPLACE(*YES) CRTMSGF MSGF(NERONI2/JHEXSRC) TEXT('Hexadecimal on source. Msgf') /* Messaggi del Cpp. */ ADDMSGD MSGID(JHE0054) MSGF(NERONI2/JHEXSRC) MSG('Il file &2/&1 non è + di tipo source.') SECLVL('Il membro &3 del file &1 + nella libreria &2 è stato aperto per un''attività che + richiede un file source. Esso tuttavia non possiede + caratteristiche source.') FMT((*CHAR 10) (*CHAR 10) + (*CHAR 10)) ADDMSGD MSGID(JHE0055) MSGF(NERONI2/JHEXSRC) MSG('Dati troncati dal + file source &2/&1.') SECLVL('Il membro &3 del file &1 + nella libreria &2 è stato aperto per un''attività che + richiede un file source. Esso possiede caratteristiche + source ma la sua lunghezza record è superiore a quella + tollerata nell''attività in corso. Il reperimento dei + dati avverrebbe col troncamento della loro parte + finale.') FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JHE0056) MSGF(NERONI2/JHEXSRC) 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)) /* Messaggi del Cmd. */ /* Nessuno. */ //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JHEXSRCC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Hexadecimal on source. Cmd */ /* Claudio Neroni 27-04-1982 Creato. */ /* Mette esadecimali su statement source. */ /* */ PGM PARM(&FILELIB &MBR) /* Riceve File source e libreria ove risiede. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Riceve Membro source su cui inserire caratteri esadecimali. */ 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) /* Il file non è di tipo source. */ DCL VAR(&NOSOURCE) TYPE(*LGL) /* Il file ha il record troppo lungo. */ DCL VAR(&TOOLONG) TYPE(*LGL) /* Il membro in esame è vuoto. */ DCL VAR(&EMPTY) TYPE(*LGL) /* Dati per i messaggi. */ DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SUBSTRING(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SUBSTRING(&FILELIB 11 10)) /* Controlla l'esistenza del membro da sopradatare. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR) /* Dealloca e alloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000 MCH0000) ALCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) WAIT(1) /* Ridirige le due letture del programma sul membro. */ OVRDBF FILE(ARRIV) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) OVRDBF FILE(KEYED) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) /* Chiama il programma manipolatore degli esadecimali. */ CALL PGM(JHEXSRCD) PARM(&NOSOURCE &TOOLONG &EMPTY) /* Se il file non è di tipo source, messaggia e rilascia. */ IF COND(&NOSOURCE) THEN(DO) CHGVAR VAR(&MSGDTA) VALUE((&FILELIB !! &MBR)) SNDPGMMSG MSGID(JHE0054) MSGF(JHEXSRC) MSGDTA(&MSGDTA) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se la lunghezza record è maggiore della massima prevista, */ /* messaggia e rilascia. */ IF COND(&TOOLONG) THEN(DO) CHGVAR VAR(&MSGDTA) VALUE((&FILELIB !! &MBR)) SNDPGMMSG MSGID(JHE0055) MSGF(JHEXSRC) MSGDTA(&MSGDTA) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il membro è vuoto, messaggia e rilascia. */ IF COND(&EMPTY) THEN(DO) CHGVAR VAR(&MSGDTA) VALUE((&FILELIB !! &MBR)) SNDPGMMSG MSGID(JHE0056) MSGF(JHEXSRC) MSGDTA(&MSGDTA) + MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Esegue le attività finali. */ RCLRSC: /* Dealloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse e ritorna al chiamante. */ RCLRSC RETURN /* In caso d'errore, restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ ERRORE: JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Essendo già spediti i diagnostici del caso, */ /* aggiunge il CPF0001. */ CPF0001: SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JHEXSRC) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JHEXSRCD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Hexadecimal on source. InsHex * Claudio Neroni 27-04-1982 Creato. * Inserisce valori esadecimali in una riga source. * Claudio Neroni 26-11-2008 Modificato. * In attesa di soluzioni migliori, portato a 100 campo dati per RPG ILE. *--------------------------------------------------------------------------------------------- * Video. FJHEXSRCDW CF E WORKSTN USROPN * File source aperto in sequenza d'arrivo. FARRIV UF F 400 DISK * File information data structure. F INFDS(AIDS) * File source aperto per chiavi. FKEYED UF F 400 6AIDISK KEYLOC(1) F USROPN *--------------------------------------------------------------------------------------------- D B S 1 DIM(100) Byte riga *--------------------------------------------------------------------------------------------- * File information data structure. D AIDS DS * File. D AIDSFI 83 92 * Libreria. D AIDSLB 93 102 * Membro. D AIDSMB 129 138 * Numero di record presenti all'apertura. D AIDSNR 156 159B 0 * Tipo di accesso. D AIDSAT 160 161 * Flag di file source. D AIDSSO 163 163 * Lunghezza record. D AIDSLE 283 286B 0 * Numero relativo di record. D AIDSRN 397 400B 0 *--------------------------------------------------------------------------------------------- IARRIV NO 40 I 1 6 2STM I 13 115 DIS IKEYED NO 40 I 1 6 2STM I 13 115 DIS *--------------------------------------------------------------------------------------------- * Scambia parametri. C *ENTRY PLIST C PARM *IN62 NOSRC 1 O Non è source C PARM *IN63 TOOLON 1 O Troppo lungo C PARM *IN64 EMPTY 1 O Vuoto * Sposta file, libreria e membro dalla file information data * structure al video. C MOVE AIDSMB MBR C MOVE AIDSFI FILE C MOVE AIDSLB LIB * Propone dei default per i caratteri da trasformare. C MOVE '!' C1 C MOVE '"' C2 C MOVE '22' H1 C MOVE '20' H2 * Predispone il termine del programma. C SETON LR * Lascia che l'RPG apra il file in sequenza d'arrivo * e ne legge un record per valutare la lunghezza. C 1 SETLL ARRIV 11 C N11 READ ARRIV 11 * Se il file non è di tipo source, * oppure se il record è lungo più di 400 caratteri, * oppure se il membro è vuoto, * ritorna subito. C AIDSSO COMP 'Y' 6262 C N11AIDSLE COMP 400 63 C AIDSNR COMP *ZERO 6464 C 62 COR 63 COR 64 RETURN * Apre il file display. C OPEN JHEXSRCDW * Se il file source possiede tipo di accesso uguale ad AR, * esegue il trattamento per i file in sequenza d'arrivo. C AIDSAT IFEQ 'AR' C EXSR RARR * Altrimenti, chiude il file, lo riapre per chiave ed * esegue il trattamento per i file con chiave. C ELSE C CLOSE ARRIV C OPEN KEYED C EXSR RKEY C END * Ritorna. C RETURN *--------------------------------------------------------------------------------------------- * Tratta i source in sequenza d'arrivo. C RARR BEGSR * La lettura del primo record è già stata eseguita * nell'attività preliminare per valutare la lunghezza record. C RARRIN TAG C SETOFF 11 C 30 READ ARRIV 11 C 31 READP ARRIV 11 C 11 SETON 70 C 11AIDSRN CHAIN ARRIV 12 C 11 CAN 12 RETURN C RARRRI TAG C if aidsle < 115 C eval %subst(dis:aidsle+1-12) = *blank C endif * Interpreta il campo in forma zone. C CALL 'QDCXLATE' C PARM 100 XLATLE 5 0 I Lungh dati C disz PARM dis XLATDA 100 U Dati C PARM 'JTBLZONEB' XLATTB 10 I Tabella C PARM '*LIBL' XLATLB 10 I Libreria * Interpreta il campo in forma digit. C CALL 'QDCXLATE' C PARM 100 XLATLE 5 0 I Lungh dati C disd PARM dis XLATDA 100 U Dati C PARM 'JTBLDIGITB' XLATTB 10 I Tabella C PARM '*LIBL' XLATLB 10 I Libreria C EXFMT F1 * Se richiesto con l'auto enter sul campo di ricerca, * legge il record con campo di sequenza STA uguale o, in difetto, * appena superiore al valore impostato nel campo di ricerca SCAN. C 08 DO * Tenta il posizionamento su un numero relativo di record * desunto dal campo di ricerca. * Se non riesce, salta a non trovato. C Z-ADD SCAN SCAN$ 5 0 C SCAN$ SETLL ARRIV 11 C N11 READ ARRIV 11 C 11*HIVAL SETLL ARRIV C 11 READP ARRIV 12 C 11 CAN 12 RETURN * Se il campo di sequenza del record recuperato è uguale * al valore cercato, salta a trovato. C STM CABEQ SCAN RARRRI * Se il campo di sequenza del record recuperato è maggiore * del valore cercato, esegue una ricerca all'indietro * leggendo un record per volta sino a trovarne uno con campo * di sequenza uguale al cercato o inferiore. * Se trova inizio file, salta a trovato. * Se trova uguale, salta a trovato. * Se trova inferiore, rilegge un record in avanti e salta * a trovato. C STM IFGT SCAN C RARRRP TAG C READP ARRIV 11 C 11AIDSRN CHAIN ARRIV 12 C 11 GOTO RARRRI C STM CABEQ SCAN RARRRI C STM IFLT SCAN C READ ARRIV 11 C 11AIDSRN CHAIN ARRIV 12 C GOTO RARRRI C END C GOTO RARRRP C ELSE * Altrimenti, * se il campo di sequenza del record recuperato è minore * del valore cercato, esegue una ricerca in avanti * leggendo un record per volta sino a trovarne uno con campo * di sequenza uguale al cercato o maggiore. * Se trova fine file, salta a trovato. * Se trova uguale o maggiore, salta a trovato. C RARRR TAG C READ ARRIV 11 C 11AIDSRN CHAIN ARRIV 12 C 11 GOTO RARRRI C STM CABGE SCAN RARRRI C GOTO RARRR C END C SETON H1 C RETURN C END * Fine auto enter sul campo di ricerca. C 01 RETURN C 30 COR 31 GOTO RARRIN C EXFMT F2 C 01 RETURN * C C1 COMP *BLANK 5151 C 51 DO C CALL 'JCVHC' C PARM H1 C PARM HEX1 1 C PARM ERRORE 1 C END * C C2 COMP *BLANK 5252 C 52 DO C CALL 'JCVHC' C PARM H2 C PARM HEX2 1 C PARM ERRORE C END * C C3 COMP *BLANK 5353 C 53 DO C CALL 'JCVHC' C PARM H3 C PARM HEX3 1 C PARM ERRORE C END * C C4 COMP *BLANK 5454 C 54 DO C CALL 'JCVHC' C PARM H4 C PARM HEX4 1 C PARM ERRORE C END * C MOVEA DIS B C DO 100 X 7 0 C B(X) CABEQ *BLANK RARRFD * * * C 51 DO C B(X) COMP C1 11 C 11 MOVE HEX1 B(X) C 11 GOTO RARRFD C END * C 52 DO C B(X) COMP C2 11 C 11 MOVE HEX2 B(X) C 11 GOTO RARRFD C END * C 53 DO C B(X) COMP C3 11 C 11 MOVE HEX3 B(X) C 11 GOTO RARRFD C END * C 54 DO C B(X) COMP C4 11 C 11 MOVE HEX4 B(X) C 11 GOTO RARRFD C END * C RARRFD TAG C END C MOVEA B DIS C EXCEPT RARREM C AIDSRN CHAIN ARRIV 11 C 11 RETURN C GOTO RARRIN C ENDSR *--------------------------------------------------------------------------------------------- * Tratta i source con chiave. C RKEY BEGSR C *LOVAL SETLL KEYED C READ KEYED 11 C 11 RETURN C RKEYIN TAG C SETOFF 11 C 30 READ KEYED 11 C 31 READP KEYED 11 C 11 SETON 70 C 11STM SETLL KEYED C 11 READ KEYED 12 C 11 CAN 12 RETURN C RKEYRI TAG C if aidsle < 115 C eval %subst(dis:aidsle+1-12) = *blank C endif C EXFMT F1 C 08 DO C SCAN SETLL KEYED C READ KEYED 11 C 11*HIVAL SETLL KEYED C 11 READP KEYED 12 C 11 CAN 12 RETURN C GOTO RKEYRI C END C 01 RETURN C 30 COR 31 GOTO RKEYIN C EXFMT F2 C 01 RETURN * C C1 COMP *BLANK 5151 C 51 DO C CALL 'JCVHC' C PARM H1 C PARM HEX1 1 C PARM ERRORE 1 C END * C C2 COMP *BLANK 5252 C 52 DO C CALL 'JCVHC' C PARM H2 C PARM HEX2 1 C PARM ERRORE C END * C C3 COMP *BLANK 5353 C 53 DO C CALL 'JCVHC' C PARM H3 C PARM HEX3 1 C PARM ERRORE C END * C C4 COMP *BLANK 5454 C 54 DO C CALL 'JCVHC' C PARM H4 C PARM HEX4 1 C PARM ERRORE C END * C MOVEA DIS B C DO 100 X 7 0 C B(X) CABEQ *BLANK RKEYFD * * * C 51 DO C B(X) COMP C1 11 C 11 MOVE HEX1 B(X) C 11 GOTO RKEYFD C END * C 52 DO C B(X) COMP C2 11 C 11 MOVE HEX2 B(X) C 11 GOTO RKEYFD C END * C 53 DO C B(X) COMP C3 11 C 11 MOVE HEX3 B(X) C 11 GOTO RKEYFD C END * C 54 DO C B(X) COMP C4 11 C 11 MOVE HEX4 B(X) C 11 GOTO RKEYFD C END * C RKEYFD TAG C END C MOVEA B DIS C EXCEPT RKEYEM C STM SETLL KEYED C READ KEYED 11 C 11 RETURN C GOTO RKEYIN C ENDSR *--------------------------------------------------------------------------------------------- OARRIV E RARREM O UYEAR 8 O UMONTH 10 O UDAY 12 O DIS 115 *--------------------------------------------------------------------------------------------- OKEYED E RKEYEM O UYEAR 8 O UMONTH 10 O UDAY 12 O DIS 115 *--------------------------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JHEXSRCDW) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A*%%TS SD 20081126 175858 ANPRO15 REL-V5R4M0 5722-WDS A* Claudio Neroni 27-04-1982 Creato. A* Inserisce valori esadecimali in una riga source. A* A*%%EC A DSPSIZ(27 132 *DS4) A CHGINPDFT A MSGLOC(27) A CA03(01 'Ritorna.') A PRINT(QSYSPRT) A R F1 A*%%TS SD 20081126 175858 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('Statement source.') A ROLLUP(30 'Rollup.') A ROLLDOWN(31 'Rolldown.') A SETOF(70) A BLINK A OVERLAY A 2 16'Riga ...:' A PUTRETAIN A STM 6Y 2O 2 26DSPATR(HI) A EDTCDE(3) A 70 ERRMSGID(CPF5203 *LIBL/QCPFMSG) A 2 43'Riga da cercare:' A PUTRETAIN A SCAN 6Y 2B 2 60DSPATR(CS) A DSPATR(HI) A CHECK(FE) A CHECK(RB) A CHECK(ER) A EDTCDE(3) A CHANGE(08 'Cambiato campo di ricerc- A a riga.') A 3 16'Membro .:' A PUTRETAIN A MBR 10A O 3 26DSPATR(HI) A PUTRETAIN A 4 16'File ...:' A PUTRETAIN A FILE 10A O 4 26DSPATR(HI) A PUTRETAIN A 5 16'Libreria:' A PUTRETAIN A LIB 10A O 5 26DSPATR(HI) A PUTRETAIN A 7 1'....+....1....+....2....+....3....- A +....4....+....5....+....6....+....- A 7....+....8....+....9....+...10...' A DSPATR(UL) A DIS 103A B 8 1TEXT('Statement source.') A CHECK(LC) A DSPATR(PC) A DISZ 103A O 10 1DSPATR(RI) A DISD 103A O 11 1DSPATR(RI) A R F2 A TEXT('Servizio.') A BLINK A OVERLAY A 2 30'Char' A PUTRETAIN A 4 30'Char' A PUTRETAIN A 6 30'Char' A PUTRETAIN A 8 30'Char' A PUTRETAIN A 2 37'= Hex' A PUTRETAIN A 4 37'= Hex' A PUTRETAIN A 6 37'= Hex' A PUTRETAIN A 8 37'= Hex' A PUTRETAIN A C1 1A B 2 35TEXT('Carattere 1 da sostituire.') A DSPATR(CS) A DSPATR(HI) A C2 1A B 4 35TEXT('Carattere 2 da sostituire.') A DSPATR(CS) A DSPATR(HI) A C3 1A B 6 35TEXT('Carattere 3 da sostituire.') A DSPATR(CS) A DSPATR(HI) A C4 1A B 8 35TEXT('Carattere 4 da sostituire.') A DSPATR(CS) A DSPATR(HI) A H1 2A B 2 43TEXT('Esadecimale 1 sostitutore.') A DSPATR(CS) A DSPATR(HI) A H2 2A B 4 43TEXT('Esadecimale 2 sostitutore.') A DSPATR(CS) A DSPATR(HI) A H3 2A B 6 43TEXT('Esadecimale 3 sostitutore.') A DSPATR(CS) A DSPATR(HI) A H4 2A B 8 43TEXT('Esadecimale 4 sostitutore.') A DSPATR(CS) A DSPATR(HI) A 12 17'20' A PUTRETAIN A 12 20'ABC' A PUTRETAIN A 12 28'2A' A PUTRETAIN A 16 20'ABC' A PUTRETAIN A DSPATR(UL) A 12 39'30' A PUTRETAIN A 12 42'ABC' A PUTRETAIN A DSPATR(CS) A 12 50'3A' A PUTRETAIN A 13 17'21' A PUTRETAIN A 13 20'ABC' A PUTRETAIN A DSPATR(RI) A 13 28'2B' A PUTRETAIN A 13 31'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(RI) A DSPATR(BL) A 13 39'31' A PUTRETAIN A 14 42'ABC' A PUTRETAIN A DSPATR(CS) A DSPATR(HI) A 13 50'3B' A PUTRETAIN A 14 17'22' A PUTRETAIN A 14 20'ABC' A PUTRETAIN A DSPATR(HI) A 14 28'2C' A PUTRETAIN A 16 53'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(CS) A DSPATR(BL) A DSPATR(UL) A 14 39'32' A PUTRETAIN A 15 31'ABC' A PUTRETAIN A DSPATR(RI) A DSPATR(BL) A DSPATR(UL) A 14 50'3C' A PUTRETAIN A 15 17'23' A PUTRETAIN A 15 20'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(RI) A 15 28'2D' A PUTRETAIN A 15 53'ABC' A PUTRETAIN A DSPATR(RI) A DSPATR(CS) A DSPATR(BL) A DSPATR(UL) A 15 39'33' A PUTRETAIN A 14 53'ABC' A PUTRETAIN A DSPATR(CS) A DSPATR(BL) A DSPATR(UL) A 15 50'3D' A PUTRETAIN A 16 17'24' A PUTRETAIN A 13 53'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(RI) A DSPATR(BL) A DSPATR(CS) A 16 28'2E' A PUTRETAIN A 19 42'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(UL) A DSPATR(ND) A DSPATR(CS) A 16 39'34' A PUTRETAIN A 12 31'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(BL) A 16 50'3E' A PUTRETAIN A 17 17'25' A PUTRETAIN A 20 42'ABC' A PUTRETAIN A DSPATR(BL) A DSPATR(CS) A 17 28'2F' A PUTRETAIN A 17 31'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(RI) A DSPATR(BL) A DSPATR(ND) A 17 39'35' A PUTRETAIN A 21 20'ABC' A PUTRETAIN A DSPATR(RI) A DSPATR(BL) A 17 50'3F' A PUTRETAIN A 18 17'26' A PUTRETAIN A 13 42'ABC' A PUTRETAIN A DSPATR(CS) A DSPATR(RI) A 18 39'36' A PUTRETAIN A 18 42'ABC' A PUTRETAIN A DSPATR(CS) A DSPATR(HI) A DSPATR(UL) A 19 17'27' A PUTRETAIN A 19 20'ABC' A PUTRETAIN A DSPATR(ND) A 19 39'37' A PUTRETAIN A 15 42'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(RI) A DSPATR(CS) A 20 17'28' A PUTRETAIN A 20 20'ABC' A PUTRETAIN A DSPATR(BL) A 20 39'38' A PUTRETAIN A 18 20'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(UL) A 21 17'29' A PUTRETAIN A 16 42'ABC' A PUTRETAIN A DSPATR(CS) A DSPATR(UL) A 21 39'39' A PUTRETAIN A 16 31'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(BL) A DSPATR(UL) A 21 42'ABC' A PUTRETAIN A DSPATR(BL) A DSPATR(RI) A DSPATR(CS) A 17 42'ABC' A PUTRETAIN A DSPATR(RI) A DSPATR(CS) A DSPATR(UL) A 14 31'ABC' A PUTRETAIN A DSPATR(BL) A DSPATR(UL) A 17 20'ABC' A PUTRETAIN A DSPATR(RI) A DSPATR(UL) A 12 53'ABC' A PUTRETAIN A DSPATR(BL) A DSPATR(HI) A DSPATR(CS) A 17 53'ABC' A PUTRETAIN A DSPATR(HI) A DSPATR(RI) A DSPATR(CS) A DSPATR(BL) A DSPATR(UL) //ENDSRC //ENDBCHJOB