H debug(*yes) **************************************************************** * Parse CGI using QzhbCgiParse API **************************************************************** * Copyright (c) 2000, Craig Pelkie * ALL RIGHTS RESERVED * Craig Pelkie * Bits & Bytes Programming, Inc. * craig@web400.com * * User/date Mark Text * ============= ==== ====================================== * JJ 2006-08-11 : ZIP1 - Changed to allow QUERY STRING * * CRTRPGMOD MODULE(yourlib/CGIPARSEZ) SRCFILE(yourlib/QRPGSRC) * CRTPGM PGM(yourlib/CGIPARSEZ) BNDSRVPGM(QHTTPSVR/QZHBCGI) **************************************************************** **************************************************************** * arrNames - array of field names parsed from HTML form * arrValues - array of field values parsed from HTML form * * No assumptions are made about the data in a field. For * example, numeric fields are returned left-justified in * the array. * * The program needs to take care of any special * formatting required to use the data (for example, right- * justify and zero-fill numeric fields). **************************************************************** D arrNames s 30 dim(100) D arrValues s 60 dim(100) **************************************************************** * Variables for QzhbCgiParse call * * zhbCmd - command string to execute * zhbFormat - output format; CGII0200=use CGI form var format * zhbBuffer - target buffer * zhbBufLen - length of target buffer * zhbRspLen - length of response **************************************************************** D zhbCmd s 6 D zhbFormat s 8 inz('CGII0200') D zhbBuffer s 512 D zhbBufLen s 9b 0 inz(%len(zhbBuffer)) D zhbRspLen s 9b 0 inz(0) **************************************************************** * Miscellaneous variables used in program * * arraySize - number of elements in cgiNames/cgiValues * varCount - number of values returned from QzhbCgiParse * N - loop index * ptr1 - pointer to cgiFormat * * nameLength - name length work field * nameValue - value of name field * varLength - variable length work field * varValue - value of the variable **************************************************************** D arraySize s 5 0 inz(%elem(arrNames)) D varCount s 9b 0 D N s 5 0 inz(1) D ptr1 s * D nameLength s 9b 0 D nameValue s like(arrNames) D varLength s 9b 0 D varValue s like(arrValues) **************************************************************** * Variables for CGII0200 format * * cgiFormat - entire format * cgiBytRtn - bytes returned * cgiBytAvl - bytes available * cgiCHandle - continuation handle * cgiOffset - offset to first variable entry * cgiNumber - number of variables returned * * cgiLength - template to determine lengths * cgiLenEntry - length of variable entry * cgiLenName - length of variable name * * cgiValueLength - template to determine length of value * cgiLenValue - length of variable value **************************************************************** D cgiFormat ds based(ptr1) D cgiBytRtn 9b 0 D cgiBytAvl 9b 0 D cgiCHandle 20 D cgiOffset 9b 0 D cgiNumber 9b 0 D cgiLength ds based(ptr1) D cgiLenEntry 9b 0 D cgiLenName 9b 0 D cgiValueLength ds based(ptr1) D cgiLenValue 9b 0 D/COPY QSYSINC/QRPGLESRC,QUSEC C *entry plist C parm arrNames C parm arrValues C parm varCount **************************************************************** * Initialize Bytes Available, Bytes Provided in QUSEC **************************************************************** Jan C eval N = 1 C eval QUSBAVL = 0 C eval QUSBPRV = 0 **************************************************************** * Call QzhbCgiParse API, return input from browser * to field zhbBuffer **************************************************************** ZIP1 * QUERY_STRING ZIP1 C eval zhbCmd = '-f' + ZIP1 C x'00' ZIP1 C callb (e) 'QzhbCgiParse' ZIP1 C parm zhbCmd ZIP1 C parm zhbFormat ZIP1 C parm zhbBuffer ZIP1 C parm zhbBufLen ZIP1 C parm zhbRspLen ZIP1 C parm QUSEC ZIP1 * StdIn ZIP1 C If zhbBuffer = *Blanks C eval zhbCmd = '-POST' + C x'00' C callb (e) 'QzhbCgiParse' C parm zhbCmd C parm zhbFormat C parm zhbBuffer C parm zhbBufLen C parm zhbRspLen C parm QUSEC ZIP1 C EndIf **************************************************************** * Return if error on call **************************************************************** C if (%error = '1') or C (QUSBAVL > 0) C dump C eval varCount = 0 C return C endif **************************************************************** * STEP 1 - Get values in CGII0200 format **************************************************************** C eval ptr1 = %addr(zhbBuffer) C eval varCount = cgiNumber **************************************************************** * STEP 2 - Set pointer to start of buffer plus offset into * the work buffer where data values begin. **************************************************************** C eval ptr1 = %addr(cgiFormat) + C cgiOffset **************************************************************** * Retrieve all name/value pairs entered on HTML form. **************************************************************** C dou N > varCount **************************************************************** * Store value of name length, move pointer to start of * field name value (the name defined on HTML form with * with prefix of FORM_), use %str to retrieve field value. **************************************************************** C eval nameValue = *blanks C eval nameLength = cgiLenName C eval ptr1 = ptr1 + C %size(cgiLength) C if nameLength > 0 C eval nameValue = %str(ptr1 : C nameLength) C endif **************************************************************** * STEP 3 - Move pointer past field name. Length of the * field value is available at the new position. **************************************************************** C eval ptr1 = ptr1 + nameLength C eval varLength = cgiLenValue **************************************************************** * Move pointer to field value, use %str to retrieve value. **************************************************************** C eval varValue = *blanks C eval ptr1 = ptr1 + C %size(cgiValueLength) C if varLength > 0 C eval varValue = %str(ptr1 : C varLength) C endif **************************************************************** * Save retrieved field name/value pair into arrays **************************************************************** C eval arrNames(N) = nameValue C eval arrValues(N) = varValue **************************************************************** * Increment array counter, check if counter is within the * number of elements provided in return arrays, exit if not. **************************************************************** C eval N = N + 1 C if N > arraySize C leave C endif **************************************************************** * STEP 4 - Move pointer to start of next field's data. **************************************************************** C eval ptr1 = ptr1 + varLength C enddo C return