本程序有两文件test.asp 和tree.asp 还有一些图标文件

1。test.asp 调用类生成树 代码如下

<%@ Language=VBScript %>

<%

'========================================

' 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 "asp"

secSubNode1.CreateChild "php"

secSubNode1.CreateChild "jsp"

Set SubNode2 = Node1.CreateChild("os")

SubNode2.CreateChild "winnt"

SubNode2.CreateChild "win2000"

Set Node2 = MyTree2.CreateChild("Desktop")

Node2.CreateChild "Area Code Lookup"

Node2.CreateChild "Arin Based Whois Search"

Node2.CreateChild "World Time Zone Map"

MyTree2.Draw()

Set MyTree2 = Nothing

%>

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 "" & vbCrLf

Response.Write "

" & vbCrLf

Response.Write "

" & vbCrLf

If Expanded Then

Response.Write "" & vbCrLf

If mbChildrenInitialized Then

Response.Write "

" & vbCrLf

Response.Write "

" & vbCrLf

Response.Write "

" & vbCrLf

End If

End If

Response.Write "

" & vbCrLf If Expanded Then Response.Write "" & vbCrLf ElseIf Not mbChildrenInitialized Then Response.Write "" & vbCrLf Else Response.Write "" & vbCrLf End If Response.Write "	" & Value & "
	" & vbCrLf For Each ChildNode In mcolChildren.Items ChildNode.Draw() Next Response.Write "

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

" & vbCrLf

End Sub

Private Sub AddClientScript()

%>

<%

End Sub

End Class

%>