×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript FAQ

Call COM components from VBScr

How to create a DSN programmatically and call it from VBScript by caf
Posted: 24 Nov 00

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.


Back to VBScript FAQ Index
Back to VBScript Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close