<%
' Database field is a Class property, add, delete, modify, action-check functions such as class method
Class Cls_leibie
Private Nclassid,sclassname,nparentid,sparentpath,ndepth,nrootid,nchild,norderid,sfilepath ' defines the properties of the class, That is, the database field corresponds to the variable)
Private Rs,sql,errorstr
Private Sub Class_Initialize ()
Errorstr= ' "' initialization error message is NULL
End Sub
Private Sub Class_Terminate () to close a database connection when destroying a class
If IsObject (Conn) Then
Conn.close
Set Conn = Nothing
End If
End Sub
' ******************* Set individual properties ******************************************************
Public Property Let ClassID (str) ' Get Category ID (primary key)
Nclassid=str
Call Classproperty () ' Gets the class ID called this function to read all the properties of the class
End Property
Public Property Let ClassName (str) ' Get category name
Sclassname=str
End Property
Public Property Get ClassName
Classname=sclassname
End Property
Public Property Let ParentID (str) ' Get category Parent ID
Nparentid=str
End Property
Public Property Get ParentID
Parentid=nparentid
End Property
Public Property Let Parentpath (str) ' Gets the parent path ID
Sparentpath=str
End Property
Public Property Get Parentpath
Parentpath=sparentpath
End Property
Public Property Let Depth (str) ' Get category depth
Ndepth=str
End Property
Public Property Get Depth
Depth=ndepth
End Property
Public Property Let Rootid (str) ' Get category root ID
Nrootid=str
End Property
Public Property Get Rootid
Rootid=nrootid
End Property
Number of public Property Let children (str) subcategories
Nchild=str
End Property
Public Property Get Child
Child=nchild
End Property
Public Property Let OrderID (str) ' Sort ID
Norderid=str
End Property
Public Property Get OrderID
Orderid=norderid
End Property
Public Property Let FilePath (str) ' category file root (generate static file path, station Lao Yang Web technology blog is to generate static, so set this field)
Sfilepath=str
End Property
Public Property Get FilePath
Filepath=sfilepath
End Property
'******************************************************************************
Private Sub Classproperty () reads all properties of a class
Sql= "SELECT * from Articleclass where classid=" & Nclassid
Set Rs=conn.execute (SQL)
If not rs.eof then
Sclassname=trim (RS ("ClassName"))
Nparentid=trim (RS ("ParentID"))
Sparentpath=trim (RS ("Parentpath"))
Ndepth=trim (RS ("Depth"))
Nrootid=trim (RS ("Rootid"))
Nchild=trim (RS ("Child"))
Norderid=trim (RS ("OrderID"))
Sfilepath=trim (RS ("FilePath"))
End If
Set rs=nothing
End Sub
The Public Function Faddcheck () category adds a check function, and the result is 0 by checking that 1 indicates an error occurred, exits the function when an error occurs, and writes the error message to the error variable Errorstr
Dim tempRS
Faddcheck=0
If Sclassname= "then" class name is empty
Faddcheck=1
Errorstr= class name cannot be empty! "
Exit Function
Else
If nparentid= "then" Parent ID is empty
Faddcheck=1
Errorstr= "Parent ID cannot be empty! "
Exit Function
Else
If Nparentid<>0 Then
Set Temprs=conn.execute ("Select ClassID from Articleclass where classid=" & Nparentid) ' Parent category does not exist
If Temprs.eof Then
Faddcheck=1
Errorstr= category does not exist or has been deleted! "
Exit Function
Else
Sql= "Select ClassID from Articleclass where Classname= '" & Sclassname & "' and parentid= ' & Nparentid ' class name repeat
Set Rs=conn.execute (SQL)
If not rs.eof then
Faddcheck=1
Errorstr= "class name repeat!" "
Exit Function
End If
Set rs=nothing
End If
Set temprs=nothing
Else
Sql= "Select ClassID from Articleclass where Classname= '" & Sclassname & "' and parentid= ' & Nparentid ' class name repeat
Set Rs=conn.execute (SQL)
If not rs.eof then
Faddcheck=1
Errorstr= "class name repeat!" "
Exit Function
End If
Set rs=nothing
End If
End If
End If
End Function
Public Sub Sadd ()
Dim Maxclassid,maxrootid
Set rs = Conn.execute ("Select Max (ClassID) from Articleclass") ' finds the largest category ID in the current database, and if no data is set to 0, the category ID to insert is the current maximum ID plus 1
Maxclassid=rs (0)
If IsNull (MAXCLASSID) Then
Maxclassid=0
End If
Set rs=nothing
Nclassid=maxclassid+1
Set Rs=conn.execute ("Select Max (Rootid) from Articleclass") ' finds the largest root ID in the current database, and if no data is set to 0, the root ID to insert is the current maximum root ID plus 1
Maxrootid=rs (0)
If IsNull (Maxrootid) Then
Maxrootid=0
End If
Nrootid=maxrootid+1
Set Rs=conn.execute ("Select Rootid,depth,parentpath,child,orderid from Articleclass where classid=" & Nparentid) ' Find the appropriate information for the parent category
If not rs.eof then
Nrootid=trim (RS ("Rootid")) ' root ID is the same as the parent class root ID
Sparentpath=trim (RS ("Parentpath")) & "," &nparentid
If CInt (Trim (nparentid)) >0 Then ' parent ID is greater than 0, there is a parent class, so the depth of the category to be inserted is 1, and the parent ID is no greater than 0. The current category to be inserted is the root category, and the depth is 0
Ndepth=cint (Trim (RS ("Depth"))) +1
Else
Ndepth=0
End If
If CInt (Trim ("child")) >0 Then
Dim Rsprevorderid
' Get OrderID with the last column at the same level as this column.
Set Rsprevorderid=conn.execute ("Select Max (OrderID) from Articleclass where parentid=" & ParentID)
Prevorderid=rsprevorderid (0)
The maximum orderid of a sub column that gets the same parent column but is larger than this column, and if it is larger than the previous one, the value is instead.
Set Rsprevorderid=conn.execute ("Select Max (OrderID) from Articleclass 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
Set rsprevorderid=nothing
End If
Norderid=prevorderid+1
Else
Norderid=0
Sparentpath= "0"
Ndepth=0
End If
Set rs=nothing
Nchild=0
Sql= "INSERT into Articleclass (Classid,classname,parentid,parentpath,depth,rootid,child,orderid,filepath) VALUES (" & Nclassid & "," "& Sclassname &", "& Nparentid &", "& Sparentpath &" ', "& Ndepth & "," & Nrootid & "," & Nchild & "," & Norderid & "," & Sfilepath & ""
Conn.execute (SQL)
If Parentid>0 Then
' Update the number of child columns of its parent class
Conn.execute ("Update articleclass set child=child+1 where classid=" & Nparentid)
' Update the column order and the column order number larger than the need and the same under this category
If prevorderid<> "" Then
Conn.execute ("Update articleclass set orderid=orderid+1 where rootid=" & Nrootid & "and orderid>" & Prevord Erid & "and classid<>" & Nclassid)
End If
End If
End Sub
The Public Function Feditcheck () category modifies the check function, and the result is 0 by checking that 1 indicates an error occurred, exits the function when an error occurs, and writes the error message to the error variable Errorstr
Dim tempRS
Feditcheck=0
If nclassid= "then" Category ID is empty
Feditcheck=1
Errorstr= Category ID cannot be empty! "
Exit Function
Else
If Sclassname= "then" class name is empty
Feditcheck=1
Errorstr= class name cannot be empty! "
Exit Function
Else
If Nparentid<>0 Then
Set Temprs=conn.execute ("Select ClassID from Articleclass where classid=" & Nparentid) ' Parent category does not exist
If Temprs.eof Then
Faddcheck=1
Errorstr= category does not exist or has been deleted! "
Exit Function
Else
Set Rs=conn.execute ("Select ClassID from Articleclass where Classname= '" & Sclassname & "' and Classid<>" & Amp Nclassid & "and parentid=" & Nparentid)
If not rs.eof then ' class name duplicate
Feditcheck=1
Errorstr= "class name repeat!" "
Exit Function
End If
Set rs=nothing
End If
Set temprs=nothing
End If
End If
End If
End Function
Public Sub Sedit () ' Category modification
sql= "Update articleclass set Classname= '" & Sclassname & "', Filepath= '" & Sfilepath & "' Where classid= ' & Nclassid
Conn.execute (SQL)
End Sub
The Public Function Fdeletecheck () category deletes the check function, and the result is 0 by checking that 1 indicates an error occurred, exits the function when an error occurs, and writes the error message to the error variable Errorstr
Fdeletecheck=0 ' Here Delete the code that does not write cascading deletion of the article section, delete should cascade delete
If nclassid= "" Then
Fdeletecheck=1
Errorstr= "The category ID to be deleted cannot be empty!" "
Exit Function
Else
Set Rs=conn.execute ("Select child from Articleclass where classid=" & Nclassid)
If Rs.bof and rs.eof then
Fdeletecheck=1
Errorstr= "category does not exist or has been deleted! "
Exit Function
Else
If Trim (RS ("Child")) >0 Then
Fdeletecheck=1
Errorstr= "This category contains subcategories, delete the subcategories, and then delete this category!" "
Exit Function
End If
End If
End If
End Function
Public Sub SDelete ()
If Ndepth>0 then ' modify parent ID number of children
Conn.execute ("Update articleclass set child=child-1 where child>0 and classid=" & Nparentid)
End If
Sql= "Delete from Articleclass where classid=" & Nclassid
Conn.execute (SQL)
End Sub
Public Function Ferrstr ()
Ferrstr=errorstr
End Function
End Class
%>
Index.asp
<% @LANGUAGE = "VBSCRIPT" codepage= "65001"%>
<%
' Author site: www.guaishi.org
' E-mail: guaishiorg@126.com
' qq:514777880
session.codepage=65001
Response.Charset = "Utf-8"
%>
<! DOCTYPE HTML PUBLIC "-//W3C//DTD XHTML 1.0 transitional//en" "Http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd ">
<meta http-equiv= "Content-type" content= "text/html; Charset=utf-8 "/>
<title></title>
<style type= "Text/css" >
body{margin:0;padding:0;font-size:12px; Background-color: #FFFFFF;}
ul{List-style-type:none; margin:0 0 0 20px; padding:0;}
li{white-space:nowrap; padding:0;}
. childdiv{Background:url (images/dot.gif); background-repeat:repeat-y;}
span {cursor:pointer;}
</style>
<script type= "Text/javascript" >
var xmlHttp; Define a global variable
var currentid=1;//sets the currently selected ID, and a JS error occurs if this ID does not exist
Category Display Main function
cid--the layer ID of the child category
ID--Category ID
Pid--[+] and [-] icon IDs
fid--category Icon ID
function Divdisplay (CID,ID,PID,FID)
{
if (GetId (CID). style.display== ')//subcategory does not display the icon display control
{
GetId (CID). style.display= ' None ';
GetId (PID). src = ' images/closed.gif ';
GetId (FID). src = ' images/folder.gif ';
}
else//Expand sub-category action
{
GetId (CID). style.display= ';
GetId (PID). src = ' images/opened.gif ';
GetId (FID). src = ' images/folderopen.gif ';
if (GetId (CID). innerhtml== ' | | GetId (CID). innerhtml== ' submitting data ... ')
{
GetId (CID). Innerhtml= ';
Showchild (Cid,id); Call to show child category functions
}
}
}
Same as the previous function, only function in the last category
function DivDisplay2 (CID,ID,PID,FID)
{
if (GetId (CID). style.display== ')
{
GetId (CID). style.display= ' None ';
GetId (PID). src = ' images/lastclosed.gif ';
GetId (FID). src = ' images/folder.gif ';
}
Else
{
GetId (CID). style.display= ';
GetId (PID). src = ' images/lastopen.gif ';
GetId (FID). src = ' images/folderopen.gif ';
if (GetId (CID). innerhtml== ' | | GetId (CID). innerhtml== ' submitting data ... ')
{
GetId (CID). Innerhtml= ';
Showchild (Cid,id);
}
}
}
Category Add function
id--Category ID
function Classadd (ID) {
if (GetId ("P" +id). Src.indexof ("last") >0) {//Add action at the end of the category
if (! GetId ("P" +id). onclick) {
GetId ("P" +id). Onclick=function () {DivDisplay2 ("C" +id,id, "P" +id, "F" +id); Add Click events for [+] and [-]
GetId ("s" +id). Ondblclick=function () {DivDisplay2 ("C" +id,id, "P" +id, "F" +id); Add a double-click event for span that displays category text
GetId ("P" +id). src = ' images/lastopen.gif ';
}
}
else{
if (! GetId ("P" +id). onclick) {//No Add action for last category
GetId ("P" +id). Onclick=function () {Divdisplay ("C" +id,id, "P" +id, "F" +id);
GetId ("s" +id). Ondblclick=function () {Divdisplay ("C" +id,id, "P" +id, "F" +id);
GetId ("P" +id). src = ' images/opened.gif ';
}
}
GetId ("C" +id). style.display= ';
Showchild ("C" +id,id);
}
Category modification function
function Classedit (id,classname) {
GetId ("s" +id). Innerhtml=classname;
}
Delete function for categories with multiple subcategories
function Classdel (ID) {
Showchild ("C" +id,id);
Currentselect (Currentid,id)
Browseright (ID);
}
Delete function for category with only one subcategory
function ClassDel1 (ID) {
if (GetId ("P" +id). Src.indexof ("last") >0) {//When the category is the final category of the current category
GetId ("P" +id). style.cursor= "Cursor"; Set the icon's mouse through style
GetId ("P" +id). Onclick=function () {}; The icon Click event is modified to an empty function because only one subcategory is removed and there is no more subcategories.
GetId ("s" +id). Ondblclick=function () {}; Ditto
GetId ("P" +id). src = ' images/lastnochild.gif '; Icon Settings
}
else{
GetId ("P" +id). style.cursor= "Cursor"; Delete operations other than the last category
GetId ("P" +id). Onclick=function () {};
GetId ("s" +id). Ondblclick=function () {};
GetId ("P" +id). src = ' images/nofollow2.gif '; The icon settings here are not the same as before
}
Showchild ("C" +id,id);
Currentselect (Currentid,id);
Browseright (ID);
}
Passing parameters to the right frame
function Browseright (ID) {
Currentselect (Currentid,id);
Top. Contentframe.location= ". /articlemain.asp? Classid= "+ ID;
}
function to set category check state
function Currentselect (oldid,newid) {
Currentid=newid;
document.getElementById ("s" +oldid). style.backgroundcolor= "White";
document.getElementById ("s" +currentid). style.backgroundcolor= "#C0C0E9";
}
Creating XMLHttpRequest Objects
function Createxmlhttprequest ()
{
if (window. ActiveXObject)
{
XmlHttp = new ActiveXObject ("Microsoft.XMLHTTP");
}
Else
{
XmlHttp = new XMLHttpRequest ();
}
}
Ajax processing functions
ID, layer ID
RID, ID of the data in the table
function Showchild (cid,id)
{
Createxmlhttprequest ();
if (xmlHttp)
{
Xmlhttp.open (' POST ', ' child.asp ', true);
Xmlhttp.setrequestheader (' Content-type ', ' application/x-www-form-urlencoded ');
var senddata = ' id= ' +id;
Xmlhttp.send (SendData);
Xmlhttp.onreadystatechange=function ()
{
if (xmlhttp.readystate==4)
{
if (xmlhttp.status==200)
{
GetId (CID). InnerHTML = Xmlhttp.responsetext;
}
Else
{
GetId (CID). innerhtml= ' ERROR: ' +xmlhttp.statustext;
}
}
Else
{
GetId (CID). innerhtml= "Submitting data ...";
}
}
}
Else
{
GetId (CID). innerhtml= ' Sorry, your browser does not support XMLHttpRequest, please use IE6 above version! ';
}
}
Get Page Object
ID, layer ID
function GetId (ID)
{
return document.getElementById (ID);
}
</script>
<body>
<!--#include file= ". /conn.asp "-->
<%
' Show the root directory
Sql= "SELECT *, (select top 1 ClassID from Articleclass where depth=0 order by ClassID Desc) as LastID Articleclass Re depth=0 ORDER by ClassID "
Set Rs=conn.execute (SQL)
If not rs.eof then
Response. Write "<ul>" &vbcr
Do as not rs.eof
If CInt (Trim (RS ("ClassID"))) =cint (Trim (RS ("LastID")) Then
If RS ("child") >0 Then
Response. Write "<li> "
Response. Write " <span ' s" & Trim (RS ("ClassID")) & "onclick=" Browseright ("& Trim (RS (" ClassID)) & "" ondblclick= " DivDisplay2 (' C "&rs (" ClassID ") &" ', ' "&rs (" ClassID ") &" ', ' P "&rs (" ClassID ") &", ' F "& RS (" ClassID ") &" ') "" > "& RS (" ClassName ") &" </span> "
Else
Response. Write "<li>Response. Write " <span ' s" & Trim (RS ("ClassID")) & "onclick=" Browseright ("& Trim (RS (" ClassID ") &") ">" & RS ("ClassName ") &" </span> "
End If
Else
If RS ("child") >0 Then
Response. Write "<li>Response. Write " <span ' s" & Trim (RS ("ClassID")) & "onclick=" Browseright ("& Trim (RS (" ClassID)) & "" ondblclick= "" Divdisplay " (' C "&rs (" ClassID ") &" ', ' "&rs (" ClassID ") &" ', ' P "&rs (" ClassID ") &", ' F "& RS (" ClassID ") & "')" ">" & RS ("ClassName") & "</span>"
Else
Response. Write "<li>Response. Write " <span ' s" & Trim (RS ("ClassID")) & "onclick=" Browseright ("& Trim (RS (" ClassID ") &") ">" & RS ("ClassName ") &" </span> "
End If
End If
If CInt (Trim (RS ("ClassID"))) =cint (Trim (RS ("LastID")) Then
Response. Write "<div id= ' C" &rs ("ClassID") & "' style= ' Display:none;" ></div> "
Else
Response. Write "<div id= ' C" &rs ("ClassID") & "' style= ' display:none; ' class= '" "Childdiv" "></div>"
End If
Response. Write "</li>" &vbcr
Rs.movenext
Loop
Response. Write "</ul>" &vbcr
End If
Rs.close
Set rs=nothing
Conn.close
Set conn = Nothing
%>
</body>
