'=====================================================================
' clsADOCursorAnalyzer
' --------------------------------------------------------------------
'
' Created By  : Bob Bedell [email protected]
'
' Created On  : January 5, 2005
'
' Last Update : January 11, 2005
'
' VBA Version : Retail 6.4.8869
' --------------
' -- REQUIRES --
' --------------
' Microsoft Data Access Components (MDAC) 2.8
' (http://msdn.microsoft.com/data/mdac/...s/default.aspx)
' * NOTE - ADO object library appear in references dialog as "Microsoft
'   ActiveX Data Objects 2.8 Library.
'
' "Microsoft OLE DB Service Component 1.0 Type Library"
' * Note: This object library contains the Data Link Properties
'   user interface and is included in MDAC. The Class_Initialize event
'   checks to see if this library is referenced.
'
' -------------------
' --  DESCRIPTION  --
' -------------------
' This class instantiates ADO recordset objects representing all 32
' possible combinations of cursor location, lock type, and cursor
' type from any data source with an installed OLE DB provider.
' As each recordset is created, the following information
' is output to a text file:
' - OLE DB Provider name.
' - Cursor location, type and lock type requested.
' - Cursor location, type and lock type actually provided by the OLE DB
'   Provider used.
' - Functionality supported by the provided cursor.
' - Whether the provided cursor supports the RecordCount property.
'
' Because this class uses the Data Link Properties user interface, the
' user can enter a connection string for any OLE DB provider installed
' on their system.
' --------------------------------------------------------------------
' -- CLASS FIELDS --          -- USE --
' --------------------------------------------------------------------
' m_strConnectionString       Required. Connection string set in the
'                             Data Link Properties user interface. No
'                             default.
' m_strOutputFile             Required. Stores path and file name of
'                             output file.
' m_strSQLCommand             Required. Stores SQL SELECT statement to
'                             serve as source argument for recordset
'                             Open method.
' --------------------------------------------------------------------
' -- SAMPLE USAGE --
' --------------------------------------------------------------------
' Paste the following code in a standard module and run the
' "AnalyseCusors" procedure from the Debug window.
' ----------------------------------------------------------
'Option Compare Database
'
'Global g_lngLineCount As Long
'
'Sub AnalyzeCursors()
'   On Error GoTo Err_Handler
'
'   Dim blnErrorOccurred As Boolean
'   blnErrorOccurred = False
'
'   'Instantiate ADOCursorAnalyzer object
'   Dim objADOCursorAnalyzer As clsADOCursorAnalyzer
'   Set objADOCursorAnalyzer = New clsADOCursorAnalyzer
'
'   With objADOCursorAnalyzer
'
'      'Invoke Data Link Properties interface
'      .SetConnectionString
'      .SQLCommand = InputBox("Enter a SQL SELECT statement for a single " & _
'                             "table in your data source:" & vbCrLf _
'                             & vbCrLf & "Example: " & Chr(34) _
'                             & "SELECT * FROM tblData" & Chr(34), "ADO Cursor Analyzer")
'      .OutputFile = InputBox("Enter the path and name of a file to output " & _
'                             "cursor data to." & vbCrLf _
'                             & vbCrLf & "Example: " & Chr(34) _
'                             & "C:\cursordata.txt" & Chr(34), "ADO Cursor Analyzer")
'      .RunAnalysis
'
'   End With
'
'   MsgBox "Cursor analysis complete." & vbCrLf & _
'          g_lngLineCount & " lines printed to output file."
'
'Exit_Here:
'   On Error Resume Next
'   'Open Wordpad if no errors occurred.
'   If Not blnErrorOccurred Then: objADOCursorAnalyzer.OpenWordPad
'   'Destroy objADOCursorAnalyzer instance.
'   If Not objADOCursorAnalyzer Is Nothing Then: Set objADOCursorAnalyzer = Nothing
'   Exit Sub
'
'Err_Handler:
'   Dim strMessage As String
'   blnErrorOccurred = True
'
'   If Err.Number = -2147220990 Then
'      MsgBox Prompt:=Err.Description, _
'             Buttons:=vbInformation, _
'             Title:="Operation cancelled by user."
'   Else
'      strMessage = "An error has occurred in " & _
'                   Err.Source & "." & vbCrLf & vbCrLf
'      strMessage = strMessage & "Error Number: " & Trim(Str(Err.Number)) & vbCrLf _
'                              & "Error Description: " & Err.Description
'      MsgBox Prompt:=strMessage, _
'             Buttons:=vbCritical, _
'             Title:="An Error occurred"
'   End If
'
'   Resume Exit_Here
'
'End Sub
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­--------------------

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'                          CLASS FIELDS
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Private m_strConnectionString As String
Private m_strOutputFile As String
Private m_strSQLCommand As String

' Private module-level variables
Private m_objConnection As ADODB.Connection
Private m_objRecordset As ADODB.Recordset
Private m_alngCursorLocations(1) As Long
Private m_alngCursorOptions(12) As Long
Private m_alngCursorTypes(3) As Long
Private m_alngLockTypes(3) As Long
Private m_lngCursorLocation As Long
Private m_lngCursorType As Long
Private m_lngLockType As Long
Private m_intErrorHandling As Integer
Private m_intOutputFile As Integer

' Constant declarations.
Private Const ERR_BAD_MSDASC_REFERENCE = vbObjectError + 513
Private Const ERR_DATA_LINK_PROMPT_CANCELLED = vbObjectError + 514
Private Const ERR_INVALID_CONNECTION_STRING = vbObjectError + 515
Private Const ERR_OPEN_CONNECTION_FAILED = vbObjectError + 516
Private Const ERR_OPEN_RECORDSET_FAILED = vbObjectError + 517
Private Const OutputDivider = _
   "==========================================================="

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'                          CLASS PROPERTIES
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'=====================================================================
' ConnectionString Property
' --------------------------
' Required. Connection string set in the Data Link Properties user
' interface. No Default.
'=====================================================================
Public Property Get ConnectionString() As String

   ConnectionString = m_strConnectionString

End Property

'=====================================================================
' OutputFile Property
' --------------------------
' Required. Stores path and file name of output file.
'=====================================================================
Public Property Let OutputFile(strOutputFile As String)

   m_strOutputFile = strOutputFile

End Property

'=====================================================================
' SQLCommand Property
' --------------------------
' Required. Stores SQL SELECT statement to serve as Source argument for
' recordset Open method. No Default.
'=====================================================================
Public Property Let SQLCommand(strSQLCommand As String)

   m_strSQLCommand = strSQLCommand

End Property

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'                          CLASS METHODS
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'=====================================================================
' OpenWordPad Method
' --------------------------
' Opens wordpad and displays output text file.
'
' Param                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Public Function OpenWordPad()

   Dim x As Variant
  'C:\WINDOWS\SYSTEM32\write.exe
  x = Shell("write.exe " & m_strOutputFile, 1)


Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::OpenWordPad", Err.Description
   Resume Exit_Here
End Function

'=====================================================================
' RunAnalysis Method
' --------------------------
' Wrapper function for internal, private functions that fill enum
' arrays, open an output file, manages connection and recordset
' objects, and perform cursor analysis.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Public Function RunAnalysis() As Long

   Dim intCursorLocationIndex As Integer
   Dim intCursorTypeIndex As Integer
   Dim intLockTypeIndex As Integer

   On Error GoTo Err_Handler

   Call BuildCursorLocationsArray
   Call BuildCursorOptionArray
   Call BuildCursorTypesArray
   Call BuildLockTypesArray

   Call OpenOutputFile

   Call WriteOutput("ADO Cursor Analyzer, Version 1.0")
   Call WriteOutput("Generated: " & Now)

   'Establish connection to data source
   If Not OpenConnection Then _
      Err.Raise ERR_OPEN_CONNECTION_FAILED, "clsADOCursorAnalyzer::RunAnalysis", _
         "Call to clsADOCursorAnalyzer::OpenConnection failed."

   Call WriteOutput("OLE DB Provider: " & m_objConnection.Provider)

   For intCursorLocationIndex = 0 To UBound(m_alngCursorLocations)
      m_lngCursorLocation = m_alngCursorLocations(intCursorLocationIndex)
      For intCursorTypeIndex = 0 To UBound(m_alngCursorTypes)
         m_lngCursorType = m_alngCursorTypes(intCursorTypeIndex)
         For intLockTypeIndex = 0 To UBound(m_alngLockTypes)
            m_lngLockType = m_alngLockTypes(intLockTypeIndex)

            Call WriteOutput("")
            Call WriteOutput(OutputDivider)
            Call WriteOutput("")
            Call WriteOutput("Requested Cursor:")

            Call OutputConstantDescriptions(m_lngCursorLocation, _
                                             m_lngCursorType, _
                                             m_lngLockType)

            If Not OpenRecordset(m_lngCursorLocation, m_lngCursorType, m_lngLockType) Then
               Err.Raise ERR_OPEN_RECORDSET_FAILED, "clsADOCursorAnalyzer::RunAnalysis", _
                  "Call to clsADOCursorAnalyzer::OpenRecordset failed."
            Else

               Call WriteOutput("Provided Cursor:")
               Call OutputConstantDescriptions(m_objRecordset.CursorLocation, _
                                                m_objRecordset.CursorType, _
                                                m_objRecordset.LockType)

               Call WriteOutput("Functionality Supported:")
               Call FunctionalitySupported(m_objRecordset)

            End If

         Next intLockTypeIndex
      Next intCursorTypeIndex
   Next intCursorLocationIndex
      'Close output file
   Close m_intOutputFile

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Select Case Err.Source
      Case "clsADOCursorAnalyzer::BuildCursorLocationsArray", _
            "clsADOCursorAnalyzer::BuildCursorOptionArray", _
            "clsADOCursorAnalyzer::CursorTypesArray", _
            "clsADOCursorAnalyzer::BuildLockTypesArray", _
            "clsADOCursorAnalyzer::OpenConnection", _
            "clsADOCursorAnalyzer::OpenRecordset"
         Err.Raise Err.Number, Err.Source, Err.Description
      Case Else
         Err.Raise Err.Number, "clsADOCursorAnalyzer::RunAnalysis", Err.Description
   End Select

   Resume Exit_Here

End Function

'=====================================================================
' SetConnectionString Function
' --------------------------
' Sets m_strConnectionString to any valid OLE DB provider connection
' string using the Data Link Properties user interface.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Public Function SetConnectionString()

   On Error GoTo Err_Handler

   Dim objDataLink As MSDASC.DataLinks
   Dim strConnString As String

   Set objDataLink = New MSDASC.DataLinks
   m_strConnectionString = objDataLink.PromptNew
   If Len(m_strConnectionString) = 0 Then _
      Err.Raise ERR_INVALID_CONNECTION_STRING, "clsErrorHandler::SetConnectionString", _
         "No valid connection string set."

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   If Err.Number = 91 Then
      Err.Raise ERR_DATA_LINK_PROMPT_CANCELLED, "clsErrorHandler::SetConnectionString", _
         "Data Link prompt cancelled by user."
   ElseIf Err.Number = ERR_INVALID_CONNECTION_STRING Then
      Err.Raise Err.Number, Err.Source, Err.Description
   Else
      Err.Raise Err.Number, "clsCusorAnalyzer::SetConnectionString", Err.Description
   End If

   Resume Exit_Here

End Function

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'                          PRIVATE FUNCTIONS
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'=====================================================================
' BuildCursorLocationsArray
' --------------------------
' Fills a long array with the values of ADO 2.8 CursorLocationEnum
' constants.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Private Function BuildCursorLocationsArray() As Long

   On Error GoTo Err_Handler

   m_alngCursorLocations(0) = ADODB.CursorLocationEnum.adUseClient
   m_alngCursorLocations(1) = ADODB.CursorLocationEnum.adUseServer

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::BuildCursorLocationsArray", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' BuildCursorOptionArray
' --------------------------
' Fills a long array with the values of ADO 2.8 CursorOptionEnum
' constants.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Private Function BuildCursorOptionArray() As Long

   On Error GoTo Err_Handler

   m_alngCursorOptions(0) = ADODB.CursorOptionEnum.adAddNew
   m_alngCursorOptions(1) = ADODB.CursorOptionEnum.adApproxPosition
   m_alngCursorOptions(2) = ADODB.CursorOptionEnum.adBookmark
   m_alngCursorOptions(3) = ADODB.CursorOptionEnum.adDelete
   m_alngCursorOptions(4) = ADODB.CursorOptionEnum.adFind
   m_alngCursorOptions(5) = ADODB.CursorOptionEnum.adHoldRecords
   m_alngCursorOptions(6) = ADODB.CursorOptionEnum.adIndex
   m_alngCursorOptions(7) = ADODB.CursorOptionEnum.adMovePrevious
   m_alngCursorOptions(8) = ADODB.CursorOptionEnum.adNotify
   m_alngCursorOptions(9) = ADODB.CursorOptionEnum.adResync
   m_alngCursorOptions(10) = ADODB.CursorOptionEnum.adSeek
   m_alngCursorOptions(11) = ADODB.CursorOptionEnum.adUpdate
   m_alngCursorOptions(12) = ADODB.CursorOptionEnum.adUpdateBatch

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::BuildCursorOptionArray", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' BuildCursorTypesArray
' --------------------------
' Fills a long array with the values of ADO 2.8 CursorTypeEnum
' constants.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Private Function BuildCursorTypesArray() As Long

   On Error GoTo Err_Handler

   m_alngCursorTypes(0) = ADODB.CursorTypeEnum.adOpenForwardOnly
   m_alngCursorTypes(1) = ADODB.CursorTypeEnum.adOpenKeyset
   m_alngCursorTypes(2) = ADODB.CursorTypeEnum.adOpenDynamic
   m_alngCursorTypes(3) = ADODB.CursorTypeEnum.adOpenStatic

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::BuildCursorTypesArray", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' BuildLockTypesArray
' --------------------------
' Fills a long array with the values of ADO 2.8 LockTypeEnum
' constants.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Private Function BuildLockTypesArray() As Long

   On Error GoTo Err_Handler

   m_alngLockTypes(0) = ADODB.LockTypeEnum.adLockReadOnly
   m_alngLockTypes(1) = ADODB.LockTypeEnum.adLockPessimistic
   m_alngLockTypes(2) = ADODB.LockTypeEnum.adLockOptimistic
   m_alngLockTypes(3) = ADODB.LockTypeEnum.adLockBatchOptimistic

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::BuildLockTypesArray", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' FunctionalitySupported Function
' --------------------------
' Translates CursorOptionEnum values to member names and builds
' output strings.
'
' Parameters                 Use
' ------------------------------------------------
' m_objRecordset             ByRef. ADO Recordset object
'                            to be evaluated.
'
' Returns
' -------
'
'=====================================================================
Private Function FunctionalitySupported(ByRef objRecorset As ADODB.Recordset)

   Dim strOutputString As String
   Dim blnSupports As Boolean
   Dim intIndex As Integer
   Dim strRecordCountSupport As String

   On Error GoTo Err_Handler

   For intIndex = 0 To 12
      blnSupports = objRecorset.Supports(m_alngCursorOptions(intIndex))
      If blnSupports Then
         Select Case m_alngCursorOptions(intIndex)
            Case adAddNew
                strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "AddNew"
            Case adApproxPosition
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "AbsolutePosition and AbsolutePage"
            Case adBookmark
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Bookmark"
            Case adDelete
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Delete"
            Case adFind
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Find"
            Case adHoldRecords
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Holding Records"
            Case adIndex
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Index"
            Case adMovePrevious
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "MovePrevious and Move"
            Case adNotify
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Notifications"
            Case adResync
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Resyncing data"
            Case adSeek
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Seek"
            Case adUpdate
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Update"
            Case adUpdateBatch
               strOutputString = strOutputString & vbCrLf & vbTab & "- " & _
                                   "Batch updating"
         End Select
      End If
   Next intIndex

   Call WriteOutput(Right$(strOutputString, Len(strOutputString) - 2))

   If objRecorset.Supports(adBookmark) Or objRecorset.Supports(adApproxPosition) Then
      strRecordCountSupport = "Yes"
   Else
      strRecordCountSupport = "No"
   End If

   Call WriteOutput("Supports RecordCount Property: " & strRecordCountSupport)

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::FunctionalitySupported", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' OpenConnection Function
' --------------------------
' Opens ADO connection to specified datasource.
'
' Parameters                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
' Returns True if connection opened successfully.
'=====================================================================
Private Function OpenConnection() As Boolean

   On Error GoTo Err_Handler

   Set m_objConnection = New ADODB.Connection
   m_objConnection.ConnectionString = m_strConnectionString
   m_objConnection.Open

   If Not m_objConnection Is Nothing Then
      If m_objConnection.State <> adStateOpen Then
         OpenConnection = False
      Else
         OpenConnection = True
      End If
   End If

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:

   Err.Raise Err.Number, "clsADOCursorAnalyzer::OpenConnection", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' OpenRecordset Function
' --------------------------
' Opens ADO recordset object.
'
' Param                 Use
' ------------------------------------------------
' lngCursorLocation     Value of recordset object's
'                       Cussorocation property.
' lngCursorType         CursorType argument of recordset object's
'                       Open method.
' lngLockType           LockType argument of recordset object's
'                       Open method.
'
' Returns
' -------
' Returns True if recordset opened successfully.
'=====================================================================

Private Function OpenRecordset(ByVal lngCursorLocation As Long, _
                               ByVal lngCursorType As Long, _
                               ByVal lngLockType As Long) As Boolean

   On Error GoTo Err_Handler

   If Not m_objRecordset Is Nothing Then
      If m_objRecordset.State = adStateOpen Then m_objRecordset.Close
      Set m_objRecordset = Nothing
   End If

   Set m_objRecordset = New ADODB.Recordset
   m_objRecordset.CursorLocation = lngCursorLocation
   m_objRecordset.Open m_strSQLCommand, m_objConnection, lngCursorType, lngLockType, adCmdText

   If Not m_objRecordset Is Nothing Then
      If m_objRecordset.State <> adStateOpen Then
         OpenRecordset = False
      Else
         OpenRecordset = True
      End If
   End If

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:

   Err.Raise Err.Number, "clsADOCursorAnalyzer::OpenRecordset", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' OpenOutputFile Function
' --------------------------
' Opens text file for data output.
'
' Param                 Use
' ------------------------------------------------
' None
'
' Returns
' -------
'
'=====================================================================
Private Function OpenOutputFile()

   On Error Resume Next
   Kill m_strOutputFile

   On Error GoTo Err_Handler

   'Initialize output file
   m_intOutputFile = FreeFile
   Open m_strOutputFile For Output As m_intOutputFile

   'Initialize line count to 0
   g_lngLineCount = 0

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::OpenOutputFile", Err.Description
   Resume Exit_Here
End Function


'=====================================================================
' OutputConstantDescriptions Function
' --------------------------
' Evaluates long constant values and outputs corresponding string
' description.
'
' Param                 Use
' ------------------------------------------------
' lngCursorLocation     Value of constant in the
'                       ADODB.CursorLocationEnum.
' lngCursorType         Value of constant in the
'                       ADODB.CursorTypeEnum.
' lngLockType           Value of constant in the
'                       ADODB.LockTypeEnum.
'
' Returns
' -------
'
'=====================================================================
Private Function OutputConstantDescriptions(ByVal lngCursorLocation As Long, _
                                            ByVal lngCursorType As Long, _
                                            ByVal lngLockType As Long)
   Dim strRequestedCursorLocation As String
   Dim strRequestedCursorType As String
   Dim strRequestedLockType As String
   Dim strOutputString As String

   On Error GoTo Err_Handler

   Select Case lngCursorLocation
            Case adUseServer
               strRequestedCursorLocation = "Server-side"
            Case adUseClient
               strRequestedCursorLocation = "Client-side"
   End Select

   Select Case lngCursorType
            Case adOpenForwardOnly
               strRequestedCursorType = "Forward-Only"
            Case adOpenKeyset
               strRequestedCursorType = "Keyset"
            Case adOpenDynamic
               strRequestedCursorType = "Dynamic"
            Case adOpenStatic
               strRequestedCursorType = "Static"
   End Select

   Select Case lngLockType
            Case adLockReadOnly
               strRequestedLockType = "Read-Only"
            Case adLockPessimistic
               strRequestedLockType = "Pessimistic"
            Case adLockOptimistic
               strRequestedLockType = "Optimistic"
            Case adLockBatchOptimistic
               strRequestedLockType = "BatchOptimistic"
   End Select

   strOutputString = vbTab & strRequestedCursorLocation & ", " & _
                             strRequestedCursorType & " cursor with " & _
                             strRequestedLockType & " locking."

   Call WriteOutput(strOutputString)


Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::OutputConstantDescriptions", Err.Description
   Resume Exit_Here

End Function

'=====================================================================
' WriteOutput Function
' --------------------------
' Writes string output to the output file.
'
' Param                 Use
' ------------------------------------------------
' strOutput             String value to be written
'                       to file.
'
' Returns
' -------
'
'=====================================================================
Private Function WriteOutput(strOutput As String)

   On Error GoTo Err_Handler

   Print #m_intOutputFile, strOutput
   g_lngLineCount = g_lngLineCount + 1

Exit_Here:
   On Error Resume Next
   Exit Function

Err_Handler:
   Err.Raise Err.Number, "clsADOCursorAnalyzer::WriteOutput", Err.Description
   Resume Exit_Here
End Function

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'                          CLASS EVENTS
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'=====================================================================
' Class_Initialize
' --------------------------
' Checks for a valid reference to the "Microsoft OLE DB Service
' Component 1.0 Type Library (MSDASC) and sets error trapping to
' "Break on Unhandled Errors"
'=====================================================================
Private Sub Class_Initialize()

   On Error GoTo 0

   Dim ref As Access.Reference
   Dim blnMSDASCReferenced As Boolean, blnBroken As Boolean

   Const cMSDASCGUID As String = "{2206CEB0-19C1-11D1-89E0-00C04FD7A829}"

   m_intErrorHandling = Application.GetOption("Error Trapping")
   Application.SetOption "Error Trapping", 2

   For Each ref In Application.References
      On Error Resume Next
      blnBroken = ref.IsBroken
         If VBA.Err Then blnBroken = True
            On Error GoTo 0
            If ref.Name = "MSDASC" And ref.Kind = 0 And _
               VBA.StrComp(ref.Guid, cMSDASCGUID, 1) = 0 And _
               Not blnBroken Then
               blnMSDASCReferenced = True
            Exit For
         End If
   Next ref

   Set ref = Nothing

   If Not blnMSDASCReferenced Then _
      Err.Raise ERR_BAD_MSDASC_REFERENCE, "clsADOCursorAnalyzer::Initialize", _
         "A reference to the Microsoft OLE DB Service Component 1.0 Type Library has to be set."
End Sub

'=====================================================================
' Class_Terminate
' --------------------------
' Cleans up ADO objects, close output file, reset error trapping
' setting, opens outfilr in wordpad.
'=====================================================================
Private Sub Class_Terminate()

   On Error GoTo 0

   'Cleanup objects
   If Not m_objRecordset Is Nothing Then
      If m_objRecordset.State = adStateOpen Then m_objRecordset.Close
      Set m_objRecordset = Nothing
   End If

   If Not m_objConnection Is Nothing Then
      If m_objConnection.State = adStateOpen Then m_objConnection.Close
      Set m_objConnection = Nothing
   End If

   'Close output file
   On Error Resume Next
   Close m_intOutputFile
   On Error GoTo 0

   'Reset Error Trapping to original setting
   Application.SetOption "Error Trapping", m_intErrorHandling

End Sub