我这个程序有问题（数据库还原）

我这个程序有时候可以还原数据库，但有时候不行，我估计是当数据库有连接时，就还原不了数据库，该怎么解决，或者怎样关闭当前所有数据库的连接
Private Sub mnuSystemR_Click()
   Dim gSQLServer As SQLDMO.SQLServer
On Error GoTo ErrHandler:
    If gSQLServer Is Nothing Then
        Set gSQLServer = New SQLDMO.SQLServer
    End If
    gSQLServer.LoginTimeout = 15
    gSQLServer.Connect "(local)", "sa", "sa"
    
    Dim oRestore As SQLDMO.Restore
    
    Dim Msg As String
    Dim Response As String
    Set oRestore = New SQLDMO.Restore
    oRestore.DATABASE = "data"
     CommonDialog1.CancelError = True
   On Error GoTo Errhandler1
   ' 设置标志
   CommonDialog1.Flags = cdlOFNHideReadOnly
   ' 设置过滤器
   CommonDialog1.Filter = "All Files (data*.*)|data*.*"
   ' 指定缺省的过滤器
   CommonDialog1.FilterIndex = 2
   ' 显示“打开”对话框
   '
   Dim riqi As String
   CommonDialog1.FileName = riqi
   CommonDialog1.ShowSave
   ' 显示选定文件的名字
   riqi = CommonDialog1.FileName
    
    oRestore.Files = riqi
    
    '当连接的时候，鼠标变化
    Screen.MousePointer = vbHourglass
    
    '恢复数据库
    oRestore.SQLRestore gSQLServer
    
    '恢复后鼠标返回默认的状态
    Screen.MousePointer = vbDefault
   
    Set oRestore = Nothing
    MsgBox "数据库还原成功！"
    
    Exit SubErrHandler:
    MsgBox "Error " & Err.Description
    Resume Next
Errhandler1:
       ' 用户按了“取消”按钮
   Exit Sub
End Sub

解决方案 »

  1.   

    *********************************************************
    '* 名称：BackupDatabase
    '* 功能：备份数据库
    '* 控件：一个文本框和两个按钮（备份到和确定）
    '*********************************************************
    Public Sub BackupDatabase()
    Dim cn As New ADODB.Connection
    Dim s_path, s_dataexport As String
    s_path = App.Path
    Me.MousePointer = 11   '设置鼠标指针形状
    'student1是需要备份的数据库名称
    s_dataexport = "backup database student1 to disk='" + CommonDialog1.FileName + "'"
    cn.Open "driver={sql server};server=" & d1 & ";database=student1;persist security info=false; userid=sa"  '数据库连接字符串
    '这里不需要连接master数据库，即可完成备份
    cn.BeginTrans
    cn.Execute s_dataexport
    Err.Number = 0
    If Err.Number = 0 Then
        cn.CommitTrans
        MsgBox "数据备份成功！", vbInformation, "提示"
        MsgBox "数据备份文件存放路径:" & CommonDialog1.FileName, vbOKOnly, "提示"
        Unload Me
    Else
        cn.RollbackTrans
        MsgBox "数据备份失败！请检查数据库是否正在打开！", vbCritical, "提示"
    End If
    cn.Close
    Set cn = Nothing
    Me.MousePointer = 1
    End Sub'*********************************************************
    '* 名称：RestoreDataBase
    '* 功能：还原数据库
    '* 控件：一个文本框和两个按钮（ 打开和确定）
    '*********************************************************
    Public Sub RestoreDataBase()
    If Text1.Text = "" Then
        MsgBox "请选择要恢复的数据文件！", vbInformation, "提示"
        Exit Sub
    Else
        ret = MsgBox("数据恢复操作将会覆盖以前的所有数据并且覆盖后无法恢复，您确定要进行恢复操作吗？", vbQuestion + vbOKCancel, "提示")
        If ret = vbOK Then
           Dim cn As New ADODB.Connection
           Dim sn As New ADODB.Recordset
           Dim s_restore As String
           Me.MousePointer = 11
           cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;server=" & d1 & ";Initial Catalog=master;Data Source=127.0.0.1;user id=sa;password=" & d3 & ""
           sn.Open "select  spid  from  sysprocesses  where  dbid=db_id('student1')", cn
            Do While Not sn.EOF
              cn.Execute "kill " & sn("spid")
              sn.MoveNext
            Loop
            sn.Close
            s_restore = "restore database student1 from disk='" + Trim(Text1.Text) + "'  with REPLACE"
            cn.Execute s_restore
             'Debug.Print gs_conn_string
             '此时需要连接master数据库才能完成数据恢复操作
             '同上student1为需要恢复的数据库
            s_restore = "restore database student1 from disk='" + Trim(Text1.Text) + "'"
             'text1一个用于记录需要恢复文件的地址的textbox
            cn.Execute s_restore
            cn.BeginTrans
            If Err.Number = 0 Then
                cn.CommitTrans
                MsgBox "数据恢复成功！", vbInformation, "提示"
                Command1.Enabled = True
                Label1.Visible = False
            Else
                cn.RollbackTrans
                MsgBox "数据恢复失败！", vbCritical, "提示"
                Command1.Enabled = True
            End If
            cn.Close
            Set cn = Nothing
            Me.MousePointer = 1
        Else
            Exit Sub
        End If                      '''''''''''''''''''''''''''''''''''''''''
        On Error Resume Next
        Dim DBC As New DataBaseConnection
        If db.State = 1 Then
           db.Close
        End If
        db.ConnectionString = DBC.SqlConnectString(d1, d2, d3)
        rs.CursorType = adOpenDynamic
        rs.CursorLocation = adUseClient
        rs.LockType = adLockOptimistic
        db.CursorLocation = adUseClient
        db.Open
        Set cmd.ActiveConnection = db
        If Err.Number Then
           MsgBox Err.Description, 16 + vbOKOnly, Err.Number
           Exit Sub
        End If
        db.DefaultDatabase = "student1"
        If Err.Number Then
           MsgBox Err.Description, 16 + vbOKOnly, Err.Number
           Exit Sub
        End If
    End If
    End Sub                      '''''''''''''''''''''''''''''''''''''''''''''如果当前没有与要恢复的数据库立连接，则不需要加单引号中的内容。如果希望恢复数据库之后继续建立连接，则需要写这部分代码。我要恢复数据库名称为student1，备份数据库的时候是在连接状态下进行的，但是恢复数据库不可以在数据库存在连接的状态下进行操作！代码的解决方法是：先连接SQL Server中主库master 库，在该库中的sysprocesses表中存放着所有连接到此数据库的连接信息，将这些连接信息用Kill语句删除。然后再恢复数据库student1，由于用Kill语句后，数据库已经被断开，所以在恢复完成后，再用系统最初的连接数据库代码连接上数据库student1。
      

  2.   

    删除所有的数据库连接CREATE PROCEDURE usp_killDBConnections @DBName varchar(50), @withmsg bit=1
    AS
    SET NOCOUNT ON
    DECLARE @spidstr varchar(8000)
    DECLARE @ConnKilled smallint
    SET @ConnKilled=0
    SET @spidstr = ''IF db_id(@DBName) < 4 
    BEGIN
    PRINT 'Connections to system databases cannot be killed'
    RETURN
    ENDSELECT @spidstr=coalesce(@spidstr,',' )+'kill '+convert(varchar, spid)+ '; '
    FROM master..sysprocesses WHERE dbid=db_id(@DBName)IF LEN(@spidstr) > 0 
    BEGIN
    EXEC(@spidstr) SELECT @ConnKilled = COUNT(1)
    FROM master..sysprocesses WHERE dbid=db_id(@DBName) ENDIF @withmsg =1
    PRINT  CONVERT(VARCHAR(10), @ConnKilled) + ' Connection(s) killed for DB '  + @DBName
    GO
      

  3.   

    '用这个函数
    '恢复数据库,返回出错信息,正常恢复,返回""
    '调用:frestoredatabase_a "备份文件名","数据库名"
    'sDataBasePath  恢复后的数据库存放目录
    'sBackupNumber  是从那个备份号恢复
    'sReplaceExist  指定是否覆盖已经存在的数据
    Public Function fRestoreDatabase_a(ByVal sBackUpfileName$ _
                                    , ByVal sDataBaseName$ _
                                    , Optional ByVal sDataBasePath$ = "" _
                                    , Optional ByVal sBackupNumber& = 1 _
                                    , Optional ByVal sReplaceExist As Boolean = False _
                                    ) As String
        
        Dim iDb As ADODB.Connection, iRe As ADODB.Recordset
        Dim iConcStr$, iSql$, iReturn$, iI&
        
        On Error GoTo lbErr
        
        '创建对象
        Set iDb = New ADODB.Connection
        Set iRe = New ADODB.Recordset
        
        '连接数据库服务器
        iConcStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=zj"
        iDb.Open iConcStr
        
        '得到还原后的数据库存放目录,如果没有指定,存放到SQL SERVER的DATA目录
        If sDataBasePath = "" Then
            iSql = "select filename from master..sysfiles"
            iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
            iSql = iRe(0)
            iRe.Close
            sDataBasePath = Left(iSql, InStrRev(iSql, "\"))
        End If
        
        '检查数据库是否存在
        If sReplaceExist = False Then
            iSql = "select 1 from master..sysdatabases  where name='" & sDataBaseName & "'"
            iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
            If iRe.EOF = False Then
                iReturn = "数据库已经存在!"
                iRe.Close
                GoTo lbExit
            End If
            iRe.Close
        End If
        
        '关闭用户进程,防止其它用户正在使用数据库,导致数据恢复失败
        iSql = "select spid from master..sysprocesses where dbid=db_id('" & sDataBaseName & "')"
        iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
        While iRe.EOF = False
            iSql = "kill " & iRe(0)
            iDb.Execute iSql
            iRe.MoveNext
        Wend
        iRe.Close
        
        '获取数据库恢复信息
        iSql = "restore filelistonly from disk='" & sBackUpfileName & "'" & vbCrLf & _
            "with file=" & sBackupNumber
        iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
        
        '生成数据库恢复语句
        iSql = "restore database [" & sDataBaseName & "]" & vbCrLf & _
            "from disk='" & sBackUpfileName & "'" & vbCrLf & _
            "with file=" & sBackupNumber & vbCrLf
        With iRe
            While Not .EOF
                iReturn = iRe("PhysicalName")
                iI = InStrRev(iReturn, ".")
                iReturn = IIf(iI = 0, "", Mid(iReturn, iI)) & "'"
                iSql = iSql & ",move '" & iRe("LogicalName") & _
                        "' to '" & sDataBasePath & sDataBaseName & iReturn & vbCrLf
                .MoveNext
            Wend
            .Close
        End With
        iSql = iSql & IIf(sReplaceExist, ",replace", "")
        
        iDb.Execute iSql
        iReturn = ""
        GoTo lbExit
        
    lbErr:
        iReturn = Error
    lbExit:
        fRestoreDatabase_a = iReturn
    End Function
      

  4.   

    Option ExplicitDim dmoServer As SQLDMO.SQLServer
    Dim dmoRestore As SQLDMO.Restore
    Dim WithEvents dmoRestoreEvent As SQLDMO.Restore
    Private Sub RestoreDBFromFile(ServerName As String, DBName As String, BackupToRestore As String)
        Dim str As String
        Dim ifExistDB As Boolean
        On Error GoTo Handler
        
        '判断参数
        If ServerName = "" Or DBName = "" Or BackupToRestore = "" Then
          MsgBox "服务器名称，数据库名称，数据库文件不能为空！", vbInformation + vbOKOnly, "错误提示！"
          Exit Sub
        End If
        
        '打开SQL-Server的连接
        Set dmoServer = New SQLDMO.SQLServer
        With dmoServer
            .LoginSecure = True
            .Connect ServerName
        End With
        
        '新的SQL-DMO 的恢复对象
        Set dmoRestore = New SQLDMO.Restore
        '启动事件
        Set dmoRestoreEvent = dmoRestore
        
        With dmoRestore
            '恢复对象的数据库名称
            .Database = DBName
            '指定操作
            .Action = SQLDMORestore_Database
            '强制覆盖现有数据库
            .ReplaceDatabase = True
            '从文件中恢复
            .Files = BackupToRestore
            '匹配逻辑名称 和 物理名称（成对出现）
            
            str = "[test_DATA]" + "," + "[" + Trim(txtSQLPath.Text) + "\" + Trim(TxtDB.Text) + "_data.mdf]"
            str = str + ",[test_Log]" + "," + "[" + Trim(txtSQLPath.Text) + "\" + Trim(TxtDB.Text) + "_log.LDF]"
            
            .RelocateFiles = str
            '开始恢复
            Screen.MousePointer = vbHourglass
            .PercentCompleteNotification = 1
            
            Frame1.Enabled = False
            cmdRestore.Enabled = False
            cmdClose.Enabled = False
            
            .SQLRestore dmoServer
        End With
        
        '下面Verify被恢复的数据库
        dmoRestore.SQLVerify dmoServer
        
        If PGSQL.Value = 100 Then
            PGSQL.Visible = False
            
            lblPercent.Caption = "数据库" & TxtDB.Text & "已经成功被恢复！"
            lblPercent.Visible = True
        End If
        
        '对象关闭
        Set dmoRestore = Nothing
        dmoServer.DisConnect
        Set dmoServer = Nothing
        
        Screen.MousePointer = vbDefault
        
        Frame1.Enabled = True
        cmdRestore.Enabled = True
        cmdClose.Enabled = True    Exit Sub
    Handler:
        Frame1.Enabled = True
        cmdRestore.Enabled = True
        cmdClose.Enabled = True
        
        If Err.Number = -2147221499 Then
            Resume Next
        Else
            MsgBox Err.Number & vbCrLf & Err.Description
            Screen.MousePointer = vbDefault
        End If
    End Sub
    Private Sub cmdClose_Click()
        Unload Me
    End Sub
    Private Sub cmdFile_Click()
        dlgFile.Filter = "全部文件(*.*)|*.*"
        dlgFile.CancelError = False
        dlgFile.ShowOpen
        If dlgFile.FileName = "" Then Exit Sub
        txtPath.Text = dlgFile.FileName
    End SubPrivate Sub cmdRestore_Click()
        Call RestoreDBFromFile(txtServer.Text, TxtDB.Text, txtPath.Text)
    End SubPrivate Sub cmdSQL_Click()
        txtSQLPath.Text = OpenDirectoryTV(frmRestore, "SQL-Server的安装路径!")
    End Sub
    Private Sub dmoRestoreEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
        PGSQL.Value = Percent
        PGSQL.Refresh
        
        DoEvents
    End Sub
    Public Function OpenDirectoryTV(odtvOwner As Form, Optional odtvTitle As String) As String
       Dim lpIDList As Long
       Dim sBuffer As String
       Dim szTitle As String
       Dim tBrowseInfo As BrowseInfo
       szTitle = odtvTitle
       With tBrowseInfo
          .hwndOwner = odtvOwner.hWnd
          .lpszTitle = lstrcat(szTitle, "")
          .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
       End With
       lpIDList = SHBrowseForFolder(tBrowseInfo)
       If (lpIDList) Then
          sBuffer = Space(MAX_PATH)
          SHGetPathFromIDList lpIDList, sBuffer
          sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
          OpenDirectoryTV = sBuffer
       End If
    End Function
    Private Sub Form_Load()
        '=========================================
        ' 读取服务器名
        Dim sqlApp As New SQLDMO.Application
        Dim NL As SQLDMO.NameList
        Dim Index As Integer
        
        Set NL = sqlApp.ListAvailableSQLServers
        For Index = 1 To NL.Count
            txtServer.AddItem NL.Item(Index)
        Next
        Set sqlApp = Nothing
        '=========================================    txtPath.Text = App.Path
    End SubPrivate Sub txtServer_Change()
        On Error Resume Next
        
        txtSQLPath.Text = ""    Set dmoServer = New SQLDMO.SQLServer
        dmoServer.LoginSecure = True
        dmoServer.Connect Trim(txtServer.Text)
        txtSQLPath.Text = dmoServer.Registry.SQLDataRoot + "\Data"
        Set dmoServer = Nothing
    End SubPrivate Sub txtServer_Click()
        txtServer_Change
    End Sub