'----DSN Declarations--------
Option Explicit
Public Enum eDBType
FileBased
ServerBased
End Enum
Public Type tDSNAttrib
Type As eDBType 'FileBased (eg Access) or ServerBased (eg. SQL Server)
Server As String 'Database Server
Description As String 'Database description
DSN As String 'The DSN Name
Driver As String 'The Drive name
Database As String 'Name or path of database
UserID As String 'The UserID
Password As String 'The User Password
TrustedConnection As Boolean 'If True ignore the UserID and Password as will us NT
SystemDSN As Boolean 'If True creates a system DSN, else creates a user DSN.
End Type
Private Const ODBC_ADD_DSN = 1
Private Const ODBC_CONFIG_DSN = 2
Private Const ODBC_REMOVE_DSN = 3
Private Const ODBC_ADD_SYS_DSN = 4
Private Const ODBC_CONFIG_SYS_DSN = 5
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
'Purpose : Creates a new DSN
'Inputs : tAttributes A type containing the input parameters for the DSN.
' Look in either "C:\WINNT\Odbc.ini" or the registry under "HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI"
' for typical details.
'Outputs : Returns True if successful
'Author : Andrew Baker
'Date : 15/01/2001 11:55
'Notes : If TrustedConnection is set to False, then you must supply a valid UID
' and PWD (username and password), otherwise the DSN will not be created.
'Revisions :
'Assumptions :
Public Function DSNCreate(tAttributes As tDSNAttrib) As Boolean
Dim lRet As Long
Dim sAttributes As String
On Error Resume Next
If tAttributes.Type = FileBased Then
'File based database
sAttributes = "DBQ=" & tAttributes.Database & vbNullChar
Else
'Server based database
sAttributes = "Server=" & tAttributes.Server & vbNullChar
sAttributes = sAttributes & "DATABASE=" & tAttributes.Database & vbNullChar
End If
'Name of DSN
sAttributes = sAttributes & "DSN=" & tAttributes.DSN & vbNullChar
If Len(tAttributes.Description) Then
'Description
sAttributes = sAttributes & "DESCRIPTION=" & tAttributes.Description & vbNullChar
End If
If tAttributes.TrustedConnection Then
'Use Windows NT Authentication
'(will only validate the username and password when connection to the database)
sAttributes = sAttributes & "Trusted_Connection=Yes" & vbNullChar
Else
'Specify a username and password (must specify a valid username and password)
If Len(tAttributes.UserID) Then
sAttributes = sAttributes & "UID=" & tAttributes.UserID & vbNullChar
End If
If Len(tAttributes.Password) Then
sAttributes = sAttributes & "PWD=" & tAttributes.Password & vbNullChar
End If
End If
If tAttributes.SystemDSN Then
'Create a system DSN (visible to all users and services)
DSNCreate = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, tAttributes.Driver, sAttributes)
Else
'Create a user DSN (visible to the current users)
DSNCreate = SQLConfigDataSource(0&, ODBC_ADD_DSN, tAttributes.Driver, sAttributes)
End If
End Function
'Purpose : Deletes an existing DSN
'Inputs : tAttributes A type containing the input parameters of the DSN.
' Look in either "C:\WINNT\Odbc.ini" or the registry under "HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI"
' for typical details.
' [bSystemDSN] If True deletes as system DSN, else deletes a user DSN.
'Outputs : Returns True if successful
'Author : Andrew Baker
'Date : 15/01/2001 11:55
'Notes :
'Revisions :
'Assumptions :
Public Function DSNDelete(sDSN As String, sDriver As String, Optional bSystemDSN As Boolean = False) As Boolean
Dim lRet As Long
Dim sAttributes As String
On Error Resume Next
sAttributes = "DSN=" & sDSN & vbNullChar
If bSystemDSN Then
DSNDelete = SQLConfigDataSource(0&, ODBC_REMOVE_DSN, sDriver, sAttributes)
Else
DSNDelete = SQLConfigDataSource(0&, ODBC_REMOVE_SYS_DSN, sDriver, sAttributes)
End If
End Function
'Demonstration routine
Sub Test()
Dim tDSNDetails As tDSNAttrib
'---Add an Access DSN
With tDSNDetails
.Database = "C:\vbusers.mdb"
.Driver = "Microsoft Access Driver (*.mdb)"
.Password = ""
.UserID = "Admin"
.DSN = "TestDSN"
.Description = "A Test Database"
.Type = FileBased
End With
If DSNCreate(tDSNDetails) Then
MsgBox "Created user DSN"
'Delete the new DSN
If DSNDelete(tDSNDetails.DSN, tDSNDetails.Driver) Then
MsgBox "Deleted New DSN"
Else
MsgBox "Failed to Delete New DSN"
End If
Else
MsgBox "Failed to Create DSN"
End If
'---Add an SQL Server DSN
With tDSNDetails
.Database = "Pubs"
.Driver = "SQL Server"
.Server = "MyServer"
.TrustedConnection = True 'Use NT authentication
.Password = ""
.UserID = ""
.DSN = "TestDSN2"
.Description = "A Test Database2"
.Type = ServerBased
.SystemDSN = True 'Create a System DSN
End With
If DSNCreate(tDSNDetails) Then
MsgBox "Created system DSN"
'Delete the new DSN
If DSNDelete(tDSNDetails.DSN, tDSNDetails.Driver) Then
MsgBox "Deleted New DSN"
Else
MsgBox "Failed to Delete New DSN"
End If
Else
MsgBox "Failed to Create DSN"
End If
End Sub
Reply With Quote
