*=====================================================================
* RPG ILE MODULE CGIDEV2/CTRDVY
*
* After compiling this RPG MODULE,
* create the related program with the following command:
*
* CRTPGM CGIDEV2/CTRDVY MODULE(CGIDEV2/CTRDVY) ACTGRP(CRTDVY)
*
* To execute this program,
* enter the following in your WEB browser command line:
* http://.../cgidev2p/ctrdvy.pgm
*
*=====================================================================
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
FCTRDVY if e k disk usropn
F extfile('CGIDEV2/CTRDVY')
*=====================================================================
* Includes to be used in all CGIs
*=====================================================================
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
/copy CGIDEV2/qrpglesrc,variables3
*--------------------------------------------------------------------
* Variables to receive input string parameters
*--------------------------------------------------------------------
D request s 10a
D YourName s 15a
D Pos_to s 15a
D PagUpDwn s 8a
D LstSeqNoC s 5a
D LinesInPgC s 5a
D LstCtr s 30a
*--------------------------------------------------------------------
* Other program variables and constants
*--------------------------------------------------------------------
* Name of this program
D PgmName c 'CTRDVY'
* External HTML
D extHtml s 2000 inz('/cgidev/html/ctrdvy.txt')
* Indicators for GetHtmlIfsMult subprocedure
D IfsMultIndicators...
d ds
D NoErrors n
D NameTooLong n
D NotAccessible n
D NoFilesUsable n
D DupSections n
D FileIsEmpty n
*
D Page1SW s 1a
D EofSW s 1a
D PageSize s 5s 0 inz(10)
D a s 5s 0
D b s 5s 0
D i s 5s 0
D RollBack s 5s 0
D LinesInPag s 5s 0
D SeqNo s 5s 0
D LstSeqNo s 5s 0
D Zero5 s 5a inz('00000')
*===================================================
* The following variables have nothing to do with this CGI.
* They are there just to allow the testing of some subprocedures.
*===================================================
* Variable for testing subprocedure ZhbCountAllVars
D nbrInpVars s 10i 0
* Variables for testing subprocedure ZhbGetVarDetails
D ThisVarVal s 1000a
D ThisOccur s 10i 0
D ThisVarName s 50
D ThisVarOccur s 10i 0
D FoundInd s n
* Variables for testing subprocedure RtvSubsVarInfo
D SectionIn s 50
D RelSeqNo s 10i 0
D ReturnDS s 92
D RetDS ds
D RetSection 50
D RetVar 30
D RetStartPos 10u 0
D RetLen 10u 0
*=====================================================================
C exsr SetTimeStr
*=====================================================================
* Read remote browser input
*=====================================================================
/copy CGIDEV2/qrpglesrc,prolog3
*=====================================================================
* The following lines are not needed in this program.
* They just illustrate the use of two subprocedures:
* - ZhbCountAllVars
* - ZhbGetVarDetails
*=====================================================================
* Example of retrieving
* the number of occurrences of all variables in the CGI input
C eval nbrInpVars = ZhbCountAllVars
* Example of retrieving
* detailed information for all the input variables
C if nbrInpVars » 0
C 1 do nbrInpVars ThisOccur
C eval ThisVarVal =
C ZhbGetVarDetails(ThisOccur:
C ThisVarName:
C ThisVarOccur:
C FoundInd)
C enddo
C endif
* Example of clearing the HTML output buffer
C callp clrHtmlBuffer
*=====================================================================
* Main line
*=====================================================================
* Parse the input string
* Main function
C eval request = zhbgetvarupper('request')
* Customer name
C eval YourName = zhbgetvar('yrname')
* Position to ...
C eval Pos_to = zhbgetvar('pos_to')
* Page up or down?
C eval PagUpDwn = zhbgetvar('pageupdown')
* Last country displayed in html page
C eval LstCtr = zhbgetvar('lastcountry')
* Last line number displayed in html page
C eval LstSeqNoC = zhbgetvar('lastseqno')
C exsr BldLstSeq
* Number of lines displayed in html page
C eval LinesInPgC = zhbgetvar('linesinpage')
C exsr BldLinPag
*------------------
* Load external html
C eval IfsMultIndicators = getHtmlIfsMult(
C %trim(exthtml):'«as400»')
*------------------
* Open file
C if not %open(CTRDVY)
C open CTRDVY
C endif
* Set output variables for section "top"
C exsr SetTop
* Send section "top"
C callp wrtsection('top')
* If just starting, ...
C if request=' '
C exsr Start
C endif
*------------------
C callp wrtsection('go')
* Find 1st record in file
C exsr FindFirst
*------------------
* Position to the next input record
C exsr Position
*
C eval LinesInPag = 0
*------------------
* Read
C eval eofSW = ' '
C LinesInPag DOueq PageSize
C read ctrrec
C if %eof
C eval eofSW = 'x'
C leave
C endif
C eval SeqNo = SeqNo +1
C eval LinesInPag = LinesInPag +1
C IF LinesInPag =1
C callp wrtsection('tabstr')
C if CtrNam = CtrNam1st
C eval Page1SW = 'x'
C else
C eval Page1SW = *blank
C endif
C endIF
C exsr SetTabRow
C callp wrtsection('tabrow')
C endDO
*------------------
* End of page or end of file:
C exsr SetTabEnd
C IF LinesInPag »= 1
C callp wrtsection('tabend')
C if Page1SW = ' '
C callp wrtsection('pageup')
C endif
C callp wrtsection('eopageup')
C if eofSW = ' '
C callp wrtsection('pagedown')
C endif
C callp wrtsection('eopagedown')
C ELSE
C callp wrtsection('none')
C ENDIF
*------------------
* Send the response html buffer and exit
C exsr Exit
*=====================================================================
* If just started, ...
*=====================================================================
C Start begsr
C callp wrtsection('start')
C exsr Exit
C endsr
*=====================================================================
* Find the first record in the file
*=====================================================================
C FindFirst begsr
C *like define CtrNam CtrNam1st
C eval CtrNam = *loval
C CtrNam setll ctrrec
C read ctrrec
C if not%eof
C eval CtrNam1st = CtrNam
C endif
C endsr
*=====================================================================
* Build the "last sequence number" field, "LstSeqNo"
*=====================================================================
C BldLstSeq begsr
* shift it right, pad left with 0's
C ' ' checkr LstSeqNoC b
C IF b = 0
C eval LstSeqnoC = Zero5
C ENDIF
C IF b = 5
C move LstSeqnoC LstSeqno
C ENDIF
C IF b «» 0 and b «» 5
C eval a = 5 - b
C eval LstSeqnoC = %subst(Zero5:1:a) +
C %subst(LstSeqnoC:1:b)
C ENDIF
C testn LstSeqnoC 40
C *in40 ifeq '1'
C move LstSeqnoC LstSeqno
C else
C eval LstSeqno = 0
C endif
C endsr
*=====================================================================
* Build the "lines in html page" field, "LinesInPag"
*=====================================================================
C BldLinPag begsr
* shift it right, pad left with 0's
C ' ' checkr LinesInPgC b
C IF b = 0
C eval LinesInPgC = Zero5
C ENDIF
C IF b = 5
C move LinesInPgC LinesInPag
C ENDIF
C IF b «» 0 and b «» 5
C eval a = 5 - b
C eval LinesInPgC = %subst(Zero5:1:a) +
C %subst(LinesInPgC:1:b)
C ENDIF
C testn LinesInPgC 40
C *in40 ifeq '1'
C move LinesInPgC LinesInPag
C else
C eval LinesInPag = 0
C endif
C endsr
*=====================================================================
* Position to the next record to read
*=====================================================================
C Position begsr
*------------------
* Position to beginning of file or to a given (generic) name
C IF PagUpDwn = ' '
C if Pos_to = ' '
C eval Seqno = 0
C eval CtrNam = *loval
C CtrNam setll ctrrec
C else
C exsr RollTo
C endif
C ENDIF
*------------------
* Page down
C PagUpDwn ifeq 'pagedown'
C exsr PageDown
C endif
*------------------
* Page up
C PagUpDwn ifeq 'pageup'
C exsr PageUp
C endif
*------------------
C endsr
*=====================================================================
* Roll up to a given record
*=====================================================================
C RollTo begsr
C *like define Pos_to Pos_toUp
C *like define CtrNam CtrNamUp
C eval Pos_toUp = uppify(Pos_to:0)
C ' ' checkr Pos_toUp i
*
C eval SeqNo = 0
C eval CtrNam = *loval
C CtrNam setll ctrrec
*
C read ctrrec
C dow not%eof
C eval SeqNo = SeqNo +1
C eval CtrNamUp = %subst(CtrNam:1:i)
C eval CtrNamUp = uppify(CtrNamUp:0)
C if CtrNamUp »= Pos_toUp
C leave
C endif
C read ctrrec
C enddo
*
C CtrNam setll ctrrec
C eval SeqNo = SeqNo -1
*
C endsr
*=====================================================================
* Position to the beginning of the next page
*=====================================================================
C PageDown begsr
C eval CtrNam = LstCtr
C eval SeqNo = LstSeqNo
C CtrNam setgt ctrrec
C endsr
*=====================================================================
* Position to the beginning of the previous page
*=====================================================================
C PageUp begsr
C eval CtrNam = LstCtr
C eval SeqNo = LstSeqNo
C CtrNam chain ctrrec
C if not%found
C eval SeqNo = 0
C eval CtrNam = *loval
C goto PageUpX
C endif
* Number of records do read backwards
C eval i = 0
C eval RollBack = PageSize + LinesInPag -1
* Read previous
C i doueq RollBack
C readp ctrrec
C if %eof
C eval SeqNo = 0
C eval CtrNam = *loval
C leave
C endif
C eval i = i +1
C eval SeqNo = SeqNo -1
C enddo
*
C CtrNam setll ctrrec
C if SeqNo » 0
C eval SeqNo = SeqNo -1
C endif
*
C PageUpX tag
C endsr
*=====================================================================
* Set output variables for section "top"
*=====================================================================
C SetTop begsr
*
* Clear all variables and
* set variable "/%YOURNAME%/"
* with the value taken from character field "YourName"
C callp updHTMLvar('YOURNAME':YourName:
C InitHTMLVars)
*
C endsr
*=====================================================================
* Set output variables for section "tabrow"
*=====================================================================
C SetTabRow begsr
*
* Set variable "/%SEQNO%/"
* with the edited value taken from numeric field "SeqNo" (5,0)
C callp updhtmlvar('SEQNO':
C %trim(%editc(SeqNo:'4')))
* Set variable "/%COUNTRY%/"
* with the value taken from character field "CtrNam"
C eval CtrNam=%xlate('_':' ':
C CtrNam)
C callp updHTMLvar('COUNTRY':CtrNam:'1':'%trim')
* Set variable "/%DELVDAYS%/"
* with the edited value taken from numeric field "CtrDay" (3,0)
C callp updhtmlvar('DELVDAYS':
C %trim(%editw(CtrDay:' 0 ')))
*
C endsr
*=====================================================================
* Set output variables for section "tabend"
*=====================================================================
C SetTabEnd begsr
*
* set variable "/%YOURNAME%/"
* with the value taken from character field "YourName"
C callp updHTMLvar('YOURNAME':YourName:
C InitHTMLVars)
* Set variable "/%LASTCOUNTRY%/"
* with the value taken from character field "CtrNam"
C callp updHTMLvar('LASTCOUNTRY':CtrNam)
* Set variable "/%LASTSEQNO%/"
* with the value taken from character field "Seqno"
C callp updHTMLvar('LASTSEQNO':
C %trim(%editc(Seqno:'4')))
* Set variable "/%LINESINPAG%/"
* with the value taken from character field "LinesInPag"
C callp updHTMLvar('LINESINPAG':
C %trim(%editc(LinesInPag:'4')))
*
C endsr
*=====================================================================
* Time started
*=====================================================================
C SetTimeStr begsr
C time TimeStart
C endsr
*=====================================================================
* Time ended and time elapsed elapsed
*=====================================================================
C SetTimeEnd begsr
C time TimeEnd
C TimeEnd subdur TimeStart MsElaps:*ms
C eval SecElaps = MsElaps / 1000000
C endsr
*=====================================================================
* Send response html and quit
*=====================================================================
C Exit begsr
C exsr SetTimeEnd
C callp updhtmlvar('RUNTIME':
C %trim(%editw(SecElaps:' 0 . ')))
C callp wrtsection('runtime')
C callp wrtsection('end')
*------------------
* Example of retrieving information about a substitution variable.
* In this case, it will be the 1st variable in section "top"
C eval SectionIn = 'top'
C eval RelSeqno = 1
C eval rc = RtvSubsVarInfo(SectionIn:
C RelSeqno:ReturnDS)
C eval RetDS = ReturnDS
*------------------
* 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')
*
* Quit
C* eval *inlr = *on
C return
C endsr
|
Member
CTRDVY
in
CGIDEV2 / QRPGLESRC