|
 |
|
|
|
 |
|
 |
|
 |
|
|
|
|
Database-Driven Menu. N-Tier Open Source Code Database-Driven Javascript 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> |
|
|
|
 |
|
 |
|
|
