'得到还原后的数据库存放目录,如果没有指定,存放到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
lbErr: iReturn = Error lbExit: fRestoreDatabase_a = iReturn End Function 要给分啊!
********************************************************* '* 名称: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
备份: 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
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
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是什么,值是什么
'**模 块 名: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
要给分啊!
'* 名称: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
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
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是什么,值是什么