cdbexplorer.cls

《VB6数据库开发指南》所有的例程的源码

    For Each prop In obj.Properties
      strPropertyName = prop.Name
      Set li = mlvw.ListItems.Add _
        (, strPropertyName, strPropertyName)
      li.SubItems(1) = CStr(prop.Value)
    Next  ' Property
  End With
  
  Exit Sub

ProcError:
  Select Case Err.Number
    Case 3251, 3219, 3267
      ' property can't be read in this manner
      ' continue
      Resume Next
    Case 438
      ' object doesn't support this property or method
      ' this is a collection object
      Exit Sub
    Case Else
      ' something else, raise it again
      Err.Raise _
        Err.Number, _
        Err.Source, _
        Err.Description, _
        Err.HelpFile, _
        Err.HelpContext
  End Select

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 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