下面这段代码是无限级分类代码
但是添加分类一直运行错误，本人找不到原因，请大家指教
问题应该在sub saveadd,修改和删除分类可以使用
<%
Dim Action,ParentID,ErrMsg,FoundErr,strTemp
ParentID=trim(request("ParentID"))
Action=trim(Request("Action"))
if ParentID="" then
ParentID=0
else
ParentID=CLng(ParentID)
end if
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>分类管理</title>
<link href="style.css" rel="stylesheet" type="text/css">
</head>
<body>
<table width="100%" border="0" align="center" cellpadding="2" cellspacing="1" class="border">
<tr class="topbg">
<td height="22" colspan="2" align="center"><strong>信 息 分 类 管 理</strong></td>
</tr>
<tr class="tdbg">
<td width="100" height="30" ><strong>分类管理导航：</strong></td>
<td> <a href="?Action=Add">添加分类</a> | <a href="?">管理分类</a></td>
</tr>
</table>
<%
if Action="Add" then
call AddClass()
elseif Action="SaveAdd" then
call SaveAdd()
elseif Action="Modify" then
call Modify()
elseif Action="SaveModify" then
call SaveModify()
elseif Action="Del" then
call DeleteClass()
else
call main()
end if
conn.close
set conn=nothing
if FoundErr=True then
call WriteErrMsg()
end if
sub main()
dim arrShowLine(10)
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
dim sqlClass,rsClass,i,iDepth
sqlClass="select * From zl_class order by RootID,OrderID"
set rsClass=server.CreateObject("adodb.recordset")
rsClass.open sqlClass,conn,1,1
%>
<table width="100%" border="0" cellpadding="2" cellspacing="1" class="border">
<tr align="center" class="title">
<td width="50%" height="22"><strong>信息分类名称</strong></td>
<td><strong>操作选项</strong></td>
</tr>
<%
If Not rsClass.Eof Then
do while not rsClass.eof
%>
<tr class="tdbg">
<td>
<%
iDepth=rsClass("Depth")
if rsClass("NextID")>0 then
arrShowLine(iDepth)=True
else
arrShowLine(iDepth)=False
end if
if iDepth>0 then
for i=1 to iDepth
if i=iDepth then
if rsClass("NextID")>0 then
response.write "<img src='images/tree/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
else
response.write "<img src='images/tree/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
end if
else
if arrShowLine(i)=True then
response.write "<img src='images/tree/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
else
response.write "<img src='images/tree/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
end if
end if
next
end if
if rsClass("Child")>0 then
response.write "<img src='images/tree/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>"
else
response.write "<img src='images/tree/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>"
end if
if rsClass("Depth")=0 then
response.write "<b>"
end if
response.write "<a href='?Action=Modify&ClassID=" & rsClass("ClassID") & "' title='" & rsClass("ClassName") & "'>" & rsClass("ClassName") & "</a>"
if rsClass("Child")>0 then
response.write "（" & rsClass("Child") & "）"
end if
%>
</td>
<td align="center">
<a href="?Action=Add&ParentID=<%=rsClass("ClassID")%>">添加子分类</a>
| <a href="?Action=Modify&ClassID=<%=rsClass("ClassID")%>">修改设置</a> | <a href="?Action=Del&ClassID=<%=rsClass("ClassID")%>" onClick="<%if rsClass("Child")>0 then%>return ConfirmDel1();<%else%>return ConfirmDel2();<%end if%>">删除分类</a> </td>
</tr>
<%
rsClass.movenext
loop
Else
Response.Write("<tr><td class=""tdbg"" height=""22"" colspan=""2"" align=""center"">请先添加分类！</td></tr>")
End If
rsClass.close
set rsClass=nothing
%>
</table>
<script language="JavaScript" type="text/JavaScript">
function ConfirmDel1()
{
alert("此分类下还有子分类，必须先删除下属子分类后才能删除此分类！");
return false;
}
function ConfirmDel2()
{
if(confirm("删除分类将同时删除此分类中的所有信息，并且不能恢复！确定要删除此分类吗？"))
return true;
else
return false;
}
</script>
<%
end sub
sub AddClass()
%>
<table width="100%" border="0" cellpadding="2" cellspacing="1" class="border">
<form name="form1" method="post" action="?" onSubmit="return check()">
<tr align="center" class="title">
<td height="22" colspan="2"><strong>添加分类</strong></td>
</tr>
<tr class="tdbg">
<td width="40%" align="right"><strong>所属分类</strong>：<br></td>
<td>
<select name="ParentID">
<%call ShowClass_Option(0,ParentID)%>
</select>
</td>
</tr>
<tr class="tdbg">
<td height="22" align="right"><strong>分类名称</strong>：</td>
<td>
<input name="ClassName" type="text" size="37" maxlength="20"></td>
</tr>
<tr class="tdbg">
<td colspan="2" align="center"><br>
<input name="Action" type="hidden" id="Action" value="SaveAdd"> <input name="Add" type="submit" class="button" id="Add" value="添加分类">
<input name="Cancel" type="button" class="button" id="Cancel" onClick="window.location.href='?'" value="取 消">
<br>
<br></td>
</tr>
</form>
</table>
<script language="JavaScript" type="text/JavaScript">
function check()
{
if (document.form1.ClassName.value=="")
{
alert("分类名称不能为空！");
document.form1.ClassName.focus();
return false;
}
}
</script>
<%
end sub
sub Modify()
dim ClassID,sql,rsClass,i
ClassID=trim(request("ClassID"))
if ClassID="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>参数不足！</li>"
exit sub
else
ClassID=CLng(ClassID)
end if
sql="select * From zl_class where ClassID=" & ClassID
set rsClass=server.CreateObject ("Adodb.recordset")
rsClass.open sql,conn,1,3
if rsClass.bof and rsClass.eof then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>找不到指定的分类！</li>"
else
%>
<table width="100%" border="0" cellpadding="2" cellspacing="1" class="border">
<form name="form1" method="post" action="?" onSubmit="return check()">
<tr class="title">
<td height="22" colspan="2" align="center"><strong>修改分类</strong></td>
</tr>
<tr class="tdbg">
<td width="40%" align="right"><strong>所属分类</strong>：<br></td>
<td>
<%
if rsClass("ParentID")<=0 then
response.write "无（作为一级分类）"
else
dim rsParentClass,sqlParentClass
sqlParentClass="Select * From zl_class where ClassID in (" & rsClass("ParentPath") & ") order by Depth"
set rsParentClass=server.CreateObject("adodb.recordset")
rsParentClass.open sqlParentClass,conn,1,1
do while not rsParentClass.eof
for i=1 to rsParentClass("Depth")
response.write " "
next
if rsParentClass("Depth")>0 then
response.write "└"
end if
response.write " " & rsParentClass("ClassName") & "<br>"
rsParentClass.movenext
loop
rsParentClass.close
set rsParentClass=nothing
end if
%> </td>
</tr>
<tr class="tdbg">
<td align="right"><strong>分类名称</strong>：</td>
<td><input name="ClassName" type="text" value="<%=rsClass("ClassName")%>" size="37" maxlength="20">
<input name="ClassID" type="hidden" id="ClassID" value="<%=rsClass("ClassID")%>"></td>
</tr>
<tr class="tdbg">
<td colspan="2" align="center"><br>
<input name="Action" type="hidden" id="Action" value="SaveModify"> <input name="Submit" type="submit" class="button" id="Submit" value="保存修改结果">
<input name="Cancel" type="button" class="button" id="Cancel" onClick="window.location.href='?'" value="取 消">
<br>
<br></td>
</tr>
</form>
</table>
<script language="JavaScript" type="text/JavaScript">
function check()
{
if (document.form1.ClassName.value=="")
{
alert("分类名称不能为空！");
document.form1.ClassName.focus();
return false;
}
}
</script>
<%
end if
rsClass.close
set rsClass=nothing
end sub
%>
</body>
</html>
<%
sub SaveAdd()
dim ClassID,ClassName,OnElite,OnTop,ClassPicUrl,LinkUrl,PrevOrderID
dim sql,rs,trs
dim RootID,ParentDepth,ParentPath,ParentStr,ParentName,MaxClassID,MaxRootID
dim PrevID,NextID,Child
FoundErr=False
ClassName=trim(request("ClassName"))
if ClassName="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>分类名称不能为空！</li>"
end if
if FoundErr=True then
exit sub
end if
set rs = conn.execute("select Max(ClassID) From zl_class")
MaxClassID=rs(0)
if isnull(MaxClassID) then
MaxClassID=0
end if
rs.close
ClassID=MaxClassID+1
set rs=conn.execute("select max(RootID) From zl_class")
MaxRootID=rs(0)
if isnull(MaxRootID) then
MaxRootID=0
end if
rs.close
RootID=MaxRootID+1
if ParentID>0 then
sql="select * From zl_class where ClassID=" & ParentID & ""
rs.open sql,conn,1,1
if rs.bof and rs.eof then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>所属分类已经被删除！</li>"
end if
if FoundErr=True then
rs.close
set rs=nothing
exit sub
else
RootID=rs("RootID")
ParentName=rs("ClassName")
ParentDepth=rs("Depth")
ParentPath=rs("ParentPath")
Child=rs("Child")
ParentPath=ParentPath & "," & ParentID '得到此分类的父级分类路径
PrevOrderID=rs("OrderID")
if Child>0 then
dim rsPrevOrderID
'得到与本分类同级的最后一个分类的OrderID
set rsPrevOrderID=conn.execute("select Max(OrderID) From zl_class where ParentID=" & ParentID)
PrevOrderID=rsPrevOrderID(0)
set trs=conn.execute("select ClassID From zl_class where ParentID=" & ParentID & " and OrderID=" & PrevOrderID)
PrevID=trs(0)
'得到同一父分类但比本分类级数大的子分类的最大OrderID，如果比前一个值大，则改用这个值。
set rsPrevOrderID=conn.execute("select Max(OrderID) From zl_class where ParentPath like '" & ParentPath & ",%'")
if (not(rsPrevOrderID.bof and rsPrevOrderID.eof)) then
if not IsNull(rsPrevOrderID(0)) then
if rsPrevOrderID(0)>PrevOrderID then
PrevOrderID=rsPrevOrderID(0)
end if
end if
end if
else
PrevID=0
end if
end if
rs.close
else
if MaxRootID>0 then
set trs=conn.execute("select ClassID From zl_class where RootID=" & MaxRootID & " and Depth=0")
PrevID=trs(0)
trs.close
else
PrevID=0
end if
PrevOrderID=0
ParentPath="0"
end if
sql="Select * From zl_class Where ParentID=" & ParentID & " AND ClassName='" & ClassName & "'"
set rs=server.CreateObject("adodb.recordset")
rs.open sql,conn,1,1
if not(rs.bof and rs.eof) then
FoundErr=True
if ParentID=0 then
ErrMsg=ErrMsg & "<br><li>已经存在一级分类：" & ClassName & "</li>"
else
ErrMsg=ErrMsg & "<br><li>“" & ParentName & "”中已经存在子分类“" & ClassName & "”！</li>"
end if
rs.close
set rs=nothing
exit sub
end if
rs.close
sql="Select top 1 * From zl_class"
rs.open sql,conn,1,3
rs.addnew
rs("ClassID")=ClassID
rs("ClassName")=ClassName
rs("RootID")=RootID
rs("ParentID")=ParentID
if ParentID>0 then
rs("Depth")=ParentDepth+1
else
rs("Depth")=0
end if
rs("ParentPath")=ParentPath
rs("OrderID")=PrevOrderID
rs("Child")=0
rs("PrevID")=PrevID
rs("NextID")=0
rs.update
rs.Close
set rs=Nothing
'更新与本分类同一父分类的上一个分类的“NextID”字段值
if PrevID>0 then
conn.execute("update zl_class set NextID=" & ClassID & " where ClassID=" & PrevID)
end if
if ParentID>0 then
'更新其父类的子分类数
conn.execute("update zl_class set Child=Child+1 where ClassID="&ParentID)
'更新该分类排序以及大于本需要和同在本分类下的分类排序序号
conn.execute("update zl_class set OrderID=OrderID+1 where RootID=" & rootid & " and OrderID>" & PrevOrderID)
conn.execute("update zl_class set OrderID=" & PrevOrderID & "+1 where ClassID=" & ClassID)
end if
Response.Redirect "?"
end sub
sub SaveModify()
dim ClassName,OnElite,OnTop,ClassPicUrl,LinkUrl
dim trs,rs
dim ClassID,sql,rsClass,i
FoundErr=False
ClassID=trim(request("ClassID"))
if ClassID="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>参数不足！</li>"
else
ClassID=CLng(ClassID)
end if
ClassName=trim(request("ClassName"))
OnElite=trim(request("OnElite"))
OnTop=trim(request("OnTop"))
ClassPicUrl=trim(request("ClassPicUrl"))
LinkUrl=trim(request("LinkUrl"))
if ClassName="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>分类名称不能为空！</li>"
end if
if FoundErr=True then
exit sub
end if
sql="select * From zl_class where ClassID=" & ClassID
set rsClass=server.CreateObject ("Adodb.recordset")
rsClass.open sql,conn,1,3
if rsClass.bof and rsClass.eof then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>找不到指定的分类！</li>"
rsClass.close
set rsClass=nothing
exit sub
end if
if rsClass("Child")>0 and LinkUrl<>"" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>本分类有子分类，所以不能设为外部链接地址。</li>"
end if
if OnElite="Yes" then
OnElite=True
else
OnElite=False
end if
if OnTop="Yes" then
OnTop=True
else
OnTop=False
end if
if FoundErr=True then
rsClass.close
set rsClass=nothing
exit sub
end if
rsClass("ClassName")=ClassName
rsClass.update
rsClass.close
set rsClass=nothing
Response.Redirect "?"
end sub
sub DeleteClass()
dim sql,rs,PrevID,NextID,ClassID
FoundErr=False
ClassID=trim(Request("ClassID"))
if ClassID="" then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>参数不足！</li>"
exit sub
else
ClassID=CLng(ClassID)
end if
sql="select * From zl_class where ClassID=" & ClassID
set rs=server.CreateObject ("Adodb.recordset")
rs.open sql,conn,1,3
if rs.bof and rs.eof then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>分类不存在，或者已经被删除</li>"
else
if rs("Child")>0 then
FoundErr=True
ErrMsg=ErrMsg & "<br><li>该分类含有子分类，请删除其子分类后再进行删除本分类的操作</li>"
end if
end if
if FoundErr=True then
rs.close
set rs=nothing
exit sub
end if
PrevID=rs("PrevID")
NextID=rs("NextID")
if rs("Depth")>0 then
conn.execute("update zl_class set Child=Child-1 where ClassID=" & rs("ParentID"))
end if
rs.delete
rs.update
rs.close
set rs=nothing
'修改上一分类的NextID和下一分类的PrevID
if PrevID>0 then
conn.execute "update zl_class set NextID=" & NextID & " where ClassID=" & PrevID
end if
if NextID>0 then
conn.execute "update zl_class set PrevID=" & PrevID & " where ClassID=" & NextID
end if
Response.Redirect "?"
end sub
sub ShowClass_Option(ShowType,CurrentID)
if ShowType=0 then
response.write "<option value='0'"
if CurrentID=0 then response.write " selected"
response.write ">-请选择-</option>"
end if
dim rsClass,sqlClass,strTemp,tmpDepth,i
dim arrShowLine(20)
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
sqlClass="select * From zl_class order by RootID,OrderID"
set rsClass=Conn.execute(sqlClass)
if rsClass.bof and rsClass.eof then
response.write "<option value=''>请先添加信息分类</option>"
else
do while not rsClass.eof
tmpDepth=rsClass("Depth")
if rsClass("NextID")>0 then
arrShowLine(tmpDepth)=True
else
arrShowLine(tmpDepth)=False
end if
if ShowType=1 then
strTemp="<option value='" & rsClass("ClassID") & "'"
elseif ShowType=2 then
strTemp="<option value='" & rsClass("ClassID") & "'"
elseif ShowType=3 then
if rsClass("Child")>0 then
strTemp="<option value=''"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
elseif ShowType=4 then
if rsClass("Child")>0 then
strTemp="<option value=''"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
if CurrentID>0 and rsClass("ClassID")=CurrentID then
strTemp=strTemp & " selected"
end if
strTemp=strTemp & ">"
if tmpDepth>0 then
for i=1 to tmpDepth
strTemp=strTemp & " "
if i=tmpDepth then
if rsClass("NextID")>0 then
strTemp=strTemp & "├ "
else
strTemp=strTemp & "└ "
end if
else
if arrShowLine(i)=True then
strTemp=strTemp & "│"
else
strTemp=strTemp & " "
end if
end if
next
end if
strTemp=strTemp & rsClass("ClassName")
strTemp=strTemp & "</option>"
response.write strTemp
rsClass.movenext
loop
end if
rsClass.close
set rsClass=nothing
end sub
%>
附：表结构（表名为zl_class，以下是其包含字段名和字段类型）
ClassID ClassName ParentID ParentPath Depth RootID Child PrevID NextID OrderID
自动编号 文本 数字 文本 数字 数字 数字 数字 数字 数字
[此贴子已经被作者于2007-6-29 16:59:49编辑过]
