如何做一个增加系统DSN的过程

Question

Public Enum e_DSNtype
    eUserDSN = 0    '用户数据源
    eSysDSN         '系统数据源
End EnumPrivate 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_REMOVE_SYS_DSN = 6
Private Const vbAPINull As Long = 0&Private Const SQL_SUCCESS As Long = 0
Private Const SQL_ERROR As Long = -1
Private Const SQL_FETCH_NEXT As Long = 1Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Integer
Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (env As Long) As Integer
'创建数据源   成功返回TRUE，失败返回FALSE
Public Function fun_CreateDSN(ByVal DSNname As String, ByVal ODBCdriver As String, ByVal DSNtype As e_DSNtype, _
                              ByVal SVRname As String, ByVal DBname As String, ByVal User As String, _
                              ByVal pwd As String, ByVal DSNdesc As String) As Boolean
'    DSNname：数据源名
'    ODBCdriver：数据源驱动
'    DSNtype：数据源类型（系统、用户）
'    SVRname：服务器名称
'    DBname：数据库名
'    User：用户名
'    PWD：密码
'    DSNdesc：数据源描述
    On Error Resume Next
    Dim nRet As Long
    Dim sAttributes As String
    If DSNname <> "" Then sAttributes = "DSN=" & DSNname & Chr$(0)
    If DSNdesc <> "" Then sAttributes = sAttributes & "DESCRIPTION=" & DSNdesc & Chr$(0)
    If SVRname <> "" Then sAttributes = sAttributes & "SERVER=" & SVRname & Chr$(0)
    If User <> "" Then sAttributes = sAttributes & "UID=" & User & Chr$(0)
    If pwd <> "" Then sAttributes = sAttributes & "PWD=" & pwd & Chr$(0)
    If InStr(1, LCase$(ODBCdriver), "access") > 0 Then
        If DBname <> "" Then sAttributes = sAttributes & "DBQ=" & DBname & Chr$(0)
    ElseIf InStr(1, LCase$(ODBCdriver), "sql server") > 0 Then
        sAttributes = "DSN=" & DSNname & Chr$(0) & "Server=" & SVRname & Chr$(0) & _
                    "UseProcForPrepare=Yes" & Chr$(0)
    Else
        If DBname <> "" Then sAttributes = sAttributes & "DATABASE=" & DBname & Chr$(0)
    End If
    If DSNtype = eSysDSN Then
        nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, ODBCdriver, sAttributes)
    ElseIf DSNtype = eUserDSN Then
        nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, ODBCdriver, sAttributes)
    Else
        fun_CreateDSN = False
        Exit Function
    End If
    If nRet = 0 Then
        fun_CreateDSN = False
    Else
        fun_CreateDSN = True
    End If
End Function'删除数据源，成功返回TRUE，失败返回FALSE
Public Function fun_DeleteDSN(ByVal DSNname As String, ByVal ODBCdriver As String, ByVal DSNtype As e_DSNtype) As Boolean
'    DSNname：数据源名
'    ODBCdriver：数据源驱动
'    DSNtype：数据源类型（系统、用户）
    On Error Resume Next
    Dim nRet As Long
    Dim sAttributes As String
    sAttributes = sAttributes & "DSN=" & DSNname & Chr$(0)
    If DSNtype = eSysDSN Then
        nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, ODBCdriver, sAttributes)
    ElseIf DSNtype = eUserDSN Then
        nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, ODBCdriver, sAttributes)
    Else
        fun_DeleteDSN = False
        Exit Function
    End If
    If nRet = 0 Then
        fun_DeleteDSN = False
    Else
        fun_DeleteDSN = True
    End If
End Function'搜索系统中所有的DSN(ODBC)数据源和对应的驱动    0表示失败，其余数值表示返回的驱动或数据源的数量（数组从1开始）
Public Function fun_GetDSNsAndDrivers(ByRef strArr_DSNs() As String, ByRef strArr_DRVs() As String) As Long
    Dim int_Ret As Integer
    Dim sDSNItem As String * 1024
    Dim sDRVItem As String * 1024
    Dim int_I As Integer
    Dim sDSN As String
    Dim sDRV As String
    Dim iDSNLen As Integer
    Dim iDRVLen As Integer
    Dim lHenv As Long     '对环境处理
    
    On Error GoTo doError
    
    ReDim strArr_DSNs(0) As String
    ReDim strArr_DRVs(0) As String
    If SQLAllocEnv(lHenv) <> SQL_ERROR Then
        int_I = 0
        sDSNItem = Space(1024)
        sDRVItem = Space(1024)
        int_Ret = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
        Do Until int_Ret <> SQL_SUCCESS
            sDSN = Left$(sDSNItem, iDSNLen)
            sDRV = Left$(sDRVItem, iDRVLen)
            int_I = int_I + 1
            If int_I = 1 Then
                ReDim strArr_DSNs(1 To 1) As String
                ReDim strArr_DRVs(1 To 1) As String
            Else
                ReDim Preserve strArr_DSNs(1 To int_I) As String
                ReDim Preserve strArr_DRVs(1 To int_I) As String
            End If
            strArr_DSNs(int_I) = sDSN
            strArr_DRVs(int_I) = sDRV
            sDSNItem = Space(1024)
            sDRVItem = Space(1024)
            int_Ret = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
        Loop
        fun_GetDSNsAndDrivers = int_I
    Else
        fun_GetDSNsAndDrivers = 0
    End If
    Exit Function
doError:
    fun_GetDSNsAndDrivers = 0
End Function

Answer 1

新增 DSN 的方法有二种：
1、使用 DBEngine 控件的 RegisterDatabase 方法
2、呼叫 SQLConfigDataSource API不管使用以上任何一种方法新增 DSN，一共会写入二个地方，一个是注册表，一个是 ODBC.INI。而刪除 DSN 的方法同上面的第二种方法，呼叫 SQLConfigDataSource API。以下之模块以 Oracle73 Ver 2.5 为例，在 Form 的声明区中加入以下声明及模块：Private Const ODBC_ADD_DSN = 1 ' Add data source
Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data source
Private Const vbAPINull As Long = 0& ' NULL PointerPrivate Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
(ByVal hwndParent As Long, ByVal fRequest As Long, _
ByVal lpszDriver As String, ByVal lpszAttributes As String) As LongPublic Sub CreateDSN(sDSN As String)
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As String
sDriver = "Oracle73 Ver 2.5"
sAttributes = "Server=Oracle8" & Chr$(0)
sAttributes = sAttributes & "DESCRIPTION=" & sDSN & Chr$(0)
'sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)
sAttributes = sAttributes & "DATABASE=DBFinance" & Chr$(0)
sAttributes = sAttributes & "Userid=Scott" & Chr$(0)
'sAttributes = sAttributes & "PWD=myPassword" & Chr$(0)
DBEngine.RegisterDatabase sDSN, sDriver, True, sAttributes '注一
'nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, sDriver, sAttributes) '注二
End SubPublic Sub DeleteDSN(sDSN As String)
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As String
sDriver = "Oracle73 Ver 2.5"
sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)
nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, sDriver, sAttributes)
End Sub
'假设要产生的 DSN 为 Test，实际使用示例如下：Private Sub Command1_Click()
CreateDSN "Test"
End SubPrivate Sub Command2_Click()
DeleteDSN "Test"
End Sub
'而写到系統的数据如下：
1、ODBC.INI[ODBC 32 bit Data Sources]
Test=Oracle73 Ver 2.5 (32 bit)[Test]
Driver32=C:\ORAWIN95\ODBC250\sqo32_73.dll
2、注册表机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources
名称：Test 数据：Oracle73 Ver 2.5机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Test
名称：Description 数据：Test
名称：Driver 数据：C:\ORAWIN95\ODBC250\sqo32_73.dll
名称：Server 数据：Oracle8
名称：UserId 数据：Scott
※注一及注二可任选一种，只要將不使用的方法 Mark 起來即可！
※若您想使用其他之数据库，只要將以上模块稍作修改即可！