5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 2 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number S o u r c e L i s t i n g 1 //----------------------------------------------------------------- 200524 000100 2 // procedure prototypes 200524 000200 3 //----------------------------------------------------------------- 200524 000300 4 200524 000400 5 /copy *libl/qrpglesrc,rdstrapi#1 200524 000500 *--------------------------------------------------------------------------------------------* * RPG member name . . . . . : RDSTRAPI#1 * 1 * External name . . . . . . : RDWEBSHR/QRPGLESRC(RDSTRAPI#1) * 1 * Last change . . . . . . . : 05/24/20 20:44:45 * 1 * Text 'description' . . . . : String API Include #1 * 1 *--------------------------------------------------------------------------------------------* 6+ * convert a string to upper case 200524 1000100 7+d strToUpper pr 32767a extproc('strToUpper') varying 200524 1000200 8+d 32767a const varying options(*varsize) 200524 1000300 9+ * convert a string to lower case 200524 1000400 10+d strToLower pr 32767a extproc('strToLower') varying 200524 1000500 11+d 32767a const varying options(*varsize) 200524 1000600 12+ * convert a character to an integer 200524 1000700 13+D byteToInt pr 10u 0 extproc('byteToInt') 200524 1000800 14+d 1a const 200524 1000900 15+ * convert an integer to a character 200524 1001000 16+D intToByte pr 1a extproc('intToByte') 200524 1001100 17+d 10u 0 const 200524 1001200 18+ * return a 12 byte string based on timestamp 200524 1001300 19+d strUnique pr 12a extproc('strUnique') 200524 1001400 20+ * return a 12 byte string based on software clock 200524 1001500 21+d strDistinct pr 12a extproc('strDistinct') 200524 1001600 22+ * convert a sting to an integer value 200524 1001700 23+d strToInt PR 20i 0 extproc('strToInt') 200524 1001800 24+d string 20a const varying options(*varsize) 200524 1001900 25+ * convert a sting to a floating point value 200524 1002000 26+d strToFloat PR 8f extproc('strToFloat') 200524 1002100 27+d string 20a const varying options(*varsize) 200524 1002200 28+ * Replace all instances of a character string in a string 200524 1002300 29+d strReplace PR 32765a extproc('strReplace') varying 200524 1002400 30+d string 32765a const varying options(*varsize) 200524 1002500 31+d scanFor 32a const varying options(*varsize) 200524 1002600 32+d replaceWith 32a const varying options(*varsize) 200524 1002700 33+ 200524 1002800 34+d strSession pr 12a extproc('strSession') 200524 1002900 35 /copy *libl/qrpglesrc,rdwtnapi#1 200524 000600 *--------------------------------------------------------------------------------------------* * RPG member name . . . . . : RDWTNAPI#1 * 2 * External name . . . . . . : RDWEBSHR/QRPGLESRC(RDWTNAPI#1) * 2 * Last change . . . . . . . : 05/24/20 20:57:53 * 2 * Text 'description' . . . . : WEB WORKSTATION INCLUDE #1 * 2 *--------------------------------------------------------------------------------------------* 36+ * initialize web interface 200524 2000001 37+d wtnInit pr extproc('wtnInit') 200524 2000100 38+d app_id 20a const 200524 2000200 39+d channel 5s 0 const 200524 2000300 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 3 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 40+d server_id 12a const 200524 2000400 41+ 200524 2000500 42+ * clean up web interface 200524 2000501 43+d wtnTerm pr extproc('wtnTerm') 200524 2000600 44+ 200524 2000700 45+ * open formatted stream 200524 2000701 46+d wtnOpen pr * extproc('wtnOpen') 200524 2000800 47+d mbrname 10a const 200524 2000900 48+ 200524 2001000 49+ * set instance to formatted stream 200524 2001001 50+d wtnSetInst pr extproc('wtnSetInst') 200524 2001100 51+d memptr * value DS Size 200524 2001200 52+ 200524 2001300 53+ * close formatted stream 200524 2001301 54+d wtnClose pr extproc('wtnClose') 200524 2001400 55+ 200524 2001500 56+ * flush response to HTTP server / complete response 200524 2001501 57+d wtnFlush pr extproc('wtnFlush') 200524 2001600 58+ 200524 2001700 59+ * receive request from HTTP server 200524 2001701 60+d wtnRecv pr 20a extproc('wtnRecv') 200524 2001800 61+d wait_secs 10i 0 const 200524 2001900 62+ 200524 2002000 63+ * prepare to merge formatted stream with program data 200524 2002002 64+d wtnRecSet pr n extproc('wtnRecSet') 200524 2002100 65+d recname 10a const varying options(*varsize) 200524 2002200 66+ 200524 2002300 67+ * output formatted stream to HTTP server 200524 2002301 68+d wtnRecWrt pr n extproc('wtnRecWrt') 200524 2002400 69+d recname 10a const varying options(*varsize) 200524 2002500 70+d address * value options(*nopass) 200524 2002600 71+ 200524 2002700 72+ * map HTTP form variables to data structure 200524 2002701 73+d wtnRecGet pr n extproc('wtnRecGet') 200524 2002800 74+d name 10a const varying options(*varsize) 200524 2002900 75+d record * value 200524 2003000 76+ 200524 2003100 77+ * read changed record from table 200524 2003101 78+d wtnLstRdc pr n extproc('wtnLstRdc') 200524 2003200 79+d recname 10a const varying options(*varsize) 200524 2003300 80+ 200524 2003400 81+ * future 200524 2003401 82+d wtnLstVal pr 65530a extproc('wtnLstVal') varying 200524 2003500 83+d fldname 10a const varying options(*varsize) 200524 2003600 84+ 200524 2003700 85+ * insert program data into formatted stream 200524 2003701 86+d wtnFldSet pr n extproc('wtnFldSet') 200524 2003800 87+d fldname 10a const varying options(*varsize) 200524 2003900 88+d thisVal 65530a const varying options(*varsize) 200524 2004000 89+ 200524 2004100 90+ * get HTML form value 200524 2004101 91+d wtnFldGet pr 65530a extproc('wtnFldGet') varying 200524 2004200 92+d fldname 10a const varying options(*varsize) 200524 2004300 93+ 200524 2004400 94+ * get web query-string value 200524 2004401 95+d wtnQryGet pr 32767a extproc('wtnQryGet') varying 200524 2004500 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 4 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 96+d fldname 40a const varying options(*varsize) 200524 2004600 97+ 200524 2004700 98+ * get environment variable value 200524 2004701 99+d wtnEnvGet pr 32767a extproc('wtnEnvGet') varying 200524 2004800 100+d fldname 40a const varying options(*varsize) 200524 2004900 101+ 200524 2005000 102+ * session initialize 200524 2005001 103+d wtnSeeInit pr extproc('wtnSeeInit') 200524 2005100 104+d data_ptr * value 200524 2005200 105+d data_len 10u 0 const 200524 2005300 106+ 200524 2005400 107+ * retrieve session data 200524 2005401 108+d wtnSeeGet pr extproc('wtnSeeGet') 200524 2005500 109+d app_id 10a const 200524 2005600 110+ 200524 2005700 111+ * store session data 200524 2005701 112+d wtnSeePut pr extproc('wtnSeePut') 200524 2005800 113+d app_id 10a const 200524 2005900 114+ 200524 2006000 115+ * output HTTP header 200524 2006001 116+d wtnHdrSet pr extproc('wtnHdrSet') Success / Fail 200524 2006100 117+d hdrname 32a const varying options(*varsize) Variable Name 200524 2006200 118+d hdrvalue 4096a const varying options(*varsize) Variable value 200524 2006300 119+ 200524 2006400 120+ * output message to client 200524 2006401 121+d wtnMsgWrt pr extproc('wtnMsgWrt') 200524 2006500 122+d message 240a const varying options(*varsize) 200524 2006600 123+d focus 10a const varying options(*varsize) 200524 2006700 124+d errorflag n const 200524 2006800 125+ 200524 2006900 126+ * retrieve client request 200524 2006901 127+d wtnAction pr n extproc('wtnAction') 200524 2007000 128+d member 10a const 200524 2007100 129+ 200524 2007200 130+ * output row from SQL cursor 200524 2007201 131+d wtnRowWrt pr n extproc('wtnRowWrt') 200524 2007300 132+d recname 10a const varying options(*varsize) 200524 2007400 133+d cursor * value options(*nopass) 200524 2007500 134+ 200524 2007600 135 /copy *libl/qrpglesrc,rdcsrapi#1 200524 000700 *--------------------------------------------------------------------------------------------* * RPG member name . . . . . : RDCSRAPI#1 * 3 * External name . . . . . . : RDWEBSHR/QRPGLESRC(RDCSRAPI#1) * 3 * Last change . . . . . . . : 05/24/20 21:11:33 * 3 * Text 'description' . . . . : CURSOR API #1 * 3 *--------------------------------------------------------------------------------------------* 136+ * initialize SQL cursor interface 200524 3000001 137+d csrInit pr n extproc('csrInit') 200524 3000100 138+d userid 10a const options(*nopass) DS Size 200524 3000200 139+d password 10a const options(*nopass) DS Size 200524 3000300 140+ 200524 3000400 141+ * clean up SQL cursor interface 200524 3000401 142+d csrTerm pr extproc('csrTerm') 200524 3000500 143+ 200524 3000600 144+ * set library list of QSQSRVR job based on Job Description 200524 3000601 145+d csrSetLibl pr n extproc('csrSetLibl') 200524 3000700 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 5 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 146+d lib 10a const DS Size 200524 3000800 147+d jobd 10a const DS Size 200524 3000900 148+ 200524 3001000 149+ * instantiate a new SQL cursor 200524 3001001 150+d csrNew pr * extproc('csrNew') 200524 3001100 151+d file 10a const DS Size 200524 3001200 152+d columns 2048a const varying DS Size 200524 3001300 153+d options(*nopass: *varsize) 200524 3001400 154+d distinct n const options(*nopass) 200524 3001500 155+ 200524 3001600 156+ * clean up SQL cursor interface 200524 3001601 157+d csrOvrMbr pr n extproc('csrOvrMbr') 200524 3001700 158+d member 10a const DS Size 200524 3001800 159+ 200524 3001900 160+ * clean up SQL cursor 200524 3001901 161+d csrDestroy pr extproc('csrDestroy') 200524 3002000 162+d cursor * value DS Size 200524 3002100 163+ 200524 3002200 164+ * set pointer to SQL cursor 200524 3002201 165+d csrSetInst pr extproc('csrSetInst') 200524 3002300 166+d cursor * value DS Size 200524 3002400 167+ 200524 3002500 168+ * set value of SQL where clause 200524 3002501 169+d csrSetFilter pr extproc('csrSetFilter') 200524 3002600 170+d filter 1024a const varying options(*varsize) 200524 3002700 171+ 200524 3002800 172+ * set value of SQL orderby clause 200524 3002801 173+d csrSetOrder pr extproc('csrSetOrder') 200524 3002900 174+d orderby 128a const varying options(*varsize) 200524 3003000 175+ 200524 3003100 176+ * set SQL cursor page size 200524 3003101 177+d csrSetPageSize pr 10i 0 extproc('csrSetPageSize') 200524 3003200 178+d size 5i 0 const DS Size 200524 3003300 179+ 200524 3003400 180+ * open SQL cursor 200524 3003401 181+d csrOpen pr n extproc('csrOpen') 200524 3003500 182+ 200524 3003600 183+ * requery SQL object and determine row count 200524 3003601 184+d csrRequery pr extproc('csrRequery') 200524 3003700 185+ 200524 3003701 186+ * requery SQL object 200524 3003702 187+d csrRefresh pr n extproc('csrRefresh') 200524 3003800 188+ 200524 3003900 189+ * close SQL cursor and free space 200524 3003901 190+d csrClose pr extproc('csrClose') 200524 3004000 191+ 200524 3004100 192+ * goto a row in an SQL cursor 200524 3004101 193+d csrGoto pr n extproc('csrGoto') 200524 3004200 194+d orient 5i 0 const DS Size 200524 3004300 195+d number 10i 0 const options(*nopass) DS Size 200524 3004400 196+ 200524 3004500 197+ * goto a page in an SQL cursor 200524 3004501 198+d csrPage pr 10i 0 extproc('csrPage') 200524 3004600 199+d orient 5i 0 const DS Size 200524 3004700 200+d number 10i 0 const options(*nopass) DS Size 200524 3004800 201+ 200524 3004900 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 6 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 202+ * seek for the first row that contains a field value 200524 3004901 203+d csrSeek pr 10i 0 extproc('csrSeek') 200524 3005000 204+d field 32a const varying 200524 3005100 205+d value 128a const varying 200524 3005200 206+ 200524 3005300 207+ * flag an SQL cursor row for future operation 200524 3005301 208+d csrRowSetFlag pr 10i 0 extproc('csrRowSetFlag') 200524 3005400 209+d row 10i 0 const 200524 3005500 210+d flag n const 200524 3005600 211+ 200524 3005700 212+ * determine if a cursor row has been flaged 200524 3005701 213+d csrRowGetFlag pr n extproc('csrRowGetFlag') 200524 3005800 214+d row 10i 0 const 200524 3005900 215+ 200524 3006000 216+ * return the number of flagged rows 200524 3006001 217+d csrFlagCnt pr 10i 0 extproc('csrFlagCnt') 200524 3006100 218+ 200524 3006200 219+ * return SQL cursor row count 200524 3006201 220+d csrRowCnt pr 10i 0 extproc('csrRowCnt') 200524 3006300 221+ 200524 3006301 222+d csrCurRow pr 10i 0 extproc('csrCurRow') 200524 3006400 223+d csrCurPageP pr 10i 0 extproc('csrCurPageP') 200524 3006500 224+d csrCurPage pr 10i 0 extproc('csrCurPage') 200524 3006600 225+d csrLstPage pr 10i 0 extproc('csrLstPage') 200524 3006700 226+ 200524 3006800 227+ * return column value as a string 200524 3006801 228+d csrColStr pr 32765a extproc('csrColStr') varying 200524 3006900 229+d column 32a const varying 200524 3007000 230+ 200524 3007100 231+ * return column value as an integer 200524 3007101 232+d csrColInt pr 20i 0 extproc('csrColInt') 200524 3007200 233+d column 32a const varying 200524 3007300 234+ 200524 3007400 235+ * return column value as a floating point value 200524 3007401 236+d csrColFloat pr 8f extproc('csrColFloat') 200524 3007500 237+d column 32a const varying 200524 3007600 238+ 200524 3007700 239+ * return column value as a packed decimal value 200524 3007701 240+d csrColPacked pr 63p32 extproc('csrColPacked') 200524 3007800 241+d column 32a const varying 200524 3007900 242+ 200524 3008000 243+ * return column value as a date value 200524 3008001 244+d csrColDate pr d extproc('csrColDate') 200524 3008100 245+d column 32a const varying 200524 3008200 246+ 200524 3008300 247+ * return column value as a time value 200524 3008301 248+d csrColTime pr t extproc('csrColTime') 200524 3008400 249+d column 32a const varying 200524 3008500 250+ 200524 3008600 251+ * return column value as a timestamp value 200524 3008601 252+d csrColStamp pr z extproc('csrColStamp') 200524 3008700 253+d column 32a const varying 200524 3008800 254+ 200524 3008900 255+ * transform an SQL cursor to a stream file 200524 3008901 256+d csrToStmf pr n extproc('csrToStmf') 200524 3009000 257+d path 1024a const varying options(*varsize) DS Size 200524 3009100 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 7 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 258+d format 3a const options(*nopass) DS Size 200524 3009200 259+ 200524 3009300 260+ * execute an SQL statement 200524 3009301 261+d csrExec pr n extproc('csrExec') 200524 3009400 262+d stmt 8192a const varying options(*varsize) DS Size 200524 3009500 263+ 200524 3009600 264+ * return the number of pages in an SQL cursor 200524 3009601 265+d csrPages pr 10i 0 extproc('csrPages') 200524 3009700 266+ 200524 3009800 267+d csr_bof c 0 200524 3009900 268+d csr_next c 1 200524 3010000 269+d csr_first c 2 200524 3010100 270+d csr_last c 3 200524 3010200 271+d csr_prior c 4 200524 3010300 272+d csr_absolute c 5 200524 3010400 273+d csr_relative c 6 200524 3010500 274+d csr_next_flag c 9 200524 3010600 275+d csr_same c 20 200524 3010700 276+d csr_page c 99999 200524 3010800 277+ 200524 3010900 278+d csr_did_init s n inz(*off) 200524 3011000 279 200524 000800 280 //----------------------------------------------------------------- 200524 000900 281 // module level data 200524 001000 282 //----------------------------------------------------------------- 200524 001100 283 200524 001200 284 d rw e ds extname(rwpgmc) qualified 200524 001300 285 200524 001400 *--------------------------------------------------------------------------------------------* 4 * Data structure . . . . . . : RW * 4 * External format . . . . . : RWPGMCR : RDPTL/RWPGMC * 4 *--------------------------------------------------------------------------------------------* 4 286=D ACTION 20A Action 4000001 287=D SES_LEN 10S 0 Session Length 4000002 288=D SES_DATA 20500A Session Data 4000003 289=D APP_DATA 8192A Application Data 4000004 290 d c1 s * inz(*null) 200524 001500 291 d s1 s * inz(*null) 200524 001600 292 d row_count s 10i 0 200524 001700 293 d page_number s 10i 0 200524 001800 294 d page_count s 10i 0 200524 001900 295 200524 002000 296 //----------------------------------------------------------------- 200524 002100 297 // program entry 200524 002200 298 //----------------------------------------------------------------- 200524 002300 299 200524 002400 300 c *entry plist 200524 002500 301 c parm rw 200524 002600 302 200524 002700 303 /free 200524 002800 304 200524 002900 305 //----------------------------------------------------------------- 200524 003000 306 // set references to screen and cursor 200524 003100 307 //----------------------------------------------------------------- 200524 003200 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 8 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 308 200524 003300 309 if s1 <> *null; B01 200524 003400 310 wtnSetInst(s1); 01 200524 003500 311 csrSetInst(c1); 01 200524 003600 312 endif; E01 200524 003700 313 200524 003800 314 //----------------------------------------------------------------- 200524 003900 315 // branch to subroutines based on requested actions 200524 004000 316 //----------------------------------------------------------------- 200524 004100 317 200524 004200 318 select; B01 200524 004300 319 when rw.action = 'INIT'; X01 200524 004400 320 exsr do_init; 01 200524 004500 321 when rw.action = 'GOTO'; X01 200524 004600 322 exsr do_goto; 01 200524 004700 323 when rw.action = 'PAGECOUNT'; X01 200524 004800 324 exsr do_page_count; 01 200524 004900 325 endsl; E01 200524 005000 326 200524 005100 327 return; 200524 005200 328 200524 005300 329 //----------------------------------------------------------------- 200524 005400 330 // initialization 200524 005500 331 //----------------------------------------------------------------- 200524 005600 332 200524 005700 333 begsr do_init; 200524 005800 334 200524 005900 335 s1 = wtnOpen('IUI103'); 200524 006000 336 c1 = csrNew('TLOC100P':'NAME, GADDRSTR AS ADDR'); 200524 006100 337 200524 006200 338 csrSetOrder('NAME, CITY'); 200524 006300 339 csrSetPageSize(10); 200524 006400 340 csrOpen(); 200524 006500 341 200524 006600 342 page_count = csrPages(); 200524 006700 343 200524 006800 344 endsr; 200524 006900 345 200524 007000 346 //----------------------------------------------------------------- 200524 007100 347 // goto the page requested 200524 007200 348 //----------------------------------------------------------------- 200524 007300 349 200524 007400 350 begsr do_goto; 200524 007500 351 200524 007600 352 page_number = strToInt(wtnQryGet('page')); 200524 007700 353 200524 007800 354 if page_number < 1 or page_number > page_count; B01 200524 007900 355 page_number = 1; 01 200524 008000 356 endif; E01 200524 008100 357 200524 008200 358 csrPage(csr_absolute:page_number); 200524 008300 359 200524 008400 360 //----------------------------------------------------------------- 200524 008500 361 // fetch all rows on requested page and output to client 200524 008600 362 //----------------------------------------------------------------- 200524 008700 363 200524 008800 5770WDS V7R3M0 160422 RN IBM ILE RPG QTEMP/IUI103 IBMI1 05/24/20 21:11:47 Page 9 Line <---------------------- Source Specifications ----------------------------><---- Comments ----> Do Page Change Src Seq Number ....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+...10 Num Line Date Id Number 364 clear row_count; 200524 008900 365 200524 009000 366 wtnRecWrt('CR'); 200524 009100 367 200524 009200 368 dow csrGoto(csr_next) and row_count < 10; B01 200524 009300 369 wtnRecSet('AR'); 01 200524 009400 370 wtnFldSet('name':csrColStr('NAME')); 01 200524 009500 371 wtnFldSet('addr':%trimr(csrColStr('ADDR'))); 01 200524 009600 372 wtnRecWrt('AR'); 01 200524 009700 373 row_count += 1; 01 200524 009800 374 enddo; E01 200524 009900 375 200524 010000 376 wtnRecWrt('FIN'); 200524 010100 377 200524 010200 378 endsr; 200524 010300 379 200524 010400 380 //----------------------------------------------------------------- 200524 010500 381 // return page_count to client 200524 010600 382 //----------------------------------------------------------------- 200524 010700 383 200524 010800 384 begsr do_page_count; 200524 010900 385 200524 011000 386 wtnRecSet('PC'); 200524 011100 387 wtnFldSet('pages':%char(page_count)); 200524 011200 388 wtnRecWrt('PC'); 200524 011300 389 200524 011400 390 endsr; 200524 011500 391 200524 011600 392 /end-free 200524 011700 * * * * * E N D O F S O U R C E * * * * *