frmmain.frm

SQL SERVER 2000数据库的由备份文件的创建

    
    '第二个页面时执行
    If cmdQuit.Tag = 1 Then
        If optCreateDB.Value = True Then
            DoEvents
            Call ShowFrame(4)
            cmdNext.Enabled = False
            cmdNext.Tag = 2
            
            Call CreateDB
        End If
        
        If optBackupDB.Value = True Then
            Call ShowFrame(3)
            cmdNext.Tag = "0"
        End If
        
        If optRestoreDB.Value = True Then
            Call ShowFrame(2)
            cmdNext.Tag = "1"
        End If
        
        If optReCreateDB.Value = True Then
            DoEvents
            Call ShowFrame(4)
            Call ReCreateDB
            cmdNext.Enabled = False
            cmdNext.Tag = 3
        End If
    End If
    
'按钮状态
    If Val(cmdQuit.Tag) < 4 Then
        cmdNext.Enabled = True And cmdNext.Enabled
    End If
    If Val(cmdQuit.Tag) > 0 Then
        cmdPre.Enabled = True
    End If

End Sub

Private Sub cmdPre_Click()
    Select Case cmdQuit.Tag
        Case 1
            Call ShowFrame(0)
        Case 2, 3
            Call ShowFrame(1)
        Case 4
            Select Case cmdNext.Tag
            Case "0"
                Call ShowFrame(3)
                txtBackupPath.Text = ""
            Case "1"
                Call ShowFrame(2)
                txtRestorePath.Text = ""
            Case "2", "3"
                Call ShowFrame(1)
            End Select
    End Select
    
    '按钮状态
    If Val(cmdQuit.Tag) < 4 Then
        cmdNext.Enabled = True
    Else
        cmdNext.Enabled = False
    End If
    If Val(cmdQuit.Tag) > 0 Then
        cmdPre.Enabled = True
    Else
        cmdPre.Enabled = False
    End If
    
End Sub

Private Sub cmdQuit_Click()
    Unload Me
End Sub

Private Sub cmdShowDialog_Click(Index As Integer)
    With dlgMain
        .Filter = "数据备份文件(*.BAK)|*.BAK"
        .CancelError = False
        .ShowSave
        
        If Index = 0 Then
            txtBackupPath.Text = .FileName
        Else
            txtRestorePath.Text = .FileName
        End If
    End With
End Sub

Private Sub ShowFrame(ByRef Index As Integer)
    With fraMain
        For i = .LBound To .UBound
            If i = Index Then
                fraMain(i).Visible = True
                fraMain(i).Top = 180
                fraMain(i).Left = 180
                
                cmdQuit.Tag = i    '传一个位置值，省一个全局变量
            Else
                fraMain(i).Visible = False
            End If
        Next
    End With
End Sub

Private Sub Form_Load()
    Call ShowFrame(0)
    
    cmdPre.Enabled = False
    
    If Not ExistProcess("sqlservr.exe") Then
        MsgBox "本机上没有安装数据库软件，或者数据库软件没有启动。要使用本软件必须安装数据库软件，并启动才可以。"
    End If
End Sub

Private Sub optBackupDB_Click()
    cmdNext.Enabled = True

End Sub

Private Sub optCreateDB_Click()
    cmdNext.Enabled = True
End Sub

Private Sub optReCreateDB_Click()
    cmdNext.Enabled = True
End Sub

Private Sub optRestoreDB_Click()
    cmdNext.Enabled = True
End Sub

Private Sub BackupDB(ByRef strFilePath As String)
    On Error GoTo Sub_Err

    Dim strSQL As String
    
    '建一个设备
    strSQL = "EXEC sp_addumpdevice 'disk', 'BackupFile', '" & strFilePath & "' "
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    '备份数据库
    strSQL = " BACKUP DATABASE CRM TO BackupFile"
    
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    lblAlert.Caption = "数据库备份成功！请妥善保管备份文件。"

Sub_Err:
    If Err.Number <> 0 Then
        lblAlert.Caption = "数据库备份失败！"
    End If
    '删除设备
    strSQL = " exec sp_dropdevice 'BackupFile'"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
End Sub

Private Sub CreateDB()
    On Error GoTo Sub_Err

    Dim strSQL As String
    Dim recTemp As ADODB.Recordset
    
    '在D盘下建立数据库目录 D:\CRMDB，如果存在就不建立
    If Dir("D:\CRMDB", vbDirectory) = "" Then
        MkDir "d:\CRMDB"
    End If
    
    strSQL = "Select Count(*) as RecNumber from master..sysdatabases where name='CRM'"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text), True, recTemp)
    
    If recTemp.Fields("RecNumber") = 0 Then
        '建立数据库
        strSQL = "CREATE DATABASE CRM ON ( NAME = CRMDATA,FILENAME = 'd:\crmdb\crmdata.mdf') LOG ON ( NAME = 'CRMLOG',   FILENAME = 'd:\crmdb\crmlog.ldf') "
        
        Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    End If
    
    '建一个设备
    strSQL = "EXEC sp_addumpdevice 'disk', 'BackupFile', '" & App.Path & "\CRM.DAT' "
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    '恢复数据库
    strSQL = " RESTORE DATABASE CRM FROM BackupFile"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    lblAlert.Caption = "数据库创建成功！管理员管理密码为空。"

Sub_Err:
    If Err.Number <> 0 Then
        lblAlert.Caption = "数据库创建出错！"
    End If
    
    '删除设备
    strSQL = " exec sp_dropdevice 'BackupFile'"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    Set recTemp = Nothing
    
End Sub

Private Sub ReCreateDB()
    On Error GoTo Sub_Err

    Dim strSQL As String
    
    '建一个设备
    strSQL = "EXEC sp_addumpdevice 'disk', 'BackupFile', '" & App.Path & "\CRM.DAT' "
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    '恢复数据库
    strSQL = " RESTORE DATABASE CRM FROM BackupFile"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    lblAlert.Caption = "数据库重建成功！管理员管理密码为空。"

Sub_Err:
    If Err.Number <> 0 Then
        lblAlert.Caption = "数据库重建出错，可能的原因是有其他用户在使用软件，请重启后再试！"
    End If
    
    '删除设备
    strSQL = " exec sp_dropdevice 'BackupFile'"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
End Sub

Private Sub RestoreDB(ByRef strFilePath As String)
    On Error GoTo Sub_Err

    Dim strSQL As String
    
    '建一个设备
    strSQL = "EXEC sp_addumpdevice 'disk', 'BackupFile', '" & strFilePath & "' "
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    '恢复数据库
    strSQL = " RESTORE DATABASE CRM FROM BackupFile"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
    lblAlert.Caption = "数据库恢复成功！。"

Sub_Err:
    If Err.Number <> 0 Then
        lblAlert.Caption = "数据库恢复出错！可能的原因是有其他用户在使用软件，请重新启动本机后再试。"
    End If
    
    '删除设备
    strSQL = " exec sp_dropdevice 'BackupFile'"
    
    Call ExecBackupResotre(strSQL, Trim$(txtAccout.Text), Trim$(txtPassWord.Text))
    
End Sub