VB6.0动态添加、修改、删除ODBC的DSN

动态管理DSN的方法网上有很多，但大都是通过SQLConfigDataSource这个函数来完成，不过这还不是最根本的方法，最彻底的当然是直接修改注册表，但那样有些麻烦，ODBC 2.0中提供了直接来修改注册表以达到管理DSN目的的函数，这才是最直接的方法，有一些ODBC的驱动，如果你使用SQLConfigDataSource并不会达到预期的目的，比如我现在所碰到的XTG Systems InterBase6 ODBC driver这个驱动，在你调用SQLConfigDataSource后还是会出现对话框，这很讨厌，所以我这篇文章的目的是，绕过ODBC驱动程序，直接创建、修改、删除DSN，这里我仅以用户DSN来说明。

首先说明一点，DSN其实存在于注册表中，创建、修改、删除DSN的工作都是针对注册表的，以这里的XTG Systems InterBase6 ODBC driver驱动为例，它在安装时，把驱动文件拷贝到系统文件夹后，在注册表中创建下列项：

[HKEY_LOCAL_MACHINE/SOFTWARE/ODBC/ODBCINST.INI/XTG Systems InterBase6 ODBC driver]

对于我们来说，创建一个用户DSN比如说sqTest，就相当于在注册表中下列项[HKEY_CURRENT_USER/Software/ODBC/ODBC.INI/ODBC Data Sources]中添加一个值：
"sqTest"="XTG Systems InterBase6 ODBC driver"
然后在[HKEY_CURRENT_USER/Software/ODBC/ODBC.INI]中添加一项sqTest，然后把属性值写入到sqTest中。

就是这么简单，通过ODBC 2.0中提供的函数来实现就非常容易了。

ODBC 2.0中提供了两个函数：
SQLGetPrivateProfileString 用来从注册表中读取DSN信息
SQLWritePrivateProfileString 用来写入DSN信息到注册表

我把自己的示例代码附在这里，相信聪明的你一看就知道了：

'模块ConfigDsn.bas
Option Explicit

Public Const ODBC_ADD_DSN = 1
Public Const ODBC_CONFIG_DSN = 2
Public Const ODBC_REMOVE_DSN = 3
Public Const ODBC_ADD_SYS_DSN = 4
Public Const ODBC_CONFIG_SYS_DSN = 5
Public Const ODBC_REMOVE_SYS_DSN = 6
Public Const ODBC_REMOVE_DEFAULT_DSN = 7

Private sqBuffer As String * 100

'这里定义了一些驱动需要的属性，你可以视你的驱动需要相应地
'    修改源代码中这部分的内容
Private Type cfgDSN
    dsn As String
    dbname As String
    drvfile As String
    drv As String
    charset As String
    role As String
End Type

Private Declare Function SQLGetPrivateProfileString Lib "ODBCCP32.DLL" (ByVal lpszSection As String,

ByVal lpszEntry As String, ByVal lpszDefault As String, ByVal RetBuffer As String, ByVal cbRetBuffer

As Long, ByVal lpszFilename As String) As Long
Private Declare Function SQLWritePrivateProfileString Lib "ODBCCP32.DLL" (ByVal lpszSection As

String, ByVal lpszEntry As String, ByVal lpszString As String, ByVal lpszFilename As String) As Long

Public Sub ConfigDSN(fRequest As Integer, lpszDriver As String, lpszAttributes As String)
    Dim dsn As String    '获得DSN名称,形如DSN=..;以分号判定名称结束
    Dim ds As cfgDSN
   
    dsn = GetFieldValue(lpszAttributes, "DSN")
    If dsn = "" Then Exit Sub
   
    Select Case fRequest
        Case ODBC_REMOVE_DSN        '删除
            SQLWritePrivateProfileString "ODBC Data Sources", dsn, vbNullString, "ODBC.INI"
            SQLWritePrivateProfileString dsn, vbNullString, vbNullString, "ODBC.INI"
           
        Case ODBC_CONFIG_DSN        '修改
            Dim str As String
            str = GetFieldValue(lpszAttributes, "Rename")
            If str <> "" Then
                ds.dsn = str
            Else
                ds.dsn = dsn
            End If
            ds.drv = lpszDriver
            SQLGetPrivateProfileString lpszDriver, "Driver", "", sqBuffer, 100, "ODBCINST.INI"
            ds.drvfile = Trim(sqBuffer)
           
            '从注册表获得已有信息
            SQLGetPrivateProfileString dsn, "Database", "", sqBuffer, 100, "ODBC.INI"
            ds.dbname = Trim(sqBuffer)
            SQLGetPrivateProfileString dsn, "CharacterSet", "", sqBuffer, 100, "ODBC.INI"
            ds.charset = Trim(sqBuffer)
            SQLGetPrivateProfileString dsn, "Role", "", sqBuffer, 100, "ODBC.INI"
            ds.role = Trim(sqBuffer)
           
            '从传递来的参数中获得修改信息
            str = GetFieldValue(lpszAttributes, "Database")
            If str <> "" Then ds.dbname = str
            str = GetFieldValue(lpszAttributes, "CharacterSet")
            If str <> "" Then ds.charset = str
            str = GetFieldValue(lpszAttributes, "Role")
            If str <> "" Then ds.role = str
       
            '删除DSN
            SQLWritePrivateProfileString "ODBC Data Sources", dsn, vbNullString, "ODBC.INI"
            SQLWritePrivateProfileString dsn, vbNullString, vbNullString, "ODBC.INI"
           
            '把ds的信息写入注册表
            SQLWritePrivateProfileString ds.dsn, "Description", "夏克DSN管理器自动添加或修改的DSN信息(C)2005", "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "Driver", ds.drvfile, "ODBC.INI"
            SQLWritePrivateProfileString "ODBC Data Sources", ds.dsn, ds.drv, "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "Database", ds.dbname, "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "CharacterSet", ds.charset, "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "Role", ds.role, "ODBC.INI"
       
        Case ODBC_ADD_DSN           '添加
            '删除可能存在的同名DSN
            SQLWritePrivateProfileString "ODBC Data Sources", dsn, vbNullString, "ODBC.INI"
            SQLWritePrivateProfileString dsn, vbNullString, vbNullString, "ODBC.INI"
           
            ds.drv = lpszDriver
            ds.dsn = dsn
            ds.dbname = GetFieldValue(lpszAttributes, "Database")
            ds.charset = GetFieldValue(lpszAttributes, "CharacterSet")
            ds.role = GetFieldValue(lpszAttributes, "Role")
            SQLGetPrivateProfileString lpszDriver, "Driver", "", sqBuffer, 100, "ODBCINST.INI"
            ds.drvfile = Trim(sqBuffer)
           
            '把ds的信息写入注册表
            SQLWritePrivateProfileString ds.dsn, "Description", "夏克DSN管理器自动添加或修改的DSN信息(C)2005", "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "Driver", ds.drvfile, "ODBC.INI"
            SQLWritePrivateProfileString "ODBC Data Sources", ds.dsn, ds.drv, "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "Database", ds.dbname, "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "CharacterSet", ds.charset, "ODBC.INI"
            SQLWritePrivateProfileString ds.dsn, "Role", ds.role, "ODBC.INI"
           
        Case Else
            '暂不支持
    End Select
End Sub

Private Function GetFieldValue(Attributes As String, FiledName As String) As String
    Dim iStart As Integer, iEnd As Integer
    Dim UAttributes As String
    Dim UFiledName As String
   
    UAttributes = UCase(Attributes)
    UFiledName = UCase(FiledName)
   
    Dim iLen As Integer
    iLen = Len(UFiledName & "=")
   
    iStart = InStr(UAttributes, UFiledName & "=")
    If iStart > 0 Then
        iEnd = InStr(iStart, UAttributes, ";")
        If iEnd > 0 Then
            GetFieldValue = Mid(Attributes, iStart + iLen, iEnd - iStart - iLen)
        Else
            GetFieldValue = Mid(Attributes, iStart + iLen)
        End If
    End If
End Function

'-------------------------------------------------------
'-------------------------------------------------------

'界面Form1.frm

'说明：TextDriver中输入驱动名称，就是在调用ODBC连接字符串中Driver=后面的那个
'在这里我以XTG Systems InterBase6 ODBC driver为例
'TextAttr输入属性参数，例如下例是个常见的格式
'DSN=sqTest001;
'Database=C:/../data/123.gdb;
'这样如果要选择添加按钮的话，就会增加一个叫sqTest001的DSN

'如果你要修改DSN的名字，我特意提供了一个Rename参数，例如：
'DSN=sqTest001;
'Database=C:/../data/123.gdb;
'Rename=sqTest002
'这样如果选修改按钮的话，就会把sqTest001修改为sqTest002

'如果要删除，则
'DSN=sqTest002;
'然后按删除按钮

'代码很好懂，不多罗嗦，看不懂的话可以给我联系sequh@126.com 夏克

Option Explicit

Private Sub Command1_Click()
    ConfigDSN ODBC_ADD_DSN, TextDriver, TextAttr
    MsgBox "OK"
End Sub

Private Sub Command2_Click()
    ConfigDSN ODBC_CONFIG_DSN, TextDriver, TextAttr
    MsgBox "OK"
End Sub

Private Sub Command3_Click()
    ConfigDSN ODBC_REMOVE_DSN, TextDriver, TextAttr
    MsgBox "OK"
End Sub