我想在vb程序中点击'恢复'按钮就可以恢复sql数据库,点击'备份'按钮可以备份sql数据库,请各位大哥给出源代码,只要能够实现,马上结帐,送100分

解决方案 »

  1.   

    '*************************************************************************
    '**模 块 名:fBackupDatabase_a
    '**描    述:备份数据库,返回出错信息,正常恢复,返回""
    '**调    用:fBackupDatabase_a "备份文件名","数据库名"
    '**参数说明:
    '**          sBackUpfileName  恢复后的数据库存放目录
    '**          sDataBaseName    备份的数据名
    '**          sIsAddBackup     是否追加到备份文件中
    '**说    明:引用Microsoft ActiveX Data Objects 2.x Library
    '**创 建 人:邹建
    '**日    期:2003年12月09日
    '*************************************************************************
    Public Function fBackupDatabase_a(ByVal sBackUpfileName$ _
                                    , ByVal sDataBaseName$ _
                                    , Optional ByVal sIsAddBackup As Boolean = False _
                                    ) As String
                                    
        Dim iDb As ADODB.Connection
        Dim iConcStr$, iSql$, iReturn$
        
        On Error GoTo lbErr
        
        '创建对象
        Set iDb = New ADODB.Connection
        
        '连接数据库服务器,根据你的情况修改连接字符串
        iConcStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=zj"
        iDb.Open iConcStr
        
        '生成数据库备份语句
        iSql = "backup database [" & sDataBaseName & "]" & vbCrLf & _
                "to disk='" & sBackUpfileName & "'" & vbCrLf & _
                "with description='" & "zj-backup at:" & Date & "(" & Time & ")'" & vbCrLf & _
                IIf(sIsAddBackup, "", ",init")
                
        iDb.Execute iSql
        GoTo lbExit
        
    lbErr:
        iReturn = Error
    lbExit:
        fBackupDatabase_a = iReturn
    End Function'*************************************************************************
    '**模 块 名:frestoredatabase_a
    '**描    述:恢复数据库,返回出错信息,正常恢复,返回""
    '**调    用:frestoredatabase_a "备份文件名","数据库名"
    '**参数说明:
    '**          sDataBasePath  恢复后的数据库存放目录
    '**          sBackupNumber  是从那个备份号恢复
    '**          sReplaceExist  指定是否覆盖已经存在的数据
    '**说    明:引用Microsoft ActiveX Data Objects 2.x Library
    '**创 建 人:邹建
    '**日    期:2003年12月09日
    '*************************************************************************
    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
    要给分啊!
      

  2.   

    *********************************************************
    '* 名称: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
      

  3.   

    '*********************************************************
    '* 名称: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
      

  4.   

    备份:
    Public Sub DoBackup(byval strPathFile As String)
      On Error GoTo ER
      
      Dim oMouse As clsMouseCtrl
      
      Dim CN As ADODB.Connection
      Dim strDatabase As String
      Dim strSql As String
      Dim rs As ADODB.Recordset
      Dim i As Long
      Dim str As String
      Dim blnPathIsExist As Boolean
      
      Set oTool = New sTool
      Set oRule = New bRuleOnCompany
      
      
      strSql = "master.dbo.xp_cmdshell 'dir " & strPathInRule & "'"
      Set rs = New ADODB.Recordset
      rs.Open strSql, gCON, adOpenDynamic, adLockReadOnly
      
      blnPathIsExist = False
      For i = 0 To rs.RecordCount - 1
        str = Change2Str(rs.Fields("OUTPUT").Value)
        If str <> "" Then
          If InStr(1, str, strPathInRule, vbTextCompare) > 0 Then
            blnPathIsExist = True
            Exit For
          End If
        End If
        
        rs.MoveNext
      Next i
      
      If blnPathIsExist = False Then
        strSql = "master.dbo.xp_cmdshell 'mkdir " & strPathInRule & "'"
        gCON.Execute strSql
      End If
      
      
      If strPathFile <> "" Then
        Set CN = gCON
        strDatabase = oTool.Dbname
      Else
        Exit Sub
      End If
            
      DoEvents
      
      With CN
        strSql = "BackUp Database " & strDatabase & " to disk='" & strPathFile & "'"
        CN.Execute strSql
      End With
              
      Exit Sub
    ER:
      MsgBox "Backup Failed!" & vbCrLf & Err.Description '"Backup Failed!"
    End Sub恢复:
    Public Function DoRestore(ByVal strServer As String, ByVal strDatabase As String, _
          ByVal strUser As String, ByVal strPasswd As String, ByVal strPathFile As String, _
          ByVal astrLogicalFiles As Variant, ByVal astrPhysicalFiles As Variant, _
          ByVal blnReplace As Boolean, Optional ByVal blnSecurityIntegrator As Boolean = False) As String
            
      Dim oMouse As clsMouseCtrl
      Set oMouse = New clsMouseCtrl
      DoEvents
      
      On Error GoTo ER
      
      Dim cn As ADODB.Connection
      Set cn = New ADODB.Connection
      
      With cn
        .CursorLocation = adUseClient
        .CommandTimeout = 0
            If blnSecurityIntegrator = True Then
          .ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;" & _
            "Initial Catalog=" & "Tempdb" & ";" & _
              ";Data Source=" & strServer
        Else
          .ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=" & _
                strUser & ";Initial Catalog=" & _
                 "Tempdb" & ";Data Source=" & strServer & ";Password=" & strPasswd
        End If
        
        .Open
       
       Dim strSql As String
       Dim i As Integer
       strSql = "RESTORE DATABASE " & strDatabase & " FROM DISK = '" & strPathFile & _
       "' WITH RECOVERY" & IIf(blnReplace = True, ",REPLACE", "")
       
       For i = 1 To SafeUBound(astrLogicalFiles)
        strSql = strSql & ",move '" & astrLogicalFiles(i) & "' to '" & astrPhysicalFiles(i) & "'"
       Next i
       
       cn.Execute strSql
       DoRestore = ""
      End With
      
      Exit Function
    ER:
      DoRestore = Err.Description
    End Function
      

  5.   

    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
    上面的db,d1,d2,d3,rs是什么,值是什么