Example: Block inserts using Visual Basic

This example is a Visual Basic block insert that is significantly faster than a "parameterized" insert.

Block inserts allow you to:

See Block insert and block fetch C example 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 iSeries server 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, iSeries 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