<%
Class PageHierarchy
Private conn
Private errorMsg
Private Sub Class_Initialize()
On Error Resume Next
Set conn = Server.CreateObject("ADODB.Connection")
conn.Open "Your_Connection_String_Here"
If Err.Number <> 0 Then
errorMsg = "Database connection failed: " & Err.Description
End If
On Error Goto 0
End Sub
Private Sub Class_Terminate()
If Not conn Is Nothing Then
conn.Close
Set conn = Nothing
End If
End Sub
Public Property Get LastError()
LastError = errorMsg
End Property
Public Function HasError()
HasError = Len(errorMsg) > 0
End Function
Private Sub ClearError()
errorMsg = ""
End Sub
Public Function GenerateHierarchyCode(parentID)
On Error Resume Next
Dim rs, newHierarchy
Set rs = Server.CreateObject("ADODB.Recordset")
If parentID = -1 Then
sql = "SELECT MAX(fldhierarchy) as maxHier FROM tblsitepages WHERE fldparentid = -1"
rs.Open sql, conn
If Err.Number <> 0 Then
errorMsg = "Failed to generate hierarchy code: " & Err.Description
GenerateHierarchyCode = ""
Exit Function
End If
If rs.EOF Or IsNull(rs("maxHier")) Then
newHierarchy = "00001.00000"
Else
nextNum = CInt(Left(rs("maxHier"), 5)) + 1
newHierarchy = Right("00000" & nextNum, 5) & ".00000"
End If
Else
sql = "SELECT p.fldhierarchy, " & _
"(SELECT MAX(RIGHT(fldhierarchy, 5)) " & _
"FROM tblsitepages WHERE fldparentid = " & parentID & ") as maxChild " & _
"FROM tblsitepages p WHERE fldpageid = " & parentID
rs.Open sql, conn
If Err.Number <> 0 Then
errorMsg = "Failed to generate hierarchy code: " & Err.Description
GenerateHierarchyCode = ""
Exit Function
End If
If Not rs.EOF Then
parentHier = Left(rs("fldhierarchy"), 5)
If IsNull(rs("maxChild")) Then
childNum = "00001"
Else
nextChild = CInt(rs("maxChild")) + 1
childNum = Right("00000" & nextChild, 5)
End If
newHierarchy = parentHier & "." & childNum
End If
End If
rs.Close
Set rs = Nothing
GenerateHierarchyCode = newHierarchy
On Error Goto 0
End Function
Public Function MovePage(pageID, newParentID)
On Error Resume Next
Dim rs, oldHierarchy, newHierarchy, affected
' Validate that we're not moving a page to its own descendant
If IsDescendant(pageID, newParentID) Then
errorMsg = "Cannot move a page to its own descendant"
MovePage = False
Exit Function
End If
' Begin transaction
conn.BeginTrans
' Get old hierarchy
Set rs = conn.Execute("SELECT fldhierarchy FROM tblsitepages WHERE fldpageid = " & pageID)
If Not rs.EOF Then
oldHierarchy = rs("fldhierarchy")
Else
conn.RollbackTrans
errorMsg = "Page not found"
MovePage = False
Exit Function
End If
' Generate new hierarchy code
newHierarchy = GenerateHierarchyCode(newParentID)
If Len(newHierarchy) = 0 Then
conn.RollbackTrans
MovePage = False
Exit Function
End If
' Update the page and all its descendants
sql = "UPDATE tblsitepages SET " & _
"fldhierarchy = '" & newHierarchy & "' + SUBSTRING(fldhierarchy, LEN('" & oldHierarchy & "')+1, LEN(fldhierarchy)), " & _
"fldparentid = CASE fldpageid WHEN " & pageID & " THEN " & newParentID & " ELSE fldparentid END " & _
"WHERE fldhierarchy LIKE '" & oldHierarchy & "%'"
conn.Execute sql, affected
If Err.Number <> 0 Then
conn.RollbackTrans
errorMsg = "Failed to move page: " & Err.Description
MovePage = False
Exit Function
End If
conn.CommitTrans
MovePage = True
On Error Goto 0
End Function
Private Function IsDescendant(ancestorID, descendantID)
If ancestorID = descendantID Then
IsDescendant = True
Exit Function
End If
Dim rs
Set rs = conn.Execute("SELECT fldparentid FROM tblsitepages WHERE fldpageid = " & descendantID)
If Not rs.EOF Then
If rs("fldparentid") = -1 Then
IsDescendant = False
Else
IsDescendant = IsDescendant(ancestorID, rs("fldparentid"))
End If
Else
IsDescendant = False
End If
rs.Close
End Function
Public Function GetPageHierarchy()
On Error Resume Next
Dim html, rs
Set rs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT fldpageid, fldpagename, fldparentid, fldhierarchy " & _
"FROM tblsitepages " & _
"ORDER BY fldhierarchy"
rs.Open sql, conn
If Err.Number <> 0 Then
errorMsg = "Failed to retrieve hierarchy: " & Err.Description
GetPageHierarchy = ""
Exit Function
End If
' Add CSS styles
html = "<style>" & _
".page-tree { font-family: Arial, sans-serif; list-style: none; padding: 0; }" & _
".page-tree ul { list-style: none; padding-left: 20px; }" & _
".page-tree li { margin: 10px 0; padding: 8px; border: 1px solid #ddd; border-radius: 4px; }" & _
".page-tree li:hover { background: #f5f5f5; }" & _
".page-controls { float: right; }" & _
".page-controls a { margin-left: 10px; color: #0066cc; text-decoration: none; }" & _
".page-controls a:hover { text-decoration: underline; }" & _
".drag-handle { cursor: move; color: #666; margin-right: 10px; }" & _
"</style>"
html = html & "<ul class='page-tree' id='pageTree'>"
' First pass - top level pages
Do While Not rs.EOF
If rs("fldparentid") = -1 Then
html = html & "<li data-pageid='" & rs("fldpageid") & "'>" & _
"<span class='drag-handle'>☰</span>" & _
"<span class='page-name'>" & rs("fldpagename") & "</span>" & _
"<div class='page-controls'>" & _
"<a href='#' onclick='editPage(" & rs("fldpageid") & "); return false;'>Edit</a>" & _
"<a href='#' onclick='deletePage(" & rs("fldpageid") & "); return false;'>Delete</a>" & _
"</div>" & _
RenderSubPages(rs("fldpageid"), rs) & _
"</li>"
End If
rs.MoveNext
Loop
html = html & "</ul>"
' Add JavaScript for drag and drop
html = html & "<script>" & _
"function initDragAndDrop() {" & _
" const pageTree = document.getElementById('pageTree');" & _
" new Sortable(pageTree, {" & _
" group: 'nested'," & _
" animation: 150," & _
" fallbackOnBody: true," & _
" swapThreshold: 0.65," & _
" handle: '.drag-handle'," & _
" onEnd: function(evt) {" & _
" const pageId = evt.item.getAttribute('data-pageid');" & _
" const newParentId = evt.to.closest('li');" & _
" const parentId = newParentId ? newParentId.getAttribute('data-pageid') : -1;" & _
" updatePageHierarchy(pageId, parentId);" & _
" }" & _
" });" & _
"}" & _
"function updatePageHierarchy(pageId, newParentId) {" & _
" // Send AJAX request to update hierarchy" & _
" fetch('update_hierarchy.asp', {" & _
" method: 'POST'," & _
" headers: { 'Content-Type': 'application/x-www-form-urlencoded' }," & _
" body: 'pageId=' + pageId + '&newParentId=' + newParentId" & _
" }).then(response => response.json())" & _
" .then(data => {" & _
" if (!data.success) alert('Failed to update page hierarchy');" & _
" });" & _
"}" & _
"document.addEventListener('DOMContentLoaded', initDragAndDrop);" & _
"</script>"
rs.Close
Set rs = Nothing
GetPageHierarchy = html
On Error Goto 0
End Function
Private Function RenderSubPages(parentID, rs)
' ... (previous RenderSubPages code remains the same) ...
End Function
Public Function DeletePage(pageID)
On Error Resume Next
' Check if page has children
Dim rs
Set rs = conn.Execute("SELECT COUNT(*) as childCount FROM tblsitepages WHERE fldparentid = " & pageID)
If Not rs.EOF And rs("childCount") > 0 Then
errorMsg = "Cannot delete page with children. Delete children first."
DeletePage = False
Exit Function
End If
conn.Execute "DELETE FROM tblsitepages WHERE fldpageid = " & pageID
If Err.Number <> 0 Then
errorMsg = "Failed to delete page: " & Err.Description
DeletePage = False
Else
DeletePage = True
End If
On Error Goto 0
End Function
End Class
%>
<!-- Example usage with error handling: -->
<%
Dim pages
Set pages = New PageHierarchy
' Add a page with error handling
Dim newPageID
newPageID = pages.AddPage("New Page", -1)
If pages.HasError() Then
Response.Write "Error: " & pages.LastError()
End If
' Move a page with error handling
If Not pages.MovePage(1, 2) Then
Response.Write "Error moving page: " & pages.LastError()
End If
' Display the hierarchy with drag-and-drop enabled
Response.Write pages.GetPageHierarchy()
Set pages = Nothing
%>
