Public Property Let ODBC_DSN_NAME(ByVal sName As String)
m_ODBC_DSN_Name = sName
End Property
Public Property Let ODBC_DRIVER_NAME(ByVal sDriver As _
String)
m_ODBC_Driver_Name = sDriver
End Property
Public Property Let ODBC_DATA_SOURCE(ByVal sDBFile As _
String)
m_ODBC_Data_Source = sDBFile
End Property
Friend Function ExecuteDSNCommand( _
ByVal dsnType As DSNTypeEnum, _
ByVal sDSN_Name As String, _
ByVal sDriver As String, _
ByVal sDBFile As String, _
ByVal eAction As ACTION _
) As Boolean
On Error GoTo ExecuteDSNCommandError
Const PROCEDURENAME As String = "ExecuteDSNCommand"
Dim sAttributes As String
Dim sDBQ As String
Dim sMessage As String
Dim lRetVal As Long
Dim lErrNo As Long
If sDSN_Name = "" Then
sDSN_Name = m_ODBC_DSN_Name
End If
If sDriver = "" Then
sDriver = m_ODBC_Driver_Name
End If
If sDBFile = "" Then
sDBFile = m_ODBC_Data_Source
End If
sDBQ = mf_DSNRegistryEntry(dsnType, sDSN_Name)
If (sDBQ = "" And (eAction = ODBC_ADD_DSN Or eAction = _
ODBC_ADD_SYS_DSN)) _
Or _
(sDBQ <> "" And (eAction = ODBC_REMOVE_DSN Or eAction _
= ODBC_CONFIGURE_DSN _
Or eAction = ODBC_CONFIG_SYS_DSN Or _
eAction = ODBC_REMOVE_SYS_DSN)) Then
If Len(Dir(sDBFile)) = 0 Then
Err.Raise mc_DataFileNotFoundError, PROCEDURENAME, _
"Data file doesn't exist!"
Else
sAttributes = "DSN=" & sDSN_Name & vbNullChar & _
"DBQ=" & sDBFile & vbNullChar
lRetVal = SQLConfigDataSource(0&, eAction, _
sDriver, sAttributes)
End If
Else
If eAction = ODBC_ADD_DSN Or _
eAction = ODBC_ADD_SYS_DSN Then
sMessage = " already exists!"
lErrNo = mc_DataFileExistsError
Else
sMessage = " doesn't exist!"
lErrNo = mc_DataFileNotFoundError
End If
Err.Raise mc_DataFileExistsError, PROCEDURENAME, _
"DSN: " & sDSN_Name & sMessage
End If
ExecuteDSNCommand = True
ExecuteDSNCommandExit:
Exit Function
ExecuteDSNCommandError:
ExecuteDSNCommand = False
With m_Error
.ETDescription = Err.Description
.ETNumber = Err.Number
.ETSource = Err.Source
End With
Resume ExecuteDSNCommandExit
End Function
Public Sub CreateDSN( _
Optional ByVal dsnType As DSNTypeEnum = UserDSN, _
Optional ByVal sDSN_Name As String = "", _
Optional ByVal sDriver As String = "", _
Optional ByVal sDataSource As String = "" _
)
Dim eAction As ACTION
If dsnType = SystemDSN Then
eAction = ODBC_ADD_SYS_DSN
Else
eAction = ODBC_ADD_DSN
End If
If Not ExecuteDSNCommand(dsnType, sDSN_Name, sDriver, _
sDataSource, eAction) Then
With m_Error
If .ETNumber <> 0 Then
Err.Raise .ETNumber, .ETSource, .ETDescription
End If
End With
End If
End Sub
Public Sub DeleteDSN( _
Optional ByVal dsnType As DSNTypeEnum = UserDSN, _
Optional ByVal sDSN_Name As String = "", _
Optional ByVal sDriver As String = "", _
Optional ByVal sDataSource As String = "" _
)
Dim eAction As ACTION
If dsnType = SystemDSN Then
eAction = ODBC_REMOVE_SYS_DSN
Else
eAction = ODBC_REMOVE_DSN
End If
If Not ExecuteDSNCommand(dsnType, sDSN_Name, sDriver, _
sDataSource, eAction) Then
With m_Error
If .ETNumber <> 0 Then
Err.Raise .ETNumber, .ETSource, .ETDescription
End If
End With
End If
End Sub
Public Sub ConfigureDSN( _
Optional ByVal dsnType As DSNTypeEnum = UserDSN, _
Optional ByVal sDSN_Name As String = "", _
Optional ByVal sDriver As String = "", _
Optional ByVal sDataSource As String = "" _
)
Dim eAction As ACTION
If dsnType = SystemDSN Then
eAction = ODBC_CONFIG_SYS_DSN
Else
eAction = ODBC_CONFIGURE_DSN
End If
If Not ExecuteDSNCommand(dsnType, sDSN_Name, sDriver, _
sDataSource, eAction) Then
With m_Error
If .ETNumber <> 0 Then
Err.Raise .ETNumber, .ETSource, .ETDescription
End If
End With
End If
End Sub
Private Function mf_DSNRegistryEntry( _
DSN_TYPE As DSNTypeEnum, _
sDSN As String _
) As String
Dim lHKEY As Long
Dim sDBQ As String
Dim hKey As Long
Dim sRegValue As String
Dim lValueType As Long
mf_DSNRegistryEntry = ""
If DSN_TYPE = SystemDSN Then
lHKEY = HKEY_LOCAL_MACHINE
ElseIf DSN_TYPE = UserDSN Then
lHKEY = HKEY_CURRENT_USER
End If
If RegOpenKeyEx(lHKEY, _
"Software\ODBC\ODBC.INI\" & sDSN, _
0, _
KEY_ALL_ACCESS, hKey _
) = 0 Then
sRegValue = String(1024, 0)
If RegQueryValueEx(hKey, _
"DBQ", _
0, _
lValueType, _
sRegValue, _
Len(sRegValue) _
) = 0 Then
If lValueType = REG_SZ Then
sDBQ = Left(sRegValue, InStr(sRegValue, _
vbNullChar) - 1)
End If
End If
RegCloseKey hKey
mf_DSNRegistryEntry = sDBQ
End If
End Function
|