Learn from sources
       star Member CTRDVY in CGIDEV2 / QRPGLESRC

       *=====================================================================
       *  RPG ILE MODULE CGIDEV2/CTRDVY
       *
       *  After compiling this RPG MODULE,
       *  create the related program with the following command:
       *
       *  CRTPGM CGIDEV2/CTRDVY MODULE(CGIDEV2/CTRDVY) ACTGRP(CRTDVY)
       *
       *  To execute this program,
       *  enter the following in your WEB browser command line:
       *    http://.../cgidev2p/ctrdvy.pgm
       *
       *=====================================================================
       /copy CGIDEV2/qrpglesrc,hspecs
       /copy CGIDEV2/qrpglesrc,hspecsbnd
      FCTRDVY    if   e           k disk    usropn
      F                                     extfile('CGIDEV2/CTRDVY')
       *=====================================================================
       * Includes to be used in all CGIs
       *=====================================================================
       /copy CGIDEV2/qrpglesrc,prototypeb
       /copy CGIDEV2/qrpglesrc,usec
       /copy CGIDEV2/qrpglesrc,variables3
       *--------------------------------------------------------------------
       *  Variables to receive input string parameters
       *--------------------------------------------------------------------
      D request         s             10a
      D YourName        s             15a
      D Pos_to          s             15a
      D PagUpDwn        s              8a
      D LstSeqNoC       s              5a
      D LinesInPgC      s              5a
      D LstCtr          s             30a
       *--------------------------------------------------------------------
       *  Other program variables and constants
       *--------------------------------------------------------------------
       * Name of this program
      D PgmName         c                   'CTRDVY'
       * External HTML
      D extHtml         s           2000    inz('/cgidev/html/ctrdvy.txt')
       * Indicators for GetHtmlIfsMult subprocedure
      D IfsMultIndicators...
      d                 ds
      D  NoErrors                       n
      D  NameTooLong                    n
      D  NotAccessible                  n
      D  NoFilesUsable                  n
      D  DupSections                    n
      D  FileIsEmpty                    n
       *
      D Page1SW         s              1a
      D EofSW           s              1a
      D PageSize        s              5s 0 inz(10)
      D a               s              5s 0
      D b               s              5s 0
      D i               s              5s 0
      D RollBack        s              5s 0
      D LinesInPag      s              5s 0
      D SeqNo           s              5s 0
      D LstSeqNo        s              5s 0
      D Zero5           s              5a   inz('00000')
       *===================================================
       * The following variables have nothing to do with this CGI.
       * They are there just to allow the testing of some subprocedures.
       *===================================================
       * Variable for testing subprocedure  ZhbCountAllVars
      D  nbrInpVars     s             10i 0
       * Variables for testing subprocedure ZhbGetVarDetails
      D  ThisVarVal     s           1000a
      D  ThisOccur      s             10i 0
      D  ThisVarName    s             50
      D  ThisVarOccur   s             10i 0
      D  FoundInd       s               n
       * Variables for testing subprocedure RtvSubsVarInfo
      D  SectionIn      s             50
      D  RelSeqNo       s             10i 0
      D  ReturnDS       s             92
      D RetDS           ds
      D  RetSection                   50
      D  RetVar                       30
      D  RetStartPos                  10u 0
      D  RetLen                       10u 0
       *=====================================================================
      C                   exsr      SetTimeStr
       *=====================================================================
       * Read remote browser input
       *=====================================================================
       /copy CGIDEV2/qrpglesrc,prolog3
       *=====================================================================
       * The following lines are not needed in this program.
       * They just illustrate the use of two subprocedures:
       *      - ZhbCountAllVars
       *      - ZhbGetVarDetails
       *=====================================================================
       * Example of retrieving
       * the number of occurrences of all variables in the CGI input
      C                   eval      nbrInpVars = ZhbCountAllVars
       * Example of retrieving
       * detailed information for all the input variables
      C                   if        nbrInpVars » 0
      C     1             do        nbrInpVars    ThisOccur
      C                   eval      ThisVarVal =
      C                             ZhbGetVarDetails(ThisOccur:
      C                             ThisVarName:
      C                             ThisVarOccur:
      C                             FoundInd)
      C                   enddo
      C                   endif
       * Example of clearing the HTML output buffer
      C                   callp     clrHtmlBuffer
       *=====================================================================
       * Main line
       *=====================================================================
       * Parse the input string
       * Main function
      C                   eval      request  = zhbgetvarupper('request')
       * Customer name
      C                   eval      YourName = zhbgetvar('yrname')
       * Position to ...
      C                   eval      Pos_to   = zhbgetvar('pos_to')
       * Page up or down?
      C                   eval      PagUpDwn = zhbgetvar('pageupdown')
       * Last country displayed in html page
      C                   eval      LstCtr   = zhbgetvar('lastcountry')
       * Last line number displayed in html page
      C                   eval      LstSeqNoC = zhbgetvar('lastseqno')
      C                   exsr      BldLstSeq
       * Number of lines displayed in html page
      C                   eval      LinesInPgC = zhbgetvar('linesinpage')
      C                   exsr      BldLinPag
       *------------------
       * Load external html
      C                   eval      IfsMultIndicators = getHtmlIfsMult(
      C                             %trim(exthtml):'«as400»')
       *------------------
       * Open file
      C                   if        not %open(CTRDVY)
      C                   open      CTRDVY
      C                   endif
       * Set output variables for section "top"
      C                   exsr      SetTop
       * Send section "top"
      C                   callp     wrtsection('top')
       * If just starting, ...
      C                   if        request=' '
      C                   exsr      Start
      C                   endif
       *------------------
      C                   callp     wrtsection('go')
       * Find 1st record in file
      C                   exsr      FindFirst
       *------------------
       * Position to the next input record
      C                   exsr      Position
       *
      C                   eval      LinesInPag = 0
       *------------------
       * Read
      C                   eval      eofSW = ' '
      C     LinesInPag    DOueq     PageSize
      C                   read      ctrrec
      C                   if        %eof
      C                   eval      eofSW = 'x'
      C                   leave
      C                   endif
      C                   eval      SeqNo = SeqNo +1
      C                   eval      LinesInPag  = LinesInPag  +1
      C                   IF        LinesInPag =1
      C                   callp     wrtsection('tabstr')
      C                   if        CtrNam = CtrNam1st
      C                   eval      Page1SW = 'x'
      C                   else
      C                   eval      Page1SW = *blank
      C                   endif
      C                   endIF
      C                   exsr      SetTabRow
      C                   callp     wrtsection('tabrow')
      C                   endDO
       *------------------
       * End of page or end of file:
      C                   exsr      SetTabEnd
      C                   IF        LinesInPag »= 1
      C                   callp     wrtsection('tabend')
      C                   if        Page1SW = ' '
      C                   callp     wrtsection('pageup')
      C                   endif
      C                   callp     wrtsection('eopageup')
      C                   if        eofSW = ' '
      C                   callp     wrtsection('pagedown')
      C                   endif
      C                   callp     wrtsection('eopagedown')
      C                   ELSE
      C                   callp     wrtsection('none')
      C                   ENDIF
       *------------------
       * Send the response html buffer and exit
      C                   exsr      Exit
       *=====================================================================
       * If just started, ...
       *=====================================================================
      C     Start         begsr
      C                   callp     wrtsection('start')
      C                   exsr      Exit
      C                   endsr
       *=====================================================================
       * Find the first record in the file
       *=====================================================================
      C     FindFirst     begsr
      C     *like         define    CtrNam        CtrNam1st
      C                   eval      CtrNam = *loval
      C     CtrNam        setll     ctrrec
      C                   read      ctrrec
      C                   if        not%eof
      C                   eval      CtrNam1st = CtrNam
      C                   endif
      C                   endsr
       *=====================================================================
       * Build the "last sequence number" field, "LstSeqNo"
       *=====================================================================
      C     BldLstSeq     begsr
       * shift it right, pad left with 0's
      C     ' '           checkr    LstSeqNoC     b
      C                   IF        b = 0
      C                   eval      LstSeqnoC = Zero5
      C                   ENDIF
      C                   IF        b = 5
      C                   move      LstSeqnoC     LstSeqno
      C                   ENDIF
      C                   IF        b «» 0 and b «» 5
      C                   eval      a = 5 - b
      C                   eval      LstSeqnoC = %subst(Zero5:1:a) +
      C                             %subst(LstSeqnoC:1:b)
      C                   ENDIF
      C                   testn                   LstSeqnoC            40
      C     *in40         ifeq      '1'
      C                   move      LstSeqnoC     LstSeqno
      C                   else
      C                   eval      LstSeqno = 0
      C                   endif
      C                   endsr
       *=====================================================================
       * Build the "lines in html page" field, "LinesInPag"
       *=====================================================================
      C     BldLinPag     begsr
       * shift it right, pad left with 0's
      C     ' '           checkr    LinesInPgC    b
      C                   IF        b = 0
      C                   eval      LinesInPgC = Zero5
      C                   ENDIF
      C                   IF        b = 5
      C                   move      LinesInPgC    LinesInPag
      C                   ENDIF
      C                   IF        b «» 0 and b «» 5
      C                   eval      a = 5 - b
      C                   eval      LinesInPgC = %subst(Zero5:1:a) +
      C                             %subst(LinesInPgC:1:b)
      C                   ENDIF
      C                   testn                   LinesInPgC           40
      C     *in40         ifeq      '1'
      C                   move      LinesInPgC    LinesInPag
      C                   else
      C                   eval      LinesInPag = 0
      C                   endif
      C                   endsr
       *=====================================================================
       * Position to the next record to read
       *=====================================================================
      C     Position      begsr
       *------------------
       * Position to beginning of file or to a given (generic) name
      C                   IF        PagUpDwn = ' '
      C                   if        Pos_to = ' '
      C                   eval      Seqno = 0
      C                   eval      CtrNam = *loval
      C     CtrNam        setll     ctrrec
      C                   else
      C                   exsr      RollTo
      C                   endif
      C                   ENDIF
       *------------------
       * Page down
      C     PagUpDwn      ifeq      'pagedown'
      C                   exsr      PageDown
      C                   endif
       *------------------
       * Page up
      C     PagUpDwn      ifeq      'pageup'
      C                   exsr      PageUp
      C                   endif
       *------------------
      C                   endsr
       *=====================================================================
       * Roll up to a given record
       *=====================================================================
      C     RollTo        begsr
      C     *like         define    Pos_to        Pos_toUp
      C     *like         define    CtrNam        CtrNamUp
      C                   eval      Pos_toUp = uppify(Pos_to)
      C     ' '           checkr    Pos_toUp      i
       *
      C                   eval      SeqNo = 0
      C                   eval      CtrNam = *loval
      C     CtrNam        setll     ctrrec
       *
      C                   read      ctrrec
      C                   dow       not%eof
      C                   eval      SeqNo = SeqNo +1
      C                   eval      CtrNamUp = %subst(CtrNam:1:i)
      C                   eval      CtrNamUp = uppify(CtrNamUp)
      C                   if        CtrNamUp »= Pos_toUp
      C                   leave
      C                   endif
      C                   read      ctrrec
      C                   enddo
       *
      C     CtrNam        setll     ctrrec
      C                   eval      SeqNo = SeqNo -1
       *
      C                   endsr
       *=====================================================================
       * Position to the beginning of the next page
       *=====================================================================
      C     PageDown      begsr
      C                   eval      CtrNam = LstCtr
      C                   eval      SeqNo = LstSeqNo
      C     CtrNam        setgt     ctrrec
      C                   endsr
       *=====================================================================
       * Position to the beginning of the previous page
       *=====================================================================
      C     PageUp        begsr
      C                   eval      CtrNam = LstCtr
      C                   eval      SeqNo = LstSeqNo
      C     CtrNam        chain     ctrrec
      C                   if        not%found
      C                   eval      SeqNo = 0
      C                   eval      CtrNam = *loval
      C                   goto      PageUpX
      C                   endif
       * Number of records do read backwards
      C                   eval      i = 0
      C                   eval      RollBack = PageSize + LinesInPag -1
       * Read previous
      C     i             doueq     RollBack
      C                   readp     ctrrec
      C                   if        %eof
      C                   eval      SeqNo = 0
      C                   eval      CtrNam = *loval
      C                   leave
      C                   endif
      C                   eval      i = i +1
      C                   eval      SeqNo = SeqNo -1
      C                   enddo
       *
      C     CtrNam        setll     ctrrec
      C                   if        SeqNo » 0
      C                   eval      SeqNo = SeqNo -1
      C                   endif
       *
      C     PageUpX       tag
      C                   endsr
       *=====================================================================
       * Set output variables for section "top"
       *=====================================================================
      C     SetTop        begsr
       *
       * Clear all variables and
       * set variable  "/%YOURNAME%/"
       * with the value taken from character field "YourName"
      C                   callp     updHTMLvar('YOURNAME':YourName:
      C                             InitHTMLVars)
       *
      C                   endsr
       *=====================================================================
       * Set output variables for section "tabrow"
       *=====================================================================
      C     SetTabRow     begsr
       *
       * Set variable  "/%SEQNO%/"
       * with the edited value taken from numeric field "SeqNo" (5,0)
      C                   callp     updhtmlvar('SEQNO':
      C                             %trim(%editc(SeqNo:'4')))
       * Set variable  "/%COUNTRY%/"
       * with the value taken from character field "CtrNam"
      C                   callp     updHTMLvar('COUNTRY':CtrNam:'1':'%trim')
       * Set variable  "/%DELVDAYS%/"
       * with the edited value taken from numeric field "CtrDay" (3,0)
      C                   callp     updhtmlvar('DELVDAYS':
      C                             %trim(%editw(CtrDay:' 0 ')))
       *
      C                   endsr
       *=====================================================================
       * Set output variables for section "tabend"
       *=====================================================================
      C     SetTabEnd     begsr
       *
       * set variable  "/%YOURNAME%/"
       * with the value taken from character field "YourName"
      C                   callp     updHTMLvar('YOURNAME':YourName:
      C                             InitHTMLVars)
       * Set variable  "/%LASTCOUNTRY%/"
       * with the value taken from character field "CtrNam"
      C                   callp     updHTMLvar('LASTCOUNTRY':CtrNam)
       * Set variable  "/%LASTSEQNO%/"
       * with the value taken from character field "Seqno"
      C                   callp     updHTMLvar('LASTSEQNO':
      C                             %trim(%editc(Seqno:'4')))
       * Set variable  "/%LINESINPAG%/"
       * with the value taken from character field "LinesInPag"
      C                   callp     updHTMLvar('LINESINPAG':
      C                             %trim(%editc(LinesInPag:'4')))
       *
      C                   endsr
       *=====================================================================
       *  Time started
       *=====================================================================
      C     SetTimeStr    begsr
      C                   time                    TimeStart
      C                   endsr
       *=====================================================================
       *  Time ended and time elapsed elapsed
       *=====================================================================
      C     SetTimeEnd    begsr
      C                   time                    TimeEnd
      C     TimeEnd       subdur    TimeStart     MsElaps:*ms
      C                   eval      SecElaps = MsElaps / 1000000
      C                   endsr
       *=====================================================================
       * Send response html and quit
       *=====================================================================
      C     Exit          begsr
      C                   exsr      SetTimeEnd
      C                   callp     updhtmlvar('RUNTIME':
      C                             %trim(%editw(SecElaps:'     0 .   ')))
      C                   callp     wrtsection('runtime')
      C                   callp     wrtsection('end')
       *------------------
       * Example of retrieving information about a substitution variable.
       * In this case, it will be the 1st variable in section "top"
      C                   eval      SectionIn = 'top'
      C                   eval      RelSeqno  = 1
      C                   eval      rc = RtvSubsVarInfo(SectionIn:
      C                                  RelSeqno:ReturnDS)
      C                   eval      RetDS = ReturnDS
       *------------------
       * Do not delete the call to wrtsection with section name *fini.  It is needed
       * to ensure that all output html that has been buffered gets output.
      C                   callp     wrtsection('*fini')
       *
       * Quit
      C*                  eval      *inlr = *on
      C                   return
      C                   endsr
0.053 sec.s