I recently wrote a DSN class for use with the Access flavor of VBA. I'm preparing to refactor and would appreciate feedback.
I am aware of two issues.
- I added the
findSectionKey() function to the Registry class (which is separate and out of scope for this question) that I call, but never went back to remove the duplicate logic from my DSN class. I am aware of this and will correct it during my refactor.
- I am completely unsatisfied with the way I implemented the
Driver property. I use an Enum to specify the DriverType and then a select statement to return a string from the aforementioned Driver property. It's works well in practice, but is kind of clunky to work with (particularly when adding support for a new driver). I'm thinking I could use a Dictionary to do this better, but I've never used one and I'm unsure if that's the best approach.
So, I am concerned with Issue #2 first and foremost, but all feedback is welcome. Thanks.
' ***************************************************************************
' * Class: DSN *
' * Author: Christopher J. McClellan *
' * Published under Creative Commons Attribution-Share Alike *
' * http://creativecommons.org/licenses/by-sa/3.0/ *
' * *
' * Allows for easy creation of DSN entries in the ODBC Administrator by *
' * leveraging the Registry class. *
' * Entries in the ODBC Admin are not created until the *
' * Create() sub is called. *
' ***************************************************************************
Private Const CLASS_NAME As String = "DSN" 'for error handling
Public Enum eDSN_Bitmode
DSN_64BIT = 0
DSN_32BIT = 1
End Enum
Private Const REG_KEYNODE_32 As String = "software\wow6432Node\ODBC"
Private Const REG_KEYNODE_64 As String = "software\ODBC"
Public Enum eDSN_type
DSN_SYSTEM = 0
DSN_USER = 1
End Enum
Public Enum eDSN_Driver
DSN_DRIVER_EMPTY = 0
DSN_DRIVER_SQLSERVER = 1
DSN_DRIVER_SQLSERVER10 = 2
DSN_DRIVER_SQLSERVER11 = 3
DSN_DRIVER_ORA11G = 11
End Enum
Private Const DSN_DRIVER_SQLSERVER_NAME As String = "SQL Server"
Private Const DSN_DRIVER_SQLSERVER10_NAME As String = "SQL Server Native Client 10.0"
Private Const DSN_DRIVER_SQLSERVER11_NAME As String = "SQL Server Native Client 11.0"
Private Const DSN_DRIVER_ORA11G_NAME As String = "Oracle in OraClient11g_home1"
Public Enum eORA_CommitMode
ORA_COMMIT_IfSuccessful
ORA_COMMIT_FirstFailure
ORA_COMMIT_AllSuccessful
End Enum
Private Const ORA_COMMIT_IfSuccessful_Txt As String = "IfAllSuccessful"
Private Const ORA_COMMIT_FirstFailure_Txt As String = "UpToFirstFailure"
Private Const ORA_COMMIT_AllSuccessful_Txt As String = "AllSuccessful"
Public Enum eORA_NumericSetting
ORA_NUMSET_OracleNLS
ORA_NUMSET_MSRegional
ORA_NUMSET_US
End Enum
Private Const ORA_NUMSET_OracleNLS_txt As String = "NLS"
Private Const ORA_NUMSET_MSRegional_txt As String = "MS"
Private Const ORA_NUMSET_US_txt As String = "US"
' shared props
Private mName As String
Private mDriver As eDSN_Driver
Private mDSNType As eDSN_type
Private mBitMode As eDSN_Bitmode
Private mDriverFile As String
Private mDesc As String
' sql server props
Private mServer As String
Private mDatabase As String
Private mTrustedConnection As Boolean
' ora props
Private mAppAttributes As Boolean
Private mReadOnlyConn As Boolean
Private mCommitMode As eORA_CommitMode
Private mBindAsDate As Boolean
Private mBindAsFloat As Boolean
Private mCacheBufferSize As Long
Private mCloseCursor As Boolean
Private mDisableDPM As Boolean
Private mDisableMTS As Boolean
Private mDisableRuleHint As Boolean
Private mExecSchemaOpt As String
Private mExecSyntax As Boolean
Private mFailover As Boolean
Private mFailoverDelay As Long
Private mFailoverRetryCount As Integer
Private mFetchBufferSize As Long
Private mForceWChar As Boolean
Private mLobs As Boolean
Private mMetaDataIdDefault As Boolean
Private mNumericSetting As eORA_NumericSetting
Private mQueryTimeout As Boolean
Private mResultSets As Boolean
Private mStatementCache As Boolean
Private mUserID As String
Private mPwd As String
' defaults
Private Const DSN_DFLT_CacheBufferSize As Long = 20
Private Const DSN_DFLT_FailoverDelay As Long = 10
Private Const DSN_DFLT_FailoverRetryCount As Integer = 10
Private Const DSN_DFLT_FetchBufferSize As Long = 64000
''''''''''''''''''''''''''''BEGIN SHARED PROPERTIES''''''''''''''''''''''''''''''
Property Get NAME() As String
NAME = mName
End Property
Property Let NAME(str As String)
mName = str
End Property
Property Get Driver() As eDSN_Driver
' defaults to empty via enum
Driver = mDriver
End Property
Property Let Driver(eDriver As eDSN_Driver)
mDriver = eDriver
End Property
Property Get DriverName() As String
' read only property
Select Case mDriver
Case DSN_DRIVER_EMPTY
DriverName = ""
Case DSN_DRIVER_SQLSERVER
DriverName = DSN_DRIVER_SQLSERVER_NAME
Case DSN_DRIVER_SQLSERVER10
DriverName = DSN_DRIVER_SQLSERVER10_NAME
Case DSN_DRIVER_SQLSERVER11
DriverName = DSN_DRIVER_SQLSERVER11_NAME
Case DSN_DRIVER_ORA11G
DriverName = DSN_DRIVER_ORA11G_NAME
End Select
End Property
Property Get DSNType() As eDSN_type
DSNType = mDSNType
End Property
Property Let DSNType(pDSNType As eDSN_type)
mDSNType = pDSNType
End Property
Property Get BitMode() As eDSN_Bitmode
BitMode = mBitMode
End Property
Property Let BitMode(pBitMode As eDSN_Bitmode)
' defaults to 64 bit via the enum
mBitMode = pBitMode
End Property
Property Get DriverFile() As String
' read only property
' @ todo - optimize
' save effort by only checking the registry the first time
'If mDriverFile = "" Then
mDriverFile = getDriver
DriverFile = mDriverFile
'Else
' DriverFile = mDriverFile
'End If
End Property
Public Property Get Description() As String
Description = mDesc
End Property
Public Property Let Description(desc As String)
mDesc = desc
End Property
Property Get Server() As String
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
'Server = Err_DriverNotSet
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
Server = Me.NAME
Case Else
Server = mServer
End Select
End Property
Property Let Server(str As String)
If Me.Driver <> DSN_DRIVER_ORA11G Then
mServer = str
Else
ErrRaise_NotSupported
End If
End Property
Private Property Get RegNode() As String
' read only property
Select Case Me.BitMode
Case DSN_32BIT
RegNode = REG_KEYNODE_32
Case DSN_64BIT
RegNode = REG_KEYNODE_64
Case Else
Err.Raise vbObjectError + 25002, CurrentProject.NAME & "." & CLASS_NAME, "Invalid Bitmode"
End Select
End Property
Private Property Get HKey() As Long
' read only property
' determine which HKEY to use
Select Case Me.DSNType
Case DSN_USER
HKey = HKEY_CURRENT_USER
Case DSN_SYSTEM
HKey = HKEY_LOCAL_MACHINE
Case Else
Err.Raise vbObjectError + 25001, CurrentProject.NAME & "." & CLASS_NAME, "Invalid DSNType or DSNType not set"
End Select
End Property
''''''''''''''''''''''''''''''END SHARED PROPERTIES''''''''''''''''''''''''
''''''''''''''''''''''''''''BEGIN ORA PROPERTIES'''''''''''''''''''''''''''
Public Property Get AppAttributes() As Boolean
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
AppAttributes = False
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
AppAttributes = mAppAttributes
Case Else
AppAttributes = False
ErrRaise_NotSupported
End Select
End Property
Public Property Let AppAttributes(bool As Boolean)
If Me.Driver = DSN_DRIVER_ORA11G Then
mAppAttributes = bool
Else
mAppAttributes = False
ErrRaise_NotSupported
End If
End Property
Public Property Get ReadOnlyConnection() As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Attributes '
' true = "R" (read); false = "W" (write) '
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ReadOnlyConnection = True 'return true as a precaution
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
ReadOnlyConnection = mReadOnlyConn
Case Else
ReadOnlyConnection = True
ErrRaise_NotSupported
End Select
End Property
Public Property Let ReadOnlyConnection(bool As Boolean)
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
mReadOnlyConn = bool
Case Else
ErrRaise_NotSupported
End Select
End Property
Public Property Get BatchAutoCommitMode() As eORA_CommitMode
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
BatchAutoCommitMode = mCommitMode
Case Else
ErrRaise_NotSupported
End Select
End Property
Public Property Let BatchAutoCommitMode(mode As eORA_CommitMode)
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
mCommitMode = mode
Case Else
ErrRaise_NotSupported
End Select
End Property
Public Property Get BindAsDate() As Boolean
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
BindAsDate = mBindAsDate
Case Else
ErrRaise_NotSupported
End Select
End Property
'.... lots of properties with the same logic omitted due to space constraints
' @todo - add sql server support for sql server login
Public Property Get USERID() As String
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
USERID = mUserID
Case Else
ErrRaise_NotSupported
End Select
End Property
Public Property Let USERID(uid As String)
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
mUserID = uid
Case Else
ErrRaise_NotSupported
End Select
End Property
' @todo - add sql server support for sql server login
Public Property Get Password() As String
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
Password = mPwd
Case Else
ErrRaise_NotSupported
End Select
End Property
Public Property Let Password(pwd As String)
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
mPwd = pwd
Case Else
ErrRaise_NotSupported
End Select
End Property
''''''''''''''''''''''''''''''END ORA PROPERTIES'''''''''''''''''''''''''''
''''''''''''''''''''''''BEGIN SQL SERVER PROPERTIES''''''''''''''''''''''''
Property Get Database() As String
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
'Database = Err_DriverNotSet
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
'Database = Err_NotSupported
ErrRaise_NotSupported
Case Else
Database = mDatabase
End Select
End Property
Property Let Database(pDatabase As String)
If Me.Driver <> DSN_DRIVER_ORA11G Then
mDatabase = pDatabase
Else
'mDatabase = Err_NotSupported
ErrRaise_NotSupported
End If
End Property
Property Get TrustedConnection() As Boolean
TrustedConnection = mTrustedConnection
End Property
Property Let TrustedConnection(value As Boolean)
mTrustedConnection = value
End Property
'''''''''''''''''''''''END SQL SERVER PROPERTIES'''''''''''''''''''''''''''''''''''''
Private Function getDriver() As String
'**********************************************
' returns the file path of the .dll driver file
'**********************************************
Const PROC_NAME As String = "getDriver"
On Error GoTo ErrHandler:
If Me.Driver = DSN_DRIVER_EMPTY Then
getDriver = ""
Else
'determine bitmode
Dim skey As String
skey = RegNode
' find ODBC node
Dim odbcDriverNode As String
odbcDriverNode = findSectionKey(HKEY_LOCAL_MACHINE, skey, Me.DriverName)
If odbcDriverNode <> "" Then
'create new registry object and find the driver
Dim reg As New Registry
With reg
.ClassKey = HKEY_LOCAL_MACHINE
.sectionKey = odbcDriverNode
.ValueKey = "Driver"
If .value = "" Then
Err.Raise vbObjectError + 25003, CurrentProject.NAME & "." & CLASS_NAME, "Driver Not Found"
Else
'return
getDriver = .value
End If
End With
Else
Err.Raise vbObjectError + 25003, CurrentProject.NAME & "." & CLASS_NAME, "Driver Not Found"
End If
End If
ExitFunction:
If Not (reg Is Nothing) Then
Set reg = Nothing
End If
Exit Function
ErrHandler:
errBox CLASS_NAME, PROC_NAME
Resume ExitFunction:
End Function
Private Function findSectionKey(regClassKey As ERegistryClassConstants, sectToLookIn As String, sectToFind As String) As String
'******************************************************************
' returns full section key as string
' if a matching section key is not found, returns an empty string
'******************************************************************
On Error GoTo ErrHandler:
Const PROC_NAME As String = "findSectionKey"
Dim sSect() As String ' string array of subnodes
Dim iSectCount As Long ' length of sSect array
Dim reg As New Registry
With reg
.ClassKey = regClassKey
.sectionKey = sectToLookIn
.EnumerateSections sSect, iSectCount
Dim i As Long
For i = 1 To iSectCount
'Debug.Print .sectionKey & "\" & sSect(i)
If findSectionKey = "" Then
If sSect(i) = sectToFind Then
' found node
findSectionKey = .sectionKey & "\" & sSect(i)
Exit For
Else
'search subnodes via recursion
findSectionKey = findSectionKey(regClassKey, .sectionKey & "\" & sSect(i), sectToFind)
End If
Else
Exit For
End If
Next i
End With
ExitFunction:
If Not (reg Is Nothing) Then
Set reg = Nothing
End If
Exit Function
ErrHandler:
errBox CLASS_NAME, PROC_NAME
End Function
Public Sub Create(Optional overwrite As Boolean = True)
' ***************************************************************************************************
' Creates a new registry entry defining the DSN (or modifies existing one with matching reg key)
' The actual registry entry (thus the DSN in the odbc admin) is not created until this sub is called.
Select Case Me.Driver
Case DSN_DRIVER_EMPTY
ErrRaise_DriverNotSet
Case DSN_DRIVER_ORA11G
createORA overwrite
Case Else 'some sql server version
createSQL overwrite
End Select
End Sub
Private Sub createSQL(ByVal overwrite As Boolean)
Dim reg As New Registry
Dim SCTKEY As String
Dim isRegKey As Boolean
' Registry Section Key
SCTKEY = RegNode & "\odbc.ini\" & Me.NAME
' Create New Key and set values
With reg
.ClassKey = HKey
.sectionKey = SCTKEY
' Check existance and overwrite value
isRegKey = .KeyExists
If overwrite = True Or (overwrite = False And isRegKey = False) Then
'driver
.ValueKey = "Driver"
.ValueType = REG_SZ
.value = Me.DriverFile
'server
.ValueKey = "Server"
.ValueType = REG_SZ
.value = Me.Server
'database
.ValueKey = "Database"
.ValueType = REG_SZ
.value = Me.Database
'trusted connection
.ValueKey = "Trusted_Connection"
.ValueType = REG_SZ
If Me.TrustedConnection = True Then
.value = "Yes"
Else
.value = "No"
End If
'last user
.ValueKey = "LastUser"
.ValueType = REG_SZ
.Value = Environ("UserName")
' Description
.ValueKey = "Description"
.ValueType = REG_SZ
.value = Me.Description
End If
End With
' add a registry key to make the newly added DSN visible
If overwrite = True Or (overwrite = False And isRegKey = False) Then
addDataSourceEntry
End If
End Sub
Private Sub createORA(ByVal overwrite As Boolean)
Dim reg As New Registry
Dim SCTKEY As String
Dim isRegKey As Boolean
' Registry Section Key
SCTKEY = RegNode & "\odbc.ini\" & Me.NAME
' Create New Key and set values
With reg
.ClassKey = HKey
.sectionKey = SCTKEY
' Check existance and overwrite value
isRegKey = .KeyExists
If overwrite = True Or (overwrite = False And isRegKey = False) Then
.ValueKey = "Application Attributes"
.ValueType = REG_SZ
.value = boolAsString(Me.AppAttributes)
.ValueKey = "Attributes"
.ValueType = REG_SZ
If Me.ReadOnlyConnection Then
.value = "R"
Else
.value = "W"
End If
.ValueKey = "BatchAutocommitMode"
.ValueType = REG_SZ
Select Case Me.BatchAutoCommitMode
Case ORA_COMMIT_AllSuccessful
.value = ORA_COMMIT_AllSuccessful_Txt
Case ORA_COMMIT_FirstFailure
.value = ORA_COMMIT_FirstFailure_Txt
Case ORA_COMMIT_IfSuccessful
.value = ORA_COMMIT_IfSuccessful_Txt
End Select
.ValueKey = "BindAsDATE"
.ValueType = REG_SZ
.value = boolAsString(Me.BindAsDate)
.ValueKey = "BindAsFLOAT"
.ValueType = REG_SZ
.value = boolAsString(Me.BindAsFloat)
.ValueKey = "CacheBufferSize"
.ValueType = REG_SZ
.value = Me.CacheBufferSize
.ValueKey = "CloseCursor"
.ValueType = REG_SZ
.value = boolAsString(Me.CloseCursor)
.ValueKey = "Description"
.ValueType = REG_SZ
.value = Me.Description
.ValueKey = "DisableDPM"
.ValueType = REG_SZ
.value = boolAsString(Me.DisableDPM)
.ValueKey = "DisableMTS"
.ValueType = REG_SZ
.value = boolAsString(Me.DisableMTS)
.ValueKey = "DisableRULEHint"
.ValueType = REG_SZ
.value = boolAsString(Me.DisableRULEHint)
.ValueKey = "Driver"
.ValueType = REG_SZ
.value = Me.DriverFile
.ValueKey = "DSN"
.ValueType = REG_SZ
.value = Me.NAME
.ValueKey = "EXECSchemaOpt"
.ValueType = REG_SZ
.value = Me.EXECSchemaOpt
.ValueKey = "EXECSyntax"
.ValueType = REG_SZ
.value = boolAsString(Me.EXECSyntax)
.ValueKey = "Failover"
.ValueType = REG_SZ
.value = boolAsString(Me.Failover)
.ValueKey = "FailoverDelay"
.ValueType = REG_SZ
.value = Me.FailoverDelay
.ValueKey = "FailoverRetryCount"
.ValueType = REG_SZ
.value = Me.FailoverRetryCount
.ValueKey = "FetchBufferSize"
.ValueType = REG_SZ
.value = Me.FetchBufferSize
.ValueKey = "ForceWCHAR"
.ValueType = REG_SZ
.value = boolAsString(Me.ForceWChar)
.ValueKey = "Lobs"
.ValueType = REG_SZ
.value = boolAsString(Me.Lobs)
.ValueKey = "MetadataIdDefault"
.ValueType = REG_SZ
.value = boolAsString(Me.MetadataIdDefault)
.ValueKey = "NumericSetting"
.ValueType = REG_SZ
Select Case Me.NumericSetting
Case ORA_NUMSET_OracleNLS
.value = ORA_NUMSET_OracleNLS_txt
Case ORA_NUMSET_MSRegional
.value = ORA_NUMSET_MSRegional_txt
Case ORA_NUMSET_US
.value = ORA_NUMSET_US_txt
End Select
.ValueKey = "Password"
.ValueType = REG_SZ
.value = Me.Password
.ValueKey = "QueryTimeout"
.ValueType = REG_SZ
.value = boolAsString(Me.QueryTimeout)
.ValueKey = "ResultSets"
.ValueType = REG_SZ
.value = boolAsString(Me.ResultSets)
.ValueKey = "ServerName"
.ValueType = REG_SZ
.value = Me.Server
.ValueKey = "StatementCache"
.ValueType = REG_SZ
.value = boolAsString(Me.StatementCache)
.ValueKey = "UserID"
.ValueType = REG_SZ
.value = Me.USERID
End If
End With
' add a registry key to make the newly added DSN visible
If overwrite = True Or (overwrite = False And isRegKey = False) Then
addDataSourceEntry
End If
End Sub
Private Sub addDataSourceEntry()
Dim reg As Registry
Set reg = New Registry
With reg
.ClassKey = HKey
.sectionKey = RegNode & "\odbc.ini\odbc data sources"
.ValueKey = Me.NAME
.ValueType = REG_SZ
.value = Me.DriverName
End With
End Sub
Public Function Exists() As Boolean
' Assumes Name, DSNType, and Bitmode are set
Dim reg As New Registry
Dim SCTKEY As String
SCTKEY = RegNode & "\odbc.ini\" & Me.NAME
With reg
.ClassKey = HKey
.sectionKey = SCTKEY
If .KeyExists Then
Exists = True
Else
Exists = False
End If
End With
End Function
Public Sub Delete()
Dim reg As New Registry
With reg
.ClassKey = HKey
'delete registry Section key
.sectionKey = RegNode & "\odbc.ini\" & Me.NAME
If Exists Then
.DeleteKey
'delete related ODBC Datasource ValueKey
.sectionKey = RegNode & "\odbc.ini\odbc data sources"
.ValueKey = Me.NAME
.DeleteValue
End If
End With
End Sub
Private Function boolAsString(ByVal bool As Boolean) As String
If bool = True Then
boolAsString = "T"
Else
boolAsString = "F"
End If
End Function
Private Sub Class_Initialize()
' bypass all setters & getters when initializing
' shared props
'mName =
mDriver = DSN_DRIVER_EMPTY
mDSNType = DSN_SYSTEM
mBitMode = DSN_32BIT
'mDriverFile =
'mDesc =
'mServer =
' sql server
'mDatabase =
mTrustedConnection = True
' oracle
mAppAttributes = False
mReadOnlyConn = True
mCommitMode = ORA_COMMIT_IfSuccessful
mBindAsDate = False
mBindAsFloat = False
mCacheBufferSize = DSN_DFLT_CacheBufferSize
mCloseCursor = False
mDisableDPM = False
mDisableMTS = True
mDisableRuleHint = True
mExecSchemaOpt = ""
mExecSyntax = False
mFailover = True
mFailoverDelay = DSN_DFLT_FailoverDelay
mFailoverRetryCount = DSN_DFLT_FailoverRetryCount
mFetchBufferSize = DSN_DFLT_FetchBufferSize
mForceWChar = False
mLobs = True
mMetaDataIdDefault = False
mNumericSetting = ORA_NUMSET_OracleNLS
mQueryTimeout = False
mResultSets = False
mStatementCache = False
' @todo - make sql serv support sql server login; move to shared
'mUserID =
'mPwd =
End Sub
Private Sub errBox(ModuleName As String, procName As String, Optional style As VbMsgBoxStyle = vbCritical)
MsgBox "Module: " & ModuleName & vbCrLf & _
"Procedure: " & procName & vbCrLf & _
Err.Description, _
style, _
"Runtime Error: " & Err.number
End Sub
Private Sub ErrRaise_NotSupported()
Err.Raise vbObjectError + 25010, CurrentProject.NAME & "." & CLASS_NAME, "Driver does not support the property."
End Sub
Private Sub ErrRaise_DriverNotSet()
Err.Raise vbObjectError + 25020, CurrentProject.NAME & "." & CLASS_NAME, "Driver property is not set."
End Sub
