//BCHJOB JOB(CRSL) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) CCSID(280) /* 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-07-05 16:40 */ /* To File : "CRSL" */ /* To Library : "NERONI2" */ /* To Text : "Cursor Location. 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 "CRSL.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:\CRSL.txt" "/qsys.lib/NERONI2.lib/stringhe.file/CRSL.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(CRSL) 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/CRSL" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/CRSL) MBR(CRSL.) 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/CRSL) CRTSRCPF FILE(NERONI2/CRSL) RCDLEN(112) + TEXT('Cursor Location. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CRSL.) TOFILE(NERONI2/CRSL) + TOMBR(CRSL.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/CRSL) MBR(CRSL.) + SRCTYPE(CL) + TEXT('Cursor location. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CRSLDS) TOFILE(NERONI2/CRSL) + TOMBR(CRSLDS) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/CRSL) MBR(CRSLDS) + SRCTYPE(PF) + TEXT('Cursor location. File information data structure') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CRSLESV) TOFILE(NERONI2/CRSL) + TOMBR(CRSLESV) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/CRSL) MBR(CRSLESV) + SRCTYPE(DSPF) + TEXT('Cursor location. Sample Dspf') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CRSLES1) TOFILE(NERONI2/CRSL) + TOMBR(CRSLES1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/CRSL) MBR(CRSLES1) + SRCTYPE(RPG) + TEXT('Cursor location. Sample Rpg') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CRSLES2) TOFILE(NERONI2/CRSL) + TOMBR(CRSLES2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/CRSL) MBR(CRSLES2) + SRCTYPE(RPGLE) + TEXT('Cursor location. Sample Rpgle') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CRSLOC) TOFILE(NERONI2/CRSL) + TOMBR(CRSLOC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/CRSL) MBR(CRSLOC) + SRCTYPE(RPGLE) + TEXT('Cursor location. Retrieve Line-Position') /*----------------------------------------------------------------------------*/ //DATA FILE(CRSL.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(CRSL.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) CCSID(280) /* Claudio Neroni 13-04-1982 Creato. */ /* CRSL */ /* Cursor location. */ /* Prerequisiti: nessuno. */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTF FILE(NERONI2/CRSLDS) DLTPGM PGM(NERONI2/CRSLOC) /* Cancella gli oggetti preesistenti di esempio. */ DLTF FILE(NERONI2/CRSLESV) DLTPGM PGM(NERONI2/CRSLES1) DLTPGM PGM(NERONI2/CRSLES2) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/CRSLDS) SRCFILE(CRSL) MBR(*NONE) CRTBNDRPG PGM(NERONI2/CRSLOC) SRCFILE(CRSL) DBGVIEW(*ALL) /* Crea gli oggetti di esempio. */ CRTDSPF FILE(NERONI2/CRSLESV) SRCFILE(CRSL) CRTRPGPGM PGM(NERONI2/CRSLES1) SRCFILE(CRSL) OPTION(*LSTDBG) CRTBNDRPG PGM(NERONI2/CRSLES2) SRCFILE(CRSL) DBGVIEW(*ALL) //ENDBCHJOB //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(CRSLDS) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CN * Cursor location. A R CRSLDS A TEXT('Cursor location. + A File information + A data structure') A CRSL01 8 A COLHDG('...') A CRSLOP 1 A COLHDG('File' + A 'open') A CRSL02 1 A COLHDG('...') A CRSLST 5 A COLHDG('Status' + A 'code') A CRSL03 30 A COLHDG('...') A CRSLER 7 A COLHDG('Error' + A 'code') A CRSL04 30 A COLHDG('...') A CRSLFI 10 A COLHDG('File') A CRSLLB 10 A COLHDG('Library') A CRSL05 26 A COLHDG('...') A CRSLMB 10 A COLHDG('Member') A CRSL06 13 A COLHDG('...') A CRSLFL 4B A COLHDG('Forms lines or' + A 'workstation lines') A CRSL07 2 A COLHDG('...') A CRSLNR 9B A COLHDG('Record quantity' + A 'in input file' + A 'at open') A CRSLAT 2 A COLHDG('Access' + A 'type') A CRSL08 1 A COLHDG('...') A CRSLSO 1 A COLHDG('Source' + A 'file' + A 'flag') A CRSL09 24 A COLHDG('...') A CRSLOL 4B A COLHDG('Overflow' + A 'line') A CRSL10 71 A COLHDG('...') A CRSLRE 10 A COLHDG('Last record' + A 'format' + A 'processed') A CRSLDC 2 A COLHDG('Device' + A 'class') A CRSL11 10 A COLHDG('...') A CRSLLE 9B A COLHDG('First read' + A 'record' + A 'length') A CRSL12 80 A COLHDG('...') A CRSLCL 4B A COLHDG('Current' + A 'line') A CRSL13 1 A COLHDG('...') A CRSLLP 2 A COLHDG('Line/' + A 'position') //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(CRSLESV) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A*%%TS SD 20080922 110350 ANPRO15 REL-V5R4M0 5722-WDS A*%%EC A DSPSIZ(24 80 *DS3) A R W1 A*%%TS SD 20080922 110350 ANPRO15 REL-V5R4M0 5722-WDS A CA01 A CF11 A RTNCSRLOC(&RCD &FLD) A CSRLOC(LIN POS) A LIN 3S 0H A POS 3S 0H A RCD 10A H A FLD 10A H A 1 26'Cursor location. Esempio d''uso' A DSPATR(UL) A DSPATR(HI) A 5 4'come' A COME 37A B 5 11 A 7 4'quando' A QUANDO 23A O 7 11DSPATR(CS) A 9 4'fuori' A FUORI 6S 0B 9 22 A 11 4'piove' A PIOVE 12Y 2O 11 18DSPATR(CS) A EDTCDE(L) A 12 4'fldout' A FLDOUT 10A O 12 18DSPATR(CS) A 24 3'F1=Fine' A 24 12'F11=Riemissione con posizionamento- A cursore' //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(CRSLES1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Cursor location. Esempio d'uso RPG *------------------------------------------------------------------------- * Video. FCRSLESV CF E WORKSTN KINFDS CRSLDS *------------------------------------------------------------------------- * File information data structure del video. ICRSLDS E DS *------------------------------------------------------------------------- * Cicla intorno al video. C DO *HIVAL * Emette il video. C EXFMTW1 * Azzera e calcola cursore. C EXSR CRSLZE * Se richiesto, abbandona. C KA LEAVE * Se richiesto, posiziona il cursore. C *INKK IFEQ *ON C Z-ADDCRSLLI LIN C Z-ADDCRSLPO POS C ENDIF * Annota il nome del campo su cui giace il cursore. C MOVELFLD FLDOUT P * Cicla intorno al video. C ENDDO * Prenota chiusura. C SETON LR *------------------------------------------------------------------------- * Azzera e calcola cursore. C CRSLZE BEGSR * Azzera cursore. C CLEARLIN C CLEARPOS * Calcola cursore. C CALL 'CRSLOC' C PARM CRSLDS C PARM CRSLLI 30 C PARM CRSLPO 30 C ENDSR *------------------------------------------------------------------------- //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(CRSLES2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Cursor location. Esempio d'uso *------------------------------------------------------------------------- * Video. Fcrslesv cf e workstn infds(crslds) *------------------------------------------------------------------------- * File information data structure del video. D crslds e ds *------------------------------------------------------------------------- * Cicla intorno al video. C do *hival * Emette il video. C exfmt w1 * Azzera e calcola cursore. C exsr crslze * Se richiesto, abbandona. C ka leave * Se richiesto, posiziona il cursore. C if *inkk C z-add crsllin lin C z-add crslpos pos C endif * Annota il nome del campo su cui giace il cursore. C eval fldout = fld * Cicla intorno al video. C enddo * Prenota chiusura. C seton lr *------------------------------------------------------------------------- * Azzera e calcola cursore. C crslze begsr * Azzera cursore. C clear lin C clear pos * Calcola cursore. C call 'CRSLOC' C parm crslds C parm crsllin 3 0 C parm crslpos 3 0 C endsr *------------------------------------------------------------------------- //ENDSRC /*----------------------------------------------------------------------------*/ //DATA FILE(CRSLOC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CN /TITLE Cursor location. *--------------------------------------------------------------------- * Riceve in CRSL la file information data structure della * workstation da cui estrae: * in CRSLDC il codice del dispositivo su cui si opera. * in CRSLLP il codice della locazione del cursore * su di un file display. * Restituisce in PPLIN e PPPOS linea e posizione decodificati. *--------------------------------------------------------------------- * Restituisce H1 se il primo byte di CRSLDC è diverso * dall'esadecimale 01 (Keyboard display). * Tramite il secondo byte di CRSLDC distingueva mezzo video * e console 38 da tutti gli altri. * Esadecimale 00 (5250 Display Station, 960 characters). * Esadecimale 01 (System console, 1024 characters). * Informazioni sul contenuto del byte in oggetto * potevano essere desunte per il S/38 dalla CPF Programmer's Guide * appendix D (Open and I/O Feedback Area) pagina D-16 * nel release 8.0. * SU AS/400 VEDI "PROGRAMMING: DATA MANAGEMENT GUIDE" APPENDIX A. * Restituisce H3 se la linea calcolata per il cursore * supera la misura imposta dal video utilizzato. * Restituisce H4 se la posizione del cursore lungo la linea * supera la misura imposta dal video utilizzato. *--------------------------------------------------------------------- * File information data structure della workstation. D crslds e ds *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve la file information data structure del video. C parm crslds * Restituisce la linea (riga) del cursore. C parm pplin 3 0 * Restituisce la posizione (colonna) del cursore. C parm pppos 3 0 * Pulisce i parametri di ritorno. C clear pplin C clear pppos *--------------------------------------------------------------------- * Decodifica Line/Position. C do * Se il device non è Keyboard Display, errore. C movel crsldc test C test ifne x'01' C seton h1 C leave C endif * Decodifica il byte che indica la linea del cursore. C movel crsllp test C exsr bynr C z-add n lin 3 0 * Se la linea trovata è superiore al massimo previsto, errore. C lin ifgt 27 C seton h3 C leave C endif * Decodifica il byte che indica la posizione del cursore. C move crsllp test C exsr bynr C z-add n pos 3 0 * Se la posizione trovata è superiore al massimo previsto, errore. C pos ifgt 132 C seton h4 C leave C endif * Restituisce la linea trovata. C z-add lin pplin * Restituisce la posizione trovata. C z-add pos pppos * Decodifica Line/Position. C enddo * Ritorna. C return *--------------------------------------------------------------------- * Interpreta un byte come binario assoluto. C BYNR BEGSR C clear N 3 0 C TESTB '7' TEST 1 50 C 50 ADD 1 N C TESTB '6' TEST 50 C 50 ADD 2 N C TESTB '5' TEST 50 C 50 ADD 4 N C TESTB '4' TEST 50 C 50 ADD 8 N C TESTB '3' TEST 50 C 50 ADD 16 N C TESTB '2' TEST 50 C 50 ADD 32 N C TESTB '1' TEST 50 C 50 ADD 64 N C TESTB '0' TEST 50 C 50 ADD 128 N C ENDSR *--------------------------------------------------------------------- //ENDSRC //ENDBCHJOB