*********************************************************************
* RPG ILE MODULE CGI400C2/LAB31A
*
* After compiling this RPG MODULE,
* create the related program with the following command:
*
* CRTPGM CGI400C2/LAB31A MODULE(CGI400C2/LAB31A)
* 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
*=====================================================================
* 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 'LAB31A')
*------------------
* Start the html
C callp wrtsection('top')
*------------------
* Check the action requested
* and any other input "parameter" sent from the remote browser
C eval action = uppify(action)
C if action «» 'REGISTER'
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 callp wrtsection('form')
C endsr
*=====================================================================
* Register a new customer
*=====================================================================
C Register begsr
* 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
*=====================================================================
* 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
|