'────────────────────────────────
' Return the string of the data query
Private function GetDbIpInfo(byVal sql)
Dim OpenIpSearchRs
Dim result
Set OpenIpSearchRs = SQLExeCute(sql)
If Not Then
result = NullToSpace(OpenIpSearchRs("COUNTRY")) & "," & NullToSpace(OpenIpSearchRs("LOCAL")) & "," &
NullToSpace(OpenIpSearchRs("THANK"))
Else
result = NULL
End If
Set OpenIpSearchRs=Nothing
GetDbIpInfo = result
End function
'────────────────────────────────
' Convert empty database record to empty characters
Private function NullToSpace(byVal rsStr)
If isNull(rsStr) Then
NullToSpace = ""
Else
NullToSpace = Trim(rsStr)
End If
End Function
End Class
%>
Classes with directory tree structure
This program has two files and some icon files
1. The code for calling class spanning tree is as follows
<%@ Language=VBScript %>
<html>
<head>
<link rel="stylesheet" href="">
<title>tree</title>
</head>
<!-- #include file="" -->
<%
'========================================
' BUILDING A TREE PROGRAMATICALLY
'========================================
' This approach would be best suited for building
' dynamic trees using For..Next loops and such.
Set MyTree2 = New Tree
= 10
= 10
= ""
= ""
= ""
' Notice the indentation used to reprensent the hierarchy
Set Node1 = ("script")
Set SubNode1 = ("server")
Set secSubNode1 = ("html")
"<A HREF=""http://127.0.0.1/"">asp</A>"
"<A HREF=""http://127.0.0.1/"">php</A>"
"<A HREF=""http://127.0.0.1/"">jsp</A>"
Set SubNode2 = ("os")
"<A HREF=""#"">winnt</A>"
"<A HREF=""#"">win2000</A>"
Set Node2 = ("Desktop")
"<A HREF=""#"">Area Code Lookup</A>"
"<A HREF=""#"">Arin Based Whois Search</A>"
"<A HREF=""#"">World Time Zone Map</A>"
()
Set MyTree2 = Nothing
%>
</BODY>
</HTML>
2. The definition of the class is as follows
<%
'******************************************************
' Author: Jacob Gilley
' Email: avis7@
' 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 =
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
()
Set mcolChildren = Nothing
End If
End Sub
Private Sub InitChildList()
Set mcolChildren = ("")
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
= szValue
= ExpandImage
= CollapseImage
= LeafImage
+ 1, CreateChild
End Function
Classes with directory tree structure (2)
-------------------------------------
Public Sub Draw()
LoadState()
"<table border=""0"">" & vbCrLf
"<tr><td>" & vbCrLf
If Expanded Then
"<a href=""javascript:collapseNode('" & mszName & "')""><img src=""" & CollapseImage & """ border=""0""></a>" & vbCrLf
ElseIf Not mbChildrenInitialized Then
"<img src=""" & LeafImage & """ border=0>" & vbCrLf
Else
"<a href=""javascript:expandNode('" & mszName & "')""><img src=""" & ExpandImage & """ border=""0""></a>" & vbCrLf
End If
"</td>" & vbCrLf
"<td>" & Value & "</td></tr>" & vbCrLf
If Expanded Then
"<input type=""hidden"" name=""" & mszName & """ value=""1"">" & vbCrLf
If mbChildrenInitialized Then
"<tr><td> </td>" & vbCrLf
"<td>" & vbCrLf
For Each ChildNode In
()
Next
"</td>" & vbCrLf
"</tr>" & vbCrLf
End If
End If
"</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 = ("")
mnTop = 0
mnLeft = 0
mszPosition = "absolute"
End Sub
Private Sub Class_Terminate()
()
Set mcolChildren = Nothing
End Sub
Public Function CreateChild(szValue)
Set CreateChild = New TreeNode
= szValue
= ExpandImage
= CollapseImage
= LeafImage
+ 1, CreateChild
End Function
Public Sub LoadTemplate(szFileName)
Dim objWorkingNode
Dim colNodeStack
Dim fsObj, tsObj
Dim szLine
Dim nCurrDepth, nNextDepth
Set colNodeStack = ("")
Set fsObj = CreateObject("")
Set tsObj = (szFileName, 1)
nCurrDepth = 0
While Not
nNextDepth = 1
szLine = ()
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 (nCurrDepth) Then
Set (nCurrDepth) = objWorkingNode
Else
nCurrDepth, objWorkingNode
End If
Set objWorkingNode = (szLine)
nCurrDepth = nCurrDepth + 1
ElseIf nNextDepth <= nCurrDepth Then
If nNextDepth > 1 Then
nNextDepth = nNextDepth - 1
While Not (nNextDepth) And nNextDepth > 1
nNextDepth = nNextDepth - 1
WEnd
Set objWorkingNode = (nNextDepth)
Set objWorkingNode = (szLine)
nNextDepth = nNextDepth + 1
Else
Set objWorkingNode = CreateChild(szLine)
End If
nCurrDepth = nNextDepth
End If
End If
End If
WEnd
()
Set tsObj = Nothing
Set fsObj = Nothing
()
Set colNodeStack = Nothing
End Sub
Public Sub Draw()
AddClientScript()
"<div id=""treectrl"" style=""left: " & Left & "px; top: " & Top & "px; position: " & mszPosition & ";"">" & vbCrLf
"<form name=""treectrlfrm"" action=""" & ("SCRIPT_NAME") & """ method=""get"">" & vbCrLf
"<table border=""0"">" & vbCrLf
"<tr><td>" & vbCrLf
For Each ChildNode In
()
Next
"</td></tr>" & vbCrLf
"</table>" & vbCrLf
"<input type=""hidden"" name=""togglenode"" value="""">" & vbCrLf
"</form>" & vbCrLf
"</div>" & vbCrLf
End Sub
Private Sub AddClientScript()
%>
<script language="JavaScript">
function expandNode(szNodeName)
{
if( != null) {
= szNodeName;
();
}
else {
["treectrlfrm"]. = szNodeName;
["treectrlfrm"].submit();
}
}
function collapseNode(szNodeName)
{
if( != null) {
[szNodeName].value = -1;
();
}
else {
[szNodeName].value = -1;
();
}
}
</script>
<%
End Sub
End Class
%>
Previous page1234567891011121314151617181920Next pageRead the full text