关 SQLDMO 组件在一些用法!

 
今天做一个恢复数据库的程序时，突然想起 SqlServer 有一个功能强大的组件 sqldmo ，与是查阅了一下它的相关帮助，发现它刚好能够满足我的需求：
下面是我的程序的部代码，在这里共享组大家分享。

以下代码在 VB6中文版中编译通过！

启动数据服务：
Public Sub Start_server()
    Dim svr As New SQLDMO.sqlServer
    On Error GoTo errHwnd
    svr.Start False, MyServer
    svr.Close
    Exit Sub
errHwnd:
    If Err.Number <> -2147023840 Then
        MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "错误"
    End If
End Sub

联接并验证密码：
Public Function ConnServer(ByVal sqlServer As String, ByVal uid As String, ByVal pwd As String) As Boolean
    Dim st As SQLDMO_SVCSTATUS_TYPE
    Dim svr As New SQLDMO.sqlServer
    On Error GoTo errHwnd
    svr.LoginTimeout = 10
    svr.Connect sqlServer, uid, pwd
    ConnServer = True
    Exit Function
errHwnd:
    If Err.Number = -2147203048 Then
        MsgBox "登录失败密码不正确，请重新输入！", vbInformation, "提示"
    Else
        Resume Next
    End If
End Function

恢复数据库时如果要重新部署数据库特理文件位置需注意设置
恢复数据库:
Public WithEvents ores As SQLDMO.Restore                '声明事件注意此行放在过程调用之前
Private Sub RestoreData(ByVal dataFile As String)
    On Error GoTo errHwd
    Dim oSql As SQLDMO.sqlServer
    Set ores = New SQLDMO.Restore
    Set oSql = New SQLDMO.sqlServer
    oSql.LoginSecure = False
    oSql.Connect ServerName, sqlUser, sqlPwd            '联接数据服务
    ores.Action = SQLDMORestore_Database                '恢复类型数据库
    ores.Database = "Rcrs"                              '数据库名称
    ores.ReplaceDatabase = True                         '替代现有数据库如不存则创建它
    ores.Files = dataFile                               '备份文件名,如果是多个设备上的需使用.Devices属性
    ores.DatabaseFiles = dataFile                  '数据库文件此参数必须设置否则无法使用 relocatefiles
    ores.FileNumber = 1                                 '文件在设备上的ID号如果你只有一个文件就是1
    'RelocateFiles 重新部署数据库逻辑名'"[逻辑名],[物理文件名地址]"
    ores.RelocateFiles = "[tyrs2_data]" & "," & "[" & App.Path & "\rcrs_data.mdf]," & _
                        "[tyrs2_log]" & "," & "[" & App.Path & "\rcrs_log.ldf]"
    DoEvents
    ores.SQLRestore oSql                                '调用恢复方法
    Set ores = Nothing
    Set oSql = Nothing
    Exit Sub
errHwd:
    Select Case Err.Number
        Case -2147221499
            '这个错误尚不知道原因，但不影响操作结果
            Resume Next
        Case -2147218403
            MsgBox "数据库正在使用，请关闭所有正在使用数据的程序！", vbExclamation, "错误"
        Case Else
            MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "提示"
    End Select
End Sub
'恢复事件
Private Sub ores_PercentComplete(ByVal Message As String, ByVal Percent As Long)
        ProBar.Value = ProBar.Max * (Percent / 100)      '设置进度条
End Sub