Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

xanburzum

Menu XML

Recommended Posts

Criar um down menu usando XML. Toda a transformação de XML é feito usando ASP no servidor. Fácil configurável down menu.

 

default.asp

<%@ Language=VBScript %>

<%
 function generateMenu()
   set xmlDocument = server.CreateObject("MSXML.DOMDocument")
   sReturn = "clearMenu" & vbcr
   xmlDocument.async = false
   if instrrev(Request.ServerVariables ("SCRIPT_NAME"),"/")<>0 then
	sScriptName = mid(Request.ServerVariables ("SCRIPT_NAME"),instrrev(Request.ServerVariables ("SCRIPT_NAME"),"/"))
   else
	sScriptName = ""
   end if
   sPath =  lcase(replace(ucase(Request.ServerVariables ("PATH_INFO")),ucase(sScriptName),""))
   if sPath = "/" then sPath=""

   if xmlDocument.load("http://" & Request.ServerVariables("SERVER_NAME") & sPath & "/xml/menudef.xml") then
	 set objNodeList = xmlDocument.getElementsByTagname("HEADER")
	 for i = 1 to objNodeList.Length
	   sSubmenu = ""
	   set objNode = objNodelist.nextNode
	   sID =  objNode.getAttribute("NAME")
	   
	   set objChildrenList = objNode.childNodes
	   for each objChild in objChildrenList
		 if objChild.nodeName="MENUITEM" then
 			for each objMenuDef in objChild.childNodes
 			  sTag = objMenuDef.nodeName
 			  select case sTag
 				case "CAPTION" : sCaption = objMenuDef.text
				  case "URL" : 
					  sURL = objMenuDef.text
 					sTarget = objMenuDef.getAttribute("TARGET")
 				case "TARGET" : sTarget = objMenuDef.text
 			  end select
 			next 
 			sSubMenu = sSubmenu & "createSubMenu """ & sId & """,""" & sCaption & """,""" & sURL & """,""" & sTarget & """" & vbcr
 		elseif objChild.nodeName = "CAPTION" then
 		  sCaptionHeader = objChild.text
 		end if
	   next
	   
	   sReturn = sReturn & sHeader & "createHeader """ & sId & """,""" & sCaptionHeader & """" & vbcr & sSubmenu
	 next
	 
   else
	 Response.Write "document.write ""</TD></TR></TABLE><BR><BR><BR><BR>""" & vbcr
	 Response.Write "document.write ""Ocorreu um erro ao carregar o XML definição.""" & vbcr
	 Response.write "document.write ""Erro : " & replace(replace(xmlDocument.parseError.reason,chr(10),""),chr(13),"") & """" & vbcr
	 Response.Write "</SCRIPT>"
	 Response.End
   end if
   generateMenu = sReturn & vbcr & "showMenu"
 end function  
%>
<!-- #INCLUDE FILE="clientscripts\menu.vbs" -->
<html>
 <head>
	<link rel="stylesheet" type="text/css" href="stylesheet/mainstyle.css">
  <TITLE>Free scripts page</TITLE>
 </head>

 <body>
	 <span ID="Menu" CLASS="ToolBar" STYLE="display:none"></span>
	 <span ID="SubMenu"></span>
	 <script LANGUAGE="VBSCRIPT">	<% = generateMenu %>  </script>	 
 </body>
</html>

Dentro da pasta clientscripts, o arquivo menu.vbs

<script LANGUAGE="VBSCRIPT">

dim menuHTML
dim currentMenu
dim x,y,x2,y2
dim defaultWidth
dim objCurrentHighLight

function resetColorMenuItem(objSubMenu)
		objSubMenu.style.color="white"
end function

function highLightMenuItem(objSubMenu)
	objSubMenu.style.color="lightBlue"
end function

function hideSubMenu()

  xClick = window.event.clientX
  yClick = window.event.clientY

  if xClick>x and xClick<x2 and yClick>y and yClick<y2 then
 
  else
	  currentMenu.style.display="none"
	  objCurrentHighLight.style.color="white"
  end if
  
  
end function

function showSubMenu(objMenuHeader,objSubMenu)
  if objCurrentHighLight <> "" then
	objCurrentHighLight.style.color="white"
  end if
  objMenuHeader.style.cursor="hand"
  set objCurrentHighLight = objMenuHeader.children("headerText")
  objCurrentHighLight.style.color="lightBlue"
  
  if currentMenu <> "" then
	currentMenu.style.zIndex = 100
	currentMenu.style.display = "none"
	
  end if
  if (objMenuHeader.offsetLeft+objSubMenu.style.pixelWidth)>document.body.clientWidth then
	objSubMenu.style.left=document.body.clientWidth-objSubMenu.style.pixelWidth
  else
	objSubMenu.style.left=objMenuHeader.offsetLeft
  end if
  objSubMenu.style.top=objMenuHeader.offsetTop+14
  objSubMenu.style.display=""
  set currentMenu=objSubMenu
  y = objSubMenu.style.pixelTop-10
  x = objSubMenu.style.pixelLeft 
  'alert(objSubMenu.offsetHeight)
  y2 = eval(objSubMenu.style.pixelTop + objSubMenu.offsetHeight)
  x2 = eval(x + objSubMenu.style.pixelWidth) 

end function

function createHeader(sId,sHeaderName)
  dim strHTML
  
  strHTML = "<TD><SPAN onMouseOver=""showSubMenu(" & sId & ",subMenuItem" & sId & ")"" onMouseOut=""hideSubMenu()""ID=""" & sID & """ CLASS=""MenuItem"" >|  <SPAN ID=""headerText"">" & sHeaderName & "</SPAN>  </SPAN></TD>"

  Menu.style.display=""
  menuHTML = menuHTML & strHTML 
end function

function clearMenu()
	menuHTML=""
	defaultWidth = 100
	currentMenu = ""
	Menu.innerHTML = ""
	objCurrentHighLight = ""
end function

function showMenu()
  Menu.innerHTML="<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR><TD><DIV></DIV></TD>" & menuHTML & "</TR></TABLE>"
end function

function createSubMenu(sId,sHeaderName,sUrl,sTarget)

  dim htmlStr
  dim iPos
  dim strHTML

  htmlStr = subMenu.innerHTML
  iPos = instr(htmlStr,"<!-- submenu" & sId & " -->")
  if sHeaderName = "-" then 
	
	strHTML = "<HR WIDTH=100%><!-- submenu" & sId & " -->" 
	SubMenu.innerHTML=replace(htmlstr,"<!-- submenu" & sID & " -->",strHTML)
  else

   if iPos<=0 then
	 strHTML = "<SPAN CLASS='MenuItem' ID='subMenuItem" & sId & "' onMouseOut='hideSubMenu()' STYLE='display:none;width:" & defaultWidth & ";position:absolute;left:0;top:60;padding-top:0;padding-left:0;padding-bottom:20;z-index:118;'>" & _
			   "<DIV STYLE='width:" & defaultWidth & ";position:relative;left:0;top:8;z-index:118;' >" & _
				"<A ID='AS_" & sId & "'" & _
				"   STYLE='width:" & defaultWidth & ";text-decoration:none;cursor:hand;font-family:Verdana;font-size:xx-small;font-size:10;color:white'" & _
				"   HREF='" & sUrl & "' TARGET='" & sTarget & "' onMouseOver='highLightMenuItem(this)' onMouseOut='resetColorMenuItem(this)'>" & sHeaderName & _
				"   </A>" & _
				"<!-- submenu" & sId & " --></DIV></SPAN>"
   else
	 strHTML =	"<A ID='subMenuRef" & MenuIDStr & "'" & _
				  "   STYLE='width:" & defaultWidth & ";position:relative;left:0;text-decoration:none;font-family:Verdana;font-size:xx-small;font-size:10;color:white'" & _
				"   HREF='" & sUrl & "' TARGET='" & sTarget & "' onMouseOver='highLightMenuItem(this)' onMouseOut='resetColorMenuItem(this)'>" & _
				sHeaderName & "</A><!-- submenu" & sId & " -->"
   end if

   if iPos<=0 then
	SubMenu.innerHTML=SubMenu.innerHTML & strHTML
   else
	SubMenu.innerHTML=replace(htmlstr,"<!-- submenu" & sID & " -->",strHTML)
   end if
  end if
end function

</SCRIPT>

Na pasta stylesheet, o arquivo mainstyle.css

.MenuItem
{
	BACKGROUND-COLOR: black;
	COLOR: white;
	FLOAT: left;
	FONT-FAMILY: Arial;
	FONT-SIZE: xx-small;
	FONT-WEIGHT: lighter;
	LEFT: 0pt;
	POSITION: relative;
	TOP: 0pt
}
BODY
{
	MARGIN: 0px
}
.ToolBar
{
	FLOAT: right;
	MARGIN: 0px;
	PADDING-BOTTOM: 0px;
	PADDING-LEFT: 0px;
	PADDING-RIGHT: 0px;
	PADDING-TOP: 0px;
	TEXT-ALIGN: right
}
TD
{
	FONT-FAMILY: Arial;
	FONT-SIZE: x-small;
	TEXT-ALIGN: left
}
.MenuHeader
{
	BACKGROUND-COLOR: black;
	COLOR: white;
	FONT-FAMILY: Arial;
	FONT-SIZE: xx-small
}
.TDHeader
{
	BACKGROUND-COLOR: mediumblue;
	COLOR: white;
	FONT-FAMILY: Arial;
	FONT-WEIGHT: bold
}

Por fim na pasta XML, o menudef.xml

<?xml version="1.0"?>
<MENU>
 <HEADER NAME="teste">
  <CAPTION>teste</CAPTION>
  <MENUITEM NAME="Homepage">
	<CAPTION>Homepage</CAPTION>
	<URL>http://home.teste.com.br</URL>
  </MENUITEM>
 </HEADER>
 <HEADER NAME="FreeScript">
  <CAPTION>Freescript page</CAPTION>
  <MENUITEM NAME="Homepage">
	<CAPTION>Homepage</CAPTION>
	<URL>default.asp</URL>
  </MENUITEM>
 </HEADER>
 <HEADER NAME="ScriptInfo">
  <CAPTION>Scripts</CAPTION>
  <MENUITEM NAME="Requirement">
	<CAPTION>XML Menu</CAPTION>
	<URL>xmlmenu.asp</URL>
  </MENUITEM>
  <MENUITEM NAME="PureCoolMenu">
	<CAPTION>Pure Cool Menu</CAPTION>
	<URL>coolmenu.asp</URL>
  </MENUITEM>
  <MENUITEM NAME="Needhelp">
	<CAPTION>Help Me !</CAPTION>
	<URL>mailto:teste@teste.com.br</URL>
  </MENUITEM>
 </HEADER>
 <HEADER NAME="OtherLInks">
  <CAPTION>Links</CAPTION>
  <MENUITEM NAME="24Fun">
	<CAPTION>Xanburzum</CAPTION>
	<URL>definction.html</URL>
  </MENUITEM>
  <MENUITEM NAME="burzum">
	<CAPTION>burzum</CAPTION>
	<URL>download.html</URL>
  </MENUITEM>
 </HEADER>
</MENU>

Compartilhar este post


Link para o post
Compartilhar em outros sites

na minha máquina quando eu tento rodar scripts sobre <script LANGUAGE="VBSCRIPT"> não roda, talvez seja o mesmo problema seu desisto.

Compartilhar este post


Link para o post
Compartilhar em outros sites

agora so aparece isso no codigo fonte

<script LANGUAGE="VBSCRIPT">
		clearMenu
createHeader "teste","teste"
createSubMenu "(teste","Homepage","http://home.teste.com.br",")"
createHeader "FreeScript","Freescript page"
createSubMenu "(FreeScript","Homepage","default.asp",")"
createHeader "ScriptInfo","Scripts"
createSubMenu "(ScriptInfo","XML Menu","xmlmenu.asp",")"
createSubMenu "(ScriptInfo","Pure Cool Menu","coolmenu.asp",")"
createSubMenu "(ScriptInfo","Help Me !","mailto:teste@teste.com.br",")"
createHeader "OtherLInks","Links"
createSubMenu "(OtherLInks","Xanburzum","definction.html",")"
createSubMenu "(OtherLInks","burzum","download.html",")"

showMenu
	</script>

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.