VB_SQL备份和恢复函数 点击数：160    发布日期：2005-6-21 8:14:00  【字体：大 中 小】【评论】【打印】 '************************************************************************* '**模 块 名：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

评论