frmbackrest.frm

数据库备份与恢复的程序

        Set gSQLServer = New SQLDMO.SQLServer
    End If
    
    '给变量付值
    ServerName = txtServerName.Text
    UserName = txtUserName.Text
    Password = txtPassword.Text
     
    '登录时间.
    gSQLServer.LoginTimeout = 15
    ' 显示登录代码或类型: WinNT or SQL Server.
    If optWinNTAuth.Value = True Then
        gSQLServer.LoginSecure = True
    Else
        gSQLServer.LoginSecure = False
    End If
    txtStatus.Text = ""
     PrintStat "正在连接服务器......"
    '改变鼠标状态.
    Screen.MousePointer = vbHourglass

    gSQLServer.Connect ServerName, UserName, Password
    gbConnected = True
    
    ' 在列表框中添加数据库名.
    FillDatabaseList
    
    '改变鼠标状态.
    Screen.MousePointer = vbDefault
    
    '服务器连接成功.
    MsgBox "服务器连接成功！", vbOKOnly, gTitle
    
    buttonsConnectOpen
    
    ' 清空状态拦".
    txtStatus.Text = ""
    
    Exit Sub

ErrHandler:
    PrintStat "错误信息：" + vbCrLf & "    " & Err.Description
    MsgBox "错误信息 " & Err.Description, , gTitle
    
    If Screen.MousePointer = vbHourglass Then
        Screen.MousePointer = vbDefault
    End If
    
End Sub

Private Sub cmdDisconnect_Click()
    On Error GoTo ErrHandler:
    
    Dim Msg As String
    Dim Response As String

    '断开连接.
    If gbConnected = True Then
        Msg = "您确定要断开连接吗？"
        Response = MsgBox(Msg, vbOKCancel, gTitle)
        If Response = vbOK Then
            Call gSQLServer.DisConnect
            Set gSQLServer = Nothing
            cmbDatabaseName.Clear
            txtDataFileName.Text = ""
            txtStatus.Text = ""
            gbConnected = False
            buttonsConnectClosed
        End If
    End If
    
    Exit Sub
    
ErrHandler:
    PrintStat "错误信息：" + vbCrLf & "    " & Err.Description

    MsgBox "错误信息 " & Err.Description, , gTitle
    Resume Next
End Sub

Private Sub cmdBackup_Click()
    On Error GoTo ErrHandler:
    
    Dim oBackup As SQLDMO.Backup
     txtStatus.Text = ""
    gDatabaseName = cmbDatabaseName.Text
    Set oBackup = New SQLDMO.Backup
    Set oBackupEvent = oBackup ' 使 events 有效
    
    oBackup.Database = gDatabaseName
    gBkupRstrFileName = txtDataFileName.Text
    oBackup.Files = gBkupRstrFileName
    '删除已有的同名文件，创建新文件
    '会覆盖原来的已有的文件
    If Len(Dir(gBkupRstrFileName)) > 0 Then
        Kill (gBkupRstrFileName)
    End If

    Screen.MousePointer = vbHourglass
    
    ' 备份数据库.
    oBackup.SQLBackup gSQLServer
    
    Screen.MousePointer = vbDefault
   
    Set oBackupEvent = Nothing ' 使 events 无效
    Set oBackup = Nothing
    
    Exit Sub

ErrHandler:
   txtStatus.Text = ""
    PrintStat "错误信息：" + vbCrLf & "    " & Err.Description
     MsgBox "错误信息 " & Err.Description, , gTitle
    Resume Next
End Sub

Private Sub cmdRestore_Click()
    On Error GoTo ErrHandler:
    Dim oRestore As SQLDMO.Restore
    
    Dim Msg As String
    Dim Response As String

    txtStatus.Text = ""
    gDatabaseName = cmbDatabaseName.Text
    Set oRestore = New SQLDMO.Restore
    Set oRestoreEvent = oRestore        ' enable events
    oRestore.Database = gDatabaseName
    gBkupRstrFileName = txtDataFileName.Text
    oRestore.Files = gBkupRstrFileName
    
    Screen.MousePointer = vbHourglass
    
    '恢复数据库.
    oRestore.SQLRestore gSQLServer
    
    Screen.MousePointer = vbDefault
   
    Set oRestoreEvent = Nothing         ' disable events
    Set oRestore = Nothing
    Exit Sub

ErrHandler:
    txtStatus.Text = ""
    PrintStat "错误信息：" + vbCrLf & "    " & Err.Description + vbCrLf & "    请检查您所输入的路径及名称是否正确？在进行数据库恢复时，其它计算机是不能使用该数据库的，请确认后重试！"
    MsgBox "错误信息 " & Err.Description, , gTitle
    Resume Next
End Sub

Private Sub cmdBrowse_Click()
    On Error GoTo ErrHandler:
    
    CommonDialog1.CancelError = True
    CommonDialog1.Filter = "All Files (*.*)|*.*|Backup Files (*.bak)|*.bak"
    CommonDialog1.FilterIndex = 2
    CommonDialog1.InitDir = gBkupRstrFilePath
    CommonDialog1.DefaultExt = "bak"
    CommonDialog1.DialogTitle = "Data File Name:"
    CommonDialog1.Action = 1
    txtDataFileName.Text = CommonDialog1.FileName
    Exit Sub
    
ErrHandler:
    Exit Sub
End Sub



' 状态拦的提示
Private Sub oBackupEvent_Complete(ByVal Message As String)
    PrintStat "oBackupEvent_Complete -- " & Message
End Sub

Private Sub oBackupEvent_NextMedia(ByVal Message As String)
    PrintStat "oBackupEvent_NextMedia -- " & Message
End Sub

Private Sub oBackupEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
    PrintStat "oBackupEvent_PercentComplete -- " & Message & " " & Percent
End Sub

Private Sub oRestoreEvent_Complete(ByVal Message As String)
    PrintStat "oRestoreEvent_Complete -- " & Message
End Sub

Private Sub oRestoreEvent_NextMedia(ByVal Message As String)
    PrintStat "oRestoreEvent_NextMedia -- " & Message
End Sub

Private Sub oRestoreEvent_PercentComplete(ByVal Message As String, ByVal Percent As Long)
    PrintStat "oRestoreEvent_PercentComplete -- " & Message & " " & Percent
End Sub

Private Sub PrintStat(ByRef Message As String)
    txtStatus.Text = txtStatus.Text + Message + vbCrLf
End Sub



Private Sub optSSAuth_Click()
    If optSSAuth.Value = True Then
        SSAuthOptionsOn
    End If
End Sub

Private Sub optWinNTAuth_Click()
    optWinNTAuth.Value = True
    WinNTAuthOptionsOn
    txtUserName.Text = ""
    txtPassword.Text = ""
End Sub

Private Sub buttonsConnectClosed()
    cmdConnect.Default = True
    
    cmdConnect.Enabled = True
    cmdBackup.Enabled = False
    cmdRestore.Enabled = False
    cmdDisconnect.Enabled = False
    
    cmdBrowse.Enabled = False
    cmbDatabaseName.Enabled = False
    txtDataFileName.Enabled = False
   
    optWinNTAuth.Enabled = True
    optSSAuth.Enabled = True
    txtServerName.Enabled = True
    lblServer.Enabled = True
    If optWinNTAuth = True Then
        WinNTAuthOptionsOn
    Else
        SSAuthOptionsOn
    End If
End Sub

Private Sub buttonsConnectOpen()
    cmdConnect.Enabled = False
    cmdBackup.Enabled = True
    cmdRestore.Enabled = True
    cmdDisconnect.Enabled = True
    
    cmdBrowse.Enabled = True
    cmbDatabaseName.Enabled = True
    txtDataFileName.Enabled = True
    
    optWinNTAuth.Enabled = False
    optSSAuth.Enabled = False
    txtServerName.Enabled = False
    lblServer.Enabled = False
    lblUserName.Enabled = False
    lblPassword.Enabled = False
    txtUserName.Enabled = False
    txtPassword.Enabled = False
End Sub

Private Sub WinNTAuthOptionsOn()
    lblUserName.Enabled = False
    lblPassword.Enabled = False
    txtUserName.Enabled = False
    txtPassword.Enabled = False
End Sub

Private Sub SSAuthOptionsOn()
    lblUserName.Enabled = True
    lblPassword.Enabled = True
    txtUserName.Enabled = True
    txtPassword.Enabled = True
End Sub




Private Sub FillDatabaseList()
    cmbDatabaseName.Clear
    
    '列举所有的数据库名称，并加载到列表框中.
    Dim oDB As SQLDMO.Database
    For Each oDB In gSQLServer.Databases
        If oDB.SystemObject = False Then
            cmbDatabaseName.AddItem oDB.Name
        End If
    Next oDB
    '默认的路径
    Dim MyPos As Integer
    gBkupRstrFilePath = CurDir
    MyPos = InStr(1, CurDir, "DevTools", 1)
    If MyPos > 0 Then
        gBkupRstrFilePath = Left(gBkupRstrFilePath, MyPos - 1)
        If Len(Dir(gBkupRstrFilePath + "backup", vbDirectory)) Then
            gBkupRstrFilePath = gBkupRstrFilePath + "backup\"
        Else
            gBkupRstrFilePath = "c:\temp\"
        End If
    Else
        gBkupRstrFilePath = "c:\temp\"
    End If
    
    ' 选择第一个数据库
    If cmbDatabaseName.ListCount > 0 Then
        cmbDatabaseName.ListIndex = 0
        ' 指定默认的备份/恢复的数据库名称.
        If Len(cmbDatabaseName.Text) > 0 Then
            txtDataFileName.Text = gBkupRstrFilePath + cmbDatabaseName.Text + ".bak"
        End If
    End If
    
End Sub


Private Sub cmbDatabaseName_Click()
      ' 指定默认的备份/恢复的数据库名称.
    If Len(cmbDatabaseName.Text) > 0 Then
        txtDataFileName.Text = gBkupRstrFilePath + cmbDatabaseName.Text + ".bak"
    End If
End Sub