数据库还原
´引用sqldmo object library
Dim gSQLServer As SQLDMO.SQLServer
On Error GoTo ErrHandler:
If gSQLServer Is Nothing Then
Set gSQLServer = New SQLDMO.SQLServer
End If
gSQLServer.LoginTimeout = 15
frmSelectServer.Show 1
If frmSelectServer.connecString = "" Then Exit Sub
gSQLServer.Connect frmSelectServer.connecString, "sa", "sa"
Dim oRestore As SQLDMO.Restore
Dim Msg As String
Dim Response As String
Set oRestore = New SQLDMO.Restore
oRestore.DATABASE = "data"
CommonDialog1.CancelError = True
On Error GoTo Errhandler1
´ 设置标志
CommonDialog1.Flags = cdlOFNHideReadOnly
´ 设置过滤器
CommonDialog1.Filter = "All Files (data*.*)|data*.*"
´ 指定缺省的过滤器
CommonDialog1.FilterIndex = 2
´ 显示“打开”对话框
´
Dim riqi As String
CommonDialog1.FileName = riqi
CommonDialog1.ShowOpen
´ 显示选定文件的名字
riqi = CommonDialog1.FileName
oRestore.Files = riqi
´当连接的时候，鼠标变化
Screen.MousePointer = vbHourglass
´恢复前断开所有的数据库连接
Dim iDb As ADODB.Connection, iRe As ADODB.Recordset
Set iDb = New ADODB.Connection
Set iRe = New ADODB.Recordset
Dim iConcStr As String
´连接数据库服务器
iConcStr = "Provider=sqloledb;" & _
"Data Source=myServerName;" & _
"Initial Catalog=master;" & _
"User Id=myUsername;" & _
"Password=myPassword"
iDb.Open iConcStr
Dim iSql As String
iSql = "select spid from master..sysprocesses where dbid=db_id(´data´)"
iRe.Open iSql, iDb, adOpenKeyset, adLockReadOnly
frmMoive.Label1.Caption = "数据库在还原过程中,请等候。"
frmMoive.Caption = "数据库恢复"
frmMoive.Show vbModeless, Me
DoEvents
Me.Enabled = False
Dim Spath As String
If Right(App.Path, 1) <> "\" Then
Spath = App.Path & "\"
Else
Spath = App.Path
End If
frmMoive.Animation1.Open Spath & "working.avi"
frmMoive.Animation1.Play
While iRe.EOF = False
iSql = "kill " & iRe(0)
iDb.Execute iSql
iRe.MoveNext
Wend
iRe.Close
iDb.Close
´恢复数据库
oRestore.SQLRestore gSQLServer
´恢复后鼠标返回默认的状态
Me.Enabled = True
frmMoive.Animation1.Stop
Unload frmMoive
Set oRestore = Nothing
Screen.MousePointer = vbDefault
MsgBox "数据库还原成功！"
Exit Sub
ErrHandler:
MsgBox "Error " & Err.Description
Exit Sub
Errhandler1:
´ 用户按了“取消”按钮
Exit Sub
文章来源于领测软件测试网 https://www.ltesting.net/
