How to create a DSN programmatically and call it from VBScript

I'll provide the source code to the ActiveX DLL that allows you to configure, delete & add new DSNs User or System programmatically. It's bundled into an ActiveX dll so that it can be called from ASP/VBScript since VBScript cannot make API calls.

The ActiveX component handles the API calls so you still have to make sure those DLL's are present on your system.

The DLL's referenced are:
odbccp32.dll
advapi32.dll
the 32 obviously specifying that they're 32 bit

Here's the source code for the ActiveX DLL
You're goinf to need at least the Professional Edition of VB (32 bit) so that you can compile the dll.
For those of you who don't have VB or the appropriate edition of vb can get the dll here ...

http://caf.homepage.com/vbp/odbc/odbc_dll.zip

Option Explicit

Private Declare Function SQLConfigDataSource Lib "odbccp32.dll" ( _
ByVal hwndParent As Long, _
ByVal fRequest As Integer, _
ByVal lpszDriver As String, _
ByVal lpszAttributes As String _
) As Long

Private Declare Function RegCloseKey Lib "advapi32" ( _
ByVal hKey As Long _
) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByRef lpType As Long, _
ByVal lpData As String, _
ByRef lpcbData As Long _
) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal samDesired As Long, _
phkResult As Long _
) As Long

Private Const REG_BINARY& = 3 ' Free form binary
Private Const REG_SZ& = 1 ' Unicode null terminated string
Private Const HKEY_CURRENT_USER& = &H80000001
Private Const HKEY_LOCAL_MACHINE& = &H80000002
Private Const KEY_ALL_ACCESS& = &H2003F

Public Enum ACTION
ODBC_ADD_DSN& = 1 ' Add User data source
ODBC_CONFIGURE_DSN& = 2 ' Configure existing DSN
ODBC_REMOVE_DSN& = 3 ' Delete data source
'ODBC Version 2.5 & higher
ODBC_ADD_SYS_DSN& = 4 ' Add system data source
ODBC_CONFIG_SYS_DSN& = 5 ' Modify an existing system data source
ODBC_REMOVE_SYS_DSN = 6 ' Remove an existing system data source
'ODBC Version 3.0
ODBC_REMOVE_DEFAULT_DSN& = 7 ' Remove the default data source. Experienced users only!
End Enum

Public Enum DSNTypeEnum
UserDSN& = 0
SystemDSN& = 1
End Enum

Private Const mc_DataFileNotFoundError As Long = 1001
Private Const mc_DataFileExistsError As Long = 1002

Private Type ErrorType
ETNumber As Long
ETDescription As String
ETSource As String
End Type

Private m_Error As ErrorType
Private m_ODBC_DSN_Name As String
Private m_ODBC_Driver_Name As String
Private m_ODBC_Data_Source As String
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

Please note that if you get errors when pasting the code make sure it pasted correctly because I noticed the alignment got a bit messed when I pasted it in this window.