Article

RPG Source Code

Eric Nepsund

===============
RPG Source Code
===============

F*************************************************************************/ 
     F* OBJECT NAME....: CVTSPLHTMR                                           */ 
     F* DESCRIPTION....: Convert spooled file to HTML.                        */ 
     F* RELEASE........: V4R2                                                 */ 
     F* COMPILE NOTES..: 1) Execute the following prior to compile:           */ 
     F*                        CRTPF FILE(QTEMP/FILEIN) +                     */ 
     F*                          RCDLEN(202)  SIZE(*NOMAX)                    */ 
     F*                        CRTPF FILE(QTEMP/FILEOUT) +                    */ 
     F*                          RCDLEN(1024) SIZE(*NOMAX)                    */ 
     F*                                                                       */ 
     F* DATE WRITTEN...: 02/08/2001                                           */ 
     F* AUTHOR.........: Eric Nepsund                                         */ 
     F*************************************************************************/ 
     F* 
     F*---------------------------------------------------------------- 
     F* FILE DEFINITION 
     F*---------------------------------------------------------------- 
     F* 
     FFILEIN  IF  F     202            DISK 
     FFILEOUT O   F    1024            DISK                      A 
     E* 
     E*---------------------------------------------------------------- 
     E* Tables/Arrays: 
     E*---------------------------------------------------------------- 
     E* 
     E* String in (spooled file record). 
     E                    STI       202  1 
     E* String out (HTML). 
     E                    STO      1024  1 
     E* 
     E* HTML header usage. 
     E                    HTH     1  10 80 
     E* 
     E* HTML detail usage. 
     E                    HTD     1   4 80 
     E* 
     E* HTML footer usage 
     E                    HTF     1   3 80 
     I* 
     I*---------------------------------------------------------------- 
     I* Named constants. 
     I*---------------------------------------------------------------- 
     I* 
     I              '0123456789'          C         KDIGTS 
     I              '!@#'                 C         KFROM 
     I              '<>&'                 C         KTO 
     I* 
     I*---------------------------------------------------------------- 
     I* FILES 
     I*---------------------------------------------------------------- 
     I* 
     IFILEIN  NS  01 
     I                                        1   3 INSKPB 
     I                                        4   4 INSPCB 
     I                                        5 202 INDATA 
     C* 
     C*---------------------------------------------------------------- 
     C* Main 
     C*---------------------------------------------------------------- 
C* 
     C                     EXSR INZ001 
     C                     EXSR HTHEAD 
     C                     EXSR HTDETL 
     C                     EXSR HTFOOT 
     C                     EXSR EXIT 
     C* 
     C*---------------------------------------------------------------- 
     C* Initialize. 
     C*---------------------------------------------------------------- 
     C           INZ001    BEGSR 
     C* 
     C           *ENTRY    PLIST 
     C                     PARM           P1LPP   3 
     C* 
     C* If LPP is not numeric, set default. 
     C           KDIGTS    CHECKP1LPP     X 
     C           X         IFNE *ZEROS 
     C                     Z-ADD068       LPP     30 
     C                     ELSE 
     C                     MOVE P1LPP     LPP 
     C                     ENDIF 
     C* 
     C* Initialize counters. 
     C                     Z-ADD*ZEROS    WKLPP   30 
     C                     Z-ADD0         LADD    30 
     C                     Z-ADD0         LCNT    30 
     C                     Z-ADD0         LSKPB   30 
     C                     Z-ADD0         LSPCB   30 
     C* 
     C                     ENDSR 
     C* 
     C*---------------------------------------------------------------- 
     C* Write HTML header records. 
     C*---------------------------------------------------------------- 
     C           HTHEAD    BEGSR 
     C* 
     C                     DO   10        X       40 
     C                     MOVEAHTH,X     WK80   80 P 
     C           KFROM:KTO XLATEWK80      WK80 
     C                     MOVELWK80      OODTA1    P 
     C                     MOVE *BLANKS   OODTA2    P 
     C                     MOVE *BLANKS   OODTA3    P 
     C                     MOVE *BLANKS   OODTA4    P 
     C                     EXCPTOUTDTA 
     C                     ENDDO 
     C* 
     C                     ENDSR 
     C* 
     C*---------------------------------------------------------------- 
     C* Write HTML detail records. 
     C*---------------------------------------------------------------- 
     C           HTDETL    BEGSR 
     C* 
     C                     DO   *HIVAL 
     C* 
     C                     READ FILEIN                   90 
     C* 
     C           *IN90     IFEQ *ON 
     C                     LEAVE 
     C                     ENDIF 
     C* 
     C* Convert Skip-Before from alpha to numeric. 
     C           INSKPB    IFNE *BLANKS 
     C                     MOVE INSKPB    LSKPB 
     C                     ELSE 
     C                     MOVE *ZEROS    LSKPB 
     C                     ENDIF 
     C* 
     C* Convert Space-Before from alpha to numberic. 
     C           INSPCB    IFNE *BLANKS 
     C                     MOVE INSPCB    LSPCB 
     C                     ELSE 
     C                     MOVE *ZEROS    LSPCB 
     C                     ENDIF 
     C* 
     C* Skip before handling within current page. 
     C           LSKPB     IFNE *ZEROS 
     C           LCNT      ANDGT*ZEROS 
     C           LCNT      ANDLTLSKPB 
     C           LSKPB     SUB  LCNT      LADD 
     C                     SUB  1         LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     ELSE 
     C*                    : 
     C* Skip before handling to fill prior page & then start new page. 
     C           LSKPB     IFNE *ZEROS 
     C           LCNT      ANDGT*ZEROS 
     C           LCNT      ANDGTLSKPB 
     C           LCNT      ANDLELPP 
     C           LPP       SUB  LCNT      LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     Z-ADD*ZEROS    LCNT 
     C           LSKPB     SUB  1         LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     ELSE 
     C*                    : : 
     C* Skip before handling to fill prior page & then start new page. 
     C           LSKPB     IFNE *ZEROS 
     C           LCNT      ANDGT*ZEROS 
     C           LCNT      ANDGTLSKPB 
     C           LCNT      ANDGTLPP 
     C* 
     C                     Z-ADDLPP       WKLPP 
     C                     DO   *HIVAL 
     C                     ADD  LPP       WKLPP 
     C           WKLPP     IFGE LCNT 
     C                     LEAVE 
     C                     ENDIF 
     C                     ENDDO 
     C* 
     C           WKLPP     SUB  LCNT      LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     Z-ADD*ZEROS    LCNT 
     C           LSKPB     SUB  1         LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     ELSE 
     C*                    : : : 
     C* Skip before handling for new page. 
     C           LSKPB     IFNE *ZEROS 
     C           LCNT      ANDEQ*ZEROS 
     C           LSKPB     SUB  1         LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     ELSE 
     C*                    : : : : 
     C* Space before handling. 
     C           LSPCB     IFNE *ZEROS 
     C           LSPCB     ANDGT1 
     C           LSPCB     SUB  1         LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     ENDIF 
     C                     ENDIF 
     C                     ENDIF 
     C                     ENDIF 
     C                     ENDIF 
     C* 
     C* Convert non-blank lines 
* 
      *     Determine last non-blank character. 
     C           ' '       CHEKRINDATA    ENDPOS  30 
     C           ENDPOS    IFEQ *ZEROS 
     C                     Z-ADD200       ENDPOS 
     C                     ENDIF 
      * 
      *     Convert characters in string/record. 
     C                     MOVEAINDATA    STI 
     C                     MOVEA*BLANKS   STO 
     C                     Z-ADD1         I       40 
     C                     Z-ADD1         O       40 
      * 
     C                     DO   *HIVAL 
      * 
      *          Leave if over max array size. 
     C           I         IFGT 200 
     C           O         ORGT 1024 
     C                     LEAVE 
     C                     ENDIF 
      * 
      *          Set beginning of string. 
     C           I         IFEQ 1 
     C                     MOVEAHTD,2     WK80 
     C           KFROM:KTO XLATEWK80      WK80 
     C                     MOVELWK80      LINF1B  6 
     C                     MOVEALINF1B    STO,O 
     C                     ADD  6         O 
     C                     ENDIF 
      * 
      *          If at end of string, set line feed and get out. 
     C           I         IFGT ENDPOS 
     C                     MOVEAHTD,3     WK80 
     C           KFROM:KTO XLATEWK80      WK80 
     C                     MOVELWK80      LINF1E  5 
     C                     MOVEALINF1E    STO,O 
     C                     ADD  7         O 
     C                     LEAVE 
     C                     ENDIF 
      * 
      *          Skip if not in column range (ultimately pass parm) 
     C           I         IFLT 1 
     C           I         ORGT 200 
     C                     ITER 
     C                     ENDIF 
      * 
      *          Convert spaces to hidden characters. 
      *           (This eliminates the line wrap and makes things 
      *            more difficult(tedious) for someone to manually 
      *            copy/change the HTML code) 
     C           STI,I     IFEQ ' ' 
     C                     MOVEAHTD,1     WK80 
     C           KFROM:KTO XLATEWK80      WK80 
     C                     MOVELWK80      LINSPC  6 
     C                     MOVEALINSPC    STO,O 
     C                     ADD  6         O 
     C                     ELSE 
     C                     MOVEASTI,I     STO,O 
     C                     ADD  1         O 
     C                     ENDIF 
     C* 
     C                     ADD  1         I 
     C* 
     C                     ENDDO 
     C* 
     C* Skip duplicate lines when used for bold purposes. 
     C                     MOVEASTO,1     NWDTA1256 P 
     C                     MOVEASTO,257   NWDTA2256 P 
     C                     MOVEASTO,513   NWDTA3256 P 
     C                     MOVEASTO,769   NWDTA4256 P 
     C           LSPCB     IFEQ *ZEROS 
     C           LSKPB     ANDEQ*ZEROS 
     C           NWDTA1    ANDEQOODTA1 
     C           NWDTA2    ANDEQOODTA2 
     C           NWDTA3    ANDEQOODTA3 
     C           NWDTA4    ANDEQOODTA4 
     C                     ITER 
     C                     ENDIF 
     C* 
     C* Write non-blanks lines. 
     C                     MOVEASTO,1     OODTA1256 P 
     C                     MOVEASTO,257   OODTA2256 P 
     C                     MOVEASTO,513   OODTA3256 P 
     C                     MOVEASTO,769   OODTA4256 P 
     C                     EXCPTOUTDTA 
     C                     ADD  1         LCNT 
     C* 
     C* Reset line counter for page (if last line was just output) 
     C           LCNT      IFEQ LPP 
     C                     Z-ADD*ZEROS    LCNT 
     C                     ENDIF 
     C* 
     C                     ENDDO 
     C* 
     C* LR time filling of last page. 
     C           LCNT      IFGT *ZEROS 
     C           LPP       SUB  LCNT      LADD 
     C                     EXSR HTDET1                     Add blank lines 
     C                     ENDIF 
     C* 
     C                     ENDSR 
     C* 
     C*---------------------------------------------------------------- 
     C* SR to add blank lines. 
     C*---------------------------------------------------------------- 
     C           HTDET1    BEGSR 
     C* 
     C           LADD      IFGT *ZERO 
     C                     DO   LADD 
     C                     MOVEAHTD,4     WK80 
     C           KFROM:KTO XLATEWK80      WK80 
     C                     MOVELWK80      LINF2B  4 
     C                     EXCPTOUTBLK 
     C                     ADD  1         LCNT 
     C                     ENDDO 
     C                     ENDIF 
     C* 
     C                     ENDSR 
     C* 

C*---------------------------------------------------------------- 
     C* Write HTML footer records. 
     C*---------------------------------------------------------------- 
     C           HTFOOT    BEGSR 
     C* 
     C                     DO   3         X       40 
     C                     MOVEAHTF,X     WK80      P 
     C           KFROM:KTO XLATEWK80      WK80 
     C                     MOVELWK80      OODTA1    P 
     C                     MOVE *BLANKS   OODTA2    P 
     C                     MOVE *BLANKS   OODTA3    P 
     C                     MOVE *BLANKS   OODTA4    P 
     C                     EXCPTOUTDTA 
     C                     ENDDO 
     C* 
     C                     ENDSR 
     C* 
     C*---------------------------------------------------------------- 
     C* Exit subroutine. 
     C*---------------------------------------------------------------- 
     C           EXIT      BEGSR 
     C* 
     C                     MOVE *ON       *INLR 
     C                     RETRN 
     C* 
     C                     ENDSR 
     C*---------------------------------------------------------------- 
     C* OUTPUT SPECS: 
     C*---------------------------------------------------------------- 
     OFILEOUT EADD             OUTBLK 
     O                         LINF2B     4 
     O        EADD             OUTDTA 
     O                         OODTA1   256 
     O                         OODTA2   512 
     O                         OODTA3   768 
     O                         OODTA4  1024 
** HTH - HTML standard header usage 
!HTML@ 
!HEAD@ 
!TITLE@Report created by CVTSPLHTM (Convert AS/400 Spooled File to HTML)!/TITLE@ 
!META NAME="Generator" CONTENT="CVTSPLHTM (Convert AS/400 Spooled File to HTML)"@ 
!META NAME="Author"CONTENT="CVTSPLHTM (Convert AS/400 Spooled File to HTML)"@ 
!style@ 
P {font-family:Courier New; font-weight:500; font-size:8.0 pt} 
!/style@ 
!/HEAD@ 
!P@ 
** HTD - HTML detail usage 
#nbsp; 
!NOBR@ 
!/BR@ 
!BR@ 
** HTF - HTML standard footer usage 
!/FONT@ 
!/BODY@ 
!/HTML@ 

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to: