怎么在VB中实现备份?????

http://expert.csdn.net/Expert/topic/2854/2854264.xml?temp=.359997

另人的代码.参考一下:
*********************************************************
'* 名称：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:'------------------------------------------------------------------
' 代码描述：SQL Server数据库的备份与恢复
'
' 注意事项：1.需要在工程中引用Microsoft SQLDMO Object Library
'           2.备份/恢复数据库时，要保证没有其它用户连接到SQL Server
'
' 窗体控件：2个Command，名称分别为cmdBackup,cmdRestore
'           1个Label,名称为lblProgress,用于显示备份/恢复进程。'------------------------------------------------------------------
'
Option ExplicitPrivate WithEvents objBackup As SQLDMO.Backup
Private WithEvents objRestore As SQLDMO.RestorePrivate Sub cmdBackup_Click()
    Dim objSQLServer As New SQLDMO.SQLServer
    Dim strServer As String
    Dim strUserID As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim strFile As String

    strServer = "Developer"
    strUserID = "SA"
    strPassword = ""
    strDatabase = "Test"
    strFile = "c:\test.bak"

    If Dir(strFile) <> "" Then
        If MsgBox("文件" & strFile & "已存在，是否删除？", vbQuestion + vbYesNo) = vbYes Then
            Kill strFile
        Else
            Exit Sub
        End If
    End If

    lblProgress.Caption = "备份进度： 0%"
    Screen.MousePointer = 11

    On Error GoTo ErrorHandler

    objSQLServer.Connect strServer, strUserID, strPassword

    Set objBackup = New SQLDMO.Backup
    With objBackup
        .PercentCompleteNotification = 1
        .Database = strDatabase
        .Files = strFile
        .SQLBackup objSQLServer
    End With
    Set objBackup = Nothing

    objSQLServer.Close
    Set objSQLServer = Nothing

    Screen.MousePointer = 0
    Exit Sub

ErrorHandler:
    Screen.MousePointer = 0
    MsgBox Err.Description, vbCritical
End SubPrivate Sub cmdRestore_Click()
    Dim objSQLServer As New SQLDMO.SQLServer
    Dim strServer As String
    Dim strUserID As String
    Dim strPassword As String
    Dim strDatabase As String
    Dim strFile As String

    strServer = "Developer"
    strUserID = "SA"
    strPassword = ""
    strDatabase = "Test"
    strFile = "c:\test.bak"

    If Dir(strFile) = "" Then
        MsgBox "文件" & strFile & "不存在！", vbExclamation
        Exit Sub
    End If

    lblProgress.Caption = "恢复进度： 0%"
    Screen.MousePointer = 11

    On Error GoTo ErrorHandler

    objSQLServer.Connect strServer, strUserID, strPassword

    Set objRestore = New SQLDMO.Restore
    With objRestore
        .PercentCompleteNotification = 1
        .Database = strDatabase
        .ReplaceDatabase = True
        .Files = strFile
        .SQLRestore objSQLServer
    End With
    Set objRestore = Nothing

    objSQLServer.Close
    Set objSQLServer = Nothing

    Screen.MousePointer = 0
    Exit Sub

ErrorHandler:
    Screen.MousePointer = 0
    MsgBox Err.Description, vbCritical
End SubPrivate Sub objBackup_Complete(ByVal Message As String)
    lblProgress.Caption = "备份成功！"
    Set objBackup = Nothing
End SubPrivate Sub objBackup_PercentComplete(ByVal Message As String, ByVal Percent As Long)
    lblProgress.Caption = "备份进度： " & Percent & "%"
    DoEvents
End SubPrivate Sub objRestore_Complete(ByVal Message As String)
    lblProgress.Caption = "恢复成功！"
    Set objRestore = Nothing
End SubPrivate Sub objRestore_PercentComplete(ByVal Message As String, ByVal Percent As Long)
    lblProgress.Caption = "恢复进度： " & Percent & "%"
    DoEvents
End Sub'备份数据库'需要添加一个commoldialog控件
Sub backDataBase()
    On Error GoTo errnum
    dlg.CancelError = True
    Cn1.Execute "use master"
    dlg.Filter = "(*.bak)|*.bak"
    dlg.ShowSave
    MousePointer = 11
    Cn1.Execute "BACKUP DATABASE kffgl TO DISK = '" & dlg.FileName & "'"  '备份数据库
    MousePointer = 0
    Set Cn1 = Nothing
    '重新建立连接
errnum:


    Call dbint
    Set Cn1 = New ADODB.Connection
    Cn1.Open "Driver={SQL Server};Server=" & SQL_SRV & ";Uid=" & SA & ";Pwd=" & PA & ";Database=" & SJK & ""
End Sub

以sqlserver示例：备份：
    strSQL = "BACKUP database " & DatabaseName & " TO DISK='" _
            & strPath & DatabaseName & strDate & ".bak'" _
            & " WITH RESTART"恢复：
    strSQLRestore = "RESTORE DATABASE " & DatabaseName & " FROM DISK = '" _
            & strPath & File1.FileName _
            & "' with" _
            & " MOVE '" & DatabaseName & "_data' TO '" _
            & gstrCurrPath & DatabaseDir & DatabaseName & "_data.mdf'" _
            & ",MOVE '" & DatabaseName & "_log' TO '" _
            & gstrCurrPath & DatabaseDir & DatabaseName & "_log.ldf'" _
            & ",replace,restart"

access数据库的备份与恢复：'备份数据
Public Function BackupMDB() As Boolean
On Error GoTo ErrLab
    BackupMDB = False

    Screen.MousePointer = 11

    If CopyFile(MdbSourcePath, MdbBackupPath, False) = 0 Then
        Screen.MousePointer = 0
        MsgBox "备份失败！" & vbCrLf & "请确保其它应用程序没有使用当前数据库！" & vbCrLf & "然后关闭其它所有子窗体后再备份！", vbInformation, "提示"
    Else
        Screen.MousePointer = 0
        BackupMDB = True
        MsgBox "备份成功！", vbInformation, "祝贺"
    End If
    Exit Function
ErrLab:
    Screen.MousePointer = 0
    MsgBox "发生意外错误!请稍后再试" & vbCrLf & Err.Description, vbInformation + vbOKOnly, "消息"
End Function'恢复数据库
Public Function RestoreMDB() As Boolean
On Error Resume Next
    Dim tempCon As ADODB.Connection
    Dim tempRs As ADODB.Recordset
    RestoreMDB = True    If MsgBox("该操作把当前数据库替换为之前备份过的数据库。执行之后将不可撤消！" & vbCrLf & "您确定要恢复当前数据库吗？", vbQuestion + vbOKCancel + vbDefaultButton2, "小心！") = vbCancel Then
       Exit Function
    End If

    Set tempCon = New ADODB.Connection
    Set tempRs = New ADODB.Recordset

    tempCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & MdbBackupPath & ";jet oledb:database password=790319"
    tempRs.Open "Select * from Document", tempCon, adOpenStatic, adLockOptimistic
    If Err.Number <> 0 Then
        MsgBox "以前尚未备份过，或者已经备份的数据库已被破坏,不能进行恢复！", vbInformation, "提示信息"
    Else
        '关闭连接
        tempRs.Close
        tempCon.Close
        Set tempCon = Nothing

        con.Close '先关闭全局连接

        If CopyFile(MdbBackupPath, MdbSourcePath, False) = 0 Then
            MsgBox "请确保其它应用程序没有使用当前数据库！" & vbCrLf & vbCrLf & _
                   "然后关闭其它所有子窗体后再恢复！", vbInformation, "恢复失败"
        Else
            MsgBox "恢复成功！", vbInformation, "祝贺"
        End If

        ConnectDatabase con '再开启全局连接
    End If
End Function

如果是 SQL Server2000 可以这样做：
Dim cn As New ADODB.Connection
cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=具体计算机名;Initial Catalog=具体数据库名;Data Source=XXX"CommonDialog1.Filter = "*.SQB"
CommonDialog1.ShowSave
cn.Execute ("backup database 具体数据库名 to disk='" & CommonDialog1.FileName & "'")

调试易

怎么在VB中实现备份?????

解决方案 »