.







Cenk Yurtseven
 
English Deutsch Türkçe
Home ASP Code Library ASP Code Library Database Tools Database Tools
 Displaying  1.  of  3  Display: 


 
Database-Driven Menu Database-Driven Menu Language:  ASP 
Database-Driven Menu. N-Tier Open Source Code Database-Driven Javascript Menu.

Database-Driven Menu
 

<%@Language="VBScript" %>
<%
Option Explicit
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H0001
Const adUseClient = 3
Dim Conn_1
Dim xCount1
Dim SQLCount
Dim TblName
Dim IdFieldName
Dim ParentIDName
Dim CatsName
Dim IsActiveField
Private Function GetParentCats(ByRef strObjID, ByRef HTMLCode, ByRef TrueFalse)
     Dim ScanSQL
     Dim RS_Scan
     Dim CatsHTML
     CatsHTML = ""
     ScanSQL = "SELECT * FROM [" & TblName & "] WHERE " & ParentIDName & " = " & strObjID
     If IsActiveField <> "" Then
          ScanSQL = ScanSQL & " AND " & IsActiveField & " <> 0"
     End If
     ScanSQL = ScanSQL & " ORDER BY " & CatsName & " ASC"
     Set RS_Scan = Server.CreateObject("ADODB.Recordset")
     With RS_Scan
          .CursorLocation = adUseClient
          .Open (ScanSQL), Conn_1, adOpenForwardOnly, adLockReadOnly, adCmdText
          Select Case TrueFalse
               Case True
               If Not .EOF Then
                    CatsHTML = CatsHTML & HTMLCode
               End If
               Case False
               If .EOF Then
                    CatsHTML = CatsHTML & HTMLCode
               End If
          End Select
          .Close
     End With
     Set RS_Scan = Nothing
     GetParentCats = CatsHTML
End Function
Private Function GetMainCats(ByRef strParent)
     Dim ScansSQL
     Dim RS_Scans
     Dim MainOutp
     Dim ListsID
     Dim Lists_Name
     Dim SpanHTML
     ScansSQL = "SELECT * FROM [" & TblName & "] WHERE " & ParentIDName & " = " & strParent
     If IsActiveField <> "" Then
          ScansSQL = ScansSQL & " AND " & IsActiveField & " <> 0"
     End If
     ScansSQL = ScansSQL & " ORDER BY " & CatsName & " ASC"
     MainOutp = ""
     Set RS_Scans = Server.CreateObject("ADODB.Recordset")
     With RS_Scans
          .CursorLocation = adUseClient
          .Open (ScansSQL), Conn_1, adOpenForwardOnly, adLockReadOnly, adCmdText
          MainOutp = MainOutp & vbCrLf & "<DIV ID=""menuBar"" CLASS=""menuBar"">"
          Do While Not .EOF
               ListsID = .Fields(IdFieldName).Value
               Lists_Name = .Fields(CatsName).Value
               xCount1 = xCount1 + 1
               MainOutp = MainOutp & vbCrLf & "<DIV ID=""Bar" & xCount1 & """ CLASS=""Bar"" menu=""menu" & xCount1 & "_1"" ONCLICK=""mainNav(" & ListsID & ");"">" & Lists_Name & "</DIV>"
               SpanHTML = SpanHTML & GetParentCats(ListsID, vbCrLf & "<DIV ID=""menu" & xCount1 & "_1""></DIV>", False)
               .MoveNext
          Loop
          .Close
     End With
     Set RS_Scans = Nothing
     xCount1 = xCount1 + 1
     MainOutp = MainOutp & vbCrLf & "<DIV ID=""Bar" & xCount1 & """ CLASS=""Bar"" menu=""menu" & xCount1 & "_1"" ONCLICK=""document.location=(''http://www.yurtseven.org'')"">yurtseven.org</DIV></DIV>"
     GetMainCats = MainOutp & SpanHTML
     SQLCount = xCount1 & "_1"
End Function
Private Function ScanFolders(ByRef ParentID, ByRef strLoops, ByRef objChain, ByRef strZindex)
     Dim ScansSQL
     Dim RS_Scan
     Dim DB_ListsID
     Dim DB_Lists_ParentID
     Dim DB_Lists_Name
     Dim xCount
     Dim MenuChain
     Dim IsNewDiv
     Dim OutHTML
     ScansSQL = "SELECT * FROM [" & TblName & "] WHERE " & ParentIDName & " = " & ParentID
     If IsActiveField <> "" Then
          ScansSQL = ScansSQL & " AND " & IsActiveField & " <> 0"
     End If
     ScansSQL = ScansSQL & " ORDER BY " & CatsName & " ASC"
     Set RS_Scan = Server.CreateObject("ADODB.Recordset")
     With RS_Scan
          .CursorLocation = adUseClient
          .Open (ScansSQL), Conn_1, adOpenForwardOnly, adLockReadOnly, adCmdText
          Do While Not .EOF
               DB_ListsID = .Fields(IdFieldName).Value
               DB_Lists_ParentID = .Fields(ParentIDName).Value
               DB_Lists_Name = .Fields(CatsName).Value
               If xCount = 0 Then
                    OutHTML = OutHTML & vbCrLf & "</DIV>"
               End If
               xCount = xCount + 1
               If DB_Lists_ParentID = 0 Then
                    strLoops = strLoops + 1
                    MenuChain = strLoops
               Else
                    MenuChain = objChain & "_" & xCount
                    strZindex = strZindex + 1
                    If xCount = 1 Then
                         IsNewDiv = True
                         OutHTML = OutHTML & vbCrLf & "<DIV ID=""menu" & MenuChain & """ CLASS=""Menu"" STYLE=""z-index : " & strZindex & """>"
                    End If
                    OutHTML = OutHTML & vbCrLf & "<DIV ID=""menuItem" & MenuChain & """ CLASS=""menuItem"""
                    OutHTML = OutHTML & GetParentCats(DB_ListsID, " menu=""menu" & MenuChain & "_1""", True)
                    OutHTML = OutHTML & " TITLE=""" & DB_Lists_Name & """ cmd=""" & DB_ListsID & """>" & DB_Lists_Name & "</DIV>"
               End If
               OutHTML = ScanFolders(DB_ListsID, strLoops, MenuChain, strZindex) & OutHTML
               .MoveNext
          Loop
          .Close
     End With
     Set RS_Scan = Nothing
     If DB_Lists_ParentID <> 0 And IsNewDiv = True Then
          IsNewDiv = False
     End If
     ScanFolders = OutHTML
End Function
Private Sub ExecSQLMenu()
     Dim MainCats
     Dim ScanFold
     TblName = Application("TblName")
     IdFieldName = Application("IdFieldName")
     ParentIDName = Application("ParentIDName")
     CatsName = Application("CatsName")
     IsActiveField = Application("IsActiveField")
     Set Conn_1 = Server.CreateObject("ADODB.Connection")
     Conn_1.Open Application("ConnString")
     MainCats = GetMainCats(0)
     ScanFold = ScanFolders(0, 0, 0, 0)
     Conn_1.Close
     Set Conn_1 = Nothing
     Response.Write (MainCats) & vbCrLf & "<DIV ID=""menu" & SQLCount & """></DIV>"
     Response.Write (ScanFold)
End Sub
Public Sub ExecSQL()
     On Error Resume Next
     Dim TblName
     Dim IdFieldName
     Dim ParentIDName
     Dim CatsName
     Dim IsActiveField
     Dim objSQL
     ''Global variables
     TblName = "DB_Lists" ''Table name
     IdFieldName = "DB_ListsID" ''Primary key field name
     ParentIDName = "DB_Lists_ParentID" ''Parent-ID field name
     CatsName = "DB_Lists_Name" ''Category name field
     IsActiveField = "" ''Boolean field: active/not active (this field is not reqiered, if this variable has no value, the query will return all results regardless if set to true or false.
     Application.Lock
     Application("TblName") = TblName
     Application("IdFieldName") = IdFieldName
     Application("ParentIDName") = ParentIDName
     Application("IsActiveField") = IsActiveField
     Application("CatsName") = CatsName
     Application("ConnString") = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & Server.MapPath(".") & "DB_Data.mdb" ''Connection String to your database. (SQL Server Connections: simply fill in a valid SQL Server database connection string instead of Access.)
     Application.UnLock
     Call ExecSQLMenu
     If Err <> 0 Then
          Response.Write "<BR><BR><DIV ALIGN=""center""><H3>" & Err.Description & "</H3></DIV>"
     End If
End Sub
''You may customize the design to your needs by modifying the files: SQLMenu.css, and SQLMenu.js.
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<TITLE>MENU</TITLE>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; Charset=windows-1254">
<LINK REL="STYLESHEET" HREF="SQLMenu.css" TYPE="text/css">
<SCRIPT LANGUAGE="JavaScript" SRC="SQLMenu.js" TYPE="text/javascript"></SCRIPT>
</HEAD>
<BODY ONLOAD="InitMenu();" ONCLICK="HideMenu(menuBar);" ID="Cenky" BGCOLOR="#DFD9D0">
<TABLE ALIGN="center" WIDTH="100%" CELLSPACING="0" CELLPADDING="0" BORDER="0">
<TR>
<TD><%
Call ExecSQL ''Executes the main Module and writes all contents to the browser.
%>
</TD></TR></TABLE>
</BODY>
</HTML>


 Displaying  1.  of  3  Display: 


1  2  3  Next »
Member Login  |  Contact Us