关于生成目录树结构的类

作者:admin 日期:2007-10-07

字体大小: 小中大

本程序有两文件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: avis7@airmail.net
  ' 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