//BCHJOB JOB(JSPLCVT) 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-17 16:03 */
/* To File : "JSPLCVT" */
/* To Library : "NERONI2" */
/* To Text : "Convert Spool 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 "JSPLCVT.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:\JSPLCVT.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JSPLCVT.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(JSPLCVT) 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/JSPLCVT" */
/* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */
/* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */
/* SBMDBJOB FILE(NERONI2/JSPLCVT) MBR(JSPLCVT.) 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/JSPLCVT)
CRTSRCPF FILE(NERONI2/JSPLCVT) RCDLEN(112) +
TEXT('Convert Spool File. Src')
/* Copia il sorgente dalla stringa al membro del file sorgente. */
/* Modifica testo e tipo seu del sorgente caricato. */
CPYF FROMFILE(JSPLCVT) TOFILE(NERONI2/JSPLCVT) +
TOMBR(JSPLCVT) MBROPT(*REPLACE) SRCOPT(*SEQNBR)
CHGPFM FILE(NERONI2/JSPLCVT) MBR(JSPLCVT) +
SRCTYPE(CMD) +
TEXT('Convert Spool File. Cmd')
/* Copia il sorgente dalla stringa al membro del file sorgente. */
/* Modifica testo e tipo seu del sorgente caricato. */
CPYF FROMFILE(JSPLCVT.) TOFILE(NERONI2/JSPLCVT) +
TOMBR(JSPLCVT.) MBROPT(*REPLACE) SRCOPT(*SEQNBR)
CHGPFM FILE(NERONI2/JSPLCVT) MBR(JSPLCVT.) +
SRCTYPE(CL) +
TEXT('Convert Spool File. CrtJs')
/* Copia il sorgente dalla stringa al membro del file sorgente. */
/* Modifica testo e tipo seu del sorgente caricato. */
CPYF FROMFILE(JSPLCVT1) TOFILE(NERONI2/JSPLCVT) +
TOMBR(JSPLCVT1) MBROPT(*REPLACE) SRCOPT(*SEQNBR)
CHGPFM FILE(NERONI2/JSPLCVT) MBR(JSPLCVT1) +
SRCTYPE(CLLE) +
TEXT('Convert Spool File. Cpp')
/* Copia il sorgente dalla stringa al membro del file sorgente. */
/* Modifica testo e tipo seu del sorgente caricato. */
CPYF FROMFILE(JSPLCVT2) TOFILE(NERONI2/JSPLCVT) +
TOMBR(JSPLCVT2) MBROPT(*REPLACE) SRCOPT(*SEQNBR)
CHGPFM FILE(NERONI2/JSPLCVT) MBR(JSPLCVT2) +
SRCTYPE(RPGLE) +
TEXT('Convert Spool File. ToHtml')
/* Copia il sorgente dalla stringa al membro del file sorgente. */
/* Modifica testo e tipo seu del sorgente caricato. */
CPYF FROMFILE(JSPLCVT3) TOFILE(NERONI2/JSPLCVT) +
TOMBR(JSPLCVT3) MBROPT(*REPLACE) SRCOPT(*SEQNBR)
CHGPFM FILE(NERONI2/JSPLCVT) MBR(JSPLCVT3) +
SRCTYPE(RPGLE) +
TEXT('Convert Spool File. ToPdf')
/*---------------------------------------------------------------------*/
//DATA FILE(JSPLCVT) FILETYPE(*SRC) ENDCHAR('//ENDSRC')
CMD PROMPT('Convert Spooled File to STMF')
PARM KWD(FROMFILE) TYPE(*NAME) LEN(10) MIN(1) +
PROMPT('From spooled file name')
PARM KWD(TOSTMF) TYPE(*PNAME) LEN(64) MIN(1) +
PROMPT('To stream file name')
PARM KWD(TODIR) TYPE(*PNAME) LEN(256) MIN(1) +
PROMPT('To directory')
PARM KWD(JOB) TYPE(JOB) DFT(*) SNGVAL((*)) +
PROMPT('Job name')
JOB: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) MIN(1) PROMPT('User')
QUAL TYPE(*CHAR) LEN(6) RANGE(000000 999999) +
MIN(1) PROMPT('Number')
PARM KWD(SPLNBR) TYPE(*DEC) LEN(4) DFT(*ONLY) +
RANGE(1 9999) SPCVAL((*LAST -2) (*ONLY +
-3)) PROMPT('Spooled file number')
PARM KWD(TOFMT) TYPE(*CHAR) LEN(5) RSTD(*YES) +
DFT(*TEXT) VALUES(*TEXT *HTML *PDF) +
PROMPT('Stream file format')
PARM KWD(STMFOPT) TYPE(*CHAR) LEN(8) RSTD(*YES) +
DFT(*NONE) VALUES(*NONE *ADD *REPLACE) +
PROMPT('Stream file option')
PARM KWD(STMFCODPAG) TYPE(*DEC) LEN(5 0) +
DFT(*PCASCII) RANGE(1 32767) +
SPCVAL((*PCASCII -1) (*STMF -2)) +
PMTCTL(*PMTRQS) PROMPT('Stream file code +
page')
PARM KWD(TITLE) TYPE(*CHAR) LEN(50) RSTD(*NO) +
DFT(*NONE) SPCVAL((*NONE) (*STMFILE)) +
PMTCTL(HTML) PROMPT('Title for HTML or PDF')
PARM KWD(BOOKMARK) TYPE(*CHAR) LEN(7) RSTD(*YES) +
DFT(*PAGNBR) VALUES(*PAGNBR *POS *KEY) +
PMTCTL(PDF) PROMPT('Type of PDF bookmarks')
PARM KWD(BMARKPOS) TYPE(LIST1) PMTCTL(POS) +
PROMPT('PDF bookmark string position')
LIST1: ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 300) +
PROMPT('Line number')
ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 378) +
PROMPT('Character position')
ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 378) +
PROMPT('Length')
PARM KWD(BMARKKEY) TYPE(LIST2) PMTCTL(KEY) +
PROMPT('PDF bookmark string key')
LIST2: ELEM TYPE(*CHAR) LEN(378) DFT(' ') VARY(*YES +
*INT2) PROMPT('Key string')
ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 999) +
PROMPT('Occurrence')
ELEM TYPE(*DEC) LEN(3 0) DFT(0) RANGE(-378 378) +
PROMPT('Offset')
ELEM TYPE(*DEC) LEN(3 0) DFT(1) RANGE(1 378) +
PROMPT('Length')
HTML: PMTCTL CTL(TOFMT) COND((*EQ *HTML) (*EQ *PDF)) +
NBRTRUE(*EQ 1) LGLREL(*OR)
PDF: PMTCTL CTL(TOFMT) COND((*EQ *PDF)) NBRTRUE(*EQ 1)
POS: PMTCTL CTL(BOOKMARK) COND((*EQ *POS)) NBRTRUE(*EQ 1)
KEY: PMTCTL CTL(BOOKMARK) COND((*EQ *KEY)) NBRTRUE(*EQ 1)
//ENDSRC
/*---------------------------------------------------------------------*/
//DATA FILE(JSPLCVT.) FILETYPE(*SRC) ENDCHAR('//ENDSRC')
//BCHJOB JOB(JSPLCVT.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) +
LOG(4 00 *SECLVL) MSGQ(*USRPRF)
/* Claudio Neroni 31/07/2008 Creato. */
/* Copiato da Vincenzo Cappa. */
/* http://www.freerpgtools.com/ */
/* JSPLCVT */
/* Converte Spool. */
/* Trasforma uno spool in PDF o HTML. */
/* Prerequisiti: nessuno. */
CHGLIBL LIBL(QTEMP QGPL)
ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP)
DLTCMD CMD(NERONI2/JSPLCVT)
DLTPGM PGM(NERONI2/JSPLCVT1)
DLTPGM PGM(NERONI2/JSPLCVT2)
DLTPGM PGM(NERONI2/JSPLCVT3)
CRTBNDCL PGM(NERONI2/JSPLCVT1) SRCFILE(JSPLCVT) DBGVIEW(*ALL)
CRTBNDRPG PGM(NERONI2/JSPLCVT2) SRCFILE(JSPLCVT) DFTACTGRP(*NO) +
DBGVIEW(*ALL)
CRTBNDRPG PGM(NERONI2/JSPLCVT3) SRCFILE(JSPLCVT) DFTACTGRP(*NO) +
DBGVIEW(*ALL)
CRTCMD CMD(NERONI2/JSPLCVT) PGM(JSPLCVT1) SRCFILE(JSPLCVT) +
PRDLIB(NERONI2)
//ENDBCHJOB
//ENDSRC
/*---------------------------------------------------------------------*/
//DATA FILE(JSPLCVT1) FILETYPE(*SRC) ENDCHAR('//ENDSRC')
PGM PARM(&FROMFILE &TOSTMF &TODIR &QUALJOB +
&SPLID &TOFMT &STMFOPT &STMFCODPAG &TITLE +
&BOOKMARK &BMARKPOS &BMARKKEY)
DCL VAR(&FROMFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&TOFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&TOSTMF) TYPE(*CHAR) LEN(64)
DCL VAR(&TODIR) TYPE(*CHAR) LEN(256)
DCL VAR(&QUALJOB) TYPE(*CHAR) LEN(26)
DCL VAR(&INTJOB) TYPE(*CHAR) LEN(16)
DCL VAR(&INTSPLID) TYPE(*CHAR) LEN(16)
DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&SPLID) TYPE(*DEC) LEN(4 0)
DCL VAR(&HEXSPLID) TYPE(*CHAR) LEN(4)
DCL VAR(&TOFMT) TYPE(*CHAR) LEN(5)
DCL VAR(&STMFOPT) TYPE(*CHAR) LEN(8)
DCL VAR(&STMFCODPAG) TYPE(*DEC) LEN(5 0)
DCL VAR(&CODEPAGE) TYPE(*CHAR) LEN(8)
DCL VAR(&TITLE) TYPE(*CHAR) LEN(50)
DCL VAR(&BOOKMARK) TYPE(*CHAR) LEN(7)
DCL VAR(&BMARKPOS) TYPE(*CHAR) LEN(8)
DCL VAR(&BMARKKEY) TYPE(*CHAR) LEN(388)
DCL VAR(&SPLINFO) TYPE(*CHAR) LEN(1133)
DCL VAR(&INFOLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&PAGELEN) TYPE(*CHAR) LEN(4)
DCL VAR(&SPLNBR) TYPE(*CHAR) LEN(5)
DCL VAR(&PATH) TYPE(*CHAR) LEN(1024)
DCL VAR(&INQMSGRPY) TYPE(*CHAR) LEN(10)
DCL VAR(&CTLCHAR) TYPE(*CHAR) LEN(7) VALUE('*NONE')
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&MSG) TYPE(*CHAR) LEN(100)
DCL VAR(&SEV) TYPE(*DEC) LEN(2 0)
DCL VAR(&ERRORFLAG) TYPE(*LGL) LEN(1)
/* Global message monitor to trap any unmonitored errors */
MONMSG MSGID(CPF9999 CPF0000 MCH0000) EXEC(GOTO +
CMDLBL(ERROR))
/* (A) Extract job name from qualified Job name */
CHGVAR VAR(&JOB) VALUE(%SST(&QUALJOB 1 10))
CHGVAR VAR(&USER) VALUE(%SST(&QUALJOB 11 10))
CHGVAR VAR(&JOBNBR) VALUE(%SST(&QUALJOB 21 6))
/* (B) Convert special value * to current job details */
IF COND(&JOB *EQ '*') THEN(DO)
RTVJOBA JOB(&JOB) USER(&USER) NBR(&JOBNBR)
ENDDO
/* (C) Set up spooled file number from special values */
CHGVAR VAR(&SPLNBR) VALUE(&SPLID)
IF COND(&SPLID *EQ -2) THEN(DO)
CHGVAR VAR(&SPLNBR) VALUE(*LAST)
ENDDO
IF COND(&SPLID *EQ -3) THEN(DO)
CHGVAR VAR(&SPLNBR) VALUE(*ONLY)
ENDDO
/* (D) Create first work file */
DLTF FILE(QTEMP/JSPLCVT01)
MONMSG MSGID(CPF2105)
CRTPF FILE(QTEMP/JSPLCVT01) RCDLEN(378) SIZE(*NOMAX)
CHGVAR VAR(&TOFILE) VALUE(JSPLCVT01)
/* (E) Create second work file if not converting to plain text */
IF COND(&TOFMT *NE *TEXT) THEN(DO)
DLTF FILE(QTEMP/JSPLCVT02)
MONMSG MSGID(CPF2105)
CRTPF FILE(QTEMP/JSPLCVT02) RCDLEN(382) SIZE(*NOMAX)
CHGVAR VAR(&TOFILE) VALUE(JSPLCVT02)
ENDDO
/* (F) Set Job to use default */
RTVJOBA INQMSGRPY(&INQMSGRPY)
CHGJOB INQMSGRPY(*DFT)
/* (H) If converting to HTML or PDF, we need control characters */
START: IF COND(&TOFMT *NE *TEXT) THEN(DO)
CHGVAR VAR(&CTLCHAR) VALUE(*PRTCTL)
/* (I) Set up Title if a special value */
IF COND(&TITLE *EQ *STMFILE) THEN(DO)
CHGVAR VAR(&TITLE) VALUE(&TOSTMF)
ENDDO
IF COND(&TITLE *EQ *NONE) THEN(DO)
CHGVAR VAR(&TITLE) VALUE(' ')
ENDDO
ENDDO
/* (J) Copy spooled file into work file */
CPYSPLF FILE(&FROMFILE) TOFILE(QTEMP/&TOFILE) +
JOB(&JOBNBR/&USER/&JOB) SPLNBR(&SPLNBR) +
MBROPT(*REPLACE) CTLCHAR(&CTLCHAR)
/* (K) If converting to HTML or PDF, call API to get spooled file info */
IF COND(&TOFMT *NE *TEXT) THEN(DO)
CHGVAR VAR(%BIN(&HEXSPLID)) VALUE(&SPLID)
IF COND(&SPLNBR *EQ *ONLY) THEN(CHGVAR +
VAR(%BIN(&HEXSPLID)) VALUE(0))
IF COND(&SPLNBR *EQ *LAST) THEN(CHGVAR +
VAR(%BIN(&HEXSPLID)) VALUE(-1))
CHGVAR VAR(%BIN(&INFOLEN)) VALUE(1133)
CALL PGM(QUSRSPLA) PARM(&SPLINFO &INFOLEN +
SPLA0100 &QUALJOB &INTJOB &INTSPLID +
&FROMFILE &HEXSPLID)
CHGVAR VAR(&PAGELEN) VALUE(%SST(&SPLINFO 425 4))
OVRDBF FILE(JSPLCVT01) TOFILE(QTEMP/JSPLCVT01) +
OVRSCOPE(*JOB)
OVRDBF FILE(JSPLCVT02) TOFILE(QTEMP/JSPLCVT02) +
OVRSCOPE(*JOB)
/* (L) Convert spooled file data to HTML format */
IF COND(&TOFMT *EQ *HTML) THEN(DO)
CALL PGM(JSPLCVT2) PARM(&TITLE &PAGELEN)
ENDDO
/* (M) Convert spooled file data to PDF format */
IF COND(&TOFMT *EQ *PDF) THEN(DO)
CALL PGM(JSPLCVT3) PARM(&TITLE &SPLINFO +
&BOOKMARK &BMARKPOS &BMARKKEY)
ENDDO
ENDDO
/* (N) Set codepage of stream file to be created */
CHGVAR VAR(&CODEPAGE) VALUE(&STMFCODPAG)
IF COND(&STMFCODPAG *EQ -1) THEN(CHGVAR +
VAR(&CODEPAGE) VALUE(*PCASCII))
IF COND(&STMFCODPAG *EQ -2) THEN(CHGVAR +
VAR(&CODEPAGE) VALUE(*STMF))
/* (O) Convert spooled file data in work file to stream file */
CHGVAR VAR(&PATH) VALUE(&TODIR *TCAT '/' *CAT &TOSTMF)
CPYTOSTMF +
FROMMBR('/qsys.lib/qtemp.lib/JSPLCVT01.file+
/JSPLCVT01.mbr') TOSTMF(&PATH) +
STMFOPT(&STMFOPT) STMFCODPAG(&CODEPAGE)
CHGAUT OBJ(&PATH) USER(*PUBLIC) DTAAUT(*RWX) +
OBJAUT(*ALL)
/* (P) Send completion message */
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Spooled +
file' *BCAT &FROMFILE *BCAT 'copied to +
stream file' *BCAT &TOSTMF) MSGTYPE(*COMP)
/* (Q) Delete work file(s) */
DLTF FILE(QTEMP/JSPLCVT01)
MONMSG MSGID(CPF2105)
DLTF FILE(QTEMP/JSPLCVT02)
MONMSG MSGID(CPF2105)
/* (R) Reset job attribute */
CHGJOB INQMSGRPY(&INQMSGRPY)
/* Finish */
RETURN
/* Error Handling logic */
ERROR:
/* If looping in the error handling routine, end in error */
IF COND(&ERRORFLAG) THEN(DO)
SNDPGMMSG MSGID(CPF9999) MSGF(QCPFMSG) MSGTYPE(*ESCAPE)
MONMSG MSGID(CPF0000)
GOTO CMDLBL(ENDPGM)
ENDDO
/* Set flag to prevent looping */
CHGVAR VAR(&ERRORFLAG) VALUE('1')
/* Re-send any diagnostic messages sent to this program */
ERROR1: RCVMSG MSGTYPE(*DIAG) RMV(*NO) KEYVAR(&MSGKEY) +
MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF COND(&MSGKEY *EQ ' ') THEN(GOTO CMDLBL(ERROR2))
RMVMSG MSGKEY(&MSGKEY)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO CMDLBL(ERROR1)
/* Re-send any escape messages sent to this program */
ERROR2:
CHGJOB INQMSGRPY(&INQMSGRPY)
MONMSG MSGID(CPF0000)
RCVMSG MSGTYPE(*EXCP) RMV(*NO) MSG(&MSG) +
MSGDTA(&MSGDTA) MSGID(&MSGID) SEV(&SEV) +
MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
IF COND(&SEV *GT 00) THEN(DO)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
MSGTYPE(*ESCAPE)
ENDDO
ENDPGM: ENDPGM
//ENDSRC
/*---------------------------------------------------------------------*/
//DATA FILE(JSPLCVT2) FILETYPE(*SRC) ENDCHAR('//ENDSRC')
H
FJSPLCVT02 IF F 382 DISK
FJSPLCVT01 UF A F 378 DISK
* Standard HTML header lines
D aaHeader S 80A DIM(2) CTDATA PERRCD(1)
* Standard HTML footer line
D aaFooter S 80A DIM(1) CTDATA PERRCD(1)
* Input spooled file data including control characters
D InputData DS
D saSkipLine 3A
D ssSkipLine 3S 0 OVERLAY(saSkipLine:1)
D saSpceLine 1A
D ssSpceLine 1S 0 OVERLAY(saSpceLine:1)
D saInput 378A
* Output HTML-format data
D OutputData DS
D saOutput 378A
* Program parameters - title and page length in lines
D paTitle S 50A
D piPageLen S 10I 0
* Line counter variable
D wiLine S 10I 0
* Procedure prototypes
D HTMLHeader PR
D HTMLFooter PR
D Convert PR
D Merge PR LIKE(saOutput)
D iaOutput LIKE(saOutput)
D iaInput LIKE(saInput)
D SpceLines PR
D isSpceLine LIKE(ssSpceLine)
D SkipLines PR
D isSkipLine LIKE(ssSkipLine)
* Program parameters
C *ENTRY PLIST
C PARM paTitle
C PARM piPageLen
* Output HTML header lines
C CALLP HTMLHeader
* Convert spool file lines to HTML
C READ JSPLCVT02 InputData LR
C DOW *INLR = *OFF
C CALLP Convert
C READ JSPLCVT02 InputData LR
C ENDDO
* Output HTML footer lines
C CALLP HTMLFooter
C RETURN
**********************************************************************
* Procedure to create HTML header lines *
**********************************************************************
P HTMLHeader B
D HTMLHeader PI
C EVAL saOutput = aaHeader(1)
C WRITE JSPLCVT01 OutputData
C IF paTitle <> '*NONE'
C EVAL saOutput = ''
C WRITE JSPLCVT01 OutputData
C ENDIF
C EVAL saOutput = aaHeader(2)
C WRITE JSPLCVT01 OutputData
P HTMLHeader E
**********************************************************************
* Procedure to create HTML footer line *
**********************************************************************
P HTMLFooter B
D HTMLFooter PI
C EVAL saOutput = aaFooter(1)
C WRITE JSPLCVT01 OutputData
P HTMLFooter E
**********************************************************************
* Procedure to convert spooled file data to HTML text *
**********************************************************************
P Convert B
D Convert PI
* If 'space' position is zero, 'overprint' previous line
C IF saSpceLine = '0'
C *HIVAL SETGT JSPLCVT01
C READP JSPLCVT01 OutputData 99
C EVAL saOutput = Merge(saOutput:saInput)
C UPDATE JSPLCVT01 OutputData
C ELSE
* Skip to a line if specified
C IF saSkipLine <> *BLANKS
C CALLP SkipLines(ssSkipLine)
C ENDIF
* Space a number of lines if specified
C IF saSpceLine <> *BLANKS
C CALLP SpceLines(ssSpceLine)
C ENDIF
* 'Print' line
C EVAL saOutput = saInput
C WRITE JSPLCVT01 OutputData
C ENDIF
C RETURN
P Convert E
**********************************************************************
* Procedure to merge two overlaid lines of text *
**********************************************************************
P Merge B
D Merge PI LIKE(saOutput)
D iaOutput LIKE(saOutput)
D iaInput LIKE(saInput)
D laOutput S LIKE(saOutput)
D i S 5I 0
C EVAL i = 1
C DOW i <= %size(iaInput )
C and i <= %size(iaOutput)
C and i <= %size(laOutput)
C IF %subst(iaInput:i:1) = *BLANK
C EVAL %subst(laOutput:i:1) = %subst(iaOutput:i:1)
C ELSE
C EVAL %subst(laOutput:i:1) = %subst(iaInput :i:1)
C ENDIF
C EVAL i = i + 1
C ENDDO
C RETURN laOutput
P Merge E
**********************************************************************
* Procedure to skip to a given line number *
**********************************************************************
P SkipLines B
D SkipLines PI
D isSkipLine LIKE(ssSkipLine)
C EVAL saOutput = *BLANKS
C IF wiLine > isSkipLine
C DOW wiLine < piPageLen
C WRITE JSPLCVT01 OutputData
C EVAL wiLine = wiLine + 1
C ENDDO
C EVAL saOutput = '-------------------------'
C WRITE JSPLCVT01 OutputData
C EVAL saOutput = *BLANKS
C EVAL wiLine = 1
C ENDIF
C DOW wiLine < isSkipLine
C WRITE JSPLCVT01 OutputData
C EVAL wiLine = wiLine + 1
C ENDDO
C RETURN
P SkipLines E
**********************************************************************
* Procedure to space a number of lines *
**********************************************************************
P SpceLines B
D SpceLines PI
D isSpceLine LIKE(ssSpceLine)
D liCount S 5I 0
C EVAL wiLine = wiLine + 1
C EVAL saOutput = *BLANKS
C DOW liCount < isSpceLine - 1
C WRITE JSPLCVT01 OutputData
C EVAL wiLine = wiLine + 1
C EVAL liCount = liCount + 1
C ENDDO
C RETURN
P SpceLines E
**
xxxx
//ENDSRC
/*---------------------------------------------------------------------*/
//DATA FILE(JSPLCVT3) FILETYPE(*SRC) ENDCHAR('//ENDSRC')
******************************************************************
H
* Work files
FJSPLCVT02 IF F 382 DISK
FJSPLCVT01 UF A F 378 DISK
* Program parameter - report title
D paTitle S 50A
* Program parameter - spooled file information returned by API
D SplInfo DS
D saReturned 10I 0
D saAvailabl 10I 0
D saIntJobId 16A
D saSplfId 16A
D saJobName 10A
D saUser 10A
D saJobNbr 6A
D saSplFile 10A
D saSplNbr 10I 0
D saFormType 10A
D saUsrDta 10A
D saStatus 10A
D saFilAvail 10A
D saHold 10A
D saSave 10A
D siPages 10I 0
D siCurrPage 10I 0
D siFromPage 10I 0
D siToPage 10I 0
D siLastPage 10I 0
D siRestart 10I 0
D siCopies 10I 0
D siCopyRem 10I 0
D siLPI 10I 0
D siCPI 10I 0
D siOutPty 2A
D saOutq 10A
D saOutqLib 10A
D saOpenDate 7A
D saOpenTime 6A
D saPrtFile 10A
D saPrtfLib 10A
D saPgmName 10A
D saPgmLib 10A
D saAcgCode 15A
D saPrtTxt 30A
D siRcdLen 10I 0
D siMaxRcds 10I 0
D saDevType 10A
D saPrtType 10A
D saDocName 12A
D saFlrName 64A
D saS36Proc 8A
D saFidelity 10A
D saRplUnprt 1A
D saRplChar 1A
D siPageLen 10I 0
D siPageWdth 10I 0
D siSepartrs 10I 0
D siOvrFlw 10I 0
D saDBCS 10A
D saDBCSExt 10A
D saDBCSSOSI 10A
D saDBCSRotn 10A
D saDBCSCPI 10I 0
D saGraphics 10A
D saCodePage 10A
D saFormDf 10A
D saFormDfLb 10A
D siDrawer 10I 0
D saFont 10A
D saS36SplId 6A
D siRotation 10I 0
D siJustify 10I 0
D saDuplex 10A
D saFoldRcds 10A
D saCtlChar 10A
D saAlign 10A
D saPrtQlty 10A
D saFormFeed 10A
D saVolumes 71A
D saLabels 17A
D saExchange 10A
D saCharCode 10A
D siTotRcds 10I 0
D siMultiUp 10I 0
D saFrontOvl 10A
D saFrtOvlLb 10A
D snFOOffDwn 15P 5
D snFOOffAcr 15P 5
D saBackOvl 10A
D saBckOvlLb 10A
D snBOOffDwn 15P 5
D snBOOffAcr 15P 5
D saUOM 10A
D saPagDfn 10A
D saPagDfnLb 10A
D saSpacing 10A
D snPointSiz 15P 5
D snFMOffDwn 15P 5
D snFMOffAcr 15P 5
D snBMOffDwn 15P 5
D snBMOffAcr 15P 5
D snPageLen 15P 5
D snPageWdth 15P 5
D saMethod 10A
D saAFP 1A
D saChrSet 10A
D saChrSetLb 10A
D saCdePagNm 10A
D saCdePgeLb 10A
D saCdeFnt 10A
D saCdeFntLb 10A
D saDBCSFnt 10A
D saDBCSFntL 10A
D saUserDef 10A
D saReduce 10A
D saReserv1 1A
D siOutBin 10I 0
D siCCSID 10I 0
D saUserText 100A
D saSystem 8A
D saOrigId 8A
D saCreator 10A
* Program parameter - bookmark option
D paBookmark S 7A
* Program parameter - bookmark *POS option parameters
D BMarkPos DS
D siPosCount 5I 0
D snPosLine 3P 0
D snPosChar 3P 0
D snPosLen 3P 0
* Program parameter - bookmark *KEY option parameters
D BMarkKey DS
D siKeyCount 5I 0
D siLen 5I 0
D saKeyStr 378A
D snKeyOccur 3P 0
D snKeyOff 3P 0
D snKeyLen 3P 0
* PDF 'object' array
D aiObject S 10I 0 DIM(32767)
* Start position of PDF options
D aaStart S 10A DIM(32767)
* Current object number
D wiObject S 10I 0
* Current count of bytes written
D wiChrCount S 10I 0
* Current page number
D wiPage S 10I 0
* Start position of text
D wiStart S 10I 0
* Bookmark text
D waBookmark S 378A
* Count of occurrences of the bookmark key
D wiOccurs S 5I 0
* Input spooled file data including control characters
D InputData DS
D saSkipLine 3A
D ssSkipLine 3S 0 OVERLAY(saSkipLine:1)
D saSpceLine 1A
D ssSpceLine 1S 0 OVERLAY(saSpceLine:1)
D saInput 378A
* Output PDF-format data
D OutputData DS
D saOutput 378A
* Procedure prototypes
D WritePDF PR
D iaOutput 378A CONST OPTIONS(*VARSIZE)
D AddEscape PR 378A
D iaInput 378A
D PDFHeader PR
D PDFPages PR
D PDFTrailer PR
D NewPage PR
D EndPage PR
D NumToText PR 10A
D iiNum 10I 0 CONST
D NewObject PR
* Program parameters
C *ENTRY PLIST
C PARM paTitle
C PARM SplInfo
C PARM paBookmark
C PARM BMarkPos
C PARM BMarkKey
* Output a PDF header
C CALLP PDFHeader
* Create PDF page 'objects'
C CALLP PDFPages
* Output a PDF trailer
C CALLP PDFTrailer
C RETURN
**********************************************************************
* Procedure to create a PDF 'header' *
**********************************************************************
P PDFHeader B
D PDFHeader PI
D liPage S 10I 0
D liPageObj S 10I 0
* Create catalog object
C CALLP WritePDF('%PDF-1.0')
C CALLP WritePDF('%âãÏÓ')
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('<<')
C CALLP WritePDF('/Type /Catalog')
C CALLP WritePDF('/Pages 5 0 R')
C CALLP WritePDF('/Outlines 2 0 R')
C CALLP WritePDF('/PageMode /UseOutlines')
C CALLP WritePDF('>>')
C CALLP WritePDF('endobj')
* Create outlines object
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('<<')
C CALLP WritePDF('/Type /Outlines')
C CALLP WritePDF('/Count '+%trim(NumToText(siPages)))
C CALLP WritePDF( '/First 9 0 R')
C
C CALLP WritePDF( '/Last '
C + %trim(NumToText((siPages*4)+5))
C + ' 0 R')
C CALLP WritePDF('>>')
C CALLP WritePDF('endobj')
* Create procedures object
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('[/PDF /Text]')
C CALLP WritePDF('endobj')
* Create fonts object
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('<<')
C CALLP WritePDF ('/Type /Font')
C CALLP WritePDF ('/Subtype /Type1')
C CALLP WritePDF ('/Name /F1')
C CALLP WritePDF ('/BaseFont /Courier')
C CALLP WritePDF ('/Encoding /WinAnsiEncoding')
C CALLP WritePDF ('>>')
C CALLP WritePDF ('endobj')
* Create pages object
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF ('<<')
C CALLP WritePDF ('/Type /Pages')
C CALLP WritePDF('/Count '+%trim(NumToText(siPages)))
* Write list of child pages
C EVAL liPage = wiObject + 1
C EVAL liPageObj = liPage
C CALLP WritePDF ( '/Kids ['
C + %trim(NumToText(liPage))
C + ' 0 R')
C DOW liPage < siPages + wiObject
C EVAL liPage = liPage + 1
C EVAL liPageObj = liPageObj + 4
C CALLP WritePDF ( ' '
C + %trim(NumToText(liPageObj))
C + ' 0 R')
C ENDDO
C CALLP WritePDF (' ]')
C CALLP WritePDF ('>>')
C CALLP WritePDF ('endobj')
P PDFHeader E
**********************************************************************
* Procedure to create PDF pages *
**********************************************************************
P PDFPages B
D liLine S 10I 0
D liLength S 5I 0
D liChar S 5I 0
D liX S 5I 0
D liY S 5I 0
* Create page object for first page
C EVAL wiPage = 0
C EVAL liX = 0
* Read spooled file data from input work file
C READ JSPLCVT02 InputData LR
C DOW *INLR = *OFF
* Skip to a line if specified, handling page throw if it occurs
C IF saSkipLine <> *BLANKS
C IF ssSkipLine < liLine or liLine = 0
C IF wiPage <> 0
C CALLP EndPage
C ENDIF
C CALLP NewPage
C EVAL liLine = ssSkipLine
C EVAL liY
C = (612/siPageLen) * (siPagelen-liLine)
C ELSE
C EVAL liY
C = -((612/siPageLen) * (ssSkipLine-liLine))
C EVAL liLine = ssSkipLine
C ENDIF
C ENDIF
* Space a number of lines if specified
C IF saSpceLine <> *BLANKS
C EVAL liLine = liLine + ssSpceLine
C EVAL liY
C = -((612/siPageLen) * ssSpceLine)
C ENDIF
* Set up bookmark if position option specified
C IF paBookmark = '*POS'
C IF liLine = snPosLine and waBookmark = *BLANKS
C EVAL waBookmark = %trim(%subst(saInput :
C snPosChar:
C snPosLen ))
C ENDIF
C ENDIF
* Set up bookmark if key option specified
C IF paBookmark = '*KEY'
C saKeyStr:siLenSCAN saInput:1 liChar
C IF liChar > 0
C EVAL wiOccurs = wiOccurs + 1
C IF wiOccurs = snKeyOccur
C EVAL liChar = liChar + snKeyOff
C EVAL liLength = snKeyLen
C IF liChar + liLength > siPageWdth
C EVAL liLength = siPageWdth - liChar
C ENDIF
C IF liChar < 1
C EVAL liChar = 1
C ENDIF
C IF liChar + liLength <= siPageWdth
C EVAL waBookmark = %trim(%subst(saInput :
C liChar :
C liLength ))
C ENDIF
C ENDIF
C ENDIF
C ENDIF
* Add escape character before special characters \, ( and )
C EVAL saInput = AddEscape(saInput)
* Output the line of text
C CALLP WritePDF( %trim(NumToText(liX))
C + ' '
C + %trim(NumToText(liY))
C + ' Td ('
C + %trimr(saInput)
C + ') Tj')
C READ JSPLCVT02 InputData LR
C ENDDO
C CALLP EndPage
P PDFPages E
**********************************************************************
* Procedure to create a PDF trailer *
**********************************************************************
P PDFTrailer B
D PDFTrailer PI
D laDateTime S 14A
D i S 10I 0
D liXRef S 10I 0
* Create information object
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('<<')
C CALLP WritePDF( '/Creator ('
C + %trim(saPgmLib)
C + '/'
C + %trim(saPgmName)
C + ')' )
C IF %subst(saOpenDate:1:1) = '0'
C EVAL laDateTime = '19' + %subst(saOpenDate:2:6)
C + saOpenTime
C ELSE
C EVAL laDateTime = '20' + %subst(saOpenDate:2:6)
C + saOpenTime
C ENDIF
C CALLP WritePDF( '/CreationDate (D:'
C + laDateTime + ')')
C CALLP WritePDF('/Title (' + %trim(paTitle) + ')')
C CALLP WritePDF('/Producer (CVTSPLPDF)')
C CALLP WritePDF('/Keywords ()')
C CALLP WritePDF( '/Author ('
C + %trim(saJobNbr)
C + '/'
C + %trim(saUser)
C + '/'
C + %trim(saJobName)
C + ')' )
C CALLP WritePDF('>>')
C CALLP WritePDF('endobj')
* Create cross-reference
C EVAL liXref = wiChrCount - 1
C CALLP WritePDF('xref 0 '
C + %trim(NumToText(wiObject+1)) )
C CALLP WritePDF('0000000000 65535 f')
C DO wiObject i
C CALLP WritePDF(aaStart(i) + ' 00000 n')
C ENDDO
* Write trailer
C CALLP WritePDF('trailer')
C CALLP WritePDF('<<')
C CALLP WritePDF('/Size '
C + %trim(NumToText(wiObject+1)))
C CALLP WritePDF('/Root 1 0 R')
C CALLP WritePDF('/Info '
C + %trim(NumToText(wiObject))
C + ' 0 R')
C CALLP WritePDF('>>')
C CALLP WritePDF('startxref')
C CALLP WritePDF(%trim(NumToText(liXref)))
C CALLP WritePDF('%%EOF')
P PDFTrailer E
**********************************************************************
* Procedure to create a new PDF 'object' *
**********************************************************************
P NewObject B
D NewObject PI
D lsDataLen S 10S 0
D i S 10I 0
C EVAL wiObject = wiObject + 1
C EVAL i = wiObject
C EVAL lsDataLen = wiChrCount
C MOVE lsDataLen aaStart(i)
P NewObject E
**********************************************************************
* Procedure to output PDF data
**********************************************************************
P WritePDF B
D WritePDF PI
D iaOutput 378A CONST OPTIONS(*VARSIZE)
D liLength S 5I 0
* Update byte count with length of data to be written
C ' ' CHECKR iaOutput liLength
C EVAL wiChrCount= wiChrCount + liLength + 2
* Output data to work file
C EVAL saOutput = %trimr(iaOutput)
C WRITE JSPLCVT01 OutputData
P WritePDF E
**********************************************************************
* Procedure to convert a number to text *
**********************************************************************
P NumToText B
D NumToText PI 10A
D iiNum 10I 0 CONST
D laSign S 1A
D laInput S 10A
D laOutput S 10A
D liIn S 5I 0
D liOut S 5I 0
D liNum S 10I 0
* Set up sign if and make number positive if number is negative
C IF iiNum < 0
C EVAL laSign = '-'
C EVAL liNum = -iiNum
C ELSE
C EVAL laSign = ' '
C EVAL liNum = iiNum
C ENDIF
* Number number to work character variable
C MOVE liNum laInput
* Skip over leading zeros
C EVAL liIn = 1
C EVAL liOut = 1
C DOW liIn < %size(laInput)
C and %subst(laInput:liIn:1) = '0'
C EVAL liIn = liIn + 1
C ENDDO
* Move digits to output area
C DOW liIn <= %size(laInput)
C and liOut <= %size(laOutput)
C EVAL %subst(laOutput:liOut:1)
C = %subst(laInput :liIn :1)
C EVAL liIn = liIn + 1
C EVAL liOut = liOut + 1
C ENDDO
* Add sign
C IF laSign = '-'
C EVAL laOutput = laSign + laOutput
C ENDIF
* Return number in text format
C RETURN laOutput
P NumToText E
**********************************************************************
* Procedure to add an escape character before special characters *
**********************************************************************
P AddEscape B
D AddEscape PI 378A
D iaInput 378A
D laOutput S 378A
D laChar S 1A
D i S 5I 0
D o S 5I 0
D liLength S 5I 0
* Determine length of input data
C ' ' CHECKR iaInput liLength
* Work through input data and prefix special characters with escape
C EVAL i = 1
C EVAL o = 0
C DOW i <= liLength
C EVAL laChar = %subst(iaInput:i:1)
C IF laChar = '\' or laChar = '(' or laChar = ')'
C EVAL o = o + 1
C EVAL %subst(laOutput:o:1) = '\'
C ENDIF
C EVAL o = o + 1
C EVAL %subst(laOutput:o:1) = laChar
C EVAL i = i + 1
C ENDDO
C RETURN laOutput
P AddEscape E
**********************************************************************
* Procedure to create a new page object *
**********************************************************************
P NewPage B
D NewPage PI
* Create a page object
C EVAL wiPage = wiPage + 1
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('<<')
C CALLP WritePDF('/Type /Page')
C CALLP WritePDF('/Parent 5 0 R')
C CALLP WritePDF( '/Resources << /Font <<'
C + ' /F1 4 0 R >>'
C + ' /ProcSet 3 0 R >>')
C CALLP WritePDF('/MediaBox [0 0 792 612]')
C CALLP WritePDF( '/Contents '
C + %trim(NumToText(wiObject+1))
C + ' 0 R')
C CALLP WritePDF('>>')
C CALLP WritePDF('endobj')
* Set up bookmark if *PAGNBR option specified
C IF paBookmark = '*PAGNBR'
C EVAL waBookmark = 'Page '
C + %trim(NumToText(wiPage))
C ELSE
C EVAL waBookmark = *BLANKS
C EVAL wiOccurs = 0
C ENDIF
* Create a stream object
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF( '<< /Length '
C + %trim(NumToText(wiObject+1))
C + ' 0 R >>')
C CALLP WritePDF('stream')
C EVAL wiStart = wiChrCount
C CALLP WritePDF('BT')
* Determine font size to use from Characters per inch setting
C SELECT
C WHEN siCPI = 50
C CALLP WritePDF('/F1 20 Tf')
C WHEN siCPI = 120
C CALLP WritePDF('/F1 9 Tf')
C WHEN siCPI = 150
C CALLP WritePDF('/F1 6 Tf')
C WHEN siCPI = 167
C CALLP WritePDF('/F1 6 Tf')
C OTHER
C CALLP WritePDF('/F1 10 Tf')
C ENDSL
P NewPage E
**********************************************************************
* Procedure to finish a page object *
**********************************************************************
P EndPage B
D EndPage PI
D liLength S 10I 0
* End text stream
C CALLP WritePDF('ET')
C EVAL liLength = wiChrCount- wiStart
C CALLP WritePDF('endstream')
C CALLP WritePDF('endobj')
* Create indirect length object for stream
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF(%trim(NumToText(liLength)))
C CALLP WritePDF('endobj')
* Create outline object
C EVAL waBookmark = AddEscape(waBookMark)
C CALLP NewObject
C CALLP WritePDF(%trim(NumToText(wiObject))+' 0 obj')
C CALLP WritePDF('<<')
C CALLP WritePDF('/Parent 2 0 R')
C CALLP WritePDF( '/Title ('
C + %trimr(waBookmark) + ')')
C IF wiPage > 1
C CALLP WritePDF( '/Prev '
C + %trim(NumToText(wiObject-4))
C + ' 0 R')
C ENDIF
C IF wiPage < siPages
C CALLP WritePDF( '/Next '
C + %trim(NumToText(wiObject+4))
C + ' 0 R')
C ENDIF
C CALLP WritePDF('/Dest ['
C + %trim(NumToText(wiObject-3))
C + ' 0 R /XYZ 0 792 0]')
C CALLP WritePDF('>>')
C CALLP WritePDF('endobj')
P EndPage E
//ENDSRC
//ENDBCHJOB