*********************************************************************
* RPG ILE MODULE CGI400C2/LAB31B
*
* After compiling this RPG MODULE,
* create the related program with the following command:
*
* CRTPGM CGI400C2/LAB31B MODULE(CGI400C2/LAB31B)
* ACTGRP(CGI) AUT(*USE)
*
*********************************************************************
/copy CGI400C2/qrpglesrc,hspecs
/copy CGI400C2/qrpglesrc,hspecsbnd
FCUS01 IF A 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
/copy CGI400C2/qrpglesrc,prolog3
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 'LAB31B')
*------------------
* Start the html
C callp wrtsection('top')
*------------------
* 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
* Send the html buffer and exit
C exsr Exit
*=====================================================================
* Issue the form to be filled in
*=====================================================================
C Init begsr
C exsr SetForm
C callp wrtsection('form')
C endsr
*=====================================================================
* Register a new customer
*=====================================================================
C Register begsr
* Check input data- If any error, don't come back
C exsr ChkInpDta
* Override and open file (if the first time through)
C exsr OpenDbf
* 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 "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 open CUS01
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
|