aspでディレクトリツリー構造のクラスを生成します。


ディレクトリツリー構造を生成するクラスについて
このプログラムは2つのファイルのtest.aspがあります。 とtree.asp いくつかのアイコンファイルがあります。
1です。test.asp クラス生成ツリーを呼び出します コードは以下の通りです

<%@ Language=VBScript %> 
<html> 
<head> 
<link rel="stylesheet" href="tree.css"> 
<title>tree</title> 
</head> 
<!-- #include file="tree.asp" --> 
<% 

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

%> 
以上が本文の全部です。皆さんの勉強に役に立つように、私たちを応援してください。