关于生成目录树结构的类

March 25,2004

本程序有两文件test.asp 和tree.asp 还有一些图标文件
1。test.asp 调用类生成树代码如下
<%@ Language=VBScript %>
<html>
<head>
<link rel="stylesheet" href="tree.css">
<title>tree</title>
</head>

<%

'========================================
' BUILDING A TREE PROGRAMATICALLY
'========================================
' This approach would be best suited for building
' dynamic trees using For..Next loops and such.

Set MyTree2 = New Tree
MyTree2.Top = 10
MyTree2.Left = 10
MyTree2.ExpandImage = "plus.gif"
MyTree2.CollapseImage = "minus.gif"
MyTree2.LeafImage = "webpage.gif"

' Notice the indentation used to reprensent the hierarchy
Set Node1 = MyTree2.CreateChild("script")
      Set SubNode1 = Node1.CreateChild("server")
         Set secSubNode1 = SubNode1.CreateChild("html")
            secSubNode1.CreateChild "<A HREF=""http://127.0.0.1/"">asp</A>"
            secSubNode1.CreateChild "<A HREF=""http://127.0.0.1/"">php</A>"
            secSubNode1.CreateChild "<A HREF=""http://127.0.0.1/"">jsp</A>"

      Set SubNode2 = Node1.CreateChild("os")
         SubNode2.CreateChild "<A HREF=""#"">winnt</A>"
         SubNode2.CreateChild "<A HREF=""#"">win2000</A>"

Set Node2 = MyTree2.CreateChild("Desktop")
      Node2.CreateChild "<A HREF=""#"">Area Code Lookup</A>"
      Node2.CreateChild "<A HREF=""#"">Arin Based Whois Search</A>"
      Node2.CreateChild "<A HREF=""#"">World Time Zone Map</A>"

MyTree2.Draw()

Set MyTree2 = Nothing

%>

</BODY>
</HTML>
2。tree.asp  类的定义代码如下
<%
'******************************************************
' Author: Jacob  Gilley
' Email: [email protected]
' My Terms: You can use this control in anyway you see fit
'          cause I have no means to enforce any guidelines
'          or BS that most developers think they can get
'          you to agree to by spouting out words like
'          "intellectual property" and "The Code Gods".
'          - Viva la Microsoft!
'******************************************************

Dim gblTreeNodeCount:gblTreeNodeCount = 1

Class TreeNode

Public Value
Public ExpandImage
Public CollapseImage
Public LeafImage
Public Expanded
Private mszName
Private mcolChildren
Private mbChildrenInitialized

Public Property Get ChildCount()
      ChildCount = mcolChildren.Count
End Property

Private Sub Class_Initialize()
      mszName = "node" & CStr(gblTreeNodeCount)
      gblTreeNodeCount = gblTreeNodeCount + 1

      mbChildrenInitialized = False
      Expanded = False
End Sub

Private Sub Class_Terminate()
      If mbChildrenInitialized And IsObject(mcolChildren) Then
         mcolChildren.RemoveAll()
         Set mcolChildren = Nothing
      End If
End Sub

Private Sub InitChildList()
      Set mcolChildren = Server.CreateObject("Scripting.Dictionary")
      mbChildrenInitialized = True
End Sub

Private Sub LoadState()
      If Request(mszName) = "1" Or Request("togglenode") = mszName Then
         Expanded = True
      End If
End Sub

Public Function CreateChild(szValue)

      If Not mbChildrenInitialized Then InitChildList()

      Set CreateChild = New TreeNode
      CreateChild.Value = szValue
      CreateChild.ExpandImage = ExpandImage
      CreateChild.CollapseImage = CollapseImage
      CreateChild.LeafImage = LeafImage

      mcolChildren.Add mcolChildren.Count + 1, CreateChild

End Function

Public Sub Draw()

      LoadState()

      Response.Write "<table border=""0"">" & vbCrLf
      Response.Write "<tr><td>" & vbCrLf

      If Expanded Then
         Response.Write "<a href=""javascript:collapseNode('" & mszName & "')""><img src=""" & CollapseImage & """ border=""0""></a>" & vbCrLf
      ElseIf Not mbChildrenInitialized Then
         Response.Write "<img src=""" & LeafImage & """ border=0>" & vbCrLf
      Else
         Response.Write "<a href=""javascript:expandNode('" & mszName & "')""><img src=""" & ExpandImage & """ border=""0""></a>" & vbCrLf
      End If

      Response.Write "</td>" & vbCrLf
      Response.Write "<td>" & Value & "</td></tr>" & vbCrLf

      If Expanded Then
         Response.Write "<input type=""hidden"" name=""" & mszName & """ value=""1"">" & vbCrLf

         If mbChildrenInitialized Then
            Response.Write "<tr><td> </td>" & vbCrLf
            Response.Write "<td>" & vbCrLf

            For Each ChildNode In mcolChildren.Items
                  ChildNode.Draw()
            Next

            Response.Write "</td>" & vbCrLf
            Response.Write "</tr>" & vbCrLf
         End If
      End If

      Response.Write "</table>" & vbCrLf

End Sub

End Class

Class Tree

Public Top
Public Left
Public ExpandImage
Public CollapseImage
Public LeafImage
Private mszPosition
Private mcolChildren

Public Property Let Absolute(bData)
      If bData Then mszPosition = "absolute" Else mszPosition = "relative"
End Property

Public Property Get Absolute()
      Absolute = CBool(mszPosition = "absolute")
End Property

Private Sub Class_Initialize()
      Set mcolChildren = Server.CreateObject("Scripting.Dictionary")
      mnTop  = 0
      mnLeft = 0
      mszPosition = "absolute"
End Sub

Private Sub Class_Terminate()
      mcolChildren.RemoveAll()
      Set mcolChildren = Nothing
End Sub

Public Function CreateChild(szValue)

      Set CreateChild = New TreeNode

      CreateChild.Value = szValue
      CreateChild.ExpandImage = ExpandImage
      CreateChild.CollapseImage = CollapseImage
      CreateChild.LeafImage = LeafImage

      mcolChildren.Add mcolChildren.Count + 1, CreateChild

End Function

Public Sub LoadTemplate(szFileName)
      Dim objWorkingNode
      Dim colNodeStack
      Dim fsObj, tsObj
      Dim szLine
      Dim nCurrDepth, nNextDepth

      Set colNodeStack = Server.CreateObject("Scripting.Dictionary")
      Set fsObj = CreateObject("Scripting.FileSystemObject")
      Set tsObj = fsObj.OpenTextFile(szFileName, 1)

      nCurrDepth = 0
      While Not tsObj.AtEndOfLine
         nNextDepth = 1
         szLine = tsObj.ReadLine()

         If nCurrDepth = 0 Then
            Set objWorkingNode = CreateChild(Trim(szLine))
            nCurrDepth = 1
         Else
            While Mid(szLine,nNextDepth,1) = vbTab Or Mid(szLine,nNextDepth,1) = " "
                  nNextDepth = nNextDepth + 1
            WEnd

            If nNextDepth > 1 Then szLine = Trim(Mid(szLine,nNextDepth))

            If szLine <> "" Then
                  If nNextDepth > nCurrDepth Then
                     If colNodeStack.Exists(nCurrDepth) Then
                        Set colNodeStack.Item(nCurrDepth) = objWorkingNode
                     Else
                        colNodeStack.Add nCurrDepth, objWorkingNode
                     End If

                     Set objWorkingNode = objWorkingNode.CreateChild(szLine)

                     nCurrDepth = nCurrDepth + 1
                  ElseIf nNextDepth <= nCurrDepth Then

                     If nNextDepth > 1 Then

                        nNextDepth = nNextDepth - 1
                        While Not colNodeStack.Exists(nNextDepth) And nNextDepth > 1
                              nNextDepth = nNextDepth - 1
                        WEnd

                        Set objWorkingNode = colNodeStack.Item(nNextDepth)
                        Set objWorkingNode = objWorkingNode.CreateChild(szLine)

                        nNextDepth = nNextDepth + 1
                     Else
                        Set objWorkingNode = CreateChild(szLine)
                     End If

                     nCurrDepth = nNextDepth
                  End If
            End If

         End If
      WEnd

      tsObj.Close()
      Set tsObj = Nothing
      Set fsObj = Nothing

      colNodeStack.RemoveAll()
      Set colNodeStack = Nothing

End Sub

Public Sub Draw()

      AddClientScript()

      Response.Write "<div id=""treectrl"" style=""left: " & Left & "px; top: " & Top & "px; position: " & mszPosition & ";"">" & vbCrLf
      Response.Write "<form name=""treectrlfrm"" action=""" & Request.ServerVariables("SCRIPT_NAME") & """ method=""get"">" & vbCrLf
      Response.Write "<table border=""0"">" & vbCrLf
      Response.Write "<tr><td>" & vbCrLf

      For Each ChildNode In mcolChildren.Items
         ChildNode.Draw()
      Next

      Response.Write "</td></tr>" & vbCrLf
      Response.Write "</table>" & vbCrLf

      Response.Write "<input type=""hidden"" name=""togglenode"" value="""">" & vbCrLf
      Response.Write "</form>" & vbCrLf
      Response.Write "</div>" & vbCrLf

End Sub

Private Sub AddClientScript()
%>
      <script language="JavaScript">

      function expandNode(szNodeName)
      {
         if(document.layers != null) {
            document.treectrl.document.treectrlfrm.togglenode.value = szNodeName;
            document.treectrl.document.treectrlfrm.submit();
         }
         else {
            document.all["treectrlfrm"].togglenode.value = szNodeName;
            document.all["treectrlfrm"].submit();
         }
      }

      function collapseNode(szNodeName)
      {
         if(document.layers != null) {
            document.treectrl.document.treectrlfrm.elements[szNodeName].value = -1;
            document.treectrl.document.treectrlfrm.submit();
         }
         else {
            document.treectrlfrm.elements[szNodeName].value = -1;
            document.treectrlfrm.submit();
         }
      }

      </script>
<%
End Sub

End Class

%>
演示地址：http://www.cnaspol.com/templatetree/test.asp