Example: Multiple row inserts using Visual Basic
This example is an IBM® i Access for Windows Visual Basic multiple row insert that is significantly faster than a "parameterized" insert.
Multiple row inserts allow you to:
- Insert blocks of records with one SQL call.
- Reduces the flows between the client and server.
See Multiple row INSERT and multiple row FETCH examples for additional information.
Dim cbNTS(BLOCKSIZE - 1) As Long 'NTS array
Dim lCustnum(BLOCKSIZE - 1) As Long 'Customer number array
'2nd parm passed by actual length for demo purposes
Dim szLstNam(7, BLOCKSIZE - 1) As Byte 'NOT USING NULL ON THIS PARM
Dim cbLenLstNam(BLOCKSIZE - 1) As Long 'Actual length of string to pass
Dim cbMaxLenLstNam As Long 'Size of one array element
'These will be passed as sz string so size must include room for null
Dim szInit(3, BLOCKSIZE - 1) As Byte 'Size for field length + null
Dim szStreet(13, BLOCKSIZE - 1) As Byte 'Size for field length + null
Dim szCity(6, BLOCKSIZE - 1) As Byte 'Size for field length + null
Dim szState(2, BLOCKSIZE - 1) As Byte 'Size for field length + null
Dim szZipCod(5, BLOCKSIZE - 1) As Byte 'Size for field length + null
Dim fCdtLmt(BLOCKSIZE - 1) As Single
Dim fChgCod(BLOCKSIZE - 1) As Single
Dim fBalDue(BLOCKSIZE - 1) As Single
Dim fCdtDue(BLOCKSIZE - 1) As Single
Dim irow As Long ' row counter for block errors
Dim lTotalRows As Long ' ************ Total rows to send *************
Dim lNumRows As Long ' Rows to send in one block
Dim lRowsLeft As Long ' Number of rows left to send
Dim I As Long
Dim J As Long
Dim S As String
Dim hStmt As Long
' This program needs QCUSTCDT table in your own collection.
' At the IBM i command line type:
'===> CRTLIB SAMPCOLL
'===> CRTDUPOBJ OBJ(QCUSTCDT) FROMLIB(QIWS)
' OBJTYPE(*FILE) TOLIB(SAMPCOLL) NEWOBJ(*SAME)
'===> CHGPF FILE(SAMPCOLL/QCUSTCDT) SIZE(*NOMAX)
'===> CLRPFM FILE(SAMPCOLL/QCUSTCDT)
'************** Start *****************************************************
S = "Number of records to insert into QCUSTCDT. "
S = S & "Use menu option Table Mgmt, Create QCUSTCDT to "
S = S & "create the table. Use Misc, IBM i Cmd and CLRPFM "
S = S & "command if you wish to clear it"
S = InputBox(S, gAppName, "500")
If Len(S) = 0 Then Exit Sub
lTotalRows = Val(S) 'Total number to insert
rc = SQLAllocHandle(SQL_HANDLE_STMT, ghDbc, hStmt)
If (Not (rc = SQL_SUCCESS Or rc = SQL_SUCCESS_WITH_INFO)) Then GoTo errBlockInsert
rc = SQLPrepare(hStmt, _
"INSERT INTO QCUSTCDT ? ROWS VALUES (?,?,?,?,?,?,?,?,?,?,?)", _
SQL_NTS)
If (Not (rc = SQL_SUCCESS Or rc = SQL_SUCCESS_WITH_INFO)) Then GoTo errBlockInsert
rc = SQLBindParameter(hStmt, 1, SQL_PARAM_INPUT, SQL_C_LONG, SQL_INTEGER, _
10, 0, lCustnum(0), 0, ByVal 0)
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
'Pass first parm w/o using a null
cbMaxLenLstNam = UBound(szLstNam, 1) - LBound(szLstNam, 1) + 1
rc = SQLBindParameter(hStmt, 2, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_CHAR, _
8, _
0, _
szLstNam(0, 0), _
cbMaxLenLstNam, _
cbLenLstNam(0))
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 3, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_CHAR, _
3, 0, szInit(0, 0), _
UBound(szInit, 1) - LBound(szInit, 1) + 1, _
cbNTS(0))
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 4, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_CHAR, _
13, 0, szStreet(0, 0), _
UBound(szStreet, 1) - LBound(szStreet, 1) + 1, _
cbNTS(0))
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 5, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_CHAR, _
6, 0, szCity(0, 0), _
UBound(szCity, 1) - LBound(szCity, 1) + 1, _
cbNTS(0))
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 6, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_CHAR, _
2, 0, szState(0, 0), _
UBound(szState, 1) - LBound(szState, 1) + 1, _
cbNTS(0))
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 7, SQL_PARAM_INPUT, SQL_C_CHAR, SQL_NUMERIC, _
5, 0, szZipCod(0, 0), _
UBound(szZipCod, 1) - LBound(szZipCod, 1) + 1, _
cbNTS(0))
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 8, SQL_PARAM_INPUT, SQL_C_FLOAT, SQL_NUMERIC, _
4, 0, fCdtLmt(0), 0, ByVal 0)
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 9, SQL_PARAM_INPUT, SQL_C_FLOAT, SQL_NUMERIC, _
1, 0, fChgCod(0), 0, ByVal 0)
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 10, SQL_PARAM_INPUT, SQL_C_FLOAT, SQL_NUMERIC, _
6, 2, fBalDue(0), 0, ByVal 0)
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
rc = SQLBindParameter(hStmt, 11, SQL_PARAM_INPUT, SQL_C_FLOAT, SQL_NUMERIC, _
6, 2, fCdtDue(0), 0, ByVal 0)
If (rc = SQL_ERROR) Then _
Call DspSQLDiagRec(SQL_HANDLE_STMT, hStmt, "Problem: Bind Parameter")
lRowsLeft = lTotalRows 'Initialize row counter
For J = 0 To ((lTotalRows - 1) \ BLOCKSIZE)
For I = 0 To BLOCKSIZE - 1
cbNTS(I) = SQL_NTS ' init array to NTS
lCustnum(I) = I + (J * BLOCKSIZE) 'Customer number = row number
S = "Nam" & Str(lCustnum(I)) 'Last Name
cbLenLstNam(I) = Len(S)
rc = String2Byte2D(S, szLstNam(), I)
'Debug info: Watch address to see layout
addr = VarPtr(szLstNam(0, 0))
'addr = CharNext(szLstNam(0, I)) 'address of 1,I
'addr = CharPrev(szLstNam(0, I), szLstNam(1, I)) 'address of 0, I)
'addr = CharNext(szLstNam(1, I))
'addr = CharNext(szLstNam(6, I)) 'should point to null (if used)
'addr = CharNext(szLstNam(7, I)) 'should also point to next row
rc = String2Byte2D("DXD", szInit, I)
'Vary the length of the street
S = Mid("1234567890123", 1, ((I Mod 13) + 1))
rc = String2Byte2D(S, szStreet, I)
rc = String2Byte2D("Roches", szCity, I)
rc = String2Byte2D("MN", szState, I)
rc = String2Byte2D("55902", szZipCod, I)
fCdtLmt(I) = I
fChgCod(I) = 1
fBalDue(I) = 2 * I
fCdtDue(I) = I / 2
Next I
lNumRows = lTotalRows Mod BLOCKSIZE ' Number of rows to send in this block
If (lRowsLeft >= BLOCKSIZE) Then _
lNumRows = BLOCKSIZE ' send remainder or full block
irow = 0
lRowsLeft = lRowsLeft - lNumRows
rc = SQLSetStmtAttr(hStmt, SQL_ATTR_PARAMSET_SIZE, lNumRows, 0)
If (rc = SQL_ERROR) Then GoTo errBlockInsert
rc = SQLSetStmtAttr(hStmt, SQL_ATTR_PARAMS_PROCESSED_PTR, irow, 0)
If (rc = SQL_ERROR) Then GoTo errBlockInsert
rc = SQLExecute(hStmt)
If (rc = SQL_ERROR) Then
S = "Error on Row: " & Str(irow) & Chr(13) & Chr(10)
MsgBox S, , gAppName
GoTo errBlockInsert
End If
Next J
rc = SQLEndTran(SQL_HANDLE_DBC, ghDbc, SQL_COMMIT)
If (Not (rc = SQL_SUCCESS Or rc = SQL_SUCCESS_WITH_INFO)) Then GoTo errBlockInsert
rc = SQLFreeHandle(SQL_HANDLE_STMT, hStmt)
Exit Sub
errBlockInsert:
rc = SQLEndTran(SQL_HANDLE_DBC, ghDbc, SQL_ROLLBACK)
rc = SQLFreeHandle(SQL_HANDLE_STMT, hStmt)
Public Function String2Byte2D(InString As String, OutByte() As Byte, RowIdx As Long)
As Boolean
'VB byte arrays are layed out in memory opposite of C. The string would
'be by column instead of by row so must flip flop the string.
'ASSUMPTIONS:
' Byte array is sized before being passed
' Byte array is padded with nulls if > size of string
Dim I As Integer
Dim SizeOutByte As Integer
Dim SizeInString As Integer
SizeInString = Len(InString)
SizeOutByte = UBound(OutByte, 1)
'Convert the string
For I = 0 To SizeInString - 1
OutByte(I, RowIdx) = AscB(Mid(InString, I + 1, 1))
Next I
'If byte array > len of string pad
If SizeOutByte > SizeInString Then 'Pad with Nulls
For I = SizeInString To SizeOutByte - 1
OutByte(I, RowIdx) = 0
Next I
End If
'ViewByteArray OutByte, "String2Byte"
String2Byte2D = True
End Function