RPG Source Code

===============
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@ 

0 comments

Oldest 

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:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close