Learn from sources
       Member LAB31C in CGI400C2 / QRPGLESRC

       *********************************************************************
       *  RPG ILE MODULE CGI400C22/LAB31C
       *
       *  After compiling this RPG MODULE,
       *  create the related program with the following command:
       *
       *  CRTPGM CGI400C2/LAB31C MODULE(CGI400C2/LAB31C)
       *         ACTGRP(CGI) AUT(*USE)
       *
       *********************************************************************
       /copy CGI400C2/qrpglesrc,hspecs
       /copy CGI400C2/qrpglesrc,hspecsbnd
      FCUS01     IF A e           K DISK    USROPN
      FCOUNTRIES IF   e           K DISK    USROPN
       *=====================================================================
       * Includes to be used in all CGIs
       *=====================================================================
       /copy CGI400C2/qrpglesrc,prototypeb
       /copy CGI400C2/qrpglesrc,usec
       /copy CGI400C2/qrpglesrc,variables3
       *--------------------------------------------------------------------
       *  Other program variables and constants
       *--------------------------------------------------------------------
       * variables parsed from the input string                              er conversion
      D action          s             10a
      D xcus01sex       s              1a
      D xcus01fnm       s             30a
      D xcus01lnm       s             30a
      D xcus01adr       s             50a
      D xcus01zip       s             15a
      D xcus01cit       s             50a
      D xcus01sta       s             30a
      D xcus01ctr       s             30a
       *
      D OpenSW          s              1a
      D Char500         s            500a
       *
      DColor01          s             10A
      DColor02          s             10A
      DColor03          s             10A
      DColor04          s             10A
      DColor05          s             10A
      DColor06          s             10A
      DColor07          s             10A
      DColor08          s             10A
       *
      DRed              s             10A   inz('red')
      DInpErrSW         s              1A
       *=====================================================================
       * Main line
       *=====================================================================
       * Read remote browser request (input string)
       /copy CGI400C2/qrpglesrc,prolog3
       * Parse the input string
      C                   eval      action     = zhbgetvar('action     ')
      C                   eval      xcus01sex  = zhbgetvar('xcus01sex  ')
      C                   eval      xcus01fnm  = zhbgetvar('xcus01fnm  ')
      C                   eval      xcus01lnm  = zhbgetvar('xcus01lnm  ')
      C                   eval      xcus01adr  = zhbgetvar('xcus01adr  ')
      C                   eval      xcus01zip  = zhbgetvar('xcus01zip  ')
      C                   eval      xcus01cit  = zhbgetvar('xcus01cit  ')
      C                   eval      xcus01sta  = zhbgetvar('xcus01sta  ')
      C                   eval      xcus01ctr  = zhbgetvar('xcus01ctr  ')
       * Ask the service program to load into core
       * the appropriate external html
       * (Note that if this loading was already performed,
       *  and the external html was not changed,
       *  the service program will ignore the load request,
       *  thus providing a significant response time improvement)
      C                   callp     gethtml('HTMLSRC':
      C                             'CGI400C2':
      C                             'LAB31C')
       *------------------
       * Start the html
      C                   callp     wrtsection('top')
       * Override and open files (if the first time through)
      C                   exsr      OpenDbf
       *------------------
       * Check the action requested
      C                   eval      action = uppify(action)
      C                   if        action «» 'REGISTER'
      C                   exsr      DftColors
      C                   exsr      Init
      C                   else
      C                   exsr      Register
      C                   endif
       * Leave the files opened, to save time on the next CGI request
       * Send the html buffer and exit
      C                   exsr      Exit
       *=====================================================================
       * Issue the form to be filled in
       *=====================================================================
      C     Init          begsr
       * Issue the first part of the form
      C                   exsr      SetForm
      C                   callp     wrtsection('form')
       * Issue the countries selection list
      C                   eval      ctrnam = *loval
      C     ctrnam        setll     ctrrec
       *    read loop
      C                   read      ctrrec
      C                   dow       not %eof
      C                   exsr      SetCtrRow
      C                   callp     wrtsection('ctrrow')
      C                   read      ctrrec
      C                   enddo
       * End the selection list, end the form
      C                   callp     wrtsection('ctrend')
       *
      C                   endsr
       *=====================================================================
       * Register a new customer
       *=====================================================================
      C     Register      begsr
       * Check input data- If any error, don't come back
      C                   exsr      ChkInpDta
       * Assign customer number
      C                   eval      cus01nbr = *hival
      C     cus01nbr      setgt     cus01rcd
      C                   readp     cus01rcd
      C                   if        not %eof
      C                   eval      cus01nbr = cus01nbr +1
      C                   else
      C                   eval      cus01nbr = 1
      C                   endif
       * File new customer record
      C                   eval      Cus01Sex = xCus01Sex
      C                   eval      Cus01Fnm = xCus01Fnm
      C                   eval      Cus01Lnm = xCus01Lnm
      C                   eval      Cus01Zip = xCus01Zip
      C                   eval      Cus01Adr = xCus01Adr
      C                   eval      Cus01Cit = xCus01Cit
      C                   eval      Cus01Sta = xCus01Sta
      C                   eval      Cus01Ctr = xCus01Ctr
      C                   write     cus01rcd                             69
       * Send compliments for having registered
      C                   exsr      SetDone
      C                   callp     wrtsection('done')
       * Leave the file opened, to save time on the next CGI request
      C                   endsr
       *=====================================================================
       * Check input data
       *=====================================================================
      C     ChkInpDta     begsr
      C                   eval      inpErrSW = ' '
      C                   exsr      DftColors
       *
      C                   if        xcus01sex = ' '
      C                   eval      Color01 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01fnm = ' '
      C                   eval      Color02 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01lnm = ' '
      C                   eval      Color03 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01adr = ' '
      C                   eval      Color04 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01zip = ' '
      C                   eval      Color05 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01cit = ' '
      C                   eval      Color06 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01sta = ' '
      C                   eval      Color07 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
      C                   if        xcus01ctr = ' '
      C                   eval      Color08 = Red
      C                   eval      InpErrSW = 'X'
      C                   endif
       *
      C                   if        InpErrSW «» ' '
      C                   callp     wrtsection('inperr')
      C                   exsr      Init
      C                   exsr      Exit
      C                   endif
       *
      C                   endsr
       *=====================================================================
       * Set headers default colors
       *=====================================================================
      C     DftColors     begsr
      C                   eval      Color01 = 'black'
      C                   eval      Color02 = 'black'
      C                   eval      Color03 = 'black'
      C                   eval      Color04 = 'black'
      C                   eval      Color05 = 'black'
      C                   eval      Color06 = 'black'
      C                   eval      Color07 = 'black'
      C                   eval      Color08 = 'black'
      C                   endsr
       *=====================================================================
       * Set variables in html section "form"
       *=====================================================================
      C     SetForm       begsr
       * Sex
      C                   callp     updHtmlVar('XCUS01SEX' + xCus01Sex:
      C                             'checked':
      C                             InitHtmlVars)
       * First name
      C                   callp     updHtmlVar('XCUS01FNM':xcus01fnm)
       * Last name
      C                   callp     updHtmlVar('XCUS01LNM':xcus01lnm)
       * Address
      C                   callp     updHtmlVar('XCUS01ADR':xcus01adr)
       * ZIP
      C                   callp     updHtmlVar('XCUS01ZIP':xcus01zip)
       * City
      C                   callp     updHtmlVar('XCUS01CIT':xcus01cit)
       * State
      C                   callp     updHtmlVar('XCUS01STA':xcus01sta)
       * Country
      C                   callp     updHtmlVar('XCUS01CTR':xcus01ctr)
       *------------------
       * Colors of the headers
       *------------------
      C                   callp     updHtmlVar('COLOR01':Color01)
      C                   callp     updHtmlVar('COLOR02':Color02)
      C                   callp     updHtmlVar('COLOR03':Color03)
      C                   callp     updHtmlVar('COLOR04':Color04)
      C                   callp     updHtmlVar('COLOR05':Color05)
      C                   callp     updHtmlVar('COLOR06':Color06)
      C                   callp     updHtmlVar('COLOR07':Color07)
      C                   callp     updHtmlVar('COLOR08':Color08)
       *
      C                   endsr
       *=====================================================================
       * Set variables in html section "ctrrow"
       *=====================================================================
      C     SetCtrRow     begsr
       * Country name
      C                   callp     updHtmlVar('XCTRNAM':CtrNam)
       * Selected?
      C                   select
      C                   when      CtrNam =  xCus01Ctr
      C                   callp     updHtmlVar('SELECTED':'selected')
      C                   when      CtrNam «» xCus01Ctr
      C                   callp     updHtmlVar('SELECTED':' ')
      C                   endsl
       *
      C                   endsr
       *=====================================================================
       * Set variables in html section "done"
       *=====================================================================
      C     SetDone       begsr
       * Customer number (unedited)
      C                   movel(p)  Cus01Nbr      char500
      C                   callp     updHtmlVar('XCUS01NBR':char500)
       *
      C                   endsr
       *=====================================================================
       * Override and open file (if the first time through)
       *=====================================================================
      C     OpenDbf       begsr
      C                   IF        OpenSW = ' '
      C                   eval      OpenSW = 'x'
      C                   eval      rc = docmd('OVRDBF FILE(CUS01) +
      C                             TOFILE(CENTAUR2/CUS01) +
      C                             RCDFMTLCK((CUS01RCD *SHRUPD)) +
      C                             SECURE(*YES)')
      C                   eval      rc = docmd('OVRDBF FILE(COUNTRIES) +
      C                             TOFILE(CENTAUR2/COUNTRIES) +
      C                             SECURE(*YES)')
      C                   open      CUS01
      C                   open      COUNTRIES
      C                   ENDIF
      C                   endsr
       *=====================================================================
       * Send response html and quit
       *=====================================================================
      C     Exit          begsr
       * End html
      C                   callp     wrtsection('end')
       * 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')
       * Return without raising LR indicator:
       * this will provide enhanced response time on the next request
       * for this CGI
      C                   return
      C                   endsr
0.037 sec.s