Det kan jeg sagtens, det vil måske se lidt rodet ud, beklager :-(
<%
Dim sBreadCrumb 'Categories bread crumb trail (category > category > category)
Dim Theme 'Defines the theme folder
'-------------------------------------------------------------
' Sub ShowCategoryBox
' Shows root categories as an unordered list (ul)
'-------------------------------------------------------------
Sub ShowCategoryBox
Dim nRows, nCatID
Dim fldCatID, fldChilds, fldDescription
Dim aryCats
Dim i
'Field indexes in array
fldCatID = 0
fldChilds = 1
fldDescription = 2
'Check if there is an expiry date for the cached data
If IsDate(Application("RootCats_Expiry")) Then
'If there is a expiry data, it's within the expiry time (in minutes) and there is cached data then get it
If DateDiff("n",Application("RootCats_Expiry"),Now) < shop_DataNavCache And IsArray(Application("RootCats")) Then
aryCats = Application("RootCats")
Else
aryCats = GetBrowseRootCats
'Cache the data:
Application.Lock
Application("RootCats") = aryCats
Application("RootCats_Expiry") = Now 'Set expiry date
Application.UnLock
End If
Else
'Otherwise query the database
aryCats = GetBrowseRootCats
'Cache the data
Application.Lock
Application("RootCats") = aryCats
Application("RootCats_Expiry") = Now 'Set expiry date
Application.UnLock
End If
'If we didn't get an array then something's wrong, exit.
If NOT IsArray(aryCats) Then Exit Sub
nRows = UBound(aryCats, 2)
'Start the menu box
Call StartBox("MenuBox","Genveje til")
Response.Write("<ul>")
'Display all the links:
For i = 0 to nRows
nCatID = aryCats(fldCatID,i)
'strPath = nCatID
'tmpPath = "," & strPath & ","
%>
<link href="../themes/greenblue3d/style.css" rel="stylesheet" type="text/css" />
<li><a href="<%= strNonSecPath %><% If aryCats(fldChilds,i) = 0 Then %>browse.asp<% Else %>showcat.asp<% End If %>?cat=<%= nCatID %>"><%= aryCats(fldDescription,i) %></a></li>
<%
Next
Response.Write("</ul>")
'End the menu box
Call EndBox
End Sub
'--------------------------------------------------------------------
' Function GetBrowseRootCats
' Description: Gets an array with the category data .
' Used in ShowCategoryBox.
'--------------------------------------------------------------------
Function GetBrowseRootCats
Dim rs, sql
Set rs = Server.CreateObject("ADODB.Recordset")
sql= "SELECT CatID, Childs, Description FROM categories WHERE ParentID = 0 AND Show = 1 ORDER BY Description"
rs.Open sql, Conn, adOpenForwardOnly, adLockOptimistic
'If no data was returned then write message and exit
If (rs.EOF AND rs.BOF) Then
Response.Write (" (No categories)")
set rs = nothing
Exit Function
End If
GetBrowseRootCats = Rs.GetRows
rs.Close
set rs = nothing
End Function
'--------------------------------------------------------------------
' Sub GetCategoryDetails (catId, categoryDesc, parentId, hasChilds)
' Description: Returns category details for category Id catId
' Used in ShowCurrentCatBox.
' Input:
' catId: Category Id (in)
' categoryDesc: Category description (title) (out)
' parentId: Parent category id (out)
' hasChilds: Whether the category has subcategories (out)
'--------------------------------------------------------------------
Sub GetCategoryDetails (catId, categoryDesc, parentId, hasChilds)
Dim sql
Dim rs
'Get details for current category
Set rs = Server.CreateObject("ADODB.Recordset")
sql = "SELECT c.ParentID as ParentID, c.Childs As Childs, c.Description As Description, parent.Description As ParentDesc " & _
"FROM categories c LEFT OUTER JOIN categories parent ON c.ParentID = parent.catID " & _
"WHERE c.CatID = " & catId & " AND c.Show = 1 " & _
"ORDER BY c.Description"
rs.Open sql, Conn, adOpenForwardOnly, adLockOptimistic
If NOT (rs.EOF AND rs.BOF) Then
'If if found the category get its main data
parentId = rs("ParentID")
hasChilds = rs("Childs")
'If a category has subcategories (1) then get its description, otherwise (0) get the parent's
If hasChilds = 0 Then
categoryDesc = rs("ParentDesc")
Else
categoryDesc = rs("Description")
End If
'Close recordset
rs.Close
set rs = nothing
Else
'If it couldn't find the category then clean up and exit
set rs = nothing
Exit Sub
End If
End Sub
'--------------------------------------------------------------------
' Sub ShowCurrentCatBox
' Description: Show current category box (subcategories, not root)
'--------------------------------------------------------------------
Sub ShowCurrentCatBox
Dim catId
catId = 0
'Get the category id
If Trim(Request("cat")) <> "" Then
If IsNumeric(Trim(Request("cat"))) Then catId = Trim(Request("cat"))
End If
'If we are in the root category then do not display the sub-categories box
If catId = 0 Then Exit Sub
Dim nRows, nCatID
Dim fldCatID, fldChilds, fldDescription
Dim aryCats
Dim sql, rs
Dim i
Dim categoryDesc, parentId, hasChilds
'Field indexes in array
fldCatID = 0
fldChilds = 1
fldDescription = 2
'Default values, in case the category doesn't exist or is not to be displayed.
parentId = 0
hasChilds = 1
'Get details for the current category
Call GetCategoryDetails (catId, categoryDesc, parentId, hasChilds)
'If the current category has no childs obtain the categories at the same level
If hasChilds = 0 Then
sql= "SELECT CatID, Childs, Description FROM categories WHERE ParentID = " & parentId & " AND ParentID <> 0 AND Show = 1 ORDER BY Description"
'If the current category has childs obtain them
ElseIf hasChilds = 1 Then
sql = "SELECT CatID, Childs, Description FROM categories WHERE ParentID = " & catId & " AND Show = 1 ORDER BY Description"
End If
Set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql, Conn, adOpenForwardOnly, adLockOptimistic
If (rs.EOF AND rs.BOF) Then
'Response.Write (" (No categories)")
set rs = nothing
Exit Sub
End If
aryCats = Rs.GetRows
'Clean up recordset
rs.Close
set rs = nothing
'Get number of records
nRows = UBound(aryCats, 2)
'Start menu box
Call StartBox("MenuBox",categoryDesc)
Response.Write("<ul>")
'Loop through the results creating li entries
For i = 0 to nRows
nCatID = aryCats(fldCatID,i)
%> <li><a href="<%= strNonSecPath %><% If aryCats(fldChilds,i) = 0 Then %>browse.asp<% Else %>showcat.asp<% End If %>?cat=<%= nCatID %>"><% If CStr(nCatID) = Request.QueryString("cat") Then Response.Write("<b>") %><%= aryCats(fldDescription,i) %><% If CStr(nCatID) = Request.QueryString("cat") Then Response.Write("</b>") %></a></li>
<%
Next
Response.Write("</ul>")
'End menu box
Call EndBox
End Sub
'--------------------------------------------------------------------------
' Function GetParentCategories (nCategoryId, ByRef aCategories)
' Obtains all the parent categories for a specific catagery. Used to generate
' bread crum trail navigation
' Input:
' - nCategoryId; category id
' - aCategories: empty array that will be populated with the category data.
' Returns:
' Number of parent categories
'--------------------------------------------------------------------------
Function GetParentCategories (nCategoryId, ByRef aCategories)
' Dim aCategories(2,20)
Dim sSQL
Dim rsCategory
Dim i, j
Dim ParentID
'Initialize variables
j = UBound(aCategories,2)
i = 0
ParentID = nCategoryId
Set rsCategory = Server.CreateObject("ADODB.Recordset")
'Loop until we reach the root category
While ParentID <> 0
'Query the current category
sSQL = "SELECT CatID, Description, ParentID, Childs FROM Categories WHERE CatID = " & ParentID
rsCategory.Open sSQL, Conn, adOpenForwardOnly, adLockReadOnly
If NOT (rsCategory.EOF AND rsCategory.BOF) Then
'Create a new entry for the current category
aCategories(0,i) = rsCategory("CatID")
aCategories(1,i) = rsCategory("Description")
aCategories(2,i) = rsCategory("Childs")
'Get the parent ID (0 means root category)
ParentID = rsCategory("ParentID")
i = i+1
rsCategory.Close
j = i
Else
set rsCategory = nothing
GetParentCategories = i
Exit Function
End If
Wend
'Clean up
set rsCategory = nothing
'Return number of categories
GetParentCategories = j
End Function
'--------------------------------------------------------------------
' Function GetCatTrailNav(nCatID)
' Description: Returns a string with the category breadcrumb trail
' navigation.
' Input:
' - nCatID: current category id
'--------------------------------------------------------------------
Function GetCatTrailNav(nCatID)
Dim aCats(3,20)
Dim i
Dim iCurrentCat
Dim sBreadCrumb
'Get the parent categories into the aCats array
iCurrentCat = GetParentCategories(nCatID,aCats)
sBreadCrumb = "<a href=""showcat.asp"">Kategorier</a>"
'If we have avlaid array loop through it from root to child.
If IsArray(aCats) Then
For i = iCurrentCat-1 to 0 step -1
'If we are not in the last category
If i > 0 Then
'If a category has not childs
If aCats(2,i) = 0 Then
sBreadCrumb = sBreadCrumb & " > <a href=""browse.asp?cat=" & aCats(0,i) & """>" & aCats(1,i) & "</a>"
'IIf the category has childs
Else
sBreadCrumb = sBreadCrumb & " > <a href=""showcat.asp?cat=" & aCats(0,i) & """>" & aCats(1,i) & "</a>"
End If
Else
'Add separator and last category
sBreadCrumb = sBreadCrumb & " > " & aCats(1,i)
End If
Next
End If
GetCatTrailNav = sBreadCrumb
End Function
'--------------------------------------------------------------------
' Function GetManufTrailNav(sManufacturer)
' Description: Gets manufacturer breadcrum navigations for the current one.
' Input:
' - sManufacturer: string with the current manufacturer/brand.
'--------------------------------------------------------------------
Function GetManufTrailNav(sManufacturer)
'If we got a manufacturer build and return the trail
If Len(sManufacturer) > 0 Then
GetManufTrailNav = "<a href=""showbrands.asp"">Manufacturers</a> > " & sManufacturer
End If
End Function
'--------------------------------------------------------------------
' Sub StartBox(baseStyle,title)
' Description: Display the start of a box including the header
' Input:
' - baseStyle: Box CSS style
' - title: Box title
'--------------------------------------------------------------------
Sub StartBox(baseStyle,title)
%>
<table cellspacing="0" class="<%= baseStyle %>">
<tr class="<%= baseStyle %>Title">
<th><%= title %></th>
</tr>
<tr class="<%= baseStyle %>Content">
<td>
<%
End Sub
'--------------------------------------------------------------------
' Sub EndBox
' Description: Displays the end of a box (close table)
'--------------------------------------------------------------------
Sub EndBox
%>
</td>
</tr>
</table>
<%
End Sub
'--------------------------------------------------------------------
' Sub DisplayHeader
' Description: Displays the page header (tabs and search bar)
'--------------------------------------------------------------------
Sub DisplayHeader
'First display the logo and text navigarion (top-right)
%>
<table width="1000" height="205" cellspacing=0 background="../images/bgtop.gif" id="TopNav">
<tr>
<td rowspan=2 id="LogoCell"><a href="<%= strNonSecPath %>shop.asp"></a></td>
<td id="RHTop">
<!-- <img src="images/qshop468x60_v2.gif" width=468 height=60 ALT="Q-Shop ASP Shopping Cart"><br><br> -->
<a href="<%= strNonSecPath %>cart.asp">Min indkøbsvogn</a> |
<a href="<%= strSecPath %>checkout_login.asp?UserID=<%= Session("UserID")%>&CartID=<%= Session("CartID") %>&Total=<%= Session("Total") %>&intUsers=<%= Application("intUsers") %>">Til betaling</a> |
<a href="<%= strNonSecPath %>users.asp">Min konto</a> |
<a href="<%= strNonSecPath %>fmail.asp">Kontakt</a> |
<a href="<%= strNonSecPath %>help.asp">Hjælp</a> </td>
</tr>
<tr>
<td colspan=2 id="NavTabCell">
<table id="NavTabs" cellspacing=0>
<tr>
<% 'Display the navigation tabs
Call DisplayTabs
%>
</tr>
</table>
</td>
</tr>
<tr>
<td colspan="3" class="DarkBGBar"></td>
</tr>
</table>
<table cellspacing=0 id="SearchBar">
<tr>
<td colspan="3" class="searchline"><% If sBreadCrumb <> "" Then Response.Write("<span class=""BreadCrumb"">" & sBreadCrumb & "</span>") %>
<form action="search.asp" id=quicksearch><input type="hidden" name="Criteria" value="OR">
<label for="searchtext">Søg:</label>
<input type="Text" name="srkeys" value="søge ord" onFocus="if(this.value=='search')this.value='';" class="searchtext" id="searchtext">
<input type="submit" name="Search" value="Udfør" class="searchbutton">
</form></td>
</tr>
</table>
<%
End Sub
'--------------------------------------------------------------------
' Sub DisplayTabs
' Description: Display navigation tabs
'--------------------------------------------------------------------
Sub DisplayTabs
Dim aTabs
Dim i
Dim sSelTabID
Dim iName, iURL, iID
iName = 0
iURL = 1
iID = 2
'Check what type of tab to use depending on shop settings (set in control panel)
Select Case shop_TabControl
Case "custom"
Call GetCustomTabs(aTabs)
Case "categories"
Call GetCategoryTabs(aTabs)
Case Else
'Handle problem
End Select
'Get current tab from session
sSelTabID = Session("tab")
'If we don't have data then exit
If NOT IsArray(aTabs) Then Exit Sub
Dim sStyle
'Loop through the tab data and display them checking whether the tab is currently selected or not
For i = 0 to UBound(aTabs,2)
If sSelTabID = aTabs(iID, i) Then
'Selected tab
sStyle = "Sel"
Else
'Not selected tab
sStyle = "UnSel"
End If
%>
<td class="TopMenu<%= sStyle %>Corner"><img src="themes/<%= Theme %>/corner_left.gif" width="10" height="25" alt=""></td>
<td class="TopMenu<%= sStyle %>"><a href="<%= aTabs(iURL, i) %>"><%= aTabs(iName, i) %></a></td>
<td class="TopMenu<%= sStyle %>Corner"><img src="themes/<%= Theme %>/corner_right.gif" width="10" height="25" alt=""></td>
<% 'If this isn't the last tab display the separator cell
If i < UBound(aTabs,2) Then Response.Write(" <td class=MenuSep> </td>")
Next
End Sub
'--------------------------------------------------------------------
' Sub GetCustomTabs(ByRef aTabs)
' Description: Get custom tabs
' Input:
' - aTabs: variable that will be used to return the tab data.
'--------------------------------------------------------------------
Sub GetCustomTabs(ByRef aTabs)
Dim rsTabs
Dim sql
Dim aDbTabs
Dim nRows, i
Dim iName, iURL, iID
iName = 0
iURL = 1
iID = 2
'Check if there is an expiry date for the cached data
If IsDate(Application("Tabs_Expiry")) Then
'If there is a expiry data, it's within the expiry time (in minutes) and there is cached data then get it
If DateDiff("n",Application("Tabs_Expiry"),Now) < shop_DataNavCache And IsArray(Application("Tabs")) Then
aDbTabs = Application("Tabs")
Else
'Get the data from the database
aDbTabs = GetCustomTabsData
'Cache the data
Application.Lock
Application("Tabs") = aDbTabs
Application("Tabs_Expiry") = Now 'Set expiry time
Application.Unlock
End If
Else
'Otherwise query the database
aDbTabs = GetCustomTabsData
'Cache the data
Application.Lock
Application("Tabs") = aDbTabs
Application("Tabs_Expiry") = Now 'Set expiry time
Application.Unlock
End If
'If it's not a valid array exit
If NOT IsArray(aDbTabs) Then Exit Sub
nRows = UBound(aDbTabs, 2)
ReDim aTabs(2, nRows)
'Populate the tabs for each category
For i = 0 to nRows
aTabs(iName, i) = CStr(aDbTabs(0,i)) 'Set the tab name
aTabs(iURL, i) = aDbTabs(1,i) 'Set the tab URL
aTabs(iID, i) = aDbTabs(2,i) 'Set the tab id
Next
End Sub
'--------------------------------------------------------------------
' Function GetCustomTabsData
' Description: Returns the custom tabs data from the database
'--------------------------------------------------------------------
Function GetCustomTabsData
Dim rsTabs, sql
Dim iName, iURL, iID
iName = 0
iURL = 1
iID = 2
'Query data in DB
Set rsTabs = Server.CreateObject("ADODB.Recordset")
sql= "SELECT Name, URL, TabID FROM Tabs WHERE Show = 1 ORDER BY SortOrder"
rsTabs.Open sql, Conn, adOpenForwardOnly, adLockOptimistic
'If it didn't retrieve anything use Home as default value
If (rsTabs.EOF AND rsTabs.BOF) Then
rsTabs.Close
ReDim aTabs(2, 0)
'Just return Home as a single link (default)
aTabs(iName, 0) = "Home"
aTabs(iURL, 0) = "shop.asp"
aTabs(iID, 0) = "home"
GetCustomTabsData = aTabs
'Clean up and exit
set rsTabs = nothing
Exit Function
End If
'Return data in array format
GetCustomTabsData = rsTabs.GetRows
'Clean up
rsTabs.Close
set rsTabs = nothing
End Function
'--------------------------------------------------------------------
' Sub GetCategoryTabs(ByRef aTabs)
' Description: Gets category tab data
' Input:
' aTabs: Array that will be used to return the category tab data
'--------------------------------------------------------------------
Sub GetCategoryTabs(ByRef aTabs)
Dim sql
Dim aCategories
Dim aRootCategories
Dim nRows, j
Dim iName, iURL, iID
iName = 0
iURL = 1
iID = 2
'Check if there is an expiry date for the cached data
If IsDate(Application("Tabs_Expiry")) Then
'If there is a expiry data, it's within the expiry time (in minutes) and there is cached data then get it
If DateDiff("n",Application("Tabs_Expiry"),Now) < shop_DataNavCache And IsArray(Application("Tabs")) Then
aRootCategories = Application("Tabs")
Else
'Get the data from DB
aRootCategories = GetTabCategoriesData
'Cache the data
Application.Lock
Application("Tabs") = aRootCategories
Application("Tabs_Expiry") = Now 'Set expiry time
Application.Unlock
End If
Else
'Otherwise query the database
'Get data from DB
aRootCategories = GetTabCategoriesData
'Cache data
Application.Lock
Application("Tabs") = aRootCategories
Application("Tabs_Expiry") = Now 'Set expiry time
Application.Unlock
End If
'If not valid array exit
If NOT IsArray(aRootCategories) Then Exit Sub
nRows = UBound(aRootCategories, 2)
ReDim aTabs(2, nRows+1)
'Populate first tab as Home
aTabs(iName, 0) = "Home"
aTabs(iURL, 0) = "shop.asp"
aTabs(iID, 0) = "home"
'Populate the tabs for each category
For j = 0 to nRows
aTabs(iName, j+1) = CStr(aRootCategories(2,j)) 'Set the tab name
'Check if the category has childs and provide the appropriate URL
If aRootCategories(1,j) = 0 Then
'No child categories
aTabs(iURL, j+1) = "browse.asp?cat=" & aRootCategories(0,j)
Else
'has child categories
aTabs(iURL, j+1) = "showcat.asp?cat=" & aRootCategories(0,j)
End If
aTabs(iID, j+1) = CStr(aRootCategories(0,j)) 'Set the tab id
Next
End Sub
'--------------------------------------------------------------------
' Function GetTabCategoriesData
' Description: Returns category data from database for use in tabs
'--------------------------------------------------------------------
Function GetTabCategoriesData
Dim rsRootCategories, sql
Set rsRootCategories = Server.CreateObject("ADODB.Recordset")
sql= "SELECT CatID, Childs, Description FROM categories WHERE ParentID = 0 AND Show = 1 ORDER BY Description"
rsRootCategories.Open sql, Conn, adOpenForwardOnly, adLockOptimistic
If (rsRootCategories.EOF AND rsRootCategories.BOF) Then
rsRootCategories.Close
Exit Function
End If
GetTabCategoriesData = rsRootCategories.GetRows
set rsRootCategories = nothing
End Function
'--------------------------------------------------------------------
' Sub StartMainLayout
' Description: Displays the start of the table that contains the main body area
' (left hand side navigation and body).
'--------------------------------------------------------------------
Sub StartMainLayout
%>
<!-- MAIN -->
<table cellspacing=0 id="MainBody">
<tr>
<%
End Sub
'--------------------------------------------------------------------
' Sub EndMainLayout
' Description: Displays the end of the table that contains the main
' body area.
'--------------------------------------------------------------------
Sub EndMainLayout
%>
</tr>
</table>
<!-- END MAIN -->
<%
End Sub
'--------------------------------------------------------------------
' Sub StartLHMenu
' Description: Displays start of left hand side menu table cell
'--------------------------------------------------------------------
Sub StartLHMenu
%>
<!-- LEFT -->
<td valign=top id="LeftNav">
<%
End Sub
'--------------------------------------------------------------------
' Sub DisplayLHMenu
' Description: Displays the contents of the left hand side menu
'--------------------------------------------------------------------
Sub DisplayLHMenu
'Browse Box (root categories))
Call ShowCategoryBox
'Optional current category box (only when in a subcategory)
Call ShowCurrentCatBox
'Browse by Box (category and manufacturers drop-downs)
Call StartBox("MenuBox","Genveje til efter:")
Response.Write("<form id=""quicksel"" name=""quicksel"" action=""#"">")
Response.Write(Application("QuickSel") & "<br>")
Response.Write(Application("ManuSel") & "</form>")
Call EndBox
'Extra Browse Box (other categories)
Call StartBox("MenuBox","Genveje til")
%>
<ul>
<li><a href="<%= strNonSecPath %>wishlist.asp">Min ønskeliste</a></li>
<li><a href="<%= strNonSecPath %>browse.asp?cat=ofer">Tilbud</a></li>
<% 'If there are featured products then show the featured menu
If Application("Featured") <> ""Then %>
<li><a href="<%= strNonSecPath %>browse.asp?cat=feat">Særlige varer</a></li>
<% End If %>
<li><a href="<%= strNonSecPath %>showbrands.asp?cat=feat">Mærker</a></li>
<% If shop_GiftCertEnabled AND IsProVersion Then %>
<li><a href="<%= strNonSecPath %>giftcertificate.asp">Gavekort</a></li>
<% End If %>
<li><a href="sitemap.asp">Sideoversigt</a></li>
<li><a href="<%= strNonSecPath %>fsearch.asp" >Søg</a></li>
</ul>
<%
Call EndBox
'Information Box
Call StartBox("MenuBox","Information")
%>
<ul>
<li><a href="<%= strNonSecPath %>users.asp">Min konto</a></li>
<% If Session("Logged") Then %>
<li><a href="<%= strNonSecPath %>users.asp?logout=yes">Log ud</a></li>
<% End If %>
<li><a href="<%= strNonSecPath %>shipping.asp">Forsendelse</a></li>
<li><a href="<%= strNonSecPath %>terms.asp">Betingelser & omstændigheder</a></li>
<li><a href="<%= strNonSecPath %>help.asp">Hjælp</a></li>
<li><a href="<%= strNonSecPath %>contact.asp">Kontakt os</a></li>
<li><a href="<%= strNonSecPath %>about.asp">Om os </a></li>
</ul>
<%
Call EndBox
'Show cart total box
Call ShowCartTotal
'Display theme selection box (if enabled in control panel)
Call DisplayThemeBox
'Display a banner
'Call DisplayBanner("inc/addata130x110.txt")
'Display powered by logo - PLEASE KEEP - THANK YOU!
Call DisplayPoweredBy
End Sub
'--------------------------------------------------------------------
' Sub EndLHMenu
' Description: Ends left hand side menu cell
'--------------------------------------------------------------------
Sub EndLHMenu
%>
</td>
<!-- END LEFT -->
<%
End Sub
'====================================================
' ShowCartTotal:
' Displays total in cart. If Session("Total") is not
' numeric then displays 0.
'====================================================
Sub ShowCartTotal
Dim sTotal
Call StartBox("MenuBox","Min indkøbsvogn")
sTotal = Session("Total")
'Write total in cart and 0.00 otherwise
If IsNumeric(sTotal) Then
Response.Write FormatDefCurr(sTotal)
Else
Response.Write FormatDefCurr(0.0)
End If
'Display link to cart
Response.Write("<div class=""MenuBoxFoot""><a href=""cart.asp"">Vis indkøbsvogn »</a></div>")
Call EndBox
End Sub
'====================================================
' DisplayThemeBox:
' Displays change theme box. Only on some pages
'====================================================
Sub DisplayThemeBox
'Check whether this box is enabled.
If NOT shop_DisplayThemeBox Then Exit Sub
Dim sScriptName
'Get current page (e.g. shop/browse.asp)
sScriptName = Request.ServerVariables("SCRIPT_NAME")
'If we are in one of the following pages then display it. You can add more here
'but you should only include pages you get to using only URL parameters and not
'posted forms or redirection back won't work
If Instr(sScriptName, "shop.asp") > 0 OR _
Instr(sScriptName, "users.asp") > 0 OR _
Instr(sScriptName, "showcat.asp") > 0 OR _
Instr(sScriptName, "details.asp") > 0 OR _
Instr(sScriptName, "browse.asp") > 0 Then
<%
Call EndBox
End If
End Sub
Sub DisplayPoweredBy
%>
<div align="center"><%= Application("intUsers") %> kunde/r i butikken lige nu</div>
<%
End Sub
'--------------------------------------------------------------------
' Sub StartMainBody
' Description: Start main body content cell
'--------------------------------------------------------------------
Sub StartMainBody
%>
<!-- MAIN BODY -->
<td id="BodyCell">
<%
End Sub
'--------------------------------------------------------------------
' Sub EndMainBody
' Description: End main body conten cell
'--------------------------------------------------------------------
Sub EndMainBody
%>
<!-- END MAIN BODY -->
</td>
<%
End Sub
'--------------------------------------------------------------------
' Sub StartRHBar
' Description: End previous cell and start a new one to generate a
' right hand side menu cell.
'--------------------------------------------------------------------
Sub StartRHBar
%>
<!-- RIGHT COLUMN -->
<td valign=top id="RightNav">
<%
End Sub
'--------------------------------------------------------------------
' Sub EndRHBar
' Description: End right hand side menu cell.
'--------------------------------------------------------------------
Sub EndRHBar
%>
</td>
<!-- END RIGHT COLUMN -->
<%
End Sub
'--------------------------------------------------------------------
' Sub DisplayFooter
' Description: Displays footer bar and copyright statements.
' Please keep the reference to Quadcomm Inc
'--------------------------------------------------------------------
Sub DisplayFooter
%>
<!-- FOOTER -->
<table cellspacing="0" id="BottomNav">
<tr>
<td class="DarkBGFootBar"></td>
</tr>
</table>
<div id="Footer" class=Footer>
© Copyright <%= shop_Title & ", " & Year(Now) %>. All rights reserved</div>
<a href="
http://quadcomm.com/qshop" target="_blank" title="Powered by Q-Shop"><img src="images/spc_trans.gif" width="1" height="1" alt="ASP Shopping Cart Powered by Q-Shop"></a>
<!-- END FOOTER -->
<%
End Sub
'------------------------------------------------
' Sub ShowDisplayCount(maxItems, totalItems)
' Dispays the "Dispaying 1-10 (of 20 products)" message
' Input:
' - maxItems: Number of products per page
' - totalItems: Total items to display
'------------------------------------------------
Sub ShowDisplayCount(maxItems, totalItems)
Dim nLowerNo, nUpperNo
'Get lower number
nLowerNo = (CurrentPage - 1) * maxItems + 1
'Get upper number
nUpperNo = nLowerNo - 1 + maxItems
If nUpperNo > totalItems Then nUpperNo = totalItems
%> <div class="Displaying">
Viser <%= nLowerNo %>-<%= nUpperNo %> (ud af <%= totalItems %> produkter)
</div>
<%
End Sub
'------------------------------------------------
' Function GetTheme
' Returns the current selected theme folder
'------------------------------------------------
Function GetTheme
Dim tempTheme
'If there is a theme for the session get it.
If Len(Session("THEME")) > 0 Then
tempTheme = Session("THEME")
Else
'Otherwise set it to "default"
tempTheme = "default"
End If
'If there is a theme parameter in URL use it - can be used to test the look without permanently
'changing the setting.
If Len(Trim(Request.QueryString("theme"))) > 0 Then tempTheme = Trim(Request.QueryString("theme"))
GetTheme= tempTheme
End Function
'--------------------------------------------------------------------
' Sub DisplayMetaKeywords(metaKeywords)
' Description: Displays the META KEYWORDS tag. If none is passed it
' will use shop default.
' Input:
' - metaKeywords: Overriding keywords. Pass nothing to use default.
'--------------------------------------------------------------------
Sub DisplayMetaKeywords(metaKeywords)
'If we have passed specific meta keywords display them, otherwise check default value
If Len(metaKeywords) > 0 Then
Response.Write(vbTab & "<meta name=""keywords"" content=""" & metaKeywords & """>" & vbCrLf)
ElseIf shop_MetaKeywords <> "" Then
Response.Write(vbTab & "<meta name=""keywords"" content=""" & shop_MetaKeywords & """>" & vbCrLf)
End If
End Sub
'--------------------------------------------------------------------
' Sub DisplayMetaDescription(metaDescription)
' Description: Displays the META DESCRIPTION tag. If none is passed it
' will use shop default.
' Input:
' - metaDescription: Overriding description. Pass nothing to use default.
'--------------------------------------------------------------------
Sub DisplayMetaDescription(metaDescription)
'If we have passed specific meta description display it, otherwise check default value
If Len(metaDescription) > 0 Then
Response.Write(vbTab & "<meta name=""description"" content=""" & metaDescription & """>" & vbCrLf)
ElseIf shop_MetaDescription <> "" Then
Response.Write(vbTab & "<meta name=""description"" content=""" & shop_MetaDescription & """>" & vbCrLf)
End If
End Sub
'--------------------------------------------------------------------
' Sub DisplayCommonMetaTags
' Description: Display other common metatags
'--------------------------------------------------------------------
Sub DisplayCommonMetaTags
'If a charset parameter is set in control panel then use it.
If Len(shop_CharSet) > 0 Then
Response.Write(vbTab & "<META http-equiv=Content-Type content=""text/html; charset=" & shop_CharSet & """>" & vbCrLf)
End If
Response.Write(vbTab & "<META NAME=""Author"" Content=""" & shop_CompanyName & """>" & vbCrLf)
Response.Write(vbTab & "<META NAME=""Copyright"" Content=""" & shop_CompanyName & """>" & vbCrLf)
End Sub
'--------------------------------------------------------------------
' Sub DisplayBanner(adSource)
' Description: Displays a banner using MSWC.AdRotator.
' It required MSWC.AdRotator installed (comes with IIS)
' See
http://www.microsoft.com/windows2000/en/server/iis/default.asp?url=/windows2000/en/server/iis/htm/asp/comp59f8.htm' for details on how to create ad rotation files.
' Input:
' - adSource: relative path to ads file
'--------------------------------------------------------------------
Sub DisplayBanner(adSource)
Dim varAd, objAd
Set objAd = Server.CreateObject("MSWC.AdRotator")
If err.Number = 0 Then
' Border of image
objAd.Border="0"
'Image is a hiperlink
objAd.Clickable = True
' Specify target
objAd.TargetFrame="target=_new"
varAd = objAd.GetAdvertisement(adSource)
If err.Number = 0 Then
Response.Write varAd
Else
Response.Write("<!-- ERROR: Source DisplayBanner - Error parsing ad file (" & Err.Description & ") -->")
err.Clear
End If
Else
Response.Write("<!-- ERROR: Source DisplayBanner - Error opening MSWC.AdRotator (" & Err.Description & ") -->")
err.Clear
End If
set objAd = nothing
End Sub
'=======================================================================================================
' Code to run:
'=======================================================================================================
Theme = GetTheme 'Sets the Theme variable
'=======================================================================================================
%>
Og det er følgende tabeller det drejer sig om:
table#TopNav, table#BottomNav, table#SearchBar, table#Footer, table#MainBody
