VB6 连接SQL Server数据库实例

Option Explicit

''************************************
''在这里修改数据库参数

Const IP As String = "10.28.14.30"   ''SQL数据库地址
Const PORT As String = "1433"        ''SQL数据库端口
Const USER As String = "vbxym"       ''SQL用户名
Const PASS As String = "vbxym"       ''SQL用户密码
Const DBNAME As String = "db_vbxym"  ''SQL数据库

''************************************
'''引用ADO2.8
Private CN As ADODB.Connection  ''定义连接
Private RS As ADODB.Recordset   ''定义数据集
Public TF As Boolean ''数据库初始化状态判断

''返回SQL连接字符串
Private Function CN_STR() As String

On Error GoTo er
    Dim STR As String
    STR = STR & "Provider=SQLOLEDB.1;Persist Security Info=false;"  ''sql驱动
    STR = STR & "Data Source=" & IP & "," & PORT & ";"  ''数据库地址和端口
    STR = STR & "Initial Catalog=" & DBNAME & ";"  ''数据库名
    STR = STR & "User ID=" & USER & ";"   ''用户名
    STR = STR & "Password=" & PASS & ";"  ''用户密码
    STR = STR & ", , , adAsyncConnect"  ''连接属性
    CN_STR = STR
    Exit Function
er:
   MsgBox "字符拼接错误!", vbCritical, "警告"
    
End Function

''初始化数据库
Public Function RESET_DB() As Boolean

On Error GoTo er
    Set CN = New ADODB.Connection
    Set RS = New ADODB.Recordset
    If CN.State = adStateOpen Then CN.Close  ''判断数据库是否已经打开
    CN.ConnectionTimeout = 10  ''设置连接超时
    CN.Open CN_STR  ''打开数据库
    If CN.State = adStateOpen Then  ''判断是否打开
        RESET_DB = True
        TF = True
    Else
        TF = False
        RESET_DB = False
    End If
    Exit Function
er:
   RESET_DB = False
    
End Function


''执行SQL语句
Public Function CMD_SQL(ByVal sql As String) As Boolean
    
On Error GoTo er
    If TF = False Then MsgBox "数据库没有初始化!", vbCritical, "警告": Exit Function
    If CN.State <> adStateOpen Then  ''判断数据是否打开
        CMD_SQL = False
        Exit Function
    Else
        CN.Execute sql  ''执行SQL
        CMD_SQL = True
    End If
    Exit Function
er:
   CMD_SQL = False
   
End Function

''获取SQL记录集
Public Function SELECT_SQL(ByVal sql As String) As Object ''ADODB.Recordset

On Error GoTo er
    If TF = False Then MsgBox "数据库没有初始化!", vbCritical, "警告": Exit Function
    If CN.State <> adStateOpen Then  ''判断数据是否打开
        Exit Function
    Else
        Set RS = New ADODB.Recordset
        RS.CursorLocation = adUseClient  ''客户端指针
        RS.Open sql, CN, adOpenKeyset, adLockPessimistic  ''执行SQL
        Set SELECT_SQL = RS
    End If
    Exit Function
er:
    Set SELECT_SQL = Nothing
End Function

Option Explicit

Dim MSQL As New CLS_VB6_SQL
Private Sub Command2_Click()
    If MSQL.TF = True Then
        Dim RS As ADODB.Recordset
        Set RS = MSQL.SELECT_SQL("SELECT * FROM tb_test")
        Set MSHFlexGrid1.DataSource = RS.DataSource
        'MsgBox RS.RecordCount
    Else
        MsgBox "数据库没有初始化!"
    End If
End Sub

Private Sub Form_Load()
    MSQL.RESET_DB
End Sub

https://www.lanzous.com/i6lmi4b