fuction.asp

asp无限分类之源码！适合于新手！ 这是一个实例！

<%
Function charcheck(txt)
	charcheck=txt
	chrtxt="33|34|35|36|37|38|39|40|41|42|43|44|47|58|59|60|61|62|63|91|92|93|94|96|123|124|125|126|128"
	chrtext=split(chrtxt,"|")
	for c=0 to ubound(chrtext)
		charcheck=replace(charcheck,chr(chrtext(c)),"")
	next
End Function

Function GetIp()'获取真实IP
    dim realip,proxy
    realip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    proxy = Request.ServerVariables("REMOTE_ADDR")
    If realip = "" then
        GetIp = proxy
    else
        GetIp = realip
    End if
End Function

Function HTMLDecode(reString) 'HTML解码函数(保存或提交数据时使用,可以不使用)
    Dim Str:Str=reString
    If Not IsNull(Str) Then
        Str = Replace(Str,"&","&")
        Str = Replace(Str,">",">")
        Str = Replace(Str,"<","<")
        Str = Replace(Str," ",CHR(32))
        Str = Replace(Str," ",CHR(9))
        Str = Replace(Str,"    ",CHR(9))
'        Str = Replace(Str, """, CHR(34))
        Str = Replace(Str,"'",CHR(39))
        Str = Replace(Str,"",CHR(13))
        Str = Replace(Str,"<br>",CHR(10))
        HTMLDecode = Str
    End If
End Function

Function ErrorMsg(Msgstr)'错误提示
	response.write "<script language='javascript'>"
	response.write "alert('"&Msgstr&"');"
	response.write "</script>"
	response.End()
End Function

Function ErrorMsgExit(Msgstr)'返回上一页面的错误提示窗
	response.write "<script language='javascript'>"
	response.write "alert('"&Msgstr&"');"
	response.write "location.href='javascript:history.go(-1)';"
	response.write "</script>"
	response.End()
End Function

Function ErrorMsgUrl(Msgstr,Urlstr)'带返回路径的错误提示窗
	response.write "<script language='javascript'>"
	response.write "alert('"&Msgstr&"');"
	response.write "location.href='"&Urlstr&"';"
	response.write "</script>"
	response.End()
End Function

Function closeRs(rs)
    rs.close
	set rs=nothing
End Function

Function EditClass(ClassID,ClassName,ClassCon,ClassOrderId)'修改分类函数。
   ' Response.Write "Update Class Set ClassName='"&ClassName&"',ClassCon='"&ClassCon&"',ClassOrderId="&ClassOrderId&" where Classid="&ClassID
	'Response.End()
    Conn.Execute "Update Class Set ClassName='"&ClassName&"',ClassCon='"&ClassCon&"',ClassOrderId="&ClassOrderId&" where Classid="&ClassID
	Call ErrorMsgUrl("修改成功，点击确定返回","Class.asp")
End Function

Function DelClass(ClassID)'删除分类函数。
    Set DelRs = Server.CreateObject("ADODB.Recordset")
	DelSql="select * from Class where Classid="&ParentID
    DelRs.Open DelSql,conn,1,3
    If DelRs.Recordcount<>1 or DelRs("ParentID")=0 then
	   ErrorMsg("非法数据或者所删除分类为顶级分类！")
	End If
    Conn.Execute "Delete from Class where ClassIDPath like '"&DelRs("ClassIDPath")&"%'"
	closeRs(DelRs)
	Call ErrorMsgUrl("删除成功，点击确定返回","Class.asp")
End Function

Function AddClass(ParentID,ClassName,ClassCon,ClassOrderId)'增加分类函数，ParentID为目前增加的分类所属父节点ID
    If ClassName="" or ParentID="" or Not Isnumeric(ParentID) Then
	   ErrorMsg("数据格式错误")
	End If
	If ClassOrderId="" or Not Isnumeric(ClassOrderId) Then
	   ClassOrderId=1
	End If
    Set AddClassRs = Server.CreateObject("ADODB.Recordset")
	AddClassSql="select * from Class where Classid="&ParentID
    AddClassRs.Open AddClassSql,conn,1,3
	If ParentID=0 then
	   ClassIDPath="0,"
	Else	
	   If AddClassRs.Recordcount<>1 then
		  closeRs(AddClassRs)
		  ErrorMsg("指定类别不存在")
	   End If
	   ClassIDPath=AddClassRs("ClassIDPath")
	End If
'	Response.Write ClassIDPath&","&ClassName&","&ClassCon&","&ClassOrderId
'	Response.End()
	AddClassRs.AddNew
	AddClassRs("ClassName")=ClassName
	AddClassRs("ParentID")=ParentID
	AddClassRs("ClassOrderId")=ClassOrderId
	AddClassRs("ClassCon")=ClassCon
	AddClassRs("ClassIDPath")=ClassIDPath&AddClassRs("ClassID")&","
	AddClassRs.Update
	closeRs(AddClassRs)
	Call ErrorMsgUrl("增加成功，点击确定返回","Class.asp")
End Function

Function ViewClass(ParentID,k)'后台树型列表显示分类名
	Set Rss = Conn.Execute("select * from Class where ParentID="&ParentID&" order by ClassOrderId,ClassId")
	Do While Not Rss.EOF
	   Response.Write "<tr><td height='20'>|－" & tmp(k) &""& Rss("ClassName") &"&nbsp;&nbsp;<a href='Class.asp?action=classadd&ParentID="&Rss("ClassID")&"'>增加</a>&nbsp;&nbsp;<a href='Class.asp?action=classedit&ParentID="&Rss("ClassID")&"'>修改</a>&nbsp;&nbsp;"
	   %>
	   <a href="#" onClick="{if(confirm('此分类下所有小分类将同时删除，确定要执行删除操作吗？')){location.href='Class.asp?classaction=classdel&ParentID=<%=Rss("ClassID")%>';return true;}return false;}">删除</a>
	   <%
	   Response.Write ViewClass(Rss("ClassID"),k+1)
	   Rss.MoveNext
	Loop
	Rss.close
	set Rss = nothing
End Function

Function tmp(n)'显示缩进符号
	For i = 0 To n
		tmp = tmp & "－"
	Next
End Function
%>