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...
Click here 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