I was looking for a cool menu that was open source and that was highly configurable... Well, I found this really cool DHTML menu at
WebFx - This was definately the (One) - But I wanted to pull the data from a database or something and
the WebFx menu was static. I decided to go with an XML file because I wanted to load a different menu according to the users security level.
So... I wrote this little class file that uses the DHTML Menu with my XML files. Try it and let me know if you like it or not. The menu above is the final product... Clickhere to get all source files.
Example XML
<root>
<menu id="m0">
<menuItem text="File" disabled="false" mnemonic="f">
<subMenu text="New" func="0" action="" target="" image="images/file.png" mnemonic="n"
tooltip="Add new file..." srtcut="" disabled="false"></subMenu>
<subMenu text="Open" func="0" action="" target="" image="" mnemonic=""
tooltip="Edit last selected client..." srtcut="" disabled="false"></subMenu>
<subMenu text="Action" func="1" action="function() {alert('You can run any function using this menu in the action tag...')}"
target="" image="" mnemonic="a" tooltip="Tooltip here..." srtcut="" disabled="false"></subMenu>
<subMenu text="Print" func="1" action="function() {window.print()}" target="" image="images/print.gif" mnemonic="p"
tooltip="Print this thing..." srtcut="" disabled="false"></subMenu>
<subMenu text="Find" func="0" action="" target="" image="images/icon_search.gif" mnemonic="i" tooltip="Find a thing..."
srtcut="" disabled="false"></subMenu>
<subMenu text="" func="0" action="" target="" image="" mnemonic="" srtcut=""></subMenu>
<subMenu id="m0a" text="Users" func="0" action="" target="" image="images/icon_user.gif" mnemonic="u" tooltip="Users..." srtcut="" disabled="false">
<subMenu id="m0a" text="Group Users" func="0" action="user_find.asp?gud=CLIENT" target="" image=""
mnemonic="" tooltip="Seleced client - user records..." srtcut="" disabled="false"></subMenu>
</subMenu>
</menuItem>
</menu>
</root>
How To Load Menu In Your Page
In head section...
<%
'Start Menu/Access Class ////////////////////////////////////////////////////////
'Creates javascript menu from XML file
Dim jmenu
Set jmenu = New JSKMenu
'Load XML Menu File According To Access
jmenu.checkAccess("ADMIN")
'Check Security Permissions
'jmenu.HasPermission "USER_LEVEL",Session("LoggedIn"),"ADMIN,EXEC"
'Load CSS File For Menu
jmenu.cssFile = "menu_style.css"
'jmenu.initTraverse()
jmenu.menuCreate()
Set jmenu = nothing
'///////////////////////////////////////////////////////////////////////////////
%>
In body section...
<table width=100% cellspacing=0 ID="Table4">
<tr>
<td valign=top>
<script type="text/javascript">
menuBar.write();
</script>
<script type="text/javascript">
writeNotSupported();
</script>
</td>
</tr>
</table>
Example Class File
'--------------------------------------------------------------------------------------------
' JSKMenu.cls
' Author: J Scott King
' Web: www.jskdesign.net
' Created: 6/9/2004
' Modified (Changes):
' Version 1.2
' 6/12/2004 - Added recursive function for parsing XML File. (Thanks to Erik).
' 6/16/2004 - Added security function to load XML file according to group passed.
'--------------------------------------------------------------------------------------------
' Create Menus From Given XML File
'--------------------------------------------------------------------------------------------
' This Meuu was created Using DHTML Menu 4.28 Created by Erik Arvidsson For WebFX (http://webfx.eae.net/)
' As a base. I only added XML Load functionality using a VBScript Class so you can create the
' Menu values from an XML file and then load it into the DHTML Menu.
'--------------------------------------------------------------------------------------------
'
'
' Usage:
' Add three javascript src calls in the head section of your page:
'
'
'
'
' Along with a link to your style sheet:
'
'
' Now in the head section of your document, create the class object and then load your XML file
' (See menus1.xml for structure/attributes of xml file). Then load the pointer to your css that you
' want to use for the menu.
'
' -------------------------------------------------
'Start Menu Class (Comment)
'Dim jmenu
'Set jmenu = New JSKMenu
'Load XML Menu File According to User Group(Comment)
'jmenu.checkAccess("GROUP")
'Load CSS File For Menu (Comment)
'jmenu.cssFile = "skins/winclassic.css"
'jmenu.menuCreate()
' --------------------------------------------------
'
' Limitations:
' If you want to create a menu of a subMenu - put in an id attribute in the appropriate
' subMenu tag.
'
'--------------------------------------------------------------------------------------------
Class JSKMenu
Private cssMenu 'What css file do we want to use for the menu
Private strFile, objDoc 'XML Code data file for descrip/errors and Doc Object.
Private ERR_NO_XML 'Error for no XML file passed.
Private ERR_NO_CSS 'Error for no CSS file passed.
Private LoopID 'Parent Main Menu ID holder
Private menuID 'Loop Main Menu ID holder
Private msubID 'Main SubMenu ID holder
Private subFlag 'Sub Flag Holder
Private menu_bar 'Main menubar Text Holder
Private menu_items 'Main menuitem Text Holder
Private Sub Class_Initialize()
cssMenu = ""
menu_bar = "var menuBar = new MenuBar();" & vbcrlf
menu_items = ""
ERR_NO_XML = "The JSKMenu class requires some data (XML File) first... Use obj.XMLFile = 'path/file.xml'"
ERR_NO_CSS = "The JSKMenu class requires a CSS File... Use obj.cssFile = 'path/file.css'"
End Sub
Private Sub Class_Terminate()
Set objDoc = Nothing
End Sub
'*********************************************************************
' Properties
'*********************************************************************
'Set XML File and objDoc
Public Property Let XMLFile(str)
Dim ReturnValue, x, oXMLError
If str = "" Then
raiseError ERR_NO_XML
End If
Set objDoc = Server.CreateObject("Msxml2.DomDocument.3.0")
objDoc.async = False
objDoc.validateOnParse = true
strFile = str
ReturnValue = objDoc.Load(strFile)
'Debug XML Load
'Response.write "Result of XML File Load method is: " & ReturnValue & " "
If ReturnValue = False Then
Set oXMLError = objDoc.ParseError
Response.Write " " & oXMLError.ErrorCode & " - " & oXMLError.Reason & " URL=" & oXMLError.URL & " "
Set oXMLError = Nothing
Response.Write objDoc.parseError.reason
For x = 0 to objDoc.childNodes.length
Response.Write "Node " & x & ". "
Next
End If
End Property
'Get XML File
Public Property Get XMLFile()
XMLFile = strFile
End Property
'Set CSS File For Menu
Public Property Let cssFile(css)
If css = "" Then
raiseError ERR_NO_CSS
End If
cssMenu = "// set default css file to use" &vbcrlf
cssMenu = cssMenu & "Menu.prototype.cssFile = '"& css &"';" &vbcrlf &vbcrlf
End Property
Public Property Get cssFile()
cssFile = cssMenu
End Property
'*********************************************************************
' Security Functions (Choose menu file by login group)
' Arg: MenuLevel, Session Flag
' You can use this function to load a menu for each user's access
'*********************************************************************
public function checkAccess(byVal group)
Dim menuFile
'We're just loading the same menu file here by example.
Select Case group
Case "ADMIN"
menuFile = "JSKmenu.xml"
Case "EXEC"
menuFile = "JSKmenu.xml"
Case "USER"
menuFile = "JSKmenu.xml"
Case Else
menuFile = "Nomenu.xml"
End Select
xmlFile = Server.MapPath(".") & "\" & menuFile
end function
'----------------------------------------------------------------------
' Function: accessCheck
' This function checks to see if user is logged in or session expired.
' Change the url to point to the page if user is not authorized.
'----------------------------------------------------------------------
Public Function HasPermission(byVal mLevel, byVal sess_flag, byVal menuGroup)
Dim url, check, msg, gpass, a
url = "http://" & Application("JSKDesign_WebApp") & "admin/default.asp"
msg = "Invalid page access, your session has expired or you have not yet logged into the NVMS Management System..."
check = sess_flag
gpass = 0
url = url & "?msg=" & msg
'If session Flag passes check user access to page (Group)
If menuGroup <> "ALL" Then
a = split(menuGroup,",")
For i = 0 to UBound(a)
If Trim(mLevel) = Trim(a(i)) Then
gpass = 1
End If
Next
Else
gpass = 1
End If
If Not check or gpass = 0 Then
Response.Write "" & vbcrlf
Response.Write "if (window.opener){" & vbcrlf
Response.Write "alert('Your session has timed out... Or you haven\'t logged in correctly, please try again.');" & vbcrlf
Response.Write "parent.window.close();}" & vbcrlf
Response.Write "else" & vbcrlf
Response.Write "window.top.location.href='" & url & "';"
Response.Write ""
'Response.Redirect url
End If
End Function
'*********************************************************************
' Menu Functions
'*********************************************************************
'---------------------------------- Test XML Structure -----------------
'Load and start file transversal
public function initTraverse()
dim doc
set doc = objDoc.documentElement
traverseTest(doc)
end function
'Recursive function Get all menu items... Test to see if XML menu file looks OK.
public function traverseTest(tree)
dim nodes, i
if tree.hasChildNodes() then
response.write("
")
response.write("" & tree.tagName & " : " & tree.getAttribute("text") & "")
nodes = tree.childNodes.length
for i = 0 to tree.childNodes.length-1
traverseTest(tree.childNodes(i))
response.write("
")
next
else
response.write("
no child: " & tree.tagName) & ""
end if
end function
'-------------------------------------------------------------------------------------
'------------------------- Get XML Data Driven Menu ----------------------------------
'Recursive function Get all menu items... Write out javascript menu code.
public function getMenu(tree)
dim nodes, i, x
dim text, mnemonic, node, func, disabled
dim action, image, target, srtcut, tooltip
dim subFlag, orderSession
orderSession = Session("orderID")
if tree.hasChildNodes() then
select case tree.tagName
case "menu"
menuID = tree.getAttribute("id")
LoopID = tree.getAttribute("id")
menu_items = menu_items & "var " & menuID & " = new Menu();" & vbcrlf
case "menuItem"
text = tree.getAttribute("text")
mnemonic = tree.getAttribute("mnemonic")
disabled = tree.getAttribute("disabled")
'Create Menu Bar
menu_bar = menu_bar & "menuBar.add( tmp = new MenuButton('" & text & "', " & menuID & ") );" & vbcrlf
menu_bar = menu_bar & "tmp.mnemonic = '" & mnemonic & "';" & vbcrlf
if disabled = "true" then
menu_bar = menu_bar & "tmp.disabled = true;" & vbcrlf
end if
case "subMenu"
text = tree.getAttribute("text")
mnemonic = tree.getAttribute("mnemonic")
srtcut = tree.getAttribute("srtcut")
srtcut = tree.getAttribute("srtcut")
image = tree.getAttribute("image")
msubID = tree.getAttribute("id")
disabled = tree.getAttribute("disabled")
menu_items = menu_items & "var " & msubID & " = new Menu();" & vbcrlf
menu_items = menu_items & menuID & ".add(tmp = new MenuItem('" & text & "', null, '" & image & "'," & msubID & "));" & vbcrlf
menu_items = menu_items & "tmp.mnemonic = '" & mnemonic & "';" & vbcrlf
menu_items = menu_items & "tmp.shortcut = '" & srtcut & "';" & vbcrlf
if disabled = "true" then
menu_items = menu_items & "tmp.disabled = true;" & vbcrlf
end if
menu_items = menu_items & "tmp.toolTip = '" & tooltip & "';" & vbcrlf & vbcrlf
end select
'recursive function for child nodes...
nodes = tree.childNodes.length
for i = 0 to tree.childNodes.length-1
getMenu(tree.childNodes(i))
next
else
text = tree.getAttribute("text")
mnemonic = tree.getAttribute("mnemonic")
srtcut = tree.getAttribute("srtcut")
tooltip = tree.getAttribute("tooltip")
action = tree.getAttribute("action")
func = tree.getAttribute("func")
image = tree.getAttribute("image")
target = tree.getAttribute("target")
disabled = tree.getAttribute("disabled")
msubID = tree.getAttribute("id")
if msubID <> "" then
menuID = msubID
else
menuID = LoopID
end if
if text = "" then
menu_items = menu_items & menuID & ".add(new MenuSeparator);" & vbcrlf
else
if func = 1 then
menu_items = menu_items & menuID & ".add(tmp = new MenuItem('" & text & "', " & action & ", '" & image & "'));" & vbcrlf
menu_items = menu_items & "tmp.mnemonic = '" & mnemonic & "';" & vbcrlf
menu_items = menu_items & "tmp.shortcut = '" & srtcut & "';" & vbcrlf
if disabled = "true" or checkDisabled(text,orderSession) then
menu_items = menu_items & "tmp.disabled = true;" & vbcrlf
end if
menu_items = menu_items & "tmp.toolTip = '" & tooltip & "';" & vbcrlf & vbcrlf
else
menu_items = menu_items & menuID & ".add(tmp = new MenuItem('" & text & "', '" & action & "', '" & image & "'));" & vbcrlf
menu_items = menu_items & "tmp.target = '" & target & "';" & vbcrlf
menu_items = menu_items & "tmp.mnemonic = '" & mnemonic & "';" & vbcrlf
menu_items = menu_items & "tmp.shortcut = '" & srtcut & "';" & vbcrlf
if disabled = "true" or checkDisabled(text,orderSession) then
menu_items = menu_items & "tmp.disabled = true;" & vbcrlf
end if
menu_items = menu_items & "tmp.toolTip = '" & tooltip & "';" & vbcrlf & vbcrlf
end if
end if
end if
getMenu = CleanBlank(menu_items) & vbcrlf & menu_bar & vbcrlf
end function
'Write out javascript code in client section.
Function menuCreate()
dim doc
set doc = objDoc.documentElement
Response.Write ""
End Function
Function checkDisabled(byVal menuName, byVal sess_on)
'You can disable certain menu items if a session is null or false.
Dim disFlag, mFlag
disFlag = false
'Response.Write "dude -" & menuName & ", " & sess_on
If IsNull(sess_on) or sess_on = "" Then
disFlag = true
End If
Select Case menuName
Case "Edit User"
mFlag = true
Case "Print Order"
mFlag = true
Case "Email Order"
mFlag = true
Case "Order Notes"
mFlag = true
Case "Attachments"
mFlag = true
Case "ReInspection"
mFlag = true
Case "Send Message"
mFlag = true
Case "Event Log"
mFlag = true
Case Else
mFlag = false
End Select
If disFlag and mFlag Then
checkDisabled = true
Else
checkDisabled = false
End If
End Function
'=========================================
' Supporting functions
'=========================================
Private Sub RaiseError(ByVal Msg)
Err.Raise vbObjectError + 99999, "JSK-Menu", Msg
End Sub
Private Sub Drop(ByVal txt)
Response.Write txt & vbCrLf
End Sub
'Date Format
Private Function getDate(eDate)
getDate = Mid(eDate,5,2) & "/" & Right(eDate,2) & "/" & Left(eDate,4)
End Function
Private Function CleanBlank(ByVal txt)
CleanBlank = replace(txt,"''","null")
End Function
Private Function VBBreaks(ByVal txt)
VBBreaks = replace(txt," ",vbcrlf)
End Function
End Class
