Learn from sources
       star Member BOATSCH0 in CGIDEV2 / QRPGLESRC

       *********************************************************************
       *  RPG ILE MODULE CGIDEV2/BOATSCH0
       *
       *  After compiling this RPG MODULE,
       *  create the related program with the following command:
       *
       *  CRTPGM CGIDEV2/BOATSCH0 MODULE(CGIDEV2/BOATSCH0
       *         CGIDEV2/SERVERNAME)
       *         ACTGRP(BOATSCH0) AUT(*USE)
       *
       *********************************************************************
       * MAIN PROGRAM FLOW
       *
       * 1 - Receives input from DEMOMENU html form
       *     (see member DEMOMENU in source file CGIDEV2/BOATHTML)
       *     telling which backgrond color should be used
       * 2 - Executes subroutime "setvardata"
       *     to set skeleton output html member BOATSCH0,
       *     then writes output html section "/$all"
       *     and quits.
       *********************************************************************
       /copy CGIDEV2/qrpglesrc,hspecs
       /copy CGIDEV2/qrpglesrc,hspecsbnd
       *--------------------------------------------------------------------
      FBoatTypes if   e           k disk    usropn
       *--------------------------------------------------------------------
       * Prototype definitions and standard system API error structure
       *--------------------------------------------------------------------
       /copy CGIDEV2/qrpglesrc,prototypeb
       /copy CGIDEV2/qrpglesrc,usec
       *--------------------------------------------------------------------
       * Variables common to CGI programs
       *--------------------------------------------------------------------
       /copy CGIDEV2/qrpglesrc,variables3
       *--------------------------------------------------------------------
       * Variables received from the input string
       *--------------------------------------------------------------------
      D lng             s              2
      D BckGnd          s             10
      D quit            s              4
       *--------------------------------------------------------------------
       * Other variables
       *--------------------------------------------------------------------
      D Lib             s             10
      D Fn              s             10
      D Mbr             s             10
      D BTypSW          s              1
       *--------------------------------------------------------------------
       * Prolog common to CGI programs
       * -Receive input from the remote browser
       *--------------------------------------------------------------------
       /copy CGIDEV2/qrpglesrc,prolog3
       *=====================================================================******
       * MAIN PROCESS LINE
       *=====================================================================******
 xxxxx * Get program start time for calculating execution time
 xxxxxC                   time                    timedata1
       * Parse input string
      C                   eval      lng    = zhbgetvar('lng')
      C                   eval      BckGnd = zhbgetvar('bckgnd')
      C                   eval      quit   = zhbgetvar('quit')
       * Convert to uppercase
      C                   eval      lng = uppify(lng)
      C                   eval      BckGnd = uppify(BckGnd)
       * Set output skeleton html member name
      C                   exsr      SetSkl
       * Read skeleton output html, etc.
      C                   callp     gethtml(fn:lib:mbr:'/$')
       * Retrieve environment variables
      C                   exsr      RtvEnvVar
       *------------------
       * Write sections of HTML.
       *
       * 1-Section /$top
      C                   exsr      SetTop
      C                   callp     wrtsection('top')
       * 2-Boat types
      C                   exsr      DspBtyp
       * 3-End html
      C                   exsr      SetEnd
      C                   callp     wrtsection('endhtml')
       * 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')
       *
      C     quit          IFNE      *blanks
      C     BTypSW        ifne      *blank
      C                   close     BoatTypes
      C                   endif
      C                   eval      *inlr = *on
      C                   ENDIF
       *
      C                   return
       *=====================================================================******
       *  Display boat types to select from
       *=====================================================================******
      C     DspBTyp       begsr
      C     BTypSW        ifeq      *blank
      C                   open      BoatTypes
      C                   eval      BTypSW = 'x'
      C                   endif
       *
      C                   eval      BttSeq = *loval
      C     BttSeq        setll     BttRec
      C                   do        *hival
      C                   read      BttRec                                 40
      C     *in40         ifeq      '1'
      C                   leave
      C                   endif
      C                   exsr      SetSltRow
      C                   callp     wrtsection('typsltrow')
      C                   enddo
       *
      C                   callp     wrtsection('typsltend')
       *
      C                   endsr
       *=====================================================================******
       *  Set variable data for section /$top
       *=====================================================================******
      C     SetTop        begsr
       *------------------
       * Repeat for the next invocation
       * 1)background color
      C                   callp     updhtmlvar('BCKGND':bckgnd:
      C                             InitHTMLVars)
       * 2)national language
      C                   callp     updhtmlvar('LNG':lng)
       *------------------
       * «BODY» variables
       * Texts color
      C                   callp     updhtmlvar('COLOR':'black')
      C     bckgnd        ifeq      'BLACK'
      C                   callp     updhtmlvar('COLOR':'white')
      C                   endif
       * If background black, text must be bold
      C                   callp     updhtmlvar('BOLD':' ')
      C     bckgnd        ifeq      'BLACK'
      C                   callp     updhtmlvar('BOLD':'«b»')
      C                   endif
       * BGCOLOR white, LINK blue, VLINK red, ALINK green
      C     bckgnd        ifeq      'WHITE'
      C     bckgnd        oreq      *blank
      C                   callp     updhtmlvar('BGCOLOR':'FFFFFF')
      C                   callp     updhtmlvar('LINK':'0000FF')
      C                   callp     updhtmlvar('VLINK':'FF0000')
      C                   callp     updhtmlvar('ALINK':'00FF00')
      C                   endif
       * BGCOLOR gray, LINK blue, VLINK red, ALINK green
      C     bckgnd        ifeq      'GRAY'
      C                   callp     updhtmlvar('BGCOLOR':'CCCCCC')
      C                   callp     updhtmlvar('LINK':'0000FF')
      C                   callp     updhtmlvar('VLINK':'FF0000')
      C                   callp     updhtmlvar('ALINK':'00FF00')
      C                   endif
       * BGCOLOR light blue, LINK blue, VLINK red, ALINK green
      C     bckgnd        ifeq      'LBLUE'
      C                   callp     updhtmlvar('BGCOLOR':'5BE6F3')
      C                   callp     updhtmlvar('LINK':'0000FF')
      C                   callp     updhtmlvar('VLINK':'FF0000')
      C                   callp     updhtmlvar('ALINK':'00FF00')
      C                   endif
       * BGCOLOR black, LINK green, VLINK red, ALINK white
      C     bckgnd        ifeq      'BLACK'
      C                   callp     updhtmlvar('BGCOLOR':'000000')
      C                   callp     updhtmlvar('LINK':'00FF00')
      C                   callp     updhtmlvar('VLINK':'FF0000')
      C                   callp     updhtmlvar('ALINK':'FFFFFF')
      C                   endif
      C                   endsr
       *=====================================================================******
       *  Set variable data for section /$typsltrow
       *=====================================================================******
      C     SetSltRow     begsr
      C                   callp     updhtmlvar('BTTYPE1':BtType1)
      C                   callp     updhtmlvar('BTTYPE2':BtType2)
      C                   endsr
       *=====================================================================******
       *  Set output variables for section /$endhtml
       *=====================================================================******
      C     SetEnd        begsr
       * Server protocol
      C                   callp     updhtmlvar('PROTOCOL':S_Protocol)
       * Compute run time
      C                   time                    timedata2
      C     timedata2     subdur    timedata1     ms:*ms
      C                   eval      sec = ms / 1000000
      C                   callp     updhtmlvar('runtime':
      C                             %trim(%editw(sec:'     0 .   ')))
       *
      C                   endsr
       *=====================================================================******
       * Set html output skeleton member before its read into memory
       *=====================================================================******
      C     SetSkl        begsr
       *------------------
       * Set html output skeleton member
      C                   eval      lng = uppify(lng)
      C                   eval      Lib = 'CGIDEV2'
      C                   eval      Fn  = 'DEMOHTML' + lng
      C                   eval      Mbr = 'BOATSCH0'
       *------------------
      C                   endsr
       *=====================================================================******
       *  Retrieve environment variables
       *=====================================================================******
      C     RtvEnvVar     begsr
       * Use getenvp to get this server's protocol and name
      C                   eval      S_Protocol =getenv('SERVER_PROTOCOL':
      C                             qusec)
      C                   eval      S_Name     =getenv('SERVER_NAME':
      C                             qusec)
       * Save server name in data area SERVERNAME for use of WSG programs
      C                   movel     S_Name        ServerName      256
      C                   move      'S'           MyAction          1            Save
      C                   callb     'SERVERNAME'                         69
      C                   parm                    MyAction
      C                   parm                    ServerName
       *
      C                   endsr
0.027 sec.s