Using SQLCLI From RPG

Hi,

I am working on a program that transfers files between 2 iseries. As I
connect to 2 iSeries at the same time, I have two independent SQL
connections, one local, and one remote. To do this, I'm making use of the
SQLCLI apis.

The works fine, when I transfer just 1 record at a time. But, for
performance reasons, I want to transfer a block of records at a time...
The problem I am getting, is when I call SQLFetchScroll(), not only do the
bound fields get populated, but other random fields in my program get
corrupted. It is though I have not allocated enough memory to store the
block of rows, though I cant see where I am going wrong.

So, I've trimmed down my program, and added some imbedded SQL to create a
dummy file in qtemp, to run a query over, basically to show the problem.

To see the problem:

**Compile, Run in Debug with a breakpoint on the first
SQLFetchScroll()

**When the program stops at the breakpoint, check the value of the
array w_RowStsArray . This will have 100 elements, all of value '11111'
(as initialised)

**Step over the SQLFetchScroll, and check the value of array
w_RowStsArray again. This time, elements 95, and 96 will be corrupted.


w_RowStsArray is not used anywhere in the program, yet is been corrupted.

The actual program ends up crashing with some pointer error, as some
internal work field gets blatted!.


Either, this is a bug in my program (probably!), or a bug with the IBM
SQLCLI. But, I am stuck. Can *Anyone* help....

Very big thanks in advance.


h ACTGRP(*NEW) BNDDIR('QC2LE')
*
* SQLCLI Types
D t_SQLRETURN S 10I 0 BASED(@NULL)
D t_SQLHENV S 10I 0 BASED(@NULL)
D t_SQLHDBC S 10I 0 BASED(@NULL)
D t_SQLHSTMT S 10I 0 BASED(@NULL)
D t_SQLSMALLINT S 5I 0 BASED(@NULL)
D t_SQLINTEGER S 10I 0 BASED(@NULL)
*
D t_NUMERICATRIB DS BASED(@NULL) QUALIFIED
D INTEGER 10I 0
D SMALLINT 5I 0 OVERLAY(INTEGER)
*
***********************************************************
* Work Fields
***********************************************************
*
D W_SQLHENV S LIKE(T_SQLHENV)
D W_RCOLCOUNT S LIKE(T_SQLSMALLINT)
*
* SQL
D W_RSQLHDBC S LIKE(T_SQLHDBC)
D W_RSQLHSTMT S LIKE(T_SQLHSTMT)
*
D W_TMPINT S LIKE(T_SQLINTEGER)
D W_TMPSINT S LIKE(T_SQLSMALLINT)
D W_X S 10I 0
D W_Z S 10I 0
D
D W_RFORMAT_RCDS S 10I 0 Records in RFORMAT
* Work fields for ExtendedFetch
D w_FetchedRows S 10I 0
D w_RowStsArray S 5I 0 Dim(100) inz(*all'1')
D w_RowStsArray2 S 5I 0 Dim(100) inz(*all'1')
* Record Buffer
D W_REC_BUF S 1000A BASED(@W_REC_BUF)
* Pointer to an arbartory position in above Buffer.
D W_REC_BUF_PT S *
* Size of Record Buffer, in Bytes..
* (200K approx)
D C_REC_BUF_SIZE C CONST(200000)
* Size of single record in buffer.
D w_BUF_RCDSIZE S 10i 0
*
* Temporary storage for SQL commands.
D W_SQL S 10000A VARYING
* Temporary storage for copying remote leads to local
D W_RLEADS S 9A DIM(50)
D tx S 10i 0
*********************************
* Data Structures *
*********************************
* Column Meta Data Structure... Used with SQLDescribeCol, and others
D DS_COLMETA DS QUALIFIED
D NAME 11
D NAMELN LIKE(t_SQLSMALLINT)
D SQLTYPE LIKE(t_SQLSMALLINT)
D SIZE LIKE(t_SQLINTEGER)
D DP LIKE(t_SQLSMALLINT)
D NULLS LIKE(t_SQLSMALLINT)
D LENGTH LIKEDS(t_NUMERICATRIB)
D VALPTR *
D
* Format of Remote Database File
D D_RFORMAT DS DIM(999) LIKEDS(DS_COLMETA)
*********************************
* Constants *
*********************************
D SQL_NTS C const(-3)
D SQL_SUCCESS C const(0)
D SQL_SUCCESS_WITH_INFO...
D C CONST(1)
D SQL_NO_DATA_FOUND...
D C CONST(100)
D SQL_TXN_ISOLATION...
D C CONST(0)
D SQL_TXN_NOCOMMIT...
D C CONST(1)
D SQL_ATTR_ROWS_FETCHED_PTR...
D C CONST(10053)
D SQL_ATTR_ROW_STATUS_PTR...
D C CONST(10052)

* Constants for SQLFreeStmt
D SQL_CLOSE C const(0)
D SQL_DROP C CONST(1)
D SQL_UNBIND C CONST(2)
D SQL_RESET_PRMS C CONST(3)
* Constants for SQLBindCol
D SQL_NUMERIC C CONST(2)
D SQL_DECIMAL C CONST(3)
D SQL_CHAR C CONST(1)
D SQL_INTEGER C CONST(4)
D SQL_SMALLINT C CONST(5)
D SQL_DEFAULT C CONST(99)
D SQL_DESC_LENGTH...
D C CONST(3)
* Constants for SQLBindParameter
D SQL_PARAM_INPUT...
D C CONST(1)
D SQL_C_DEFAULT C CONST(99)
* Constants for SQLExtendedFetch
D SQL_FETCH_NEXT C CONST(1)
* Constants for SQLSetStmtAttr
D SQL_ROWSET_SIZE...
D C CONST(10016)
* Other Constants
D C_LEADS_LIB C CONST('BUDSLS')
D C_POLICY_LIB C CONST('BUDDEVDTA')
D C_NONE C CONST('*NONE')
D C_LEAD C CONST('L')
D C_POLICY C CONST('P')

* Prototypes
* Send a program message
D EP_SNDPGMMSG PR EXTPGM('QMHSNDPM')
D 7A CONST MSGID
D 20A CONST MSGFQ
D 512A CONST OPTIONS(*VARSIZE) MSGDTA
D 10I 0 CONST MSGDTALEN
D 10A CONST MSGTYP
D 10A CONST OPTIONS(*VARSIZE)
CALSTKE
D 10I 0 CONST CALSTKCTR
D 4A MSGKEY
D 512A OPTIONS(*VARSIZE) ERROR
*
**************************************
* Allocate the SQLCLI Environment *
**************************************
D SQLAllocEnv PR LIKE(t_SQLRETURN)
D EXTPROC('SQLAllocEnv')
D SQLHENV LIKE(t_SQLHENV)
**************************************
* Free a Statement Handle *
**************************************
D SQLFreeStmt PR LIKE(t_SQLRETURN)
D EXTPROC('SQLFreeStmt')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D Option LIKE(t_SQLSMALLINT) VALUE
D
****************************************
* Release all SQL environment resouces *
****************************************
D SQLReleaseEnv PR LIKE(t_SQLRETURN)
D EXTPROC('SQLReleaseEnv')
D SQLHENV LIKE(t_SQLHENV) Value
**************************************
* SQL Fetch Scroll *
**************************************
D SQLFetchScroll...
D PR LIKE(t_SQLRETURN)
D EXTPROC('SQLFetchScroll')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D Orientation LIKE(t_SQLSMALLINT) VALUE
D Offset LIKE(t_SQLINTEGER) VALUE
**************************************
* SQL Set connection atributes
**************************************
D SQLSetConnectAttr...
D PR LIKE(t_SQLRETURN)
D EXTPROC('SQLSetConnectAttr')
D SQL_Conn_HDL LIKE(T_SQLHDBC) VALUE
D SQL_ATTR_NAM LIKE(t_SQLINTEGER) VALUE
D SQL_ATTR_VAL LIKE(t_SQLINTEGER) CONST
D SQL_ATTR_LN LIKE(t_SQLINTEGER) VALUE
**************************************
* SQL Set Statement atributes (Integer)
**************************************
D SQLSetStmtAttrR...
D PR LIKE(t_SQLRETURN)
D EXTPROC('SQLSetStmtAttr')
D SQL_HSTMT LIKE(T_SQLHSTMT) VALUE
D SQL_ATTR_NAM LIKE(t_SQLINTEGER) VALUE
D SQL_ATTR_INT * VALUE
D SQL_ATTR_LN LIKE(t_SQLINTEGER) VALUE
D
**************************************
* SQL Execute
**************************************
D SQLExecute PR LIKE(t_SQLRETURN)
D EXTPROC('SQLExecute')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
**************************************
* SQL Close Cursor

D SQLCloseCursor PR LIKE(t_SQLRETURN)
D EXTPROC('SQLCloseCursor')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
**************************************
* SQL Prepare *
**************************************
D SQLPrepare PR LIKE(t_SQLRETURN)
D EXTPROC('SQLPrepare')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D Sql_String * OPTIONS(*string) value
D Sql_String_ln LIKE(T_SQLSMALLINT) VALUE
*
**************************************
* SQL Describe Column *
**************************************
D SQLDescribeCol PR LIKE(t_SQLRETURN)
D EXTPROC('SQLDescribeCol')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D COLNUMBR LIKE(t_SQLSMALLINT) VALUE
D Colname 128A OPTIONS(*VARSIZE)
D Colname_BPRV LIKE(t_SQLSMALLINT) VALUE
D Colname_BAVL LIKE(t_SQLSMALLINT)
D SqlType like(t_SQLSMALLINT)
D Size LIKE(t_SQLINTEGER)
D Scale LIKE(t_SQLSMALLINT)
D Nullable LIKE(t_SQLSMALLINT)
D
*
****************************************
* SQL Return Number of Result Columns *
****************************************
D SQLNumResultCols...
D PR LIKE(t_SQLRETURN)
D EXTPROC('SQLNumResultCols')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D ROWCOUNT LIKE(t_SQLSMALLINT)
D
****************************************
* SQL Column Attributes
****************************************
D SQLColAttribute...
D PR LIKE(t_SQLRETURN)
D EXTPROC('SQLColAttributes')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D ColumnID LIKE(t_SQLSMALLINT) VALUE
D FieldToRtn LIKE(t_SQLSMALLINT) VALUE
D Char_VAL * VALUE
D Char_BPRV LIKE(T_SQLSMALLINT) VALUE
D Char_BAVL LIKE(T_SQLSMALLINT)
D Num_Val LIKEDS(t_NUMERICATRIB)
D
****************************************
* SQL Bind column to a variable
****************************************
D SQLBindCol PR LIKE(t_SQLRETURN)
D EXTPROC('SQLBindCol')
D SQLHSTMT LIKE(t_SQLHSTMT) VALUE
D COLNUMBR LIKE(t_SQLSMALLINT) VALUE
D FLD_TYPE LIKE(t_SQLSMALLINT) VALUE
D THE_FIELD * VALUE
D FLD_SIZE LIKE(t_SQLINTEGER) VALUE
D AVAIL_SIZE LIKE(t_SQLINTEGER)
D
D
**************************************
* Allocate a Statement Handle *
**************************************
D SQLAllocStmt PR LIKE(t_SQLRETURN)
D EXTPROC('SQLAllocStmt')
D SQLHDBC LIKE(t_SQLHDBC) VALUE
D SQLHSTMT LIKE(t_SQLHSTMT)
*
*
**************************************
* Connect to a SQL Data Source *
**************************************
D SQLConnect PR LIKE(T_SQLRETURN)
D EXTPROC('SQLConnect')
D HDBC LIKE(T_SQLHDBC) VALUE
D DataSource * OPTIONS(*string) value
D DatasourceLN LIKE(T_SQLSMALLINT) VALUE
D Username * OPTIONS(*string) value
D UsernameLN LIKE(T_SQLSMALLINT) VALUE
D Password * OPTIONS(*string) value
D PasswordLN LIKE(T_SQLSMALLINT) VALUE
D
*
**************************************
* Disconnect from a Data Source *
**************************************

D SQLDisconnect PR LIKE(T_SQLRETURN)
D EXTPROC('SQLDisconnect')
D HDBC LIKE(T_SQLHDBC) VALUE
D
D
**************************************
* Free a Connection Handle *
**************************************
D SQLFreeConnect PR LIKE(t_SQLRETURN)
D EXTPROC('SQLFreeConnect')
D HDBC LIKE(T_SQLHDBC) VALUE
*
**************************************
* Free the SQLCLI Environment *
**************************************
D SQLFreeEnv PR LIKE(t_SQLRETURN)
D EXTPROC('SQLFreeEnv')
D SQLHENV LIKE(t_SQLHENV) VALUE
*
**************************************
* Allocate a SQLCLI Connection *
**************************************
* SQLAllocConnect
D SQLAllocConnect...
D PR LIKE(t_SQLRETURN)
D EXTPROC('SQLAllocConnect')
D SQLHENV LIKE(t_SQLHENV) VALUE
D SQLHDBC LIKE(t_SQLHDBC)
*
*******************************************
* Send Info Message (wrapper over QMHSNDPM)
*******************************************
D P_SNDINFOMSG PR
D MSG 80A Varying const
****************
* CALCULATIONS *
****************
*
C EXSR SR_SETUPSQL
*
C/exec sql
C+ CREATE TABLE QTEMP/TST (F1 CHAR (9 ) NOT NULL WITH DEFAULT, F2
C+ NUMERIC (3 , 0) NOT NULL WITH DEFAULT, F3 CHAR (1 ) NOT NULL WITH
C+ DEFAULT, F4 CHAR (1 ) NOT NULL WITH DEFAULT, F5 CHAR (9 ) NOT
C+ NULL WITH DEFAULT, F6 CHAR (2 ) NOT NULL WITH DEFAULT, F7 NUMERIC
C+ (2 , 0) NOT NULL WITH DEFAULT, F8 CHAR (4 ) NOT NULL WITH
C+ DEFAULT, F9 CHAR (3 ) NOT NULL WITH DEFAULT, F10 CHAR (20 ) NOT
C+ NULL WITH DEFAULT, F11 DATE NOT NULL WITH DEFAULT, F12 CHAR (4 )
C+ NOT NULL WITH DEFAULT, F13 CHAR (3 ) NOT NULL WITH DEFAULT, F14
C+ CHAR (3 ) NOT NULL WITH DEFAULT, F15 CHAR (4 ) NOT NULL WITH
C+ DEFAULT, F16 CHAR (4 ) NOT NULL WITH DEFAULT, F17 DATE NOT NULL
C+ WITH DEFAULT, F18 TIME NOT NULL WITH DEFAULT, F19 DATE NOT NULL
C+ WITH DEFAULT, F20 DATE NOT NULL WITH DEFAULT, F21 TIME NOT NULL
C+ WITH DEFAULT, F22 CHAR (4 ) NOT NULL WITH DEFAULT, F23 CHAR (1 )
C+ NOT NULL WITH DEFAULT, F24 CHAR (1 ) NOT NULL WITH DEFAULT, F25
C+ NUMERIC (2 , 0) NOT NULL WITH DEFAULT, F26 CHAR (4 ) NOT NULL
C+ WITH DEFAULT, F27 DECIMAL (13 , 2) NOT NULL WITH DEFAULT, F28
C+ DECIMAL (13 , 2) NOT NULL WITH DEFAULT, F29 CHAR (2 ) NOT NULL
C+ WITH DEFAULT, F30 CHAR (2 ) NOT NULL WITH DEFAULT, F31 DECIMAL (2
C+ , 0) NOT NULL WITH DEFAULT, F32 CHAR (1 ) NOT NULL WITH DEFAULT,
C+ F33 DATE NOT NULL WITH DEFAULT, F34 DATE NOT NULL WITH DEFAULT,
C+ F35 DATE NOT NULL WITH DEFAULT, F36 NUMERIC (2 , 0) NOT NULL WITH
C+ DEFAULT, F37 DATE NOT NULL WITH DEFAULT, F38 DATE NOT NULL WITH
C+ DEFAULT, F39 DATE NOT NULL WITH DEFAULT, F40 CHAR (1 ) NOT NULL
C+ WITH DEFAULT, F41 CHAR (1 ) NOT NULL WITH DEFAULT, F42 CHAR (1 )
C+ NOT NULL WITH DEFAULT, F43 CHAR (1 ) NOT NULL WITH DEFAULT, F44
C+ CHAR (10 ) NOT NULL WITH DEFAULT, F45 DECIMAL (3 , 0) NOT NULL
C+ WITH DEFAULT, F46 DECIMAL (3 , 0) NOT NULL WITH DEFAULT, F47 CHAR
C+ (1 ) NOT NULL WITH DEFAULT, F48 CHAR (1 ) NOT NULL WITH DEFAULT,
C+ F49 CHAR (4 ) NOT NULL WITH DEFAULT, F50 CHAR (1 ) NOT NULL WITH
C+ DEFAULT, F51 CHAR (4 ) NOT NULL WITH DEFAULT, F52 CHAR (4 ) NOT
C+ NULL WITH DEFAULT)
C/end-exec
C if sqlcod=0
C for tx=1 to 1000
C/exec sql
C+ insert into qtemp/tst(f1) values('1')
C/end-exec
C
C endfor
C endif
C EXSR SR_CPYPOL
‚*
C EXSR SR_TERMSQL
C EVAL *INLR=*ON
‚*
‚* Setup SQLCLI Sessions
C SR_SETUPSQL BEGSR
* Allocate Buffer.
C EVAL @W_REC_BUF=%ALLOC(C_REC_BUF_SIZE)
C IF @W_REC_BUF=*NULL
C SETON LR
C RETURN
C ENDIF
*
C CALLP P_SNDINFOMSG('Connectig to *LOCAL')
C CALLP SQLAllocEnv(W_SQLHENV)
* Allocate Connection
C CALLP SQLAllocConnect(W_SQLHENV:W_RSQLHDBC)
* Turn off commitment control.
C EVAL W_X=SQLSetConnectAttr(W_RSQLHDBC:
C SQL_TXN_ISOLATION:
C SQL_TXN_NOCOMMIT:
C 4)
* Connect to remote datasource.
C CALLP SQLConnect(W_RSQLHDBC :
C '*LOCAL' :
C SQL_NTS :
C *null :
C SQL_NTS :
C *null :
C SQL_NTS )
* Allocate Statement for remote datasource
C CALLP SQLAllocStmt(W_RSQLHDBC:W_RSQLHSTMT)
*
C ENDSR

*************************************************************************************
* Subroutine SR_CPYPOL Copies Polics from remote to local system
*
*
*****************
C SR_CPYPOL BEGSR
*
** STEP 1 **
* Prepare SQL
C EVAL w_SQL=
C 'SELECT * FROM QTEMP.TST'
*
C CALLP SQLPrepare(W_RSQLHSTMT:
C w_SQL:SQL_NTS)
* Execute the SQL system.
C CALLP SQLExecute(W_RSQLHSTMT)
* ** STEP 2 **
* Get the format of rows returned, and bind to buffer.
* The following lines of code, (up to the ENDFOR) will
* bind all the fields contiguously into W_REC_BUF
C CALLP SQLNumResultCols(W_RSQLHSTMT:
C w_RCOLCOUNT)
C
C EVAL W_REC_BUF_PT=@W_REC_BUF
C EVAL W_BUF_RCDSIZE=0
C
C FOR W_X=1 TO W_RCOLCOUNT
*
C CALLP SQLColAttribute(W_RSQLHSTMT
C :W_X
C :SQL_DESC_LENGTH
C :*NULL:1:w_tmpsint
C :DS_COLMETA.LENGTH)
C
C CALLP SQLDescribeCol(W_RSQLHSTMT
C :W_X
C :DS_COLMETA.NAME
C :%SIZE(DS_COLMETA.NAME)
C :DS_COLMETA.NAMELN
C :DS_COLMETA.SQLTYPE
C :DS_COLMETA.SIZE
C :DS_COLMETA.DP
C :DS_COLMETA.NULLS)
*
C IF DS_COLMETA.SQLTYPE=SQL_DECIMAL
C EVAL DS_COLMETA.SQLTYPE=SQL_NUMERIC
C ENDIF
*
C CALLP SQLBindCol(W_RSQLHSTMT
C :W_X
C :DS_COLMETA.SQLTYPE
C :W_REC_BUF_PT
C :DS_COLMETA.LENGTH.INTEGER
C :W_TMPINT)
*
*
C EVAL DS_COLMETA.VALPTR=W_REC_BUF_PT
C EVAL D_RFORMAT(W_X)=DS_COLMETA
C EVAL W_REC_BUF_PT+=DS_COLMETA.SIZE
C EVAL W_BUF_RCDSIZE+=DS_COLMETA.SIZE
C
C ENDFOR
*
C EVAL W_RFORMAT_RCDS=W_X-1
C
** STEP 3 ** Read all records, 50 at a time, into buffer.
C EVAL W_Z = (C_REC_BUF_SIZE /
C W_BUF_RCDSIZE)
C -2
C IF W_Z>50
C EVAL W_Z=50
C ENDIF
C
C CALLP SQLSetStmtAttrR(W_RSQLHSTMT:
C SQL_ROWSET_SIZE:
C %ADDR(w_z):
C %SIZE(w_z))
*
C CALLP SQLSetStmtAttrR(W_RSQLHSTMT:
C SQL_ATTR_ROWS_FETCHED_PTR:
C %ADDR(w_FetchedRows):
C %size(w_fetchedRows))
*
C CALLP SQLSetStmtAttrR(W_RSQLHSTMT:
C SQL_ATTR_ROW_STATUS_PTR:
C %addr(w_RowStsArray2(1)):
C %size(w_rowstsarray2))
* Fetch rows from remote system
C DOW SQLFetchScroll(W_RSQLHSTMT:
C SQL_FETCH_NEXT:
C 0)
C <>SQL_NO_DATA_FOUND
C ENDDO
C ENDSR
*
* Terminate SQLCLI Session
C SR_TERMSQL BEGSR
* Free Statement... Remote
C CALLP P_SNDINFOMSG('Cleaning up..')
C
C IF W_RSQLHSTMT<>0
C CALLP SQLFreeStmt(W_RSQLHSTMT:SQL_DROP)
C ENDIF
* Disconnect/ Free Connection.... Remote
C IF W_RSQLHDBC<>0
C CALLP SQLDisconnect(W_RSQLHDBC)
C CALLP SQLFreeConnect(W_RSQLHDBC)
C ENDIF
* Free Environment
C IF W_SQLHENV<>0
C CALLP SQLFreeEnv(W_SQLHENV)
C ENDIF
* Release Environment
C IF W_SQLHENV<>0
C CALLP SQLReleaseEnv(W_SQLHENV)
C ENDIF
C DEALLOC @W_REC_BUF
C ENDSR
*
P P_SNDINFOMSG B
D P_SNDINFOMSG PI
D MSG 80A Varying const
D W_MSG S 80A
D LW_MSGKEY S 4A
*
* System Error Code
D LD_ERRC0100 DS STATIC QUALIFIED
D* Qus EC
D QUSBPRV 1 4B 0
D* Bytes Provided
D QUSBAVL 5 8B 0
D* Bytes Available
D QUSEI 9 15
D* Exception Id
D QUSERVED 16 16
C EVAL W_MSG=MSG
C EVAL LD_ERRC0100.QUSBPRV=%SIZE(LD_ERRC0100)
C CALLP EP_SNDPGMMSG( 'CPF9897'
C : 'QCPFMSG *LIBL'
C : W_MSG
C : %LEN(MSG)
C : '*STATUS'
C : '*EXT'
C : 0
C : LW_MSGKEY
C : LD_ERRC0100
C )
P E