*********************************************************************
* 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 "«as400»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:'«as400»')
* Retrieve environment variables
C exsr RtvEnvVar
*------------------
* Write sections of HTML.
*
* 1-Section «as400»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 «as400»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 «as400»typsltrow
*=====================================================================******
C SetSltRow begsr
C callp updhtmlvar('BTTYPE1':BtType1)
C callp updhtmlvar('BTTYPE2':BtType2)
C endsr
*=====================================================================******
* Set output variables for section «as400»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
|
Member
BOATSCH0
in
CGIDEV2 / QRPGLESRC