Imports System.Data
Imports System.Configuration
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Web
Imports System.Web.Configuration
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports System.Xml
'''
''' Extends the XmlSiteMapProvider class with edit functionality
''' Requires all siteMapNodes to have unique titles.
'''
Public Class EditableXmlSiteMapProvider
Inherits XmlSiteMapProvider
Public Sub New()
End Sub
Public Shadows Sub AddNode(ByVal parentTitle As String, ByVal title As String, ByVal url As String, ByVal roles As String)
Dim doc As XmlDocument = LoadXmlDoc()
Dim parent As XmlElement = FindNodeByTitle(doc, parentTitle)
Dim newChild As XmlElement = doc.CreateElement("siteMapNode")
newChild.SetAttribute("url", url)
' url must go in lower case to get xpath to work
newChild.SetAttribute("title", title)
' url must go in lower case to get xpath to work
newChild.SetAttribute("roles", roles)
parent.AppendChild(newChild)
SaveXmlDoc(doc)
End Sub
Public Sub UpdateNode(ByVal originalTitle As String, ByVal newParentTitle As String, ByVal title As String, ByVal url As String, ByVal roles As String)
Dim doc As XmlDocument = LoadXmlDoc()
Dim node As XmlElement = FindNodeByTitle(doc, originalTitle)
node.SetAttribute("url", url)
' url must go in lower case to get xpath to work
node.SetAttribute("title", title)
' url must go in lower case to get xpath to work
node.SetAttribute("roles", roles)
' check if the parent has changed
If node.ParentNode.Attributes("title").Value <> newParentTitle Then
node.ParentNode.RemoveChild(node)
' find the new parent
Dim newParent As XmlElement = FindNodeByTitle(doc, newParentTitle)
newParent.AppendChild(node)
End If
SaveXmlDoc(doc)
End Sub
Public Sub DeleteNode(ByVal title As String)
Dim doc As XmlDocument = LoadXmlDoc()
Dim node As XmlElement = FindNodeByTitle(doc, title)
node.ParentNode.RemoveChild(node)
SaveXmlDoc(doc)
End Sub
Private Function LoadXmlDoc() As XmlDocument
Dim doc As New XmlDocument()
doc.Load(HttpContext.Current.Server.MapPath(FilePath))
Return doc
End Function
Private Sub SaveXmlDoc(ByVal doc As XmlDocument)
Dim AbsPath As String = HttpContext.Current.Server.MapPath(FilePath)
Try
doc.Save(AbsPath)
Catch ex As UnauthorizedAccessException
Try
' try to remove 'read-only' attribute on the file.
'WebUtil.RemoveReadOnlyFileAttribute(AbsPath)
doc.Save(AbsPath)
Catch
' throw the original exception
Throw ex
End Try
End Try
MyBase.Clear()
MyBase.BuildSiteMap()
End Sub
Private Function FindNodeByTitle(ByVal doc As XmlDocument, ByVal title As String) As XmlElement
Dim xPath As String = [String].Format("//*[@title='{0}']", title)
Dim node As XmlElement = TryCast(doc.SelectSingleNode(xPath), XmlElement)
If node Is Nothing Then
Throw New Exception("Node not found with title: " & title)
End If
Return node
End Function
'''
''' The built in SiteMapNode.Url property gives a different value to the actual web.sitemap value,
''' it is a mapped value that changes depending on the v.dir of the running web site.
''' This method reads the xml attribute direct from the web.sitemap file.
'''
Public Function GetActualUrl(ByVal title As String) As String
Return Me.FindNodeByTitle(LoadXmlDoc(), title).Attributes("url").Value
End Function
Public Shared ReadOnly Property FilePath() As String
Get
' if anyone gets a nicer method to read the web siteMapFile attribute, please post it. i tried using 'System.Web.Configuration but i couldn't get it working. also, the site breaks when running off VS web server 'because of 'cannot read IIS metabase' errors.
Dim webConfigText As String = File.ReadAllText(HttpContext.Current.Server.MapPath("~/web.config"))
Dim m As Match = Regex.Match(webConfigText, "siteMapFile=""(.*?)""", RegexOptions.IgnoreCase Or RegexOptions.Multiline)
If Not m.Success Then
Return "~/Web.sitemap"
Else
' default value. otherwise we could throw new Exception("web.config does not contain a siteMapFile element");
Return m.Groups(1).Captures(0).Value
End If
End Get
End Property
Public Overrides Function FindSiteMapNode(ByVal context As System.Web.HttpContext) As System.Web.SiteMapNode
Dim node As SiteMapNode = MyBase.FindSiteMapNode(context)
If node Is Nothing Then
If context Is Nothing Then
Return Nothing
End If
Dim queryString As String = CType(context.CurrentHandler, Page).ClientQueryString
Dim pageUrl As String = HttpUtility.UrlDecode(context.Request.Path & "?" & queryString)
node = MyBase.FindSiteMapNode(pageUrl)
End If
Return node
End Function
End Class
