在WIN2000中自动实现ODBC配置的问题？？请大家一起来探讨探讨！！！

Question

可以，搜索以前的贴子，很多
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

Answer 1

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 2

留几天请大家发表意见！！
谢谢daviddivad和 hsn1982

Answer 3

最简单的方法就是用DAO来注册数据源了，DAO.DBEngine.RegisterDatabase就可以啦

Answer 4

HOWTO: Programmatically Create a DSN for SQL Server with VBhttp://support.microsoft.com/default.aspx?scid=KB;en-us;q184608

Answer 5

我知道！
谢谢，chenyu5188(蓝色情调)的提醒！