急，VB如何通过API在ODBC中加入一个SQL SERVER连接，200分

Question

比较的难，以前尝试过这样的努力，但是以失败告终。
为什么要用 ODBC 数据源呢？用连接字符串 ConnectionString 不是很好吗？

Answer 1

vb应用程序访问sql server方法探讨（2）
 出处：eNet学院
责任编辑：pjl
 
[01-11-22 20:07]  作者：  方法2.用odbc api编程 　　odbc(open database connectivity)的思想是访问异种数据库的一种可移植的方式。与数据资源对话的公用函数组装在一个称为驱动程序管理器(odbc.dll)的动态连接中。应用程序调用驱动程序管理器中的函数，而驱动程序管理器反过来通过驱动器反过来通来驱动器(sqlsrvr.dll)把它们送到服务器中。　　用odbc api编程，一般要用到以下一些函数。下面列出了常用的函数以及它们的功能。 　　下面的代码使用上面一些函数先登录到一个服务器数据库，并为随后的工作设置了语句句柄。 global gihenv as long global gihdb as long global gihstmt as long dim myresult as integer dim myconnection as srting dim mybuff as string*256 dim mybufflen as integer if sqla||ocenv(gihenv)<>sql_success then msgbox"a||ocation couldn’t happen!" end if if sql||occonnect(gihenv,gihdb)<>sql_success then msgbox "sql server couldn’t connect!" end if myconnection="dsn=myserver;uid=|c|;pwd=;app=odbctest;ws|d=lcl;
database=sales" myresult=sqldriverconnect(gihdb,test,form1.hwnd,myconnection
.len(myconnection), mybuff,256,mybufflen,sql_driver_complete_requied) myresult=sqla||ocstmt(gihds,gihstmt) myresult=sqlfreestmt(gihstmt,sql_colse) rssql="select*from customers where city="wuhan"" myresult=sqlexecdirect(gihstmt,rssql,len(rssql)) 
请参照:http://www.pconline.com.cn/pcedu/empolder/gj/vb/10111/14229.html

Answer 2

这是我在一个项目中用到方法：
先在 工程--引用  引用DAO3.51
新建工程，加一命令按纽Private Sub Command1_Click()
Dim servername As String, xt As String
servername = "youservername"
xt = "Description=SQL数据库ODBC" & vbCr & "Server=" & servername & vbCr & "Database=pubs"
DBEngine.RegisterDatabase "youODBCname_" & servername, "SQL Server", True, xt
End Sub至于得到服务器和密码及打开的方法有n种

Answer 3

to qyyayong(小李飞刀) 不可能到每台客户端去注册.

Answer 4

把以下代码放到一个类模块中：
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在程序中调用如下：假设类模块为clsDataBase
Private Sub Command1_Click()
    Dim uCls As New clsDataBase
    Dim bRet As Boolean
    bRet = uCls.fun_CreateDSN("Test", "Microsoft Access Driver (*.mdb)", eSysDSN, "", "C:\Bible.mdb", "", "", "Just a Test")
    If bRet Then
        MsgBox "Create DSN Success!", vbInformation
    Else
        MsgBox "Create DSN Fault!", vbExclamation
    End If
    Set uCls = Nothing
End Sub
Private Sub Command2_Click()
    Dim uCls As New clsDataBase
    Dim bRet As Boolean
    bRet = uCls.fun_CreateDSN("test", "SQL Server", eSysDSN, "sqltest", "", "test", "test", "Just a test")
    If bRet Then
        MsgBox "Create DSN Success!", vbInformation
    Else
        MsgBox "Create DSN Fault!", vbExclamation
    End If
    Set uCls = Nothing
End Sub
Private Sub Command3_Click()
    Dim uCls As New clsDataBase
    Dim lngRet As Long
    Dim intI As Integer
    Dim strDsns() As String
    Dim strDrvs() As String
    lngRet = uCls.fun_GetDSNsAndDrivers(strDsns, strDrvs)
    If lngRet > 0 Then
    For intI = 1 To lngRet
        Debug.Print strDsns(intI) & vbTab & strDrvs(intI)
    Next intI
    End If
    Set uCls = Nothing
End Sub