frm_dbregister.frm

1.数数库的分离与附加 2 自动查找数据库

VERSION 5.00
Begin VB.Form frm_DbRegister 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据库备份:"
   ClientHeight    =   1830
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9930
   Icon            =   "frm_DbRegister.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1830
   ScaleWidth      =   9930
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command4 
      Cancel          =   -1  'True
      Caption         =   "返回(&X)"
      Height          =   435
      Left            =   8520
      TabIndex        =   8
      ToolTipText     =   "备份数据库"
      Top             =   1200
      Width           =   1095
   End
   Begin VB.CommandButton Command3 
      Caption         =   "备份(&B)"
      Enabled         =   0   'False
      Height          =   435
      Left            =   7140
      TabIndex        =   7
      ToolTipText     =   "备份数据库"
      Top             =   1200
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "分离(&U)"
      Height          =   435
      Left            =   5850
      TabIndex        =   6
      ToolTipText     =   "注销数据库"
      Top             =   1200
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "附加(&R)"
      Height          =   435
      Left            =   4590
      TabIndex        =   5
      ToolTipText     =   "注册数据库"
      Top             =   1200
      Width           =   1095
   End
   Begin VB.TextBox txtName 
      Height          =   300
      Left            =   4575
      TabIndex        =   2
      Text            =   "文件全名(包括路径)"
      ToolTipText     =   "文件全名(包括路径)"
      Top             =   240
      Width           =   5160
   End
   Begin VB.TextBox TxtDbName 
      Height          =   300
      Left            =   4575
      Locked          =   -1  'True
      TabIndex        =   1
      Text            =   "qfjxc-demo"
      Top             =   660
      Width           =   5160
   End
   Begin VB.ListBox LstDbInfo 
      Height          =   1680
      Left            =   60
      TabIndex        =   0
      Top             =   90
      Width           =   3375
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "数据库文件:"
      Height          =   180
      Index           =   0
      Left            =   3465
      TabIndex        =   4
      Top             =   300
      Width           =   990
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "数据库名:"
      Height          =   180
      Index           =   2
      Left            =   3645
      TabIndex        =   3
      Top             =   720
      Width           =   810
   End
End
Attribute VB_Name = "frm_DbRegister"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim tmprs As New ADODB.Recordset
Dim CurDBID As Long, CurID As Long

Private Sub Command1_Click()
On Error GoTo Er
Dim strTmp As String
    If Trim(txtName.Text) = "" Then
        MsgBox "请输入文件名称！", vbExclamation, Me.Caption
        txtName.SetFocus
        Exit Sub
    End If
    TxtDbName = ""
    strTmp = Mid(Trim(txtName.Text), InStrRev(Trim(txtName.Text), "\") + 1)
    strTmp = Left(strTmp, InStrRev(strTmp, ".") - 1)
    TxtDbName = InputBox("请输入数据库名称,注意不和和现有的数据库名重名!", "数据库名称", strTmp)
    If Trim(TxtDbName.Text) = "" Then
        MsgBox "数据库名不能为空！", vbExclamation, Me.Caption
        TxtDbName.SetFocus
        Exit Sub
    End If
    
    If MsgBox("警告：确定要附加数据库 " & TxtDbName.Text & " 吗（如果数据库名或文件不正确会出错）？", vbYesNo + vbExclamation, Me.Caption) <> vbYes Then Exit Sub
    
    Cn.Execute ("sp_attach_db '" & Trim(TxtDbName.Text) & "','" & Trim(txtName.Text) & "'")
    
    Call LoadDbInfo
    
    Exit Sub
Er:
    MsgBox "错误:" & Err.Number & " 来自:" & Err.Source & vbCrLf & " 详细:" & Err.Description, vbExclamation, "注册错误:" & Err.Number
End Sub

Private Sub Command2_Click()
On Error GoTo Er
    If CurDBID <= 4 Then
        MsgBox "不能对系统数据库进行此操作！", vbExclamation, Me.Caption
        Exit Sub
    End If
    If MsgBox("警告：确定要注销数据库 " & TxtDbName.Text & " 吗（此操作后该数据库将不可用）？", vbYesNo + vbExclamation, Me.Caption) <> vbYes Then Exit Sub
    Cn.Execute ("sp_detach_db '" & Trim(TxtDbName) & "'")
    Call LoadDbInfo
    Exit Sub
Er:
    MsgBox "错误:" & Err.Number & " 来自:" & Err.Source & vbCrLf & " 详细:" & Err.Description, vbExclamation, "注销错误:" & Err.Number

End Sub

Private Sub Command3_Click()
    If LstDbInfo.ListIndex >= 0 Then
        With frm_DbBackup
            .mName = txtName.Text
            .mDbName = TxtDbName.Text
            .mDbID = CurDBID
            .Show 1
        End With
    End If
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Me.Caption = Me.Caption & " - [" & SvrName & "]"
    Call LoadDbInfo
End Sub

Private Sub LoadDbInfo()
On Error GoTo Er
    Set tmprs = Cn.Execute("select a.dbid AS FDBID,a.name AS FDBName,  a.filename AS FFileName ,isnull(a.dbID,0)  AS FID  from master..sysdatabases a " & _
                "  Order By a.dbid ")
    Set tmprs.ActiveConnection = Nothing
    With LstDbInfo
        .Clear
        Do While Not tmprs.EOF
            .AddItem tmprs!FDBName & "  -   " & tmprs!FFileName
            .ItemData(.ListCount - 1) = tmprs!FDBID
            tmprs.MoveNext
        Loop
        If .ListCount > 0 Then .ListIndex = 0
    End With
    Exit Sub
Er:
    MsgBox "错误:" & Err.Number & " 来自:" & Err.Source & vbCrLf & " 详细:" & Err.Description, vbExclamation, "取数据库信息错误:" & Err.Number

End Sub
Private Sub Form_Unload(Cancel As Integer)
    Set frm_DbRegister = Nothing
End Sub

Private Sub LstDbInfo_Click()
    If LstDbInfo.ListIndex >= 0 Then
        CurDBID = LstDbInfo.ItemData(LstDbInfo.ListIndex)
        tmprs.Filter = "FDBID=" & CurDBID
        With tmprs
            CurID = !FID
            txtName.Text = IIf(CurID = 0, !FDBName, !FFileName)
            TxtDbName.Text = !FDBName
            Command3.Enabled = (CurID <> 0)
'            Command2.Enabled = (CurID <> 0)
'            Command1.Enabled = (CurID = 0)
        End With
    End If
End Sub