⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cdbexplorer.cls

📁 《VB6数据库开发指南》所有的例程的源码
💻 CLS
📖 第 1 页 / 共 2 页
字号:

End Sub
Private Function GetDAOObjectFromNode _
  (nd As Node) As Object
' Refresh the property list for the node provided

  Dim lNodeType As dbExpNodeType
  Dim obj As Object
    
  lNodeType = TVGetNodeType(nd)
  
  Select Case lNodeType
    Case ntDatabase
      Set obj = mdb
    Case ntRootCollection
      ' find out which collection
      Select Case nd.Text
        Case "TableDefs"
          Set obj = mdb.TableDefs
        Case "QueryDefs"
          Set obj = mdb.QueryDefs
        Case "Relations"
          Set obj = mdb.Relations
      End Select
    Case ntRootObject
      ' before we can list the object
      ' properties, we need to know the
      ' collection it belongs to, which
      ' can be found by examining the Text
      ' of the parent node
      Select Case nd.Parent.Text
        Case "TableDefs"
          Set obj = mdb.TableDefs(nd.Text)
        Case "QueryDefs"
          Set obj = mdb.QueryDefs(nd.Text)
        Case "Relations"
          Set obj = mdb.Relations(nd.Text)
      End Select
    Case ntObjectCollection
      ' same as ntRootObject, except this time we
      ' need to go to the "grandparent"
      Select Case nd.Parent.Parent.Text
        Case "TableDefs"
          Select Case nd.Text
            Case "Fields"
              Set obj = _
                mdb.TableDefs(nd.Parent.Text).Fields
            Case "Indexes"
              Set obj = _
                mdb.TableDefs(nd.Parent.Text).Indexes
          End Select
        Case "QueryDefs"
          Select Case nd.Text
            Case "Fields"
              Set obj = _
                mdb.QueryDefs(nd.Parent.Text).Fields
            Case "Parameters"
              Set obj = _
                mdb.QueryDefs(nd.Parent.Text).Parameters
          End Select
        Case "Relations"
          ' the only collection is fields
          Set obj = mdb.Relations(nd.Parent.Text).Fields
      End Select
    Case ntObject
      ' get "great-grandparent" collection
      Select Case nd.Parent.Parent.Parent.Text
        Case "TableDefs"
          ' return a field or index object
          Select Case nd.Parent.Text
            Case "Fields"
              Set obj = _
                mdb.TableDefs(nd.Parent.Parent.Text). _
                Fields(nd.Text)
            Case "Indexes"
              Set obj = _
                mdb.TableDefs(nd.Parent.Parent.Text). _
                Indexes(nd.Text)
          End Select
        Case "QueryDefs"
          ' return an index or parameter object
          Select Case nd.Parent.Text
            Case "Fields"
              Set obj = _
                mdb.QueryDefs(nd.Parent.Parent.Text). _
                Fields(nd.Text)
            Case "Parameters"
              Set obj = _
                mdb.QueryDefs(nd.Parent.Parent.Text). _
                  Parameters(nd.Text)
          End Select
        Case "Relations"
          ' return a field object
          Set obj = _
            mdb.Relations(nd.Parent.Parent.Text). _
            Fields(nd.Text)
      End Select
  End Select

  Set GetDAOObjectFromNode = obj

End Function

' Public Methods

Public Sub ExploreDatabase( _
  strDBName As String, tvw As TreeView, lvw As ListView)

  Set mdb = DBEngine(0).OpenDatabase(strDBName)
  Set mtvw = tvw
  Set mlvw = lvw

  TVInit
  LVInit

  ' list database properties
  LVListProperties mdb

End Sub

Public Sub ListProperties(nd As Node)

  Dim obj As Object
  
  Set obj = GetDAOObjectFromNode(nd)
  LVListProperties obj

End Sub

Public Sub ExpandNode(nd As Node)
' Notes:
' This procedure determines the

  Dim obj As Object
  Dim strTypeName As String
  Dim strObjName As String
  
  ' skip this if within the TVInit procedure
  ' it expands the root node
  If mblnInTVInit Then
    Exit Sub
  End If
  
  ' clear all existing child nodes
  Do While nd.Children > 0
    mtvw.Nodes.Remove nd.Child.Index
  Loop
  
  ' get the associated dao object
  Set obj = GetDAOObjectFromNode(nd)
  
  ' expand based on the typename of the object
  strTypeName = TypeName(obj)
  Select Case strTypeName
    Case "Database"
      TVInit
    Case "TableDefs"
      mdb.TableDefs.Refresh
      TVGetTableDefs
    Case "QueryDefs"
      mdb.QueryDefs.Refresh
      TVGetQueryDefs
    Case "Relations"
      mdb.Relations.Refresh
      TVGetRelations
    Case "TableDef"
      strObjName = obj.Name
      ' add the fields and indexes nodes
      ' with blank child nodes so they can be expanded
      mtvw.Nodes.Add _
        strObjName, tvwChild, _
        strObjName & "Fields", "Fields"
      mtvw.Nodes.Add _
        strObjName & "Fields", tvwChild
      ' indexes
      If mdb.TableDefs(strObjName).Indexes.Count > 0 Then
        mtvw.Nodes.Add _
          strObjName, tvwChild, _
          strObjName & "Indexes", "Indexes"
        mtvw.Nodes.Add _
          strObjName & "Indexes", tvwChild
      End If
    Case "QueryDef"
      strObjName = obj.Name
      ' add the fields and parameters nodes
      ' with blank child nodes so they can be expanded
      mtvw.Nodes.Add _
        strObjName, tvwChild, _
        strObjName & "Fields", "Fields"
      mtvw.Nodes.Add _
        strObjName & "Fields", tvwChild
      ' parameters
      If mdb.QueryDefs(strObjName).Parameters.Count > 0 Then
        mtvw.Nodes.Add _
          strObjName, tvwChild, _
          strObjName & "Parameters", "Parameters"
        mtvw.Nodes.Add _
          strObjName & "Parameters", tvwChild
      End If
    Case "Relation"
      ' add the Fields node and a blank child node
      strObjName = obj.Name
      mtvw.Nodes.Add "Relations" & strObjName, tvwChild, _
        "Relations" & strObjName & "Fields", "Fields"
      mtvw.Nodes.Add _
        "Relations" & strObjName & "Fields", tvwChild
    Case "Fields"
      ' first, fields of what?
      strObjName = nd.Parent.Text
      Select Case nd.Parent.Parent.Text
        Case "TableDefs"
          mdb.TableDefs(strObjName).Fields.Refresh
          TVGetTableDefFields strObjName
        Case "QueryDefs"
          mdb.QueryDefs(strObjName).Fields.Refresh
          TVGetQueryDefFields strObjName
        Case "Relations"
          mdb.Relations(strObjName).Fields.Refresh
          TVGetRelationFields strObjName
      End Select
    Case "Indexes"
      strObjName = nd.Parent.Text
      mdb.TableDefs(strObjName).Indexes.Refresh
      TVGetTableDefIndexes strObjName
    Case "Parameters"
      strObjName = nd.Parent.Text
      mdb.QueryDefs(strObjName).Parameters.Refresh
      TVGetQueryDefParameters strObjName
  End Select

End Sub

Public Sub AddTable()

  Load frmCreateTableDef

  Set frmCreateTableDef.Database = mdb

  frmCreateTableDef.Show vbModal

  ' refresh the tabledefs node
  ExpandNode mtvw.Nodes("TableDefs")

End Sub

Public Sub DeleteTable(strTableDefName As String)

  ' delete the tabledef
  mdb.TableDefs.Delete strTableDefName
  
  ' refresh the tree
  ExpandNode mtvw.Nodes("TableDefs")

End Sub

Public Sub AddIndex()

  Dim obj As Object

  Set obj = GetDAOObjectFromNode(mtvw.SelectedItem)

  Select Case TypeName(obj)
    Case "TableDef"
      ' intialize the form with a table name
      frmCreateIndex.Initialize mdb, obj.Name
    Case "Indexes"
      frmCreateIndex.Initialize _
        mdb, mtvw.SelectedItem.Parent.Text
    Case "Index"
      frmCreateIndex.Initialize mdb, _
        mtvw.SelectedItem.Parent.Parent.Text
    Case "Field"
      ' if it's a table field, get the table name
      ' the great grand parent node tells the type
      If mtvw.SelectedItem.Parent.Parent.Parent.Text _
        = "TableDefs" Then
        ' get the name from the grand parent node
        frmCreateIndex.Initialize _
          mdb, _
          mtvw.SelectedItem.Parent.Parent.Text
      Else
        frmCreateIndex.Initialize mdb
      End If
    Case Else
      frmCreateIndex.Initialize mdb
  End Select

  frmCreateIndex.Show vbModal

  ' check cancel flag
  If Not frmCreateIndex.Cancelled Then
    ' expand the tabledef node
    ExpandNode _
      mtvw.Nodes(frmCreateIndex.TableDefName)
    ' now expand the index node for the tabledef
    ExpandNode _
      mtvw.Nodes(frmCreateIndex.TableDefName & "Indexes")
  End If

End Sub

Public Sub DeleteIndex( _
  strTableDefName As String, _
  strIndexName As String)

  ' delete the index from the indexes collection of the
  ' tabledef provided
  mdb.TableDefs(strTableDefName).Indexes.Delete strIndexName
  ' refresh the tree
  ExpandNode mtvw.Nodes(strTableDefName & "Indexes")
  
End Sub

' Public Properties

Public Property Get Database() As DAO.Database

  Set Database = mdb

End Property

Public Property Get NodeType(nd As Node) As String

  Dim obj As Object
  
  Set obj = GetDAOObjectFromNode(nd)
  
  NodeType = TypeName(obj)

End Property

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -