【VB6|第21期】检查SqlServer数据库置疑损坏的小工具（含源码）

日期：2023年7月25日
作者：Commas
签名：(ง •_•)ง 积跬步以致千里,积小流以成江海……
注释：如果您觉得有所帮助，帮忙点个赞，也可以关注我，我们一起成长；如果有不对的地方，还望各位大佬不吝赐教，谢谢^ - ^
1.01³⁶⁵ = 37.7834；0.99³⁶⁵ = 0.0255
1.02³⁶⁵ = 1377.4083；0.98³⁶⁵ = 0.0006

---

---

---

一、前言

当用户电脑、或者我们所要操作的电脑没有 SQL Server Management Studio ，而我们又想确定 SqlServer 中某个数据库是否损坏的时候，这个时候就有点难办了，只能硬着头皮先安装这种大块头的工具，然后再写 DBCC CHECKDB 的语句检测问题，时间基本都花到了安装软件上了。

为了解决这个问题，不妨自己做一个小工具，如下所示：

二、使用说明

（2-1）数据库连接测试

输入服务器名称、用户名登录名以及数据库密码，点击【数据库连接测试】按钮，可以测试参数是否正确；

（2-2）数据库完整性检测

填写需要检测的数据库名称 ，点击【开始检测】按钮

• 正确：

• 数据库置疑的错误：
  

• 数据库不存在的错误：
  

三、实现思路

实现思路很简单，先实现正常连接数据库功能，再实现数据库检测的功能，如下：

（3-1）数据库连接测试

可以通过 CN.Open 和 CN.State （其中 Dim CN As New ADODB.Connection）来判断是否可以正常连接上数据库；

Private Sub CmdPing_Click()
On Error Resume Next
    
    Dim sErr As String: sErr = ""
    Dim CN As New ADODB.Connection
    
    CN.ConnectionString = getConnectionString()
    
    CN.Open

    If CN.State = adStateOpen Then
        MsgBox "连接成功！"
        CN.Close
    Else
        MsgBox "连接失败：" & err.Description
    End If

    Set CN = Nothing
End Sub

其中，获取数据库连接字符串的函数如下所示：

Private Function getConnectionString(Optional ByVal isWinLogin As Boolean = False, Optional ByVal sDbName As String = "master") As String
On Error Resume Next
'函数说明：获取数据库连接字符串
'创建作者：Commas
'创建时间：2023-07-25
'修改时间：
'------传参说明------
'isWinLogin：是否采用 “Windows 身份验证”，默认采用 “SQL Server 身份验证”；
'sDbName：指定需要连接的数据库，默认为master
'------传参说明------
    Dim sCNStr As String
    If isWinLogin Then
        sCNStr = "Provider=SQLOLEDB;Data Source={ServerName};Initial Catalog={DatabaseName};Trusted_Connection=Yes;Persist Security Info=True;"
        If Trim(Me.TxtDB(0).Text) = "127.0.0.1" Then
            sCNStr = Replace(sCNStr, "{ServerName}", ".")
        Else
            sCNStr = Replace(sCNStr, "{ServerName}", Trim(Me.TxtDB(0).Text))
        End If
        sCNStr = Replace(sCNStr, "{DatabaseName}", "master")
    Else
        sCNStr = "Provider=SQLOLEDB;Data Source={ServerName};Initial Catalog={DatabaseName};User Id={Username};Password={Password};"
        '也可以先不指定 Initial Catalog={DatabaseName};
        'sCNStr = "Provider=SQLOLEDB;Data Source={ServerName};User Id={Username};Password={Password};"
        
        sCNStr = Replace(sCNStr, "{ServerName}", Trim(Me.TxtDB(0).Text))
        sCNStr = Replace(sCNStr, "{DatabaseName}", "master")
        sCNStr = Replace(sCNStr, "{Username}", Trim(Me.TxtDB(1).Text))
        sCNStr = Replace(sCNStr, "{Password}", Trim(Me.TxtDB(2).Text))
    End If
    getConnectionString = sCNStr
End Function

（3-2）数据库完整性检测

首先，我们用 SQL 先进行数据库数据库检查，如下：

DBCC CHECKDB ('<DataBaseName>') WITH NO_INFOMSGS;

其中，<DataBaseName> 改为需要检测的数据库名称。

接着，我们借用 CN.Errors （其中 Dim CN As New ADODB.Connection）来捕获精确的错误信息。当执行数据库查询或操作时，ADO 对象会自动将错误信息添加到 Errors 集合中，我们可以通过检查该集合来获取更详细的错误信息，包括错误号、错误描述和可能的原因等。

CN.Execute "DBCC CHECKDB ('" & sDbName & "') WITH NO_INFOMSGS;"
If CN.Errors.Count > 0 Then
    ' 捕获错误并进行相应的处理
    Dim errMsg As ADODB.Error
    For Each errMsg In CN.Errors
        'MsgBox "错误号：" & errMsg.Number & vbCrLf & "错误描述：" & errMsg.Description, vbExclamation
        If InStr(errMsg.Description, "表错误") > 0 Then
            If sErr <> "" Then sErr = sErr & Chr(10)
            sErr = sErr & errMsg.Description
        End If
    Next errMsg
    
    Err.Clear
End If

四、完整源码

Option Explicit

Private Function getConnectionString(Optional ByVal isWinLogin As Boolean = False, Optional ByVal sDbName As String = "master") As String
On Error Resume Next
'函数说明：获取数据库连接字符串
'创建作者：Commas
'创建时间：2023-07-26
'修改时间：
'------传参说明------
'isWinLogin：是否采用 “Windows 身份验证”，默认采用 “SQL Server 身份验证”；
'sDbName：指定需要连接的数据库，默认为master
'------传参说明------
    Dim sCNStr As String
    If isWinLogin Then
        sCNStr = "Provider=SQLOLEDB;Data Source={ServerName};Initial Catalog={DatabaseName};Trusted_Connection=Yes;Persist Security Info=True;"
        If Trim(Me.TxtDB(0).Text) = "127.0.0.1" Then
            sCNStr = Replace(sCNStr, "{ServerName}", ".")
        Else
            sCNStr = Replace(sCNStr, "{ServerName}", Trim(Me.TxtDB(0).Text))
        End If
        sCNStr = Replace(sCNStr, "{DatabaseName}", "master")
    Else
        sCNStr = "Provider=SQLOLEDB;Data Source={ServerName};Initial Catalog={DatabaseName};User Id={Username};Password={Password};"
        '也可以先不指定 Initial Catalog={DatabaseName};
        'sCNStr = "Provider=SQLOLEDB;Data Source={ServerName};User Id={Username};Password={Password};"
        
        sCNStr = Replace(sCNStr, "{ServerName}", Trim(Me.TxtDB(0).Text))
        sCNStr = Replace(sCNStr, "{DatabaseName}", "master")
        sCNStr = Replace(sCNStr, "{Username}", Trim(Me.TxtDB(1).Text))
        sCNStr = Replace(sCNStr, "{Password}", Trim(Me.TxtDB(2).Text))
    End If
    getConnectionString = sCNStr
End Function

Private Sub CmdPing_Click()
On Error Resume Next
    
    Dim sErr As String: sErr = ""
    Dim CN As New ADODB.Connection
    
    CN.ConnectionString = getConnectionString()
    
    CN.Open

    If CN.State = adStateOpen Then
        MsgBox "连接成功！"
        CN.Close
    Else
        MsgBox "连接失败：" & Err.Description
    End If

    Set CN = Nothing
End Sub

Private Sub CheckDatabaseIntegrity(ByVal sDbName As String)
On Error Resume Next
'函数说明：获取数据库连接字符串
'创建作者：Commas
'创建时间：2023-07-25
'修改时间：
'------传参说明------
'sDbName：指定需要连接的数据库，默认为master
'------传参说明------
    Dim sErr As String: sErr = ""
    Dim CN As New ADODB.Connection
    
    ' 设置数据库连接字符串
    CN.ConnectionString = getConnectionString()
    
    ' 打开数据库连接
    CN.Open
    
    ' 设置要执行的 SQL 查询
    CN.Execute "DBCC CHECKDB ('" & sDbName & "') WITH NO_INFOMSGS;"
    If CN.Errors.Count > 0 Then
        ' 捕获错误并进行相应的处理
        Dim errMsg As ADODB.Error
        For Each errMsg In CN.Errors
            'MsgBox "错误号：" & errMsg.Number & vbCrLf & "错误描述：" & errMsg.Description, vbExclamation
            If InStr(errMsg.Description, "表错误") > 0 Then
                If sErr <> "" Then sErr = sErr & Chr(10)
                sErr = sErr & errMsg.Description
            End If
        Next errMsg
        
        Err.Clear
    End If
    
    ' 关闭数据库连接
    CN.Close

    If sErr <> "" Then
        MsgBox "【" & "SuperMarket" & "】检测异常,详情如下：”" & Chr(10) & sErr
    Else
        MsgBox "【" & sDbName & "】检测正常"
    End If
End Sub
        
Private Sub CmdRun_Click()
On Error Resume Next
    Call CheckDatabaseIntegrity(Me.TxtDB(3).Text)
End Sub

---

版权声明：本文为博主原创文章，如需转载，请给出：
原文链接：https://blog.csdn.net/qq_35844043/article/details/131915284