******************************************************************
* Prototype for AddMsg (Add A Message) Subprocedure
******************************************************************
* Adds a message to the message list
* Inputs:
* - Message Text
* - Level (value 1, 2, or 3). Optional. Default is 1.
* Return value:
* 0 No problems
* -1 Array full
* -2 Invalid level. Message is added with level = 1.
D AddMsg pr 10i 0
D MsgText 200 value varying
D MsgLevel 10i 0 value options(*nopass)
***********************************************************************
* Prototype for c's bsearch function
***********************************************************************
D bsearch pr * extproc('bsearch')
D SearchArg * value
D DataStart * value
D Elements 10u 0 value
D Elemsize 10u 0 value
D CompFunc * ProcPtr value
****************************************************************************
* Prototype for CEEDOD, get operational descriptors
****************************************************************************
D CEEDOD PR
D Parmnum 10i 0 CONST Parameter number
D DescType 10i 0
D DataType 10i 0
D DescInfo1 10i 0
D DescInfo2 10i 0
D InLength 10i 0
D Feedback 12a options(*omit)
******************************************************************
* Prototype for CfgMsgs (Configure Messages) Subprocedure
******************************************************************
* Sets up section names, variable names for use by the
* WrtMsgs subprocedure. All parameters are optional. Defaults
* are assigned in the globals, above.
* Inputs:
* MsgFieldName: name of the externally described HTML's field to
* receive the message text. The default is msgtext.
* MsgStrSection: name of the HTML section used to start the error
* message output. The default is msgstart.
* MsgEndSection: name of the HTML section used to end the error
* message output. The default is msgend.
* MsgL1Section: name of the HTML section used to output level 1
* error messages. It should include the MsgFieldName
* substitution variable. The default is msgl1.
* MsgL2Section: name of the HTML section used to output level 2
* error messages. It should include the MsgFieldName
* substitution variable. The default is msgl2.
* MsgL3Section: name of the HTML section used to output level 3
* error messages. It should include the MsgFieldName
* substitution variable. The default is msgl3.
D CfgMsgs pr
D MsgFieldName 30 value varying options(*nopass)
D MsgStrSection 50 value varying options(*nopass)
D MsgEndSection 50 value varying options(*nopass)
D MsgL1Section 50 value varying options(*nopass)
D MsgL2Section 50 value varying options(*nopass)
D MsgL3Section 50 value varying options(*nopass)
***********************************************************************
* Prototype for cgivarcnt. Returns number of occurrences of a cgi input variable
***********************************************************************
* Inputs: - cgi variable name
* - string containing browser's input string. Should have had escape sequences
* converted from ASCII to EBCDIC by the getinput subprocedure.
* - length of data in browser's input string (inactln)
*
* Outputs: - number of occurrences of cgi variable name in browser's input string
* - 0 if none found
*
* Example: eval namecnt = cgivarcnt('name':indata:inactln)
*
D cgivarcnt pr 10i 0
D cgivarnam 50 const
D InData 32767 const varying options(*varsize)
D InActLn 10i 0 const
***********************************************************************
* Prototype for cgivarval. Returns value of nth occurrence of a cgi input variable
***********************************************************************
* Inputs: - cgi variable name
* - cgi variable occurrence number (n)
* - string containing browser's input string. Should have had escape sequences
* converted from ASCII to EBCDIC by the getinput subprocedure.
* - length of the string
* - return code
*
* Outputs: - value of nth occurrence of cgi variable name in browser's input string with
* any escape sequences converted to characters.
* - set to blanks if return code « 0. The value is returned as a
* string.
*
* - return code: 0 = successful
* -1 = variable not found
* -2 = variable found but occurrence does not exist
*
* Example: eval cust2 = cgivarval('cust':2:indata:inactln:rc)
*
*
D cgivarval pr 32767 varying
D cgivarnam 50 const
D cgivarocc 10i 0 const
D InData 32767 const varying options(*varsize)
D InActLn 10i 0 const
D rc 10i 0
***********************************************************************
* Prototype for cgivarvalUpper.
***********************************************************************
* Returns upper case value of nth occurrence of a cgi input variable
* Inputs: - cgi variable name
* - cgi variable occurrence number (n)
* - string containing browser's input string. Should have had escape sequences
* converted from ASCII to EBCDIC by the getinput subprocedure.
* - length of the string
* - return code
*
* Outputs: - value of nth occurrence of cgi variable name in browser's input string with
* any escape sequences converted to characters.
* - set to blanks if return code « 0. The value is returned as a
* string.
*
* - return code: 0 = successful
* -1 = variable not found
* -2 = variable found but occurrence does not exist
*
* Example: eval cust2 = cgivarvalupper('cust':2:indata:inactln:rc)
*
*
D cgivarvalupper pr 32767 varying
D cgivarnam 50 const
D cgivarocc 10i 0 const
D InData 32767 const varying options(*varsize)
D InActLn 10i 0 const
D rc 10i 0
***********************************************************************
* Prototype for char2hex.
***********************************************************************
* Converts characters to their hexadecimal characters
* Input: variable length character field
* Output variable length character field, twice as long, containing
* the hex digits for each input character.
*
* Example: eval hex = char2hex('ABC') returns the characters C1C2C3
*
* Uses MI instruction cvthc. Bind with binding directory QSYS/QC2LE.
*
D char2hex pr 32000 varying
D charsin 16000 const varying options(*varsize)
***********************************************************************
* Prototype for ChkIfsObj2 - Uses UNIX API stat()
***********************************************************************
* Checks IFS object's existence and optionally returns its type,
* size (31 bit), and error information.
* This subprocedure's name is ChkIfsObj2 in order to distinguish
* it from Giovanni Perotti's IFSTOOL's ChkIfsObj subprocedure.
* No authority to the object is required to use this subprocedure.
* *X authority is required for all subdirectories in the object's
* path. If this authority is lacking, the object is not accessible.
* If the object is found and is accessible, ChkIfsObj2
* returns a *on indicator. Otherwise, it returns *off.
* See parameters, below, for more details.
* If you don't care about the object's type or size or error details,
* all parameters except the first are optional.
* Required Parameters
* -------------------
* ObjPath: - Null terminated string of complete path to the object
*
* Optional (*nopass) Parameters
* -----------------------------
* ObjType - If successful, contains the object's type.
*
* ObjSize: - If successful, contains the object's size in bytes.
* - Otherwise, contains 0. This parameter is optional.
*
* C_Errno: - Contains C's errno value. This parameter is optional.
* - If successful, contains 0.
* - Otherwise, contains the C's errno value
*
* C_ErrText: - The text associated with C's errno value.
* - If successful, contains a zero length string.
* - Otherwise, contains the C message text associated with
* C's errno value.
* Examples
* --------
* - if you only want to find out if the object is accessible
* if ChkIfsObj2('/home/joe/x.y');
* - if also want the object's type
* if ChkIfsObj2('/home/joe/x.y':objType);
* - if you also want the object's size
* if ChkIfsObj2('/home/joe/x.y':objType: objSize);
* - if you also want C's errno when a failure occurs
* if ChkIfsObj2('/home/joe/x.y':objType: objSize: C_Errno);
* - if you also want C's errno text when a failure occurs
* if ChkIfsObj2('/home/joe/x.y':objType: objSize: C_Errno:
* C_ErrText);
D ChkIfsObj2 pr n
D ObjPath * value options(*string)
D ObjType 11 varying options(*nopass)
D NbrBytes 10i 0 options(*nopass)
D C_Errno 10i 0 options(*nopass)
D C_ErrText 256 varying options(*nopass)
******************************************************************
* ChkIfsObj3 - Uses UNIX API stat()
******************************************************************
* Checks IFS object's existence and optionally returns its type,
* size (31 bit), and error information.
* No authority to the object is required to use this subprocedure.
* *X authority is required for all subdirectories in the object's
* path. If this authority is lacking, the object is not accessible.
* If the object is found and is accessible, ChkIfsObj2
* returns *on. Otherwise, it returns *off. See parameters, below,
* for more details.
* If you don't care about the object's type, size, creation date, codepage, CCSID
* or error details, all parameters except the first are optional.
* Required Parameters
* -------------------
* ObjPath: - Null terminated string of complete path to the object
*
* Optional (*nopass) Parameters
* -----------------------------
* ObjType - If successful, contains the object's type.
*
* ObjSize: - If successful, contains the object's size in bytes.
* - Otherwise, contains 0. This parameter is optional.
*
* ObjCrtStamp: - If successful, contains the object's creation timestamp.
* - This parameter is optional.
*
* ObjCodePage: - If successful, contains the object's codepage.
* - Otherwise, contains 0. This parameter is optional.
*
* ObjCCSID: - If successful, contains the object's CCSID.
* - Otherwise, contains 0. This parameter is optional.
*
* C_Errno: - Contains C's errno value. This parameter is optional.
* - If successful, contains 0.
* - Otherwise, contains the C's errno value
*
* C_ErrText: - The text associated with C's errno value.
* - If successful, contains a zero length string.
* - Otherwise, contains the C message text associated with
* C's errno value.
* Examples
* --------
* - if you only want to find out if the object is accessible
* if ChkIfsObj3('/home/joe/x.y');
* - if also want the object's type
* if ChkIfsObj3('/home/joe/x.y':objType);
* - if you also want the object's size
* if ChkIfsObj3('/home/joe/x.y':objType: objSize);
* - if you also want the object's creation timestamp
* if ChkIfsObj3('/home/joe/x.y':objType: objSize: objCrtStamp);
* - if you also want the object's codepage
* if ChkIfsObj3('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage);
* - if you also want the object's CCSID
* if ChkIfsObj3('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage:
* objCCSID);
* - if you also want C's errno when a failure occurs
* if ChkIfsObj3('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage:
* objCCSID: C_Errno);
* - if you also want C's errno text when a failure occurs
* if ChkIfsObj3('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage:
* objCCSID: C_Errno: C_ErrText);
D ChkIfsObj3 pr n
D ObjPath * value options(*string)
D ObjType 11 varying options(*nopass)
D objSize 10i 0 options(*nopass)
D ObjCrtStamp z options(*nopass)
D ObjCodepage 5u 0 options(*nopass)
D ObjCCSID 5u 0 options(*nopass)
D C_Errno 10i 0 options(*nopass)
D C_ErrText 256 varying options(*nopass)
******************************************************************
* ChkIfsObj4 - Uses UNIX API stat64()
******************************************************************
* Checks IFS object's existence and optionally returns its type,
* size (64 bit), and error information.
* No authority to the object is required to use this subprocedure.
* *X authority is required for all subdirectories in the object's
* path. If this authority is lacking, the object is not accessible.
* If the object is found and is accessible, ChkIfsObj2
* returns *on. Otherwise, it returns *off. See parameters, below,
* for more details.
* If you don't care about the object's type, size, creation date, codepage, CCSID
* or error details, all parameters except the first are optional.
* Required Parameters
* -------------------
* ObjPath: - Null terminated string of complete path to the object
*
* Optional (*nopass) Parameters
* -----------------------------
* ObjType - If successful, contains the object's type.
*
* ObjSize: - If successful, contains the object's size in bytes.
* - Otherwise, contains 0. This parameter is optional.
*
* ObjCrtStamp: - If successful, contains the object's data change timestamp
* (such as object creation or data updated)
* - This parameter is optional.
*
* ObjCodePage: - If successful, contains the object's codepage.
* - Otherwise, contains 0. This parameter is optional.
*
* ObjCCSID: - If successful, contains the object's CCSID.
* - Otherwise, contains 0. This parameter is optional.
*
* C_Errno: - Contains C's errno value. This parameter is optional.
* - If successful, contains 0.
* - Otherwise, contains the C's errno value
*
* C_ErrText: - The text associated with C's errno value.
* - If successful, contains a zero length string.
* - Otherwise, contains the C message text associated with
* C's errno value.
*
* ObjChgStamp: - If successful, contains the object's attribute change.
* (example: date restored)
* - This parameter is optional.
*
* ObjAccStamp: - If successful, contains the object's last access timestamp.
* - This parameter is optional.
* Examples
* --------
* - if you only want to find out if the object is accessible
* if ChkIfsObj4('/home/joe/x.y');
* - if also want the object's type
* if ChkIfsObj4('/home/joe/x.y':objType);
* - if you also want the object's size
* if ChkIfsObj4('/home/joe/x.y':objType: objSize);
* - if you also want the object's creation timestamp
* if ChkIfsObj4('/home/joe/x.y':objType: objSize: objCrtStamp);
* - if you also want the object's codepage
* if ChkIfsObj4('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage);
* - if you also want the object's CCSID
* if ChkIfsObj4('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage:
* objCCSID);
* - if you also want C's errno when a failure occurs
* if ChkIfsObj4('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage:
* objCCSID: C_Errno);
* - if you also want C's errno text when a failure occurs
* if ChkIfsObj4('/home/joe/x.y':objType: objSize: objCrtStamp: objCodepage:
* objCCSID: C_Errno: C_ErrText);
D ChkIfsObj4 pr n
D ObjPath * value options(*string)
D ObjType 11 varying options(*nopass)
D objSize 20u 0 options(*nopass)
D ObjCrtStamp z options(*nopass) stamp of data change
D ObjCodepage 5u 0 options(*nopass)
D ObjCCSID 5u 0 options(*nopass)
D C_Errno 10i 0 options(*nopass)
D C_ErrText 256 varying options(*nopass)
D ObjChgStamp z options(*nopass) stamp of attr change
D ObjAccStamp z options(*nopass) stamp of last access
*=================================================================
* LoadStreamFile Load a stream file in memory
*=================================================================
* This subprocedure speeds up the development of programs needing to load in memory
* one or more stream files.
* A sample reason for loading a stream file in memory could be that of using its data
* in a WrtNoSection() subprocedure.
*
* Input parameters
* - Stmf address of 'path and name of the stream file'
* - DataType: BIN - do not perform any CCSID converstion, take the data as they are
* TEXT - convert the data to the CCSID of the job
* Output parameters
* - DataLength: length of stream file data
* - DataPointer: pointer to the memory area containing the stream file data
* Return code values:
* 0 operation was successful
* -1 IFS object not found
* -2 not a stream file
* -3 stream file size is 0
* -4 stream file size exceeds 16776704 byte
* -5 cannot allocate memory
* -6 cannot open stream file
* Example:
* D stmf s 1024 varying
* D rc s 10i 0
* D dataLength s 10i 0
* D dataPointer s *
* D data s 1000 based(dataPointer)
* /free
* stmf='/cgidev/conf/httpd.conf';
* rc=LoadStreamFile(stmf:'TEXT':DataLength:DataPointer);
* if rc=0;
* // ... process the stream file data in memory, pointed by "dataPointer" ...
* // release the allocated memory
* dealloc(n) DataPointer;
* endif;
* return;
*=========================================================================
D LoadStreamFile pr 10i 0
D Stmf * value options(*string)
D DataType 4 value
D DataLength 10i 0
D DataPointer *
***********************************************************************
* Prototype for chknbr
***********************************************************************
* Checks a character string to see if it contains a valid number.
* The only valid characters are -0123456789 and the character being used
* as the decimal point.
*
* Optionally, when errors are found, uses AddMsg to write records into the
* error message arrays.
* Inputs: - variable length character field containing data intended to
* be a valid decimal number.
* - maximum number of digits to the left of the decimal point
* (optional parameter). 0 or not passed means don't check it.
* If greater than 21, it is changed to 21.
* - whether to add messages to the message arrays using AddMsg
* if errors are found.
* - field's description for AddMsg purposes
* - whether to consider a negative value an error for AddMsg
* purposes. If this parameter is not passed, negative
* numbers do not cause a message to be added by AddMsg.
* Returns: Data structure containing indicators (seven indicators)
* 1 = *on = one or more errors as described in indicators
* 2 through 6 below. Indicator 7 being on does
* not set on indicator 1.
* 2 = non-numeric characters (includes minus sign in wrong place)
* 3 = multiple decimal points
* 4 = multiple signs (both leading and trailing)
* 5 = zero length input or no numeric characters
* 6 = error in number of digits to left or right of decimal
* point. Set on if:
* - more than 21 digits to the left of the decimal point
* - more than 9 digits to the right of the decimal point
* - more digits to the left of the decimal point than
* specified in maxdigits parameter.
* 7 = The value is less than 0. This condition does not
* set on indicator one.
D chknbr pr 7
D chars 32 const varying options(*varsize)
D MaxDigits 10i 0 const options(*nopass)
D AddMsgs n const options(*nopass)
D FieldDescription...
D 32 const varying options(*nopass)
D NegIsError n const options(*nopass)
******************************************************************
* Prototype for ClrHtmlBuffer subprocedure
******************************************************************
* Clears the HTML output buffer.
*
* Use this subprocedure to empty the buffer without sending it
* to either the browser or to a stream file.
*
* This is useful when program logic dictates you need to output
* something other than what has already been buffered.
D ClrHtmlBuffer pr
******************************************************************
* Prototype for ClrMsgs (Clear Messages) Subprocedure
******************************************************************
* Logically sets the number of messages to 0
D ClrMsgs pr
***********************************************************************
* Prototype for contlen (content_length)
***********************************************************************
* Returns as a numeric variable, the CONTENT_LENGTH environment
* variable. Used by getinput. Should not be called directly.
D contlen pr 10i 0 content length
***********************************************************************
* Prototype for countp.
***********************************************************************
* Increments count record whose key is
* keyvalin and returns updated count. If record does not
* exist, it is created and set to 1.
D countp pr 10i 0 Counter value
D keyvalin 20 varying const Counter key
***********************************************************************
* Prototype for CrtCookie
***********************************************************************
* Creates a cookie string in the form:
* Set-Cookie: NAME=VALUE; expires=DATE; path=PATH; domain=DOMAIN_NAME; secure; HttpOnly
* See http://ww.netscape.com/newsref/std/cookie_spec.html for details about
* how cookies work.
*
* Parameters
* - Cookie's name (required input)
* - Cookie's value (required input)
* - Return code (required output)
* 0 = no errors
* less than zero is sum of following:
* -1 blank cookie name
* -2 blank cookie value
* -4 invalid timestamp
* - Cookie's domain (required input, null or blank
* means none)
* - Cookie's path (required input, null or blank
* means none)
* - Whether secure (optional input: *on=yes *off=no)
* When *on, the cookie can be accessed only
* through a "secure" HTTP server (HTTPS).
* - Cookie's expiration timestamp (optional input) timestamp in
* format: YYYY-MM-DD-HH.MM.SS.MMMMMM
* Use local date and time. CrtCookie
* converts to GMT. Note: the UTC
* offset is as of run time, not as of
* the expiration date, so the expiration
* date/time could be off by the time difference
* between the UTC offset on standard
* versus daylight savings time.
* - HttpOnly (optional input: *on=yes *off=no) Giovanni Febr. 2012
* When *on, the cookie can be accessed only from
* the HTTP server (HTTP or HTTPS), that is from
* an Internet Browser.
* It helps mitigating the risk that a malicious client
* mitigate the risk that a malicious client side script
* (usually written in XSS), if supported by the browser,
* may access the cookie and steal security information
* (example: passwords).
* Returns:
* - variable length character field, containing the
* generated Set-Cookie header. Blank if any errors occurred.
*
* Example: eval mycookie = CrtCookie('TEST':'The Data':
* RC:'ibm.com':'/':*off:
* '2001-10-11-12.12.12.000000':*on) Giovanni Febr. 2012
D CrtCookie pr 5000 varying
D Name 1000 const varying options(*varsize)
D Value 4000 const varying options(*varsize)
D ReturnCode 10i 0
D Domain 1000 const varying options(*varsize)
D Path 1000 const varying options(*varsize)
D Secure n const options(*nopass)
D Expires z const options(*nopass)
D HttpOnly n const options(*nopass) Giovanni Febr. 2012
******************************************************************
* Prototype for CrtTagOpt
******************************************************************
* Creates an option tag.
* Use this subprocedure to build selection boxes when the
* contents are not static, or the SELECTED option varies.
* Do not use it for static selection boxes. Static, externally
* defined HTML is much more efficient.
* Inputs:
* - String to be used for the value attribute
* - String for the tag's associated text.
* - Optional input containing the value of the option to have
* the SELECTED attribute. If this parameter matches the
* first parameter, the SELECTED attribute is output.
* Output:
* - String containing an option tag. For example:
* Examples
* CrtTagOpt('AZ':Arizona) returns
* «option value="AZ"»Arizona«/option»
* CrtTagOpt('AZ':Arizona:'AZ') returns
* «option value="AZ" SELECTED»Arizona«/option»
* CrtTagOpt('AZ':Arizona:'MN') returns
* «option value="AZ"»Arizona«/option»
D CrtTagOpt pr 200 varying
D value 50 const varying
D text 100 const varying
D selected 50 const varying options(*nopass)
**************************************************************************
* Prototype for CrtUsrSpc
**************************************************************************
* Creates a randomly named, automatically extendible user space
* in a user-specified library. The user space's contents are initialized
* to all x'00's.
* Required Parameters
* - User space library (input)
* - If the library not found, CrtUsrSpc sets the user space name
* to blanks and MsgId to CPF9810
* - If the requestor does not have change authority to the library,
* CrtUsrSpc sets the user space name to blanks and MsgId to CPF2144
* - Pointer to user space (output)
* - Set to null if the user space is not created
* - Message ID (output)
* - blank if no errors
* - else, message id of error
* Optional Parameters
* - Public authority (input)
* - If not passed, it is set to *EXCLUDE
* - Text (input)
* - If not passed, it is set to 'Created by CGIDEV2' plus timestamp
* - Initial size (input)
* - If not passed, it is set to 12288
* - Extended attribute
* - If not passed, it is set to blanks
* Returns
* - If successful
* - User space name
* - Otherwise
* - Blanks
*
* Errors in system APIs
* - If any of the called system APIs fails, a message is forced into
* the CGIDEBUG file.
**************************************************************************
D CrtUsrSpc pr 10
D usrSpcLib 10 value
D usrSpcPtr *
D msgid 7
D pubAut 10 value options(*nopass)
D text 50 value options(*nopass)
D initialSize 10i 0 value options(*nopass)
D extAttr 10 value options(*nopass)
***********************************************************************
* Prototype for MI instruction cvtch (Convert Eight Bit
* Characters to Hex Nibbles)
***********************************************************************
* Converts eight bit characters to hex nibbles. 2 bytes become 1 byte.
D cvtch pr extproc('cvtch')
D receiver * value
D source * value
D size 10i 0 value
D
***********************************************************************
* Prototype for CvtDb
***********************************************************************
* Calls QtmhCvtDb API from service program QHTTPSVR/QZHBCGI
* Uses wrtdebug subprocedure to send information about the call to the debugging file.
D CvtDb pr opdesc
D DbFileName 20 Filename & Library
D InData 32767 options(*varsize) Input data
D InActLn 10i 0 Input data length
D DSBuffer 32767 options(*varsize) Data structure buffr
D DBDSLn 10i 0 Data struct length
D DBActLn 10i 0 Data struc retrn len
D DBRespCd 10i 0 Response Code
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for MI cvtefnd (Convert External Form to Numeric Value)
***********************************************************************
D cvtefnd pr 8f extproc('cvtefnd')
D string 32
D length 10i 0 value
D mask 3
D
***********************************************************************
* Prototype for MI instruction cvthc (Convert Hex to Character)
***********************************************************************
* Converts nibbles to characters (1 byte becomes 2)
D cvthc pr extproc('cvthc')
D Receiver * value
D Source * value
D size 10i 0 value
***********************************************************************
* Prototype for QtmhWrStout
***********************************************************************
* Write to standard output
D QtmhWrStout pr extproc('QtmhWrStout')
D Buffer * value
D BufferLength 10i 0 const
D error likeds(qusec)
***********************************************************************
* Prototype for c2n, converts up to 32-byte string to floating point number
***********************************************************************
* Converts a character string to a floating point variable. If
* non-zero, adds a small fuzz to the result in an attempt to
* ensure that subsequent rounding works as expected.
*
* Input: variable length character field containing a valid
* decimal number in display format.
* Output: floating point number which can then be converted to
* some other form either by assignment or via %DEC, %DECH,
* %INT, or %INTH built-in functions.
*
* The only characters included in the conversion are digits, the
* minus sign, and the current RPG decimal point character.
* If multiple decimal points are found, only the first one is used.
*
* Example: eval float = c2n('-123.34')
*
* Uses MI instruction cvtefnd. Bind with binding directory QSYS/QC2LE.
*
D c2n pr 8f
D c 32 const varying options(*varsize)
***********************************************************************
* Prototype for c2n2 subprocedure
***********************************************************************
* Converts a character string to a 30,9 packed variable.
* Adapted from getnum subprocedure, written by Barbara Morris,
* IBM Toronto laboratory.
*
* This subprocedure avoids precision problems with large
* floating point numbers by doing virtually all its work with
* characters. Performance is improved too.
* Input: variable length character field containing a valid
* decimal number in display format.
* Output: 30p 9 number
*
* The only characters included in the conversion are digits, the
* minus sign, and the current RPG decimal point character.
* If multiple decimal points are found, only the first one is used.
*
* Example: eval number = c2n2('-123.34')
D c2n2 pr 30p 9
D string 32 const varying
***********************************************************************
* Prototype for Docmd.
***********************************************************************
* Executes a CL command
* Returns 0 if executed without error; otherwise 1.
D DoCmd pr 10i 0
D cmd 2000 const varying options(*varsize)
******************************************************************
* Prototype for Encode
******************************************************************
* Returns a varying length field built from an input varying
* length field in which the following characters are converted
* to their HTML character entities:
* Character Character Entity
* --------- ----------------
* " "
* & &
* « <
* » >
* The input field can be any size up to 32767. Be sure
* that it has a correct length as shown in any of the
* following examples:
* - Passing a literal
* eval result = encode('«html»')
* - Assigning value to a varying field.
* eval vfield = '«html»'
* eval result = encode(vfield)
* - Assigning a value to a fixed field
* eval ffield = '«html»'
* eval result = encode(%trimr(ffield))
* - Passing an expression
* eval result = encode('abc' + %trimr(ffield) +
* vfield + 'xyz')
D Encode pr 32767 varying
D Input 32767 const options(*varsize) varying
******************************************************************
* Prototype for Encode2
******************************************************************
* Uses an input varying length field to create and return a
* varying length field in which selected input characters are
* changed to the their corresponding character entities.
* The characters to be converted are defined in an IFS file,
* specified in the third parameter. If the third parameter is
* not passed, a default file, /cgidevexthml/encod2arr.txt, is used.
*
* Characters not defined in the IFS file are not converted. Instead,
* the are returned without change. For example:
*
* Input: «HTML»
* Output: >HTML<
*
* Parameters
* ----------
* - Input
* - Char 8191, varying. The string to be encoded.
* - ReturnCode
* - 10i 0
* 0 successful,
* -1 file error (could be any of the following)
* (at run time, a detailed message is sent to the CGIDEBUG
* debugging file):
* - file not found
* - file not accessible (authority, etc.)
* - file empty
* - file contains no valid records
* -2 one or more data errors, usually invalid entity value
* (details in debugging file)
*
* - EntitiesFile - file that contains the arrays of characters
* and character entities
* - Char 256, *options(*nopass) varying
* - Arrays of characters and entities are loaded at run time
* this file. If the EntitiesFile parameter is not passed, file
* /cgiexthtml/encode2fil.txt is used. Otherwise, the
* EntitiesFile file is used.
*
* Testing Encode2
* ---------------
* Test encode2 from a browser using sample CGI program DSPENCODE2.
* If something does not work as expected, change encode2's arrays
* as follows:
*
* Customizing the arrays
* ----------------------
* - The default arrays are stored in /cgidevExtHTML/encode2fil.txt.
* Do not modify, move, or rename this file.
* - Copy the default file to an IFS file of your own.
* - Make sure QTMHHTP1 has *RX authority to your file
* - Modify your file.
* - Record format, one record per line
* - Comment records
* - Positions 1 -2 must be //.
* - Data records
* - Position 1 = the character to be encoded
* - Positions 2 - 9 = the character entity to be substituted for
* the character. If these positions are blank,
* the record is ignored.
* - Remainder of record = blanks or comments
* - Use your file in the EntitiesFile parameter.
* The input field can be any size up to 8191. Because
* it is varying, be sure that its length is set
* correctly. Here are a few examples:
* - Passing a literal
* eval result = encode2('«html»':rc)
* - Passing a varying field.
* eval vfield = '«html»'
* eval result = encode2(vfield:rc)
* - Passing from a fixed length field
* eval ffield = '«html»'
* eval result = encode2(%trimr(ffield):rc)
* - Passing an expression
* eval result = encode2('abc' + %trimr(ffield) +
* vfield + 'xyz':rc)
D Encode2 pr 65528 varying
D InputString 8191 const options(*varsize) varying
D ReturnCode 10i 0
D EntitiesFile 256 const varying options(*nopass)
******************************************************************
* Prototype for Decode2
* Transforms characters entities (e.g. '>') to characters (e.g. '»')
******************************************************************
* Uses an input varying length field to create and return a
* varying length field in which selected input character entities
* changed to the their corresponding charactes.
* The characters entities to be converted are defined in an IFS file,
* specified in the third parameter. If the third parameter is
* not passed, a default file, /cgidevexthml/encod2arr.txt, is used.
*
* Characters entities not defined in the IFS file are not converted. Instead,
* the are returned without change. For example:
*
* Input: >HTML<
* Output: «HTML»
*
* Parameters
* ----------
* - Input
* - Char 65528, varying. The string to be decoded.
* - ReturnCode
* - 10i 0
* 0 successful,
* -1 file error (could be any of the following)
* (at run time, a detailed message is sent to the CGIDEBUG
* debugging file):
* - file not found
* - file not accessible (authority, etc.)
* - file empty
* - file contains no valid records
* -2 one or more data errors, usually invalid entity value
* (details in debugging file)
*
* - EntitiesFile - file that contains the arrays of characters
* and character entities
* - Char 256, *options(*nopass) varying
* - Arrays of characters and entities are loaded at run time
* this file. If the EntitiesFile parameter is not passed, file
* /cgiexthtml/encode2fil.txt is used. Otherwise, the
* EntitiesFile file is used.
*
* Customizing the character entity list
* -------------------------------------
* - The default data are stored in /cgidevExtHTML/encode2fil.txt.
* It is recommended that you NOT modify, move, or rename this
* file because it could be replaced whenever CGIDEV2 is updated
* or reinstalled. Instead,
* - Copy the default file to an IFS file of your own.
* - Make sure user QTMHHTP1 has *RX authority to your file
* - Modify your file.
* - One record per line
* - Comment records
* - Positions 1 -2 must be //.
* - Data records
* - Position 1: the character to be encoded
* - Positions 2 - 9: the character entity to be substituted for
* the character. If these positions are blank,
* the record is ignored.
* - Remainder of record: blanks or comments
* - Use your file in the EntitiesFile parameter.
* The input field can be up to 65528 bytes. Because
* it is varying, be sure that its length is set
* correctly. Here are a few examples:
* - Passing a literal
* eval result = decode2('<html>':rc)
* - Passing a varying field.
* eval vfield = '<html>'
* eval result = encode2(vfield:rc)
* - Passing from a fixed length field
* eval ffield = '<html>'
* eval result = encode2(%trimr(ffield):rc)
D Decode2 pr 65528 varying
D InputString 65528 const options(*varsize) varying
D ReturnCode 10i 0
D EntitiesFile 256 const varying options(*nopass)
******************************************************************
* Prototype for EncodeBlanks
******************************************************************
* Returns a varying length field built from an input varying
* length field in which any blanks are converted to the HTML
* entity, (non-breaking space).
* The input field can be any size up to 32767. Be sure
* that it has a correct length as shown in any of the
* following examples:
* - Passing a literal
* eval result = EncodeBlanks('«html»')
* - Assigning value to a varying field.
* eval vfield = '«html»'
* eval result = EncodeBlanks(vfield)
* - Assigning a value to a fixed field
* eval ffield = '«html»'
* eval result = EncodeBlanks(%trimr(ffield))
* - Passing an expression
* eval result = EncodeBlanks('abc' +
* %trimr(ffield) + vfield + 'xyz')
D EncodeBlanks pr 32767 varying
D Input 32767 const options(*varsize) varying
***********************************************************************
* Prototype for fixmixed (need to use only when CGI_MODE = %%MIXED%%)
***********************************************************************
* Used by getinput subprocedure. It should not be necessary to call fixmixed
* directly.
* Modifies CGI input string's escape sequences: in the data portion of a couplet
* the ASCII code points are converted to the corresponding EBCDIC code points. For
* those in the field name portion, escape sequences are converted the correct single
* EBCDIC character.
* Inputs: - string containing input from the browser
* - length of the string
* Outputs: - modified string with escape sequences in the data portion of each field converted
* to EBCDIC escape sequences and those in the field name part converted to an
* EBCDIC character.
*
* Example: callp fixmixed(inbuff:inactln)
*
D fixmixed pr opdesc
D string 32767 options(*varsize)
D stringln 10i 0
****************************************************************************
* Prototype for subprocedure errno
****************************************************************************
* Returns C environment's errno parameter.
D errno pr 10i 0
****************************************************************************
* Prototype for subprocedure errnotxt
****************************************************************************
* Returns C environment's errno text
D errnotxt pr 100 varying
D errno 10i 0 value
**************************************************************************
* GetCookieByName subprocedure
**************************************************************************
* Retrieves a cookie's value given its name and occurrence.
*
* Parameters
* - Cookie's name (required input)
* - Cookie's occurrence (optional input)
* 1 is assumed if not passed.
* Returns:
* - value of the cookie having the name and occurrence. If not
* found, returns a null string.
*
* Example: eval x = GetCookieByName('TEST':1)
D GetCookieByName...
D pr 5000 varying
D Name 1000 const varying options(*varsize)
D Occurrence 10i 0 const options(*nopass)
***********************************************************************
* Prototype for getenv.
***********************************************************************
* Gets an environment variable
* If an error occurs, returns blank and error information in qusec
D getenv pr 32767 varying
D envvarnam 100 const varying options(*varsize)
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for gethtml
***********************************************************************
* Overrides to specified source physical file and loads arrays with HTML
* data from the source physical file. Arrays subsequently used by
* wrtsection, etc.
*
* The optional sectionDelimStart parameter is used to override
* the default starting section delimiter of /$.
*
* The optional sectionDelimEnd parameter is used to override the
* default non-existent ending section delimiter.
*
* The optional varDelimStart parameter is used to override the default
* start variable delimiter of /%
* The optional varDelimEnd parameter is used to override the default
* end variable delimiter of %/
*
D gethtml pr
D fn 10 const
D lib 10 const
D mbr 10 const
D sectionDelim...
D Start 20 const varying options(*nopass)
D sectionDelim...
D End 20 const varying options(*nopass)
D varDelimStart 20 const varying options(*nopass)
D varDelimEnd 20 const varying options(*nopass)
***********************************************************************
* Prototype for gethtmlIFS
***********************************************************************
* Loads arrays with HTML data from an IFS file.
* The arrays are subsequently used by wrtsection, etc.
*
* The optional sectionDelimStart parameter is used to override
* the default starting section delimiter of /$.
*
* The optional sectionDelimEnd parameter is used to override the
* default non-existent ending section delimiter.
*
* The optional varDelimStart parameter is used to override the default
* start variable delimiter of /%
* The optional varDelimEnd parameter is used to override the default
* end variable delimiter of %/
*
D gethtmlIFS pr
D IfsFile 1024 const varying
D sectionDelim...
D Start 20 const varying options(*nopass)
D sectionDelim...
D End 20 const varying options(*nopass)
D varDelimStart 20 const varying options(*nopass)
D varDelimEnd 20 const varying options(*nopass)
******************************************************************
* Prototype for GetHtmlIFSMult
******************************************************************
* Loads arrays with HTML data from multiple IFS files.
* The arrays are subsequently used by wrtsection, etc.
* Inputs
* ------
* The IfsFiles parameter contains the names of the files. A blank
* signifies the end of a file's name. The following limitations
* apply:
* - Maximum length per file name: 255 bytes not counting the
* blank seperator
* - Maximum length of all the input file names, including any
* blank separators: 32767
* - Maximum number of file names: 127
* All the files must use the same section name delimiters
* and substitution variable delimiters.
* The optional sectionDelimStart parameter is used to override
* the default starting section delimiter of /$.
* The optional sectionDelimEnd parameter is used to override the
* default non-existent ending section delimiter.
*
* The optional varDelimStart parameter is used to override the default
* start variable delimiter of /%
* The optional varDelimEnd parameter is used to override the default
* end variable delimiter of %/
* Return value
* ------------
* GetHtmlIFSMult returns a data structure containing an array of six
* indicators that can be checked to find out if any errors occurred.
* The indicators and their meanings are:
* - NoErrors: *on = no error occurred
* *off = one or more errors. Check other indicators.
* - NameTooLong *on = one or file's name exceeds 255 characters.
* File is ignored.
* - NotAccessible *on = File or directory not found, authorization
* failure, etc. File is ignored.
* - NoFilesUsable *on = All the files have been ignored.
* - DupSections *on = One or more duplicate sections were found.
* Only the first occurrence is used.
* - FileIsEmpty *on = File is empty and is ignored.
D GetHtmlIFSMult pr 6
D IfsFiles 32767 const varying options(*varsize)
D sectionDelim...
D Start 20 const varying options(*nopass)
D sectionDelim...
D End 20 const varying options(*nopass)
D varDelimStart 20 const varying options(*nopass)
D varDelimEnd 20 const varying options(*nopass)
***********************************************************************
* Prototype for getinput
***********************************************************************
* Gets and returns browser's input, input length and REQUEST_METHOD
* (GET or POST).
*
* Logic flow
* - Determine request_method
* - If POST, gets data from standard input
* - If GET, gets data from query_string
* - Uses the fixmixed subprocedure to convert ASCII escape sequences
* to their EBCDIC equivalents (if CGI_MODE is %%MIXED%%)
* - Puts data and length into Indata and InActLn, respectively
* - Puts request_method into InDataType
******************************************************************
*
D getinput pr opdesc
D InData 32767 options(*varsize) Input data
D InActLn 10i 0 Actual length Rcvd
D InDataType 4 Returns GET or POST
******************************************************************
* Prototype for GetHtmlBytesBuffered Subprocedure
******************************************************************
* Returns the number of bytes in the output HTML buffer.
* This number is incremented each time output is written with
* WrtSection or WrtNoSection.
* It is reset to 0 when either WrtSection('*fini') or
* WrtHtmlToStmfX is run.
* If this number is allowed to grow to more than 16 MB, the CGI
* program will fail.
D GetHtmlBytesBuffered...
D pr 10i 0
******************************************************************
* Prototype for GetMsgCnt (Get Message Count) Subprocedure
******************************************************************
* Returns number of message currently in the arrays.
D GetMsgCnt pr 10i 0
***********************************************************************
* Prototype for getsessionid.
***********************************************************************
* Inputs: - none
*
* Outputs: - 15-character session id: comprising the 6 digits of the
* job number followed by 9 random digits
*
* Example: eval sessionid = getsessionid
*
D getsessionid pr 15
***********************************************************************
* Prototype for hex2char
***********************************************************************
* Converts hex characters to the characters they represent
* Input: variable length character field containing hex characters
* Output variable length character field, half as long, containing
* the character representation of each input pair of hex
* characters.
*
* Example: eval hex = char2hex('ABC') returns the characters C1C2C3
*
* Uses MI instruction cvtch. Bind with binding directory QSYS/QC2LE.
*
D hex2char pr 16000 varying
D hexcharsin 32000 const varying options(*varsize)
***********************************************************************
* Prototype for isdebug. Returns '1' if debuggins is on; '0' if not.
***********************************************************************
D isdebug pr 1n
***********************************************************************
* Prototype for putenv.
***********************************************************************
* Puts an environment variable
* If an error occurs, error information in qusec
D putenv pr
D putenvval 32767 const varying options(*varsize)
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for c's qsort function
***********************************************************************
D qsort pr extproc('qsort')
D DataStart * value
D ElemCount 10u 0 value
D ElemSize 10u 0 value
D CompFunc * ProcPtr value
***********************************************************************
* Prototype for qtmhgetenv, calls QtmhGetEnv API from service program QTCP/QTMHCGI
***********************************************************************
D qtmhgetenv pr extproc('QtmhGetEnv')
D envrcvr * value
D envrcvrln 10i 0
D envrspln 10i 0
D envrqsnm * value
D envrqsln 10i 0
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for qtmhputenv (put environment variable)
***********************************************************************
D qtmhputenv pr extproc('QtmhPutEnv')
D putenvstr * value
D putenvlen 10i 0
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for QzhbCgiParse (CGIParse) API
***********************************************************************
D qzhbcgiparse pr extproc('QzhbCgiParse')
D cgipcmd 300
D cgipfmt 8
D cgipbuf 32767 options(*varsize)
D cgipbufsize 10i 0
D cgiprsplen 10i 0
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for random subprocedure
***********************************************************************
* Returns a random unsigned integer between low and high.
*
* Inputs: low end of range. Min=1 Max=maxrange
* high end of range Min=2 Max=maxrange + 1
* difference must be at least 2
*
* Maxrange is a constant, 2147483646, defined in module xxxrandom
*
* Uses CEERAN0. On first call, sets seed to 0 so that CEERAN0 uses GMT.
* On subsequent calls, uses seed as modified by previous calls to CEERAN0.
*
* Exceptions:
* If (abs(high - low) « 2) or (abs(high - low) » maxrange + 1)
* then range is changed to 1 to (maxrange + 1)
D random pr 10u 0 Random number
D low 10u 0 value Low end of range
D high 10u 0 value High end of range
***********************************************************************
* Prototype for RandomString subprocedure
***********************************************************************
* Returns a random, varying length string up to 1024 characters
* in length.
* You can select its format as shown below. The characters
* used are 0 - 9, a - z, and A - Z.
*
* Parameters
* - Number of characters to return (0 - 1024)
* If 0, a null string is returned.
* If » 1024, 1024 characters are returned.
* - First character (if not passed, defaults to *mixedDigit)
* - *upperLetter (upper case letter only)
* - *lowerLetter (lower case letter only)
* - *mixedLetter (upper or lower case letter only)
* - *upperDigit (upper case letter or digit)
* - *lowerDigit (lower case letter or digit)
* - *mixedDigit (upper or lower case letter or digit)
* - *digit (digit only)
* - Remaining characters (if not passed, defaults to *mixedDigit)
* - same choices as first character
* - UpperChars - characters that are "upper case")
* - If not passed, defaults to 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
* - LowerChars - characters that are "lower case")
* - If not passed, defaults to 'abcdefghijklmnopqrstuvwzyz'
* - DigitChars - characters that are "digits")
* - If not passed, defaults to '0123456789'
* -
* Returns
* - Varying string containing the random characters
D randomString pr 1024 varying
D length 10u 0 value
D firstChar 12 value options(*nopass)
D remainChar 12 value options(*nopass)
D UpperChars 100 value varying options(*nopass)
D LowerChars 100 value varying options(*nopass)
D DigitChars 100 value varying options(*nopass)
**************************************************************************
* Prototype for RtvUsrSpcPtr
**************************************************************************
* Retrieves a pointer to a user space.
* Parameters
* - User space name (input)
* - User space library (input)
* Returns
* - If successful
* - Pointer to the user space
* - Otherwise
* - Null pointer
*
* Errors in system APIs
* - If the call to system API QUSPTRUS fails, a message is forced into
* the CGIDEBUG file.
D RtvUsrSpcPtr pr *
D UsrSpcName 10 value
D UsrSpcLib 10 value
******************************************************************
* Prototype for RtvHtmlRcd subprocedure
******************************************************************
* Retrieves a single record from the externally described HTML
* Parameters
* - Section name (input). If *NONE, gets record by relative
* record number regardless of section.
* - Relative record number (absolute or by section) (input)
* - Return code (output)
* 0 = record found and returned
* -1 = section not found
* -2 = record not found
* -3 = record part of a duplicate section
* Returns
* - If not found (less than 1 or greater than number of records
* read), or part of a duplicate section: a null field,
* - Otherwise, the record's contents.
D RtvHtmlRcd pr 32767 varying
D Section 50 const
D RelRcd 10i 0 const
D RetCode 10i 0
******************************************************************
* Prototypte for RtvSubsVarInfo subprocedure
******************************************************************
* Retrieves information about substitution variables
* Parameters
* - Section name (input). If *NONE, gets information by
* sequence number regardless of section.
* - Relative sequence number (absolute or by section) (input)
* - Data structure containing the following (output)
* - Section name
* - Character 50 varying
* - Null if return code not 0
* - Variable name
* - Character 30 varying
* - null if return code not 0
* - Variable's starting position in the html record
* - 10 digit unsigned
* - 0 if return code not 0
* - Length of variable's name (output)
* - 10 digit unsigned
* - 0 if return code not 0
* Returns
* - Return code (output)
* - 10-digit signed integer
* 0 = Substitution variable found and returned
* -1 = section not found
* -2 = Sequence number out of range for section or
* for list of all substitution variables
D RtvSubsVarInfo pr 10i 0
D SectionIn 50 const
D RelSeqNo 10i 0 const
D ReturnDS 92
******************************************************************
* Prototype for SetNoDebug subprocedure
******************************************************************
* Sets value of global NoDebug indicator.
* If this indicator is set to on (default is off)
* calls to debugging routines return without doing
* any work.
*
* NoDebug is also set off if the open of the cgidebug file
* fails.
D SetNoDebug pr
D SetNoDebugInd n value
******************************************************************
* Prototype for timerStart subprocedure
******************************************************************
* Sets start time for timing an operations
D TimerStart pr
******************************************************************
* Prototype for timerElapsed subprocedure
******************************************************************
* Returns seconds elapsed time since the last call to TimerStart.
* If TimerStart has not been run, runs TimerStart and returns
* zero.
* Otherwise, it does NOT reset the timer start value.
D TimerElapsed pr 15p 6
******************************************************************
* Prototype for updHTMLvar subprocedure
******************************************************************
* Updates arrays containing variable names and values
* Inputs
* - variable name
* - variable value
* - action (optional)
* - '1' = replace this variable in the arrays if it is already
* there. Otherwise add it to the arrays (default).
* - '0' = clear arrays and write variable as the first element.
* - trim instructions (optional)
* - %trim - trim left and right (default)
* - %triml - trim left only
* - %trimr - trim right only
* - %trim0 - don't trim
D updHTMLvar pr
D name 30 const varying options(*varsize)
D value 1000 const varying options(*varsize)
D action 1 value options(*nopass)
D trim 6 value varying options(*nopass)
******************************************************************
* Prototype for updHTMLvar2 subprocedure
******************************************************************
* Updates arrays containing variable names and pointers and
* the dynamic storage pointed to by the pointers
* Inputs
* - variable's name
* - variable's address (pointer)
* - variable's length
* - maximum is 16 MB
* - action (optional)
* - '1' = replace this variable in the arrays if it is already
* there. Otherwise add it to the arrays (default).
* - '0' = clear arrays and write variable as the first element.
* - trim instructions (optional)
* - %trim - trim left and right (default)
* - %triml - trim left only
* - %trimr - trim right only
* - %trim0 - don't trim
* - '1' = replace this variable if it exists, otherwise add it (default)
* - '0' = clear arrays and write this one as the first
D updHTMLvar2 pr
D name 30 value varying
D address * value
D length 10i 0 value
D action 1 value options(*nopass)
D trim 6 value varying options(*nopass)
******************************************************************
* Prototype for uppify subprocedure
******************************************************************
* Converts lowercase characters to uppercase
* Examples:
* eval charstring = uppify(charstring)
* Uppify uses XLATE on English language characters
* a through z only.
* eval charstring = uppify(charstring:0)
* Uppify uses SysConvertCase API with the characters
* in the job's CCSID
* eval charstring = uppify(charstring:n)
* Uppify uses SysConvertCase API with the characters
* in CCSID n where n is a valid CCSID number.
* If the optional parameter, CCSID, is not passed, the RPG
* XLATE operation code is used with standard English language
* characters.
* When the CCSID parameter is passed, the characters operated
* upon are all the lower case characters of the CCSID. If
* the passed CCSID is 0, the job's CCSID is used.
* If the CCSID causes an error, uppify tries to use the job's
* CCSID. It that fails, then it uses English language characters
* only. Any failures result in a message being forced into the
* CGIDEBUG file.
* Performance notes
* -----------------
* If you want the best possible performance and the
* English language characters are sufficient, do
* not use the CCSID parameter.
* If you must use the CCSID parameter, use a specific
* CCSID rather than 0 (job's CCSID). Using a specific
* CCSID takes about twice as long as no CCSID. Using CCSID
* 0 (job's CCSID) takes about 3 times as long as no
* CCSID.
* In order to maximize performance, all CGIDEV2 internal
* uses of uppify use no CCSID parameter. It is recommended
* that you not use national language characters in section
* names or substitution variable names.
D uppify pr 32767 varying
D data 32767 const varying options(*varsize)
D CCSID 10i 0 const options(*nopass)
******************************************************************
* Prototype for lowfy subprocedure
******************************************************************
* Converts uppercase characters to lowercase
* Examples:
* eval charstring = lowfy(charstring)
* Lowfy uses XLATE on English language characters
* a through z only.
* eval charstring = lowfy(charstring:0)
* Lowfy uses SysConvertCase API with the characters
* in the job's CCSID
* eval charstring = lowfy(charstring:n)
* Lowfy uses SysConvertCase API with the characters
* in CCSID n where n is a valid CCSID number.
* If the optional parameter, CCSID, is not passed, the RPG
* XLATE operation code is used with standard English language
* characters.
* When the CCSID parameter is passed, the characters operated
* upon are all the lower case characters of the CCSID. If
* the passed CCSID is 0, the job's CCSID is used.
* If the CCSID causes an error, lowfy tries to use the job's
* CCSID. It that fails, then it uses English language characters
* only. Any failures result in a message being forced into the
* CGIDEBUG file.
* Performance notes
* -----------------
* If you want the best possible performance and the
* English language characters are sufficient, do
* not use the CCSID parameter.
* If you must use the CCSID parameter, use a specific
* CCSID rather than 0 (job's CCSID). Using a specific
* CCSID takes about twice as long as no CCSID. Using CCSID
* 0 (job's CCSID) takes about 3 times as long as no
* CCSID.
* In order to maximize performance, all CGIDEV2 internal
* uses of lowfy use no CCSID parameter. It is recommended
* that you not use national language characters in section
* names or substitution variable names.
D lowfy pr 32767 varying
D data 32767 const varying options(*varsize)
D CCSID 10i 0 const options(*nopass)
******************************************************************
* Prototype for WrtDebug subprocedure
******************************************************************
* Writes a message into the debugging physical file (cgidebug) if:
* - Debugging is on (CGIDEBUG command *ON, sets CGIDEBUG data
* area to '1')
* - Or, debugging is off, but force parameter is *on
* - Otherwise, wrtdebug returns without doing anything.
D wrtdebug pr
D dbgdatain 32000 const varying options(*varsize)
D force 1n value options(*nopass)
******************************************************************
* Subprocedure WrtHtmlToStmfX: Writes HTML to stream file
* (This was the original procedure WrtHtmlToStmf(), now renamed to WrtHtmlStmfX()
******************************************************************
* The contents of the HTML buffer are written to Stmf.
* If the CodePage parmeter is passed, it is used in
* writing the streamfile. Otherwise, codepage 819 is
* is used.
* The return value is the C errno if an error was detected.
* Otherwise, it is 0
DWrtHtmlToStmfX pr 10i 0
D Stmf 1024 const varying
D CodePage 10u 0 const options(*nopass)
******************************************************************
* Subprocedure WrtHtmlToStmF: Writes HTML to stream file
* (Includes support for UTF CCSID: 1200 to 1237)
* _ This is a NEW procedure written on March 18, 2018
* - calls original procedure WrtHtmlStmfX
* - if needed, uses command CGIDEV2/STMFCVT to convert the output to UTF
******************************************************************
* - The contents of the HTML buffer are written to a temporary stream file
* (in directory /tmp) with the default job CCSID
* - Command CGIDEV2/STMFCVT is used to convert the temporary stream file
* to the requested stream file
* - the temporary stream file is deleted
* The return value is the C errno if an error was detected.
* Otherwise, it is 0
DWrtHtmlToStmf pr 10i 0
D Stmf 1024 const varying
D StmfCCSID 10u 0 const options(*nopass)
******************************************************************
* Subprocedure AppHtmlToStmF: Appends HTML to stream file
******************************************************************
* The contents of the HTML buffer are appended to Stmf.
* The return value is the C errno if an error was detected.
* Otherwise, it is 0
D AppHtmlToStmf pr 10i 0
D Stmf 1024 const varying
******************************************************************
* Subprocedure WrtSectionToStmF: Writes a section to stream file
******************************************************************
* One or more sections are written to the HTML buffer,
* the contents of the HTML buffer are written to Stmf,
* the buffer is cleared.
* On the first call
* - if the stream file already exists, it is deleted
* - the stream file is then created
* Input parameters:
* - Sections:
* -- One or more blank-separated section names
* -- Section name '*FINI' should be used to end the stream file
* tells that this is the first section to be written
* - Path and name of the IFS stream file - Requested only on the first call.
* - DataType - Requested only on the first call:
* -- *TEXT (text data to be converted to the STMF CCSID)
* -- *BIN (binary data not to be converted)
* - CCSID Requested only on the first call, it is used to establish the CCSID
* of the stream file. Defaul value is 819 (ASCII).
*
D WrtSectionToStmF...
D pr
D sections 1000 value varying
D Stmf 1024 const varying options(*nopass)
D DataType 5 const varying options(*nopass)
D CCSID 10u 0 const options(*nopass)
******************************************************************
* Subprocedure wrtjobdbg: Writes qualified job name to debugging file
******************************************************************
D wrtjobdbg pr
D force 1n value options(*nopass)
******************************************************************
* Prototype for WrtMsgs (Write Messages) Subprocedure
******************************************************************
* Writes the messges in the arrays to standard output. If no
* messages are there, does nothing.
* If section names set by CfgMsgs are null (length = 0), those
* sections are not written.
D WrtMsgs pr
***********************************************************************
* Prototype for WrtNoSection
***********************************************************************
* Writes data for the browser without using substitution variables
* or sections.
*
* This subprocedure can be used when a large block of data is to
* written. This is more likely to happen when writing non-textual
* data such as images.
*
* DataP is a pointer to the storage containing the data to be written.
* DataLength is the number of bytes to be written, starting at that
* location.
*
* Examples
* callp WrtNoSection(%addr(MyBuffer):MyBufferLength)
* callp WrtNoSection(MyPointer:MyBufferLength)
D WrtNoSection pr
D DataP * const
D DataLength 10i 0 const
***********************************************************************
* Prototype for wrtpsds.
***********************************************************************
* Writes program status data structure to cgidebug file.
D wrtpsds pr
D psdsin 429
***********************************************************************
* Prototype for wrtsection
***********************************************************************
* Writes one or more sections to the browser.
*
* Parameters
* ----------
* Sections.
* - One or more section names.
* - If more than one, separate them with one or more blanks.
*
* NoNewLine:
* - If not passed, wrtsection assumes *off
* _ *off: wrtsection inserts (a newline character, x'15'), at the
* end of each html output line.
* - *on: causes each output html line to be written without a newline
* character being inserted. This is useful when binary data are
* being sent to the browser.
*
* NoDataString
* - What to do when a substitution variable is encountered and now
* value has been set up with UpdHtmlVar.
* - If not passed, uses the default value **Missing Data**
* - Otherwise, uses the value passed.
*
* Examples (using free form syntax)
* --------
* Write sections a, b, and c with newline characters, and display
* nothing when a substitution variable has no value:
* wrtSection('a b c':*off:'');
* Write sections a, b, and c without newline characters, and display
* 'error' when a substitution variable has no value:
* wrtSection('a b c':*on:'error');
* Write sections a, b, and c with newline characters, and use
* default value when a substitution variable has no value:
* wrtSection('a b c');
D wrtsection pr
D sections 1000 value varying
D nonewline n options(*nopass) value
D NoDataString 30 options(*nopass) value varying
**************************************************************************
* Prototype for xlatwCCSIDs (translate with CCSIDs) subprocedure
**************************************************************************
* Translates input data to output data using CCSIDs.
* If optional parameters 3 and 4 are specified, their CCSIDs are used
* and the toebcdic parameter is ignored.
* Otherwise, the CCSIDS contained in environment variables CGI_EBCDIC_CCSID
* and CGI_AS CII_CCSID are used and the direction of translation is as
* specified by the toebcdic parameter (*on = to EBCDIC, *off = from EBCDIC).
D xlatwCCSIDs pr 32767 varying
D toebcdic 1n value
D input 32767 value varying
D fromCCSID 10u 0 value options(*nopass)
D toCCSID 10u 0 value options(*nopass)
***********************************************************************
* Prototype for ZhbGetInput subprocedure
***********************************************************************
* Uses QzhbCgiParse to prepare internal arrays to be used
* by subsequent calls to the ZhbGetVar, ZhbGetVarUpper,
* and ZhbGetVarCnt subprocedures.
* QzhbCgiParse requires that the CGI_MODE environment variable
* be a valid EBCDIC value.
* If this condition is not met, a message is forced into the
* debugging file and the program continues until it fails.
* This procedure should not be called more than once for each set
* of input coming from the browser.
* If REQUEST_METHOD is GET, saved query string is set to blanks.
* If REQUEST_METHOD is POST, the original QUERY_STRING is returned as
* SavedQueryString and QUERY_STRING is changed to null.
* This procedure returns a count of the number of variables received.
* Note: a variable with multiple instances counts as one variable.
* Examine the QUSEC data structure for any errors.
D ZhbGetInput pr 10i 0
D SavedQueryString...
D 32767 varying options(*varsize)
D qusec 516 options(*varsize) Error structure
***********************************************************************
* Prototype for ZhbGetVar subprocedure
***********************************************************************
* Returns the value of a CGI input variable.
* If occurrence is omitted, the first occurrence is returned.
* If the occurrence does not exist, a null string is returned.
D ZhbGetVar pr 32767 varying
D varname 50 const varying options(*varsize)
D occurrence 10i 0 const options(*nopass)
***********************************************************************
* Prototype for ZhbGetVarPtr subprocedure
***********************************************************************
* Provides a way to read browser inputs that exceed ZhbGetVar's 32767
* size limit.
* Returns a pointer to the variable's data
* If not found or length is 0, returns *null
* Parameters
* - Variable name, input
* - occurrence, input
* - length, output
* Use the returned pointer with a based variable to read the data.
* It is a user program responsibility to release the memory - allocated by the service program
* for the data of the input variable - after that the data have been processed.
* This can be done with a
C* dealloc(n) data_Pointer
* If the memory allocated is not released, in the long run this will cause the service program
* not being able to acquire heap memory any longer.
* Use subprocedure ZhbDeallocVarPtr to release the memory allocated by the service program
* for the data of the input variable.
* Do not use this subprocedure for reading a file being uploaded
* from the browser. Instead, use Giovanni Perotti's FUPLOAD utility (see
* http://www.easy400.net/fupload/html/page1.htm )
D ZhbGetVarPtr pr *
D varnamein 50 const varying options(*varsize)
D occurrence 10i 0 const
D varLenOut 10i 0
***********************************************************************
* Prototype for ZhbDeallocVarPtr subprocedure
***********************************************************************
* Frees the memory allocated by the service program and pointed by a given pointer.
D ZhbDeallocVarPtr...
D pr
D Ptr *
***********************************************************************
* Prototype for ZhbGetVarUpper subprocedure
***********************************************************************
* Returns the value of a CGI input variable with lower case
* characters converted to upper case.
* If occurrence is omitted, the first occurrence is returned.
* If the occurrence does not exist, a null string is returned.
D ZhbGetVarUpper pr 32767 varying
D varnamein 50 const varying options(*varsize)
D occurrence 10i 0 const options(*nopass)
***********************************************************************
* Prototype for ZhbGetVarLower subprocedure
***********************************************************************
* Returns the value of a CGI input variable with upper case
* characters converted to lower case.
* If occurrence is omitted, the first occurrence is returned.
* If the occurrence does not exist, a null string is returned.
D ZhbGetVarLower pr 32767 varying
D varnamein 50 const varying options(*varsize)
D occurrence 10i 0 const options(*nopass)
***********************************************************************
* Prototype for ZhbGetVarCnt subprocedure
***********************************************************************
* Returns number of occurrences of a variable in the CGI input.
D ZhbGetVarCnt pr 10i 0
D varnamein 50 const varying options(*varsize)
***********************************************************************
* Prototype for ZhbCountAllVars subprocedure
***********************************************************************
* Returns number of occurrences of all variables in the CGI input.
* ZhbGetInput must have been run before calling this subprocedure.
D ZhbCountAll...
D Vars pr 10i 0
***********************************************************************
* Prototype for ZhbGetVarDetails subprocedure
***********************************************************************
* Returns detailed information for the nth variable of all variables
* counted by ZhbCountAllVars
* ZhbGetInput must have been run before calling this subprocedure.
* If variables are requested in ordinal sequence, they will be
* returned in name, name's occurrence sequence. The names will
* be in upper case.
* Parameters
* ThisOccur Input Ordinal value of variable to return
* ThisVarName Output The variable's name
* ThisVarOccur Output Occurrence within this variable
* FoundInd Output *on = found; *off = not found
*
* Return value: the variable's value
D ZhbGetVar...
D Details pr 32767 varying
D ThisOccur 10i 0 const
D ThisVarName 50
D ThisVarOccur 10i 0
D FoundInd n
******************************************************************
* Prototype for UrlEscSeq (URL Escape Sequences) Subprocedure
******************************************************************
* Converts a GET-method parameter value to the appropriate value
* by replacing special characters with URL escape sequences.
D URLESCSEQ pr 32767 varying
D inpstring 32767 varying const options(*varsize)
D trimrInd n options(*nopass) const
D options 10 varying options(*nopass) const
******************************************************************
* Prototype for UrlUnEscSeq (URL UnEscape Sequences) Subprocedure
******************************************************************
* Converts back URL escape sequences.
D URLUNESCSEQ pr 32767 varying
D inpstring 32767 varying const options(*varsize)
D options 10 varying options(*nopass) const
******************************************************************
* "GetActJob" subprocedure - Get Active Jobs
* Generates a list of active jobs in file QTEMP/JOBLIST
* Example:
* C callp getActJob
******************************************************************
D GetActJob pr
******************************************************************
* "RtvOsRls" subprocedure - Retrieve OS/400 release
******************************************************************
D RtvOSRls pr 9
******************************************************************
* GetHtmlBufferP subprocedure - Retrieves the pointer to the Html output buffer
* Returns a data structure containing
* - the pointer to the Html output buffer
* - the used length of the Html output buffer
* Example:
* D OutBuffer s 32767 based(OutbufferP)
* D OutBufferInfo ds
* D OutBufferP *
* D OutBufferLen 10u 0
* C eval OutBufferInfo=callp(GetHtmlBufferP)
******************************************************************
D GetHtmlBufferP pr 20
******************************************************************
* "GetNEndJob" subprocedure - Get a list of Not Ended Jobs to file QTEMP/JOBLIST
* Generates a list of "not-ended" jobs in file QTEMP/JOBLIST.
* A "not-ended" job is a job either active or still in job queue.
* Example:
* C callp getNEndJob
******************************************************************
D GetNendJob pr
******************************************************************
* CvtStg - Convert a string from a CCSID to another CCSID
D CVTSTG pr
D InpCodePage 10u 0
D InpBufP *
D InpBufLen 10u 0
D OutCodePage 10u 0
D OutBufP *
D OutBufLen 10u 0
D OutDtaLen 10u 0
*=====================================================================
* "CVTSTMF" subprocedure
* Purpose: convert a stream file from a code page to another code page
* Inputs: path&name of the stream file to be converted
* path&name of the converted stream file
* (could be the same as the stream file to be converted;
* this may also be obtained by specifying '*INPSTMF'
* for this parameter)
* page code of the converted stream file
* (page code 0 means: use the job CCSID for that)
* option to display the converted stream file: *YES/*NO
* (this parameter is optional, defaults to *NO)
* Outputs: return code: 0 done, -1 not done
* object size in byte (if found, otherwise 0)
* object creation time stamp (if found, otherwise 0001-01-01)
* object page code (if found, otherwise 0)
* Example:
* D rc s 10i 0
* D InpStmf s 256
* D OutStmf s 256
* D OutCodePage s 10u 0
* D Display s 4
* C eval rc=cvtStmf(InpStmf:OutStmf:
* C OutCodePage:Display)
D CvtStmf pr 10i 0
D InpStmf 256
D OutStmf 256
D OutCodePage 10u 0
D Display 4 value options(*nopass)
*=====================================================================
* "DSPSTMF" subprocedure
* Purpose: send a stream file to the browser.
* The browser will either display it, or ask what to do with it (usually: "run or save?")
* Input: path&name of the stream file to be displayed
* Output: return code: 0 successful, -1 failed
* Example:
* D rc s 10i 0
* D stmf s 1024 varying
* C eval rc=dspStmf(stmf)
D DspStmf pr 10i 0
D stmf 1024 const varying options(*varsize)
*=====================================================================
* "DNLSTMF" subprocedure
* Purpose: download a stream file.
* Similar to procedure DSPSTMF, but in this case the browser is always forced to download.
* Input: path&name of the stream file to be displayed
* Output: return code: 0 successful, -1 failed
* Example:
* D rc s 10i 0
* D stmf s 1024 varying
* C eval rc=dnlStmf(stmf)
D DnlStmf pr 10i 0
D stmf 1024 const varying options(*varsize)
******************************************************************
* "SetJobCCSID" subprocedure -
* If current job CCSID is 65535, this subprocedure sets it as specified
* in the job default CCSID.
******************************************************************
D SetJobCCSID pr
*==================================================================
* "RtvExeEnv" procedure
* Purpose: retrieve the execution environment
* Inputs: none
* Output: execution environment (char 1)
* values: "0" = batch environment
* values: "1" = interactive environment
* Example:
* D exeEnv s 1
* /free
* exeEnv=RtvExeEnv;
*
D RtvExeEnv pr 1
*=====================================================================
* "GetJobCCSID" procedure prototype
* Purpose: Retrieve job CCSID and job default CCSID
* Output: -job CCSID
* -job default CCSID
* Example:
* D jobCCSID s 10u 0
* D jobDftCCSID s 10u 0
* /free
* GetJobCCSID(jobCCSID:jobDftCCSID);
*
D GetJobCCSID pr
D jobCCSID 10u 0
D jobDftCCSID 10u 0
*=====================================================================
* "Encrypt" procedure prototype
* Purpose: Encrypt a character string
* Input: -First call indicator, must be *on in the first call,
* then it is automatically set to *off
* -Encryption key
* Output: -Resulted encrypted string (twice as long the string to be encripted)
*
* Example:
* D FirstCallInd s n
* D EncryptKey s 16000 varying
* D StringIn s 16000 varying
* D StringOut s 32000 varying
* /free
* FirstCallInd=*on;
* EncryptKey='NeverGuess';
* StringIn='OpenSesami';
* StringOut=Encrypt(FirstCallInd:EncryptKey:StringIn);
*
D Encrypt pr 32000 varying
D FirstCallInd n
D EncryptKey 16000 varying const options(*varsize)
D StringIn 16000 varying options(*varsize)
*=====================================================================
* "Decrypt" procedure prototype
* Purpose: Decrypt a string previously encrypted with procedure Crypt()
* Input: -First call indicator, must be *on in the first call,
* then it is automatically set to *off
* -Encryption key (the same used for encrypting the string)
* -String to be decrypted
* Output:- Resulted decrypted string (half as long the string to be decrypted)
*
* Example:
* D FirstCallInd s n
* D DecryptKey s 16000 varying
* D StringIn s 32000 varying
* D StringOut s 16000 varying
* /free
* FirstCallInd=*on;
* decryptKey='NeverGuess';
* StringOut=Decrypt(FirstCallInd:DecryptKey:StringIn);
*
D Decrypt pr 16000 varying
D FirstCallInd n
D DecryptKey 16000 varying const options(*varsize)
D StringIn 32000 varying options(*varsize)
*=====================================================================
* "EncryptStmf" procedure prototype
* Purpose: Encrypt a stream file
* Input: -Encryption key
* -Stream file to be encrypted
* -Encrypted stream file
*
* Example:
* D rc s 10i 0
* D EncryptKey s 16000 varying
* D StmfIn s 512
* D StmfOut s 512
* /free
* EncryptKey='NeverGuess';
* StmfIn='/cgidev/html/sonnet29.txt';
* StmfOut='/tmp/sonnet29.txt';
* rc=EncryptStmf(EncryptKey:StmfIn:StmfOut);
*
D EncryptStmf pr 10i 0
D EncryptKey 16000 varying const options(*varsize)
D StmfIn 512
D StmfOut 512
*=====================================================================
* "DecryptStmf" procedureprototype
* Purpose: Decrypt a stream file
* Input: -Decryption key
* -Stream file to be decrypted
* -Decrypted stream file
*
* Example:
* D rc s 10i 0
* D DecryptKey s 16000 varying
* D StmfIn s 512
* D StmfOut s 512
* /free
* DecryptKey='NeverGuess';
* StmfIn='/tmp/sonnet29crypted.txt';
* StmfOut='/tmp/sonnet29decrypted.txt';
* rc=DecryptStmf(DecryptKey:StmfIn:StmfOut);
*
D DecryptStmf pr 10i 0
D DecryptKey 16000 varying const options(*varsize)
D StmfIn 512
D StmfOut 512
*=========================================================================Giovanni 2018-03-17=
* "RTVOBJD" procedureprototype
* Purpose: Retrieve object description information
* in DS mapped by cgidev2/qrpglesrc,apqusrobjd
D RtvObjD pr 10i 0
D obj 20
D objtype 8
D retDS 667
*=========================================================================Giovanni 2018-03-17=
* "RTVFD_H" procedure prototype
D RtvFD_H pr 4000 Qdb_Qdbfh
D File 10
D Library 10
* Retrieve file description header
*=========================================================================Giovanni 2018-03-17=
* "RtvJobi" - Retrieve job information
* Returns a job information data structure
* mapped by DS JOBI400 mapped in QRPGLESRC member JOBI400
D RtvJobI pr 900
*****************************************************************
* IFS APIs' prototypes and constants
*****************************************************************
*****************************************************************
* IFS prototypes
*****************************************************************
* Get IFS object status via UNIX API stat()
D stat pr 10i 0 extproc('stat')
D filename * value options(*string) null terminated str
D statStruct * value
* Get IFS object status via UNIX API stat64()
D stat64 pr 10i 0 extproc('stat64')
D filename * value options(*string) null terminated str
D statStruct * value
* Open
D open pr 10i 0 extproc('open')
D filename * value options(*string) null terminated str
D openflags 10i 0 value
D mode 10u 0 value options(*nopass)
D codepage 10u 0 value options(*nopass)
* Read
D read pr 10i 0 extproc('read')
D filehandle 10i 0 value
D datareceived * value
D nbytes 10u 0 value
* Write
D write pr 10i 0 extproc('write')
D filehandle 10i 0 value
D datatowrite * value
D nbytes 10u 0 value
* Close
D close pr 10i 0 extproc('close')
D filehandle 10i 0 value
* Link (creates a hard link)
D link pr 10i 0 extproc('link')
D filepath * value options(*string)
D newlink * value options(*string)
* Unlink (unlinks an IFS file)
D unlink pr 10i 0 extproc('unlink')
D filepath * value options(*string)
D*****************************************************************
D* IFS constants
D*****************************************************************
* File Access Modes for open()
D O_RDONLY S 10i 0 inz(1)
D O_WRONLY S 10i 0 inz(2)
D O_RDWR S 10i 0 inz(4)
* oflag values for open()
D O_CREAT S 10i 0 inz(8)
D O_EXCL S 10i 0 inz(16)
D O_TRUNC S 10i 0 inz(64)
D O_LARGEFILE S 10i 0 inz(536870912)
* File Status Flags for open() and fcntl()
D O_NONBLOCK S 10i 0 inz(128)
D O_APPEND S 10i 0 inz(256)
* oflag Share Mode values for open()
D O_SHARE_RDONLY S 10i 0 inz(65536)
D O_SHARE_WRONLY S 10i 0 inz(131072)
D O_SHARE_RDWR S 10i 0 inz(262144)
D O_SHARE_NONE S 10i 0 inz(524288)
* File permissions
D S_IRUSR S 10i 0 inz(256) Read for owner
D S_IWUSR S 10i 0 inz(128) Write for owner
D S_IXUSR S 10i 0 inz(64) Execute and Search f
D S_IRWXU S 10i 0 inz(448) Read, Write, Execute
D S_IRGRP S 10i 0 inz(32) Read for group
D S_IWGRP S 10i 0 inz(16) Write for group
D S_IXGRP S 10i 0 inz(8) Execute and Search f
D S_IRWXG S 10i 0 inz(56) Read, Write, Execute
D S_IROTH S 10i 0 inz(4) Read for other
D S_IWOTH S 10i 0 inz(2) Write for other
D S_IXOTH S 10i 0 inz(1) Execute and Search f
D S_IRWXO S 10i 0 inz(7) Read, Write, Execute
* Misc
D O_TEXTDATA S 10i 0 inz(16777216) text data flag
D O_CODEPAGE S 10i 0 inz(8388608) code page flag
D O_CCSID S 10i 0 inz(32) ccsid page flag
D O_INHERITMODE S 10i 0 inz(134217728) inherit mode flag
|