Attribute VB_Name = "cliExeSQL"
'---------------------------------------------------------------------------
'
' (c) Copyright IBM Corp. 2007 All rights reserved.
' 
' The following sample of source code ("Sample") is owned by International 
' Business Machines Corporation or one of its subsidiaries ("IBM") and is 
' copyrighted and licensed, not sold. You may use, copy, modify, and 
' distribute the Sample in any form without payment to IBM, for the purpose of 
' assisting you in the development of your applications.
' 
' The Sample code is provided to you on an "AS IS" basis, without warranty of 
' any kind. IBM HEREBY EXPRESSLY DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR 
' IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
' MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. Some jurisdictions do 
' not allow for the exclusion or limitation of implied warranties, so the above 
' limitations or exclusions may not apply to you. IBM shall not be liable for 
' any damages you suffer as a result of using, copying, modifying or 
' distributing the Sample, even if IBM has been advised of the possibility of 
' such damages.
'---------------------------------------------------------------------------
'
' SOURCE FILE NAME: cliExeSQL.bas
'
' SAMPLE: How to execute SQL statements in an application
'
' FORMS USED:
'         frmMain (Demo.frm)
'
'----------------------------------------------------------------------------
'
' For more information on the sample programs, see the README file.
'
' For information on building ADO applications with Visual Basic, 
' see the Developing ADO.NET and OLE DB Applications book.
'
' For information on using SQL statements, see the SQL Reference.
'
' For the latest information on programming, compiling, and running DB2
' applications, visit the DB2 Information Center:
'     http://publib.boulder.ibm.com/infocenter/db2luw/v9r7/index.jsp
'----------------------------------------------------------------------------

Option Explicit

'This procedure executes SQL statements by using the Execute method on a
'connection object from which the returned Recordset object is always a
'read-only, forward-only cursor.  For returning a Recordset object with
'more functionality, Open method on a Recordset object may be used.
Public Function ExecuteSQLConnect(ByVal SQL As String, _
                                  strMsg As String, _
                                  con As ADODB.Connection) _
  As ADODB.Recordset

  Dim rst As ADODB.Recordset
  Dim lRecordsAffected As Long
  Dim strTokens() As String

  'define the error handler
  On Error GoTo ExecuteSQLConnect_Error

  'separate individual words of the SQL statement
  strTokens = Split(SQL)

  'execute the SQL statement
  Set rst = con.Execute(SQL, lRecordsAffected)

  If rst.State = adStateClosed Then
    'return success message for action queries
    strTokens = Split(SQL)
    strMsg = strTokens(0) & " statement succeeded. "
    If lRecordsAffected > 0 Then
      strMsg = strMsg & lRecordsAffected & " record(s) affected."
    End If
  Else
    'get recordCount and return recordset for result-returning queries
    strMsg = rst.RecordCount & " record(s) selected from SQL."
    Set ExecuteSQLConnect = rst
  End If

ExecuteSQLConnect_Exit:
  Set rst = Nothing
  Exit Function

ExecuteSQLConnect_Error:
  strMsg = "ERROR: " & Err.Description
  Resume ExecuteSQLConnect_Exit

End Function

'This procedure executes SQL statements by using the Execute method on
'a command object.  Results returned can be specified as a Recordset
'(by default) or as a stream of binary information. To obtain a binary
'stream, specify adExecuteStream in Options, then supply a stream by
'setting cmd.Properties("Output Stream").
Public Function ExecuteSQLCommand(ByVal SQL As String, _
                                  strMsg As String, _
                                  con As ADODB.Connection) _
  As ADODB.Recordset

  Dim rst As ADODB.Recordset
  Dim cmd As ADODB.Command
  Dim lRecordsAffected As Long
  Dim strTokens() As String

  'define the error handler
  On Error GoTo ExecuteSQLCommand_Error

  'initialize command object
  Set cmd = New ADODB.Command
  Set cmd.ActiveConnection = con
  cmd.CommandText = Trim$(SQL)

  'execute the SQL statement
  Set rst = cmd.Execute(lRecordsAffected)

  If rst.State = adStateClosed Then
    'return success message for action queries
    strTokens = Split(SQL)
    strMsg = strTokens(0) & " statement succeeded. "
    If lRecordsAffected > 0 Then
      strMsg = strMsg & lRecordsAffected & " record(s) affected."
    End If
  Else
    'get recordCount and return recordset for result-returning queries
    strMsg = rst.RecordCount & " record(s) selected from SQL."
    Set ExecuteSQLCommand = rst
  End If

ExecuteSQLCommand_Exit:
  Set rst = Nothing
  Set cmd = Nothing
  Exit Function

ExecuteSQLCommand_Error:
  strMsg = "ERROR: " & Err.Description
  Resume ExecuteSQLCommand_Exit

End Function

'This procedure executes SQL statements by using the Open method
'on a Recordset object.  Properties of the cursor obtained can be
'specified as arguments for the Open method.
Public Function ExecuteSQLRecordset(ByVal SQL As String, _
                                    strMsg As String, _
                                    con As ADODB.Connection) _
  As ADODB.Recordset

  Dim rst As ADODB.Recordset
  Dim strTokens() As String

  'define the error handler
  On Error GoTo ExecuteSQLRecordset_Error

  'execute the SQL statement
  Set rst = New ADODB.Recordset
  rst.Open UCase$(Trim$(SQL)), con, adOpenStatic, adLockOptimistic

  If rst.State = adStateClosed Then
    'return success message for action queries
    strTokens = Split(SQL)
    strMsg = strTokens(0) & " statement succeeded. "
  Else
    'get recordCount and return recordset for result-returning queries
    strMsg = rst.RecordCount & " record(s) selected from SQL."
    Set ExecuteSQLRecordset = rst
  End If

ExecuteSQLRecordset_Exit:
  Set rst = Nothing
  Exit Function

ExecuteSQLRecordset_Error:
  strMsg = "ERROR: " & Err.Description
  Resume ExecuteSQLRecordset_Exit

End Function