Tweet
SQL/CL sample
A week or so ago, a thread around QShell and SQL got me thinking that I've never run across examples of SQL in CL posted anywhere; so I thought I'd put one together. I used a bunch of code I had from other things and built the following. It's thinned down quite a bit just to highlight the API calls, but it's a reasonably full example that should show what's possible. Because it's done in CL, it might help make it clear that it also works in RPG, COBOL or C for anyone who doesn't have the SQL Dev Kit available.
If you have V5R4 or later with reliable PTFs, the code should compile and run as is. As written, it expects IBM's QCUSTCDT file to exist in library QIWS. Those should be the only requirements beyond general authorities to do the operations.
The program first runs:
With the VIEW available, it creates this cursor:
It then FETCHes a row that the cursor provides (there's only one row in IBM's default data), reports the column values as formatted message text, closes the cursor, and finally cleans up the allocated SQL work areas.
The program:
There are a lot of source statements, but much of that is due to blank lines, comments, API calls that are spread over many lines and all of the coding to separate almost all the API calls into separate subroutines.
I also had some code that syntax checks SQL statements; so I trimmed it down, set it to match the requirements of the main procedure and tacked it on, too.
The syntax checker:
That also can be used in V5R3 if it's converted to drop some of the V5R4 features. With a little more work, it can be used maybe back to V3R2 or so.
Compile the two as modules and bind them into a program. I only have one i 6.1 system to test it on. My others are stuck at V5R3. If it needs enhancement for different system configurations, I'd be happy to add code.
Tom
If you have V5R4 or later with reliable PTFs, the code should compile and run as is. As written, it expects IBM's QCUSTCDT file to exist in library QIWS. Those should be the only requirements beyond general authorities to do the operations.
The program first runs:
Code:
CREATE VIEW qtemp.myview01 AS
SELECT
CUSNUM, LSTNAM, INIT, BALDUE,
current date as CurDat
FROM qiws.qcustcdt
WHERE BALDUE > 100.00
Code:
SELECT
a.CUSNUM,
a.LSTNAM,
CAST(a.BALDUE AS DECIMAL (7,2)) AS MaxBal,
a.CurDat
FROM qtemp.myview01 a
WHERE a.BALDUE = (SELECT max(b.BALDUE)
FROM qtemp.myview01 b)
The program:
Code:
/* +
Basic example of CL executing a SQL statement. Requires V5R4 for +
the full set of functions used. (Statements that are generally +
available for RUNSQLSTM can be processed by similar coding using +
V5R3 constructs, e.g., SELECTs are out; but INSERT, UPDATE and +
DELETE, as well as CREATE and DROP are fine.) +
+
SQLAllocEnv Allocate a SQL environment work area +
SQLAllocConnect Allocate a connection work area +
SQLConnect Connect to a database +
SQLAllocStmt Allocate a statement work area +
SQLExecDirect Direct execution of SQL statements +
SQLFreeStmt Clean up the statement work area +
SQLTransact Commit/Rollback database changes +
SQLDisconnect Disconnect from the database +
SQLFreeConnect Clean up the connection work area +
SQLFreeEnv Clean up the SQL environment work area +
SQLColAttribute Get attributes of a result set column (V5R4) +
SQLBindCol Bind/describe a column for retrieval (V5R4) +
SQLFetch FETCH a row (V5R4) +
SQLCloseCursor Close cursor (V5R4) +
SQLError Retrieve SQL error +
+
triml Find string length +
+
SYNSQL (QSQCHKS) Syntax check SQL statement +
*/
pgm ( +
)
dcl &pNull *ptr
dcl &SQLRC *int
dcl &hEnv *int
dcl &hDBC *int
dcl &hStm *int
dcl &subRC *int value( 0 )
dcl &wInt *int value( 0 )
dcl &ofs *int value( 0 )
dcl &i *int 2 value( 0 )
dcl &SQL_SynStm *char 4098
dcl &szSQL_Stm *int 2 stg( *defined ) defvar( &SQL_SynStm 1 )
dcl &SQL_Stm *char 256 stg( *defined ) defvar( &SQL_SynStm 3 )
dcl &SQLDESCCNT *int 2 value( 1 )
dcl &SQLDESCTYP *int 2 value( 2 )
dcl &SQLDESCLEN *int 2 value( 3 )
dcl &SQLNUMERIC *int 2 value( 2 )
dcl &SQLDECIMAL *int 2 value( 3 )
dcl &SQLCOMMIT *int 2 value( 0 )
dcl &SQLNTS *int value( -3 )
dcl &SQLDROP *int 2 value( 1 )
dcl &iCol *int 2 value( 0 )
dcl &fcType *int 2 value( 0 )
dcl &bufCol *ptr
dcl &cbValueMax *int value( 0 )
dcl &ppcbValue *ptr
dcl &nAttr *int value( 0 )
dcl &smZero *int 2 value( 0 )
dcl &x00 *char 1 value( x'00' )
dcl &szSqlState *char 6
dcl &pfNtvError *int
dcl &szErrorMsg *char 512
dcl &szErrorMax *int value( 512 )
dcl &pcbError *int 2
dcl &msgtxt *char 132
dcl &msgdta *char 28
dcl &pMsgDta *ptr address( &msgdta )
dcl &nbrCols *int value( 0 )
dcl &ColAttrs *char 48
dcl &pColAttr *ptr address( &ColAttrs )
dcl &ColAttr *char 12 stg( *BASED ) basptr( &pColAttr )
dcl &psCol *int stg( *defined ) defvar( &ColAttr 1 )
dcl &DescType *int stg( *defined ) defvar( &ColAttr 5 )
dcl &pcbValue *int stg( *defined ) defvar( &ColAttr 9 )
/* +
We start by doing some initialization tasks. A SQL 'environment' +
will be allocated first, and a 'handle' is returned. Only SQL knows +
exactly where it is and how it's used. We just need to keep track +
of the handle, which is only valid in this job. Then a SQL connec- +
tion area is requested (apparently carved out of the environment). +
Again a handle is returned and we keep track of it. +
*/
/* Perform some initialization tasks... */
callsubr InitSub rtnval( &subRC )
/* +
Now that we have the areas allocated, we'll open a connection. For +
this example, we'll just pass null pointers in for the database, +
user and password. The database can be named '*LOCAL' if you wish, +
or you can use any database defined in the system's RDB directory +
as long as you can supply appropriate user/password. +
*/
/* Do a default connection for *LOCAL database... */
callsubr GetConn rtnval( &subRC )
/* +
Now we need to carve out a SQL statement area. We'll reuse this +
area a few times; the handle gets tied to the connection within the +
database within the environment. +
*/
/* Allocate a statement work handle... */
callsubr InitStm rtnval( &subRC )
/* ----------------------------------------------------------------- */
/* +
This first example is relatively simple. We'll create a sample view +
in QTEMP over IBM's sample QCUSTCDT physical file in the QIWS +
library. A few of the columns are made available in the VIEW, and a +
CurrentDate column is generated. The VIEW will then be available to +
the job, but we're not going to keep it around for very long. We +
aren't using the SQLSetConnectAttr() API in this example, so SQL +
naming is in effect by default as is ISO DATE format. +
*/
/* Set up a SQL statement for an example... */
chgvar &SQL_Stm ( +
'CREATE VIEW qtemp.myview01 AS +
SELECT +
CUSNUM, LSTNAM, INIT, BALDUE, +
current date as CurDat +
FROM qiws.qcustcdt +
WHERE BALDUE > 100.00' +
*cat &x00 +
)
/* +
We're calling the syntax check API just to include it as another +
example. This would be more useful if we didn't have constant +
strings that we probably have already verified. You might notice +
that x'00' is at the end of the string. That's because we're using +
SQL_NTS (null-terminated string) in all of our statement processing +
APIs. You can switch to using actual lengths in place of SQL_NTS. +
*/
/* Check SQL statement syntax... */
callsubr ChkSQLSyn rtnval( &subRC )
/* +
We execute our statements with SQLExecDirect(). There are pros and +
cons for this compared with SQLPrepare() plus SQLExecute(). In this +
example, we're not using parameter markers nor are we going to be +
using the same statements more than once. Just run it and go on to +
the next step. +
automatically creates a CURSOR from it. There is no explicit +
'create cursor' function. It's simply associated with the statement +
handle. +
*/
/* Execute a statement... */
callsubr ExecStm rtnval( &subRC )
/* ----------------------------------------------------------------- */
/* +
This is more complex statement and complex example. Here we'll +
execute a SELECT statement. When we do this, SQL CLI creates a +
CURSOR automatically from it. There is no explicit 'create cursor' +
function. It's simply associated with the statement handle. We want +
to FETCH from the CURSOR to get some values into our program. +
*/
/* Set up a second SQL statement for an example... */
chgvar &SQL_Stm ( +
'SELECT a.CUSNUM, +
a.LSTNAM, +
CAST(a.BALDUE AS DECIMAL (7,2)) AS MaxBal, +
a.CurDat +
FROM qtemp.myview01 a +
WHERE a.BALDUE = +
(SELECT max(b.BALDUE) +
FROM qtemp.myview01 b)' +
*cat &x00 +
)
/* Check SQL statement syntax... */
callsubr ChkSQLSyn rtnval( &subRC )
/* Execute a statement... */
callsubr ExecStm rtnval( &subRC )
/* +
Since we have no DCLF, we have no external definitions for the +
columns. Once the CURSOR is generated, SQL knows them, so we can +
ask for just about any attributes we need. +
*/
/* Retrieve attributes of result set column... */
callsubr GetAttrs rtnval( &subRC )
/* +
With the CURSOR attributes, we can tell SQL what we want to get +
when we FETCH. SQL will do any valid conversions if we want to have +
application variables that are different from the CURSOR columns, +
but we're just going to pass column attributes back in. With APIs +
and pointers, we could do stuff like apply edit codes or edit words +
or do our own data type conversions; but that's a different kind of +
example. Bruce Vining (and others) have posted Internet examples of +
ILE CL doing that with C library and MI APIs. We stick with SQL CLI +
here. +
*/
/* Set up column definitions for FETCH... */
callsubr BindCols rtnval( &subRC )
/* Fetch a row... */
callsubr FetchRow rtnval( &subRC )
/* +
We could call DSM APIs to display lists of rows or printf() for a +
spooled report. We could have DCLed variables to hold values and +
sent them to a DSPF or a UIM panel (since we know what our columns +
actually are in this example). But we're only asking for a single +
MAX() value that we know is unique in IBM's QCUSTCDT file, so we'll +
just use a temporsry MsgID to display a result. +
*/
/* Report retrieved values... */
callsubr RptValues rtnval( &subRC )
/* Close a cursor... */
callsubr CloseCursr rtnval( &subRC )
/* ----------------------------------------------------------------- */
/* +
This isn't really an "example" since there's nothing new. It just +
puts QTEMP back to its previous state. +
*/
/* Set up a third SQL statement for an example... */
chgvar &SQL_Stm ( +
'DROP VIEW qtemp.myview01' +
*cat &x00 +
)
/* Check SQL statement syntax... */
callsubr ChkSQLSyn rtnval( &subRC )
/* Execute a statement... */
callsubr ExecStm rtnval( &subRC )
/* ----------------------------------------------------------------- */
/* +
Example statements are done, so we need to start cleaning up. The +
cleanup is done in reverse order of the way we created all of our +
work areas. Statement cleanup is first, then connection, then data- +
base, and finally the SQL environment itself. +
*/
/* Free a statement... */
callsubr FreeStm rtnval( &subRC )
/* +
This might or might not be needed. It depends on what statements +
you run and whether or not anything needs to be committed or rolled +
back. We created (and dropped) an object, so we did technically +
"change" the databse. We run it here before closing the connection. +
*/
/* Finish a statement... */
callsubr FiniStm rtnval( &subRC )
/* +
This pretty much always needs to be done. Get rid of all of the +
remaining areas we had allocated in the beginning. And that gets us +
completely out of any SQL associations. +
*/
/* Do some cleanup tasks... */
callsubr FreeSub rtnval( &subRC )
return
/* +
Most of the various subroutines are simple procedure calls to the +
APIs. The return codes are usually ignored, but I used SQLError() +
at a couple points to help in fine-tuning my statements. For some- +
thing like this example program, it's almost meaningless. But you +
should test the return codes everywhere in production code and have +
appropriate handling of errors. The &SQLRC might be passed back as +
the &subRC or the handling can be with the API call. +
*/
/* ----------------------------------------------------------------- */
/* Perform some initialization tasks... */
subr InitSub
callprc 'SQLAllocEnv' ( +
&hEnv +
) +
rtnval( &SQLRC )
callprc 'SQLAllocConnect' ( +
( &hEnv *byval ) +
&hDBC +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Do a default connection for *LOCAL database... */
subr GetConn
callprc 'SQLConnect' ( +
( &hDBC *byval ) +
/* database (default) */ &x00 +
( &smZero *byval ) +
/* user (default) */ &x00 +
( &smZero *byval ) +
/* password (default) */ &x00 +
( &smZero *byval ) +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Allocate a statement work handle... */
subr InitStm
callprc 'SQLAllocStmt' ( +
( &hDBC *byval ) +
&hStm +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Execute a statement... */
subr ExecStm
callprc 'SQLExecDirect' ( +
( &hStm *byval ) +
&SQL_Stm +
( &SQLNTS *byval ) +
) +
rtnval( &SQLRC )
if ( &SQLRC *ne 0 ) do
callsubr GetError rtnval( &subRC )
enddo
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Free a statement... */
subr FreeStm
callprc 'SQLFreeStmt' ( +
( &hStm *byval ) +
( &SQLDROP *byval ) +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Finish a transaction... */
subr FiniStm
callprc 'SQLTransact' ( +
( &hEnv *byval ) +
( &hDBC *byval ) +
( &SQLCOMMIT *byval ) +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Do some cleanup tasks... */
subr FreeSub
callprc 'SQLDisconnect' ( +
( &hDBC *byval ) +
) +
rtnval( &SQLRC )
callprc 'SQLFreeConnect' ( +
( &hDBC *byval ) +
) +
rtnval( &SQLRC )
callprc 'SQLFreeEnv' ( +
( &hEnv *byval ) +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* +
All we're getting are attribute values that are returned in &nAttr. +
We want data type and length for our columns, and those are repre- +
sented either as various constants or as actual values. One value +
we retrieve will be the number of columns in the result set (in the +
CURSOR). We'll use that as a loop control to get each column. We +
pass in &pNull pointers for parms that are irrelvant. We +
*/
/* Retrieve attributes of result set column... */
subr GetColAttr
callprc 'SQLColAttribute' ( +
( &hStm *byval ) +
( &iCol *byval ) +
( &fcType *byval ) +
( &pNull *byval ) +
( &smZero *byval ) +
( &pNull *byval ) +
&nAttr +
) +
rtnval( &SQLRC )
if ( &SQLRC *ne 0 ) do
callsubr GetError rtnval( &subRC )
enddo
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Bind a column definition for value retrieval... */
subr BindCol
callprc 'SQLBindCol' ( +
( &hStm *byval ) +
( &iCol *byval ) +
( &fcType *byval ) +
( &bufCol *byval ) +
( &cbValueMax *byval ) +
( &pcbValue *byval ) +
) +
rtnval( &SQLRC )
if ( &SQLRC *ne 0 ) do
callsubr GetError rtnval( &subRC )
enddo
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Fetch a row... */
subr FetchRow
callprc 'SQLFetch' ( +
( &hStm *byval ) +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* Close a cursor... */
subr CloseCursr
callprc 'SQLCloseCursor' ( +
( &hStm *byval ) +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* +
After getting &nbrCols, loop through for each column. Get the +
length and type for each. (We don't make use of &pcbValue in this +
example, but we declare it and later retrieve it when we bind +
columns. We account for it when we set our offset up by (12) here. +
We also reset our pointer back to its origin when we're done. +
*/
/* Get result set column attributes... */
subr GetAttrs
chgvar &iCol ( 0 )
chgvar &fcType &SQLDESCCNT
callsubr GetColAttr rtnval( &subRC )
chgvar &nbrCols &nAttr
/* Get result set column #1 attributes... */
dofor &i from( 1 ) to( &nbrCols )
chgvar &iCol &i
chgvar &fcType &SQLDESCLEN
callsubr GetColAttr rtnval( &subRC )
chgvar &psCol &nAttr
chgvar &iCol &i
chgvar &fcType &SQLDESCTYP
callsubr GetColAttr rtnval( &subRC )
chgvar &DescType &nAttr
chgvar %ofs( &pColAttr ) ( %ofs( &pColAttr ) + 12 )
enddo
chgvar &pColAttr %addr( &ColAttrs )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* +
This perhaps is the trickiest of these APIs for how they're used in +
this example program. Mostly we just use the column attributes that +
we retrieved earlier. We have no need of any type conversions; we +
are going to FETCH columns exactly as they're described. But for +
SQL NUMERIC and DECIMAL, we weren't actually given a 'length'; we +
got 'precision' and 'scale' combined in a single 2-byte value that +
was stored in a 4-byte integer. The 3rd byte contains precision and +
4th byte contains scale. To pass in a "length", we do integer +
division by 256 first. That effectively shifts the value 8 bits to +
the right and drops the 'scale' byte. For SQL NUMERIC (zoned), the +
result is the number of bytes. For SQL DECIMAL (packed), we add 1 +
to the precision and divide by 2 for the number of bytes. For all +
other types, we use the original value. We don't have to do the +
'divide by 256'. We could simply redefine the 'precision' bytes and +
access it directly. +
Also, we're going to store the values in contiguous parts of the +
&msgdta variable, so we bump the pointer offset by the length each +
time through the loop. This effectively builds a record buffer. +
*/
/* Set up column definitions for FETCH... */
subr BindCols
dofor &i from( 1 ) to( &nbrCols )
chgvar &iCol &i
chgvar &fcType &DescType
chgvar &bufCol &pMsgDta
select
when ( &DescType *eq &SQLNUMERIC ) do
chgvar &ofs ( &psCol / 256 )
enddo
when ( &DescType *eq &SQLDECIMAL ) do
chgvar &ofs ( ( (&psCol / 256) + 1 ) / 2)
enddo
otherwise do
chgvar &ofs &psCol
enddo
endselect
chgvar %ofs( &pMsgDta ) ( %ofs( &pMsgDta ) + &ofs )
chgvar &cbValueMax &psCol
chgvar &ppcbValue %addr( &pcbValue )
chgvar %ofs( &pColAttr ) ( %ofs( &pColAttr ) + 12 )
/* Execute a statement... */
callsubr BindCol rtnval( &subRC )
enddo
chgvar &pColAttr %addr( &ColAttrs )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* +
This program doesn't care much about errors. We just send out a +
general message, then retrieve basic error info. We don't really +
have anything we want to do with the info. +
*/
/* Retrieve error info... */
subr GetError
sndpgmmsg msgid( CPF9898 ) msgf( QSYS/QCPFMSG ) +
msgdta( 'SQL error found' ) +
msgtype( *INFO )
callprc 'SQLError' ( +
( &hEnv *byval ) +
( &hDBC *byval ) +
( &hStm *byval ) +
&szSqlState +
&pfNtvError +
&szErrorMsg +
( &szErrorMax *byval ) +
&pcbError +
) +
rtnval( &SQLRC )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* +
We "report" our FETCHed values as &msgdta for a temporary message. +
The values were built in &msgdta and we know what kinds of data we +
FETCHed, so we can have a message format prepared. If we wanted, we +
could build FMT0001 dynamically. We bound our columns with known +
attributes, so we could use those to construct the FMT() fields. +
But that's just a 'SMOP'. +
*/
/* Send out retrieved values... */
subr RptValues
crtmsgf QTEMP/tmpmsgf
rcvmsg msgtype( *LAST ) rmv( *YES )
addmsgd FMT0001 msgf( QTEMP/tmpmsgf ) +
msg( 'Customer &1 &2 balance is &3 at &4' ) +
fmt((*CHAR 6) (*CHAR 8) (*DEC 7 2) (*CHAR 10))
rtvmsg FMT0001 msgf( QTEMP/tmpmsgf ) +
msgdta( &msgdta ) +
msg( &msgtxt )
sndpgmmsg msgid( CPF9897 ) msgf( QSYS/QCPFMSG ) +
msgdta( &msgtxt ) topgmq( *EXT ) msgtype( *INFO )
dltmsgf QTEMP/tmpmsgf
rcvmsg msgtype( *LAST ) rmv( *YES )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
/* +
Since I already had an old test version of a SQL syntax checker, I +
am adding it on as a procedure. Like this example, that coding also +
relies on defaults. But I do set the naming test for SQL-naming to +
match the SQL CLI example, and it's also set for single-test mode, +
i.e., it's set to be called once and terminate even though I call +
it three times. Actual coding should be more robust. +
*/
/* Check SQL statement syntax... */
subr ChkSQLSyn
callprc 'triml' ( +
&SQL_Stm +
( x'00' *byval ) +
) +
rtnval( &wInt )
chgvar &szSQL_Stm &wInt
callprc 'SYNSQL' ( +
&SQL_SynStm +
)
monmsg ( cpf0000 )
rtnsubr rtnval( 0 )
endsubr
/* ----------------------------------------------------------------- */
endpgm
I also had some code that syntax checks SQL statements; so I trimmed it down, set it to match the requirements of the main procedure and tacked it on, too.
The syntax checker:
Code:
/* */
/* A very simple example of using QSQCHKS to syntax check SQL */
/* statements. */
/* */
pgm ( +
&pSQL +
)
dcl &pSQL *char 4098
dcl &szSQL *int
dcl &NbrRec *int value( 1 )
dcl &Options *char 40
dcl &NbrRecPrc *int
dcl &Error *char 8 value( x'0000000000000000' )
dcl &SQLStmI *char 1024
dcl &LenSQLStmI *int value( 1024 )
dcl &RecLen *int 2 stg( *defined ) defvar( &pSQL 1 )
dcl &SQL *char 4096 stg( *defined ) defvar( &pSQL 3 )
dcl &SQLMsgF *char 10 stg( *defined ) defvar( &SQLStmI 1 )
dcl &SQLMsgFLIB *char 10 stg( *defined ) defvar( &SQLStmI 11 )
dcl &MsgID *char 7 stg( *defined ) defvar( &SQLStmI 53 )
dcl &SQLSTATE *char 5 stg( *defined ) defvar( &SQLStmI 60 )
dcl &LenRplTxt *int 4 stg( *defined ) defvar( &SQLStmI 65 )
dcl &RplTxt *char 955 stg( *defined ) defvar( &SQLStmI 69 )
dcl &nbrOptKey *int stg( *defined ) defvar( &Options 1 )
dcl &OptKeyDS *char stg( *defined ) defvar( &Options 5 )
dcl &pOptKey *ptr address( &OptKeyDS )
dcl &OptKeys *char stg( *BASED ) basptr( &pOptKey )
dcl &OptKey *int stg( *defined ) defvar( &OptKeys 1 )
dcl &szOptKey *int stg( *defined ) defvar( &OptKeys 5 )
dcl &OptKeyDta *char 10 stg( *defined ) defvar( &OptKeys 9 )
/* Set most basic of options... */
chgvar &szSQL &RecLen
chgvar &nbrOptKey ( 2 )
chgvar &OptKey ( 2 ) /* Check & terminate */
chgvar &szOptKey ( 1 )
chgvar &OptKeyDta '2'
chgvar %ofs( &pOptKey ) ( %ofs( &pOptKey ) + 9 )
chgvar &OptKey ( 1 ) /* Naming 'SQL' */
chgvar &szOptKey ( 5 )
chgvar &OptKeyDta '*SQL'
/* Call the API... */
call QSQCHKS ( +
&SQL +
&szSQL +
&NbrRec +
'*NONE ' +
&Options +
&SQLStmI +
&LenSQLStmI +
&NbrRecPrc +
&Error +
)
/* If SQLSTATE has something to say... */
if ( &SQLSTATE *ne '00000' ) do
sndpgmmsg msgid( &MsgID ) +
msgf( &SQLMsgFLIB/&SQLMsgF ) +
msgdta( %sst( &RplTxt 1 &LenRplTxt )) +
msgtype( *ESCAPE )
enddo
return
endpgm
Compile the two as modules and bind them into a program. I only have one i 6.1 system to test it on. My others are stuck at V5R3. If it needs enhancement for different system configurations, I'd be happy to add code.
Tom
Comment