VB實現SQL Server數據庫備份/恢復

´*************************************************************************
´**模 塊 名：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

原文轉自：http://www.anti-gravitydesign.com