动态管理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