ibm-information-center/dist/eclipse/plugins/i5OS.ic.rzaik_5.4.0.1/rzaikblockinserts.htm

264 lines
12 KiB
HTML
Raw Permalink Normal View History

2024-04-02 14:02:31 +00:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en-us" xml:lang="en-us">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="security" content="public" />
<meta name="Robots" content="index,follow" />
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
<meta name="DC.Type" content="reference" />
<meta name="DC.Title" content="Example: Block inserts using Visual Basic" />
<meta name="abstract" content="This example is a Visual Basic block insert that is significantly faster than a &#34;parameterized&#34; insert." />
<meta name="description" content="This example is a Visual Basic block insert that is significantly faster than a &#34;parameterized&#34; insert." />
<meta name="DC.Relation" scheme="URI" content="rzaikdirectcodeodbcapis.htm" />
<meta name="copyright" content="(C) Copyright IBM Corporation 1999, 2006" />
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1999, 2006" />
<meta name="DC.Format" content="XHTML" />
<meta name="DC.Identifier" content="blockinserts" />
<meta name="DC.Language" content="en-us" />
<!-- All rights reserved. Licensed Materials Property of IBM -->
<!-- US Government Users Restricted Rights -->
<!-- Use, duplication or disclosure restricted by -->
<!-- GSA ADP Schedule Contract with IBM Corp. -->
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
<link rel="stylesheet" type="text/css" href="./ic.css" />
<title>Example: Block inserts using Visual Basic</title>
</head>
<body id="blockinserts"><a name="blockinserts"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Example: Block inserts using Visual Basic</h1>
<div><p>This example is a Visual Basic block insert that is significantly
faster than a "parameterized" insert.</p>
<div class="section"><p><strong>Block inserts</strong> allow you to: </p>
<ul><li>Insert blocks of records with one <span class="keyword">SQL</span> call.</li>
<li>Reduces the flows between the client and server.</li>
</ul>
</div>
<div class="section"><p>See <a href="rzaikextfetch.htm#extfetch">Block insert and block fetch C example</a> for additional
information.</p>
</div>
<div class="example"> <pre>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 iSeries server command line type:
'===&gt; CRTLIB SAMPCOLL
'===&gt; CRTDUPOBJ OBJ(QCUSTCDT) FROMLIB(QIWS)
' OBJTYPE(*FILE) TOLIB(SAMPCOLL) NEWOBJ(*SAME)
'===&gt; CHGPF FILE(SAMPCOLL/QCUSTCDT) SIZE(*NOMAX)
'===&gt; CLRPFM FILE(SAMPCOLL/QCUSTCDT)
'************** Start *****************************************************
S = "Number of records to insert into QCUSTCDT. "
S = S &amp; "Use menu option Table Mgmt, Create QCUSTCDT to "
S = S &amp; "create the table. Use Misc, iSeries Cmd and CLRPFM "
S = S &amp; "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" &amp; 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 &gt;= 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: " &amp; Str(irow) &amp; Chr(13) &amp; 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 &gt; 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 &gt; len of string pad
If SizeOutByte &gt; 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</pre>
</div>
</div>
<div>
<div class="familylinks">
<div class="parentlink"><strong>Parent topic:</strong> <a href="rzaikdirectcodeodbcapis.htm" title="Many PC applications make ODBC calls that allow the user to seamlessly access data on different platforms. Before you begin developing your own application with ODBC APIs, you should understand how an ODBC application connects to and exchanges information with a database server.">Code directly to ODBC APIs</a></div>
</div>
</div>
</body>
</html>