请问用VB6怎么制作可连接到SQL数据库的应用程序（不要安装驱动的方法）？

ODBC API方式Option Explicit
Dim iStatus As Integer
Dim sResult As String
Dim iSize As Integer
Dim strConnect As String
Dim lRet As Long, lErrNo As Long
Dim iLen As Integer
Dim sSQLState As String * MAX_DATA_BUFFER
Dim sErrorMsg As String * MAX_DATA_BUFFER
Dim sMsg As String
Dim bolP As Integer
Dim lOutLen As Long
Dim ODBCInit As Boolean '标记初始化ODBC是否成功
Dim strDSN As String    'DSN数据源名称
Dim strUID As String    '用户名称
Dim strPWD As String    '用户密码
Dim strAPP As String    '
Dim strDataBase As String
Dim strSQL As String    '用于存储SQL语句
Dim lngP As Long
Dim strName As String * MAX_DATA_BUFFER
Dim strAge As String * MAX_DATA_BUFFER
Dim strNumber As String * MAX_DATA_BUFFER
Dim lngRow As LongPrivate Sub btnP_Click()
    strDSN = "Team"
    strUID = ""
    strPWD = ""
    strAPP = ""
    strDataBase = App.Path & "\DBList.mdb"
    '1  分配ODBC连接环境的句柄
    If SQLAllocEnv(lngEnv) <> 0 Then
        MsgBox "不能取得ODBC环境句柄，初始化ODBC连接失败！"
        End
    End If
    '2. 分配ODBC数据库句柄
    If SQLAllocConnect(lngEnv, lngDBHandle) <> 0 Then
        MsgBox "没有内存空间分配给数据库句柄！"
        ODBCInit = False
        iStatus = SQLFreeEnv(lngEnv)      '初始化ODBC失败，释放ODBC环境句柄
        Rem 释放出错时，提示
        If iStatus = SQL_ERROR Then
            MsgBox "释放ODBC环境时出错！"
        End If
        End
    End If
    '3.根据连接字符串连接指定的ODBC数据库
    lngP = SQLConnect(lngDBHandle, strDSN, Len(strDSN), strUID, Len(strUID), strPWD, Len(strPWD))
    If (lngP <> SQL_SUCCESS) And (lngP <> SQL_SUCCESS_WITH_INFO) Then
        MsgBox "不能连接指定的ODBC数据库！"
    End If
    '4. Allocate ODBC Statement Handle
    If SQLAllocStmt(lngDBHandle, lngStmt) <> 0 Then
          MsgBox "分配执行SQL语句的环境句柄失败！"
    End If
    '5. 执行SQL语句
    strSQL = "SELECT * FROM TB_Dealer"   'SQL语句
    Rem 执行SQL语句，如果执行失败，那么取得错误信息
    If SQLExecDirect(lngStmt, strSQL, Len(strSQL)) <> SQL_SUCCESS Then
        lRet = SQLError(lngEnv, lngDBHandle, lngStmt, sSQLState, lErrNo, sErrorMsg, MAX_DATA_BUFFER, iLen)
        sMsg = "执行SQL语句出错！" & Chr$(13) & Chr$(10)
        sMsg = sMsg & "ODBC状态： = " & Trim$(Left$(sSQLState, InStr(sSQLState, Chr$(0)) - 1)) & Chr$(13) & Chr$(10)
        sMsg = sMsg & "ODBC错误信息： = " & Left$(sErrorMsg, iLen)
        MsgBox sMsg, vbInformation, "系统消息"
    End If
    '6.从SQL结果集中一条记录一条记录的读取记录
    lngRow = 1
    Do
        bolP = SQLFetch(lngStmt)        '取得一条记录集
        If bolP = SQL_SUCCESS Then      '如果取记录成功，那么取得记录中的各个字段内容
            bolP = True
            iStatus = SQLGetData(lngStmt, 1, 1, strName, MAX_DATA_BUFFER, lOutLen)
            iStatus = SQLGetData(lngStmt, 2, 1, strAge, MAX_DATA_BUFFER, lOutLen)
            iStatus = SQLGetData(lngStmt, 3, 1, strNumber, MAX_DATA_BUFFER, lOutLen)
            msgTable.TextMatrix(lngRow, 0) = strName
            msgTable.TextMatrix(lngRow, 1) = strAge
            msgTable.TextMatrix(lngRow, 2) = strNumber
        Else
            bolP = False    ' No more rows available
        End If
        lngRow = lngRow + 1
    Loop Until Not bolP Or lngRow >= msgTable.Rows
    Rem 读取记录集完毕，释放执行SQL语句的句柄
    bolP = SQLFreeStmt(lngStmt, SQL_DROP)
    '7.断开数据库连接句柄和数据库的连接
    iStatus = SQLDisconnect(lngDBHandle)
    '8.释放数据库连接句柄
    iStatus = SQLFreeConnect(lngDBHandle)
    '9.释放ODBC环境句柄
    iStatus = SQLFreeEnv(lngEnv)
End SubPrivate Sub Form_Load()
    Dim strDriver As String
    Dim strAttributes As String
    Dim strDSN As String
    Dim strServerName As String
    Dim strDataBase As String
On Error GoTo errLoad
    With msgTable
        .Cols = 3
        .Rows = 8
        .FormatString = "<姓名|^年纪|^号码"
        .ColWidth(0) = 1000
        .ColWidth(1) = 2000
        .ColWidth(2) = 4000
    End With
    strDSN = "Team"
    strServerName = "Microsoft Access Driver (*.mdb)"
    strDataBase = App.Path & "\DBList.mdb"
    strDriver = "Microsoft Access Driver (*.mdb)"
    strAttributes = "DSN=" & strDSN & Chr$(0)
    strAttributes = strAttributes & "Server=" & strServerName & Chr$(0)
    strAttributes = strAttributes & "Database=" & strDataBase
    lngP = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes)    If lngP = 0 Then
        MessageBox hwnd, "创建ODBC数据源失败", "系统提示", vbOKOnly + vbExclamation
'    Else
'        MessageBox hwnd, "创建ODBC数据源成功", "系统提示", vbOKOnly + vbExclamation
    End If

    Exit Sub
errLoad:
    Debug.Print Err.Description
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim lngP As Long
    Rem 动态注销ODBC数据源
'    lngP = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, _
'                "SQL Server" & Chr$(0), _
'                "DSN=DreamTeamSql" & Chr$(0))
'    If lngP = 0 Then
'        MessageBox hwnd, "删除ODBC数据源失败", "系统提示", vbOKOnly + vbExclamation
'    End If
End Sub
ADO对象直接连接SqlServer'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'模块功能：专用于操作SQL Server数据库的模块
'功能描述：设计语言：VB6.0+SP6
'        ：提供SQL Server 2000数据库的连接、查询、修改等操作功能
'设计单位：
'设计者：
'设计时间：2009年5月
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Option Explicit
'变量声明区域
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public strOperateErrorMemo As String    '操作数据库失败时的描述信息
'API函数声明区
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％'自定义函数声明区
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'函数功能：连接数据库
'参数说明：strSqlName：Sql服务器名称；   strDataBaseName：数据库名称；
'        ：strUserName：登录用户名称（可以为空）；  strPassword：登录密码（可以为空）
'        ：cnnP：ADO数据源对象，用于连接数据库，参数传递类型必须为传引用！
'返回说明：连接数据库成功返回：True     失败返回：False
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Function funConnectDataBase(ByVal strSqlName As String, _
                                   ByVal strDataBaseName As String, _
                                   ByVal strUserName As String, _
                                   ByVal strPassWord As String, _
                                   ByRef cnnP As ADODB.Connection) As Boolean
    Dim strConnect As String        '连接数据库的字符串
On Error GoTo errFun
    Set cnnP = New ADODB.Connection
    strConnect = "PROVIDER=MSDASQL;" & _
                 "DRIVER={SQL Server};" & _
                 "SERVER=" & strSqlName & ";" & _
                 "DATABASE=" & strDataBaseName & ";" & _
                 "UID=" & strUserName & ";" & _
                 "PWD=" & strPassWord
    cnnP.ConnectionString = strConnect
    cnnP.Open
    funConnectDataBase = True       '连接成功
    strOperateErrorMemo = ""
    Exit Function
errFun:
    funConnectDataBase = False      '连接失败
    strOperateErrorMemo = Err.Description
    Set cnnP = Nothing
End Function
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'函数功能：执行SQL语句
'参数说明：cnnP：数据源连接对象；   adoP：记录集对象；  strSql：Sql语句；
'        ：bolHaveRecord：是否返回记录集  True：要返回值，False：不要返回值
'返回说明：True：执行成功   False：执行失败
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Function funSQLExecute(ByRef cnnP As ADODB.Connection, ByRef adoP As ADODB.Recordset, _
                              ByVal strSql As String, ByVal bolHaveRecord As Boolean) As Boolean

On Error GoTo errFun    Set adoP = New ADODB.Recordset
    Set adoP.ActiveConnection = cnnP
    adoP.Open strSql, cnnP, adOpenDynamic, adLockBatchOptimistic
    If Not bolHaveRecord Then Set adoP = Nothing
    funSQLExecute = True
    strOperateErrorMemo = ""
    Exit Function
errFun:
    funSQLExecute = False
    strOperateErrorMemo = Err.Description
    Set adoP = Nothing
    Set cnnP = Nothing
End Function
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
'函数功能：关闭数据库连接，关闭记录集
'功能描述：
'％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％％
Public Function funCloseDataBase(ByRef cnnP As ADODB.Connection, ByRef adoP As ADODB.Connection) As Boolean
On Error GoTo errFun
    Set cnnP = Nothing
    Set adoP = Nothing
    Exit Function
errFun:End Function

调试易

请问用VB6怎么制作可连接到SQL数据库的应用程序（不要安装驱动的方法）？

解决方案 »