<% dim debug_level debug_level = 0 if not enable_publish_pages then call subCacheCheck(aceCacheMinutes, ".htm") %> <% 'Option Explicit ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' Copyright (C) 2002-2003 by Netphoria, Inc. All Rights Reserved. ' 701 Watson Road ' Madison, WI 53711 ' netphoria.com ' ' This software is only licensed for use on one web site and on one web server. ' Please read the accompanying license.txt file. ' ' Original Author: Brian Thorson ' Create Date: 03-07-03 ' ' Change History: ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - dim strTitle dim strContent dim lngPageID dim NoRecord dim strDocBgColor dim strAuthor dim strPagePassword dim lngAccessLevel dim adminpage 'Dim strKeywords 'Dim strDescription 'Dim strMetaTitle dim lastUpdated dim adoCn dim strSQL dim count dim strPageName dim ace_querystring '-- '-- Aaron: 8-28-2006 '-- 'const CONST_select_fields = "[ID],[Title],[Content],[BgColor],[Author],[Password],[MenuID],[meta_title],[meta_keywords],[meta_description]" const CONST_select_fields = "[Content].[content_id], [Content].[Title], [Content].[Content], [Content].[BgColor], [Content].[Author], [Content].[Password], [Content].[AccessLevel], [Content].[MenuID], [Content].[meta_title], [Content].[meta_keywords], [Content].[meta_description], [Content].[Last Modified]" set adoCn = Server.CreateObject("ADODB.Connection") ON ERROR RESUME NEXT adoCn.Open global_ACE_conn if Err.Number <> 0 then adoCn.close set adoCn = Nothing server.transfer("/index.uc.htm") end if ON ERROR GOTO 0 ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' 2006-02-21 dkalsbeek ' detect if site publishing is enabled, if it is, then see if this page ' should have a published page, if it does, check and see if it exists, ' if it exists, then redirect to it. if enable_publish_pages and session("ace_mobile") <> "true" then RedirectIfSiteIsPublished(adoCn) end if ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # ' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # intDocumentID = Request("MenuID") if intDocumentID <> "" then strSQL = "Select " & CONST_select_fields & " From [Content] INNER JOIN [Menu] ON [Menu].[ID] = [Content].[MenuID] where [Content].[MenuID]=" & clng(intDocumentID) & " AND [Menu].[site_id] = " & siteId mode = "menu" else intDocumentID = Request("PageID") if intDocumentID <> "" then strSQL = "Select " & CONST_select_fields & " From [Content] INNER JOIN [Menu] ON [Menu].[ID] = [Content].[MenuID] where [Content].[content_id]=" & clng(intDocumentID) & " AND [Menu].[site_id] = " & clng(siteId) '-- '-- Aaron: 9-6-2006 '-- 'if enable_multiple_language_support AND NOT IsNull(i18n_id) then ' strSQL = strSQL & " AND i18n_id = " & clng(i18n_id) 'end if mode = "page" else strPageName = request.querystring("pageName") if strPageName = "" then ' check to see if this is a redirect from a custom 404 error ace_querystring = request.servervariables("query_string") if left(ace_querystring, 4) = "404;" then ace_querystring = right(ace_querystring, len(ace_querystring) - 4) ace_querystring = replace(ace_querystring, "http://", "") ace_querystring = replace(ace_querystring, request.servervariables("server_name"), "") ace_querystring = replace(ace_querystring, ":80", "") ace_querystring = replace(ace_querystring, ":443", "") if left(ace_querystring,1) = "/" then ace_querystring = right(ace_querystring, len(ace_querystring) - 1) end if if right(ace_querystring,1) = "/" then ace_querystring = left(ace_querystring, len(ace_querystring) - 1) end if strPageName = ace_querystring 'response.write ace_querystring 'response.end end if end if if strPageName <> "" then strPageName = replace(strPageName, acePublish_extension, "") strPageName = replace(strPageName, acePublish_path, "") strSQL = "Select " & CONST_select_fields & " From [Content] INNER JOIN [Menu] ON [Menu].[ID] = [Content].[MenuID] where [Content].[meta_filename]='" & replace(strPageName, "'", "''") & "' AND [Menu].[site_id] = " & clng(siteId) mode = "name" else '-- Aaron: 9-1-2006 'intDocumentID = 0 intDocumentID = GetDefaultDocumentId(adoCn) 'Response.Write("intDocumentID = '" & intDocumentID & "'
") strSQL = "Select " & CONST_select_fields & " From [Content] INNER JOIN [Menu] ON [Menu].[ID] = [Content].[MenuID] where [MenuID]=" & clng(intDocumentID) & " AND [Menu].[site_id] = " & clng(siteId) '-- '-- Aaron: 9-6-2006 '-- 'if enable_multiple_language_support AND NOT IsNull(i18n_id) AND i18n_id <> "" then ' 'strSQL = strSQL & " AND i18n_id = " & clng(i18n_id) 'end if mode = "menu" end if end if end if isIndex = IsThisTheIndexPage(intDocumentId, adoCn) 'Response.Write("isIndex = '" & isIndex & "'
") 'response.write strSQL 'response.end NoRecord = false if intDocumentID >= 0 or mode="name" then dim adoRs set adoRs = Server.CreateObject("ADODB.Recordset") '-- '-- Aaron: 9-6-2006 '-- 'if enable_multiple_language_support AND NOT IsNull(i18n_id) AND i18n_id <> "" then ' '-- ' '-- Aaron: 9-1-2006 ' '-- ' 'set adoRs = adoCn.Execute(strSQL & " AND i18n_id = " & clng(i18n_id)) ' set adoRs = adoCn.Execute(strSQL) ' if adoRs.EOF AND adoRs.BOF then ' adoRs.Close ' 'Response.write "trying w/o i18n
" & strSQL & "
" ' set adoRs = adoCn.Execute(strSQL) ' end if 'else ' set adoRs = adoCn.Execute(strSQL) 'end if 'Response.Write("strSQL = '" & strSQL & "'
") set adoRs = adoCn.Execute(strSQL) If not adoRs.EOF then 'response.write "

" & strSQL & "

" & vbNewLine if mode = "name" then intDocumentID = adoRS("MenuID") mode = "menu" end if lngPageID = adoRS("content_id") strTitle = adoRs("Title") strContent = adoRs("Content") strDocBgColor = adoRs("BgColor") strAuthor = adoRS("Author") lngAccessLevel = adoRS("AccessLevel") if isnull(lngAccessLevel) then lngAccessLevel = 0 end if count = 0 ' BT 7-26-12 use CheckForPageProtection 'CheckForParentAccessLevel(adoRS("MenuID")) 'strPagePassword = adoRS("Password") 'if isnull(strPagePassword) then ' strPagePassword = "" 'end if 'if strPagePassword = "" then ' count = 0 ' CheckForParentPagePassword(adoRS("MenuID")) 'end if strPagePassword = adoRS("Password") if isnull(strPagePassword) then strPagePassword = "" end if CheckForPageProtection(adoRS("MenuID")) strMetaTitle = adoRS("meta_title") strKeywords = adoRS("meta_keywords") strDescription = adoRS("meta_description") if IsNull(strMetaTitle) then strMetaTitle = pageTitle end if if IsNull(strKeywords) then strKeywords = defaultMetaKeywords end if if IsNull(strDescription) then strDescription = defaultMetaDescription end if lastUpdated = adoRS("Last Modified") else NoRecord = True End If adoRs.Close ' get the page name and content group if if enable_hitlens and intDocumentID > 0 then strSQL = "SELECT ID, Parent, TxtToShow FROM Menu WHERE ID IN (SELECT Parent FROM Menu WHERE ID = " & intDocumentID & ") OR ID = " & intDocumentID & " ORDER BY Parent" 'Response.Write strSQL Set adoRs = adoCn.Execute(strSQL) while NOT adoRs.EOF if CLng(adoRs.fields("ID").value) = CLng(intDocumentID) then strPageName = adoRs.fields("TxtToShow").value elseif adoRs.fields("Parent").value <> "" then strContentGroup = adoRs.fields("TxtToShow").value end if adoRs.MoveNext wend adoRs.Close end if set adoRs = nothing end if adoCn.Close set adoCn = nothing if NoRecord and mode="name" then if enable_news and instr(strPageName, "n-news/") > 0 then server.transfer "/n-news/article.asp?pagename=" & strPageName end if server.transfer "/404.asp" end if dim AccessLevel_OK AccessLevel_OK = true if enable_access_levels then if lngAccessLevel > 0 then AccessLevel_OK = authenticateUser(lngAccessLevel) end if end if %> <% dim Password_OK Password_OK = true if enable_page_passwords then if strPagePassword <> "" then Password_OK = false %> <% end if end if 'response.write "password_ok=" & password_ok & "
" 'response.write "AccessLevel_OK=" & AccessLevel_OK & "
" if Password_OK and AccessLevel_OK then response.write preContentHeader if strContent <> "" then if session("ace_mobile") = "true" then response.write(scrubMobile(scrubHTML(strContent))) elseif session("ace_facebook") = "true" then response.write(scrubFacebook(scrubHTML(strContent))) else response.write(scrubHTML(strContent)) end if else 'response.write "strContent = |" & strContent & "|" 'response.write aceDefaultPage 'response.write preContentHeader response.write getFileContent(server.mappath(aceDefaultPage)) 'response.write postContentFooter end if response.write postContentFooter elseif Password_OK and not AccessLevel_OK then response.write preContentHeader response.write "You are not authorized to view this page." response.write postContentFooter end if if session("admin_password") <> "" then %>

You are in Administrator Mode

<% '-- '-- Aaron: 9-6-2006 '-- %> <%= request.servervariables("url")%>','','width=900,height=620,resizable')"> <% 'if NoRecord then ' response.write("Click here to Add a page for this Menu Item.") 'else response.write("Edit this Page.") 'end if response.write("

") response.write("Go to your Admin Center.


") end if if enable_last_updated_on or enable_rss then response.write "
" if enable_last_updated_on then response.write "Last Updated: " & lastUpdated end if if enable_rss then response.write "   " end if response.write "
" end if %> <% ' BT 7-26-12 ' CheckForPageProtection replaces CheckForParentAccessLevel and CheckForParentPagePassword and puts it into one function. 'Sub CheckForParentPagePassword(menuid) ' dim sql ' dim rs ' count = count + 1 ' sql = "SELECT [Menu].[Parent], " &_ ' "[Content].[Password] " &_ ' "FROM [Menu], [Content] " &_ ' "WHERE [Content].[MenuID] = [Menu].[ID] " &_ ' "AND [Menu].[ID] = " & clng(menuid) ' 'response.write sql & "
" ' Set rs = Server.CreateObject("ADODB.Recordset") ' rs.open sql, adoCn ' if not rs.eof then ' 'response.write rs("password") & "
" ' 'response.write rs("parent") & "
" ' if rs("password") <> "" and not isnull(rs("password")) then ' strPagePassword = rs("password") ' 'exit sub; ' elseif rs("parent") <> 0 and count < 15 then ' CheckForParentPagePassword(rs("parent")) ' end if ' end if ' rs.close ' set rs = nothing 'End Sub ' 'Sub CheckForParentAccessLevel(menuid) ' dim sql ' dim rs ' count = count + 1 ' test how many levels deep to stop infinite loops ' sql = "SELECT [menu].[parent], " &_ ' "[Content].[AccessLevel] " &_ ' "FROM [menu], [Content] " &_ ' "WHERE [Content].[menuID] = [menu].[ID] " &_ ' "AND [menu].[id] = " & clng(menuid) ' 'response.write sql & "
" ' Set rs = Server.CreateObject("ADODB.Recordset") ' rs.open sql, adoCn ' if not rs.eof then ' 'response.write rs("password") & "
" ' 'response.write rs("parent") & "
" ' if isnumeric(rs("AccessLevel")) then ' if rs("AccessLevel") > lngAccessLevel then ' lngAccessLevel = rs("AccessLevel") ' end if ' end if ' if rs("parent") <> 0 and count < 15 then ' CheckForParentAccessLevel(rs("parent")) ' end if ' end if ' rs.close ' set rs = nothing 'End Sub ' BT 7-26-12 ' This code replaces CheckForParentAccessLevel and CheckForParentPagePassword and puts it into one function. ' It also sets the intfirstlevelmenuid Sub CheckForPageProtection(menuid) dim sql dim rs intfirstlevelmenuid = menuid 'response.write "intfirstlevelmenuid=" & intfirstlevelmenuid & "
" count = count + 1 ' test how many levels deep to stop infinite loops sql = "SELECT [menu].[parent], " &_ "[Content].[AccessLevel], " &_ "[Content].[Password] " &_ "FROM [menu], [Content] " &_ "WHERE [Content].[menuID] = [menu].[ID] " &_ "AND [menu].[id] = " & clng(menuid) 'response.write sql & "
" Set rs = Server.CreateObject("ADODB.Recordset") rs.open sql, adoCn if not rs.eof then 'response.write rs("password") & "
" 'response.write rs("parent") & "
" if isnumeric(rs("AccessLevel")) then if rs("AccessLevel") > lngAccessLevel then lngAccessLevel = rs("AccessLevel") end if end if if strPagePassword = "" and rs("password") <> "" and not isnull(rs("password")) then strPagePassword = rs("password") end if if rs("parent") <> 0 and count < 15 then CheckForPageProtection(rs("parent")) end if end if rs.close set rs = nothing End Sub ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ' Function ' dkalsbeek@netphoria.com ' 2004-SEP- ' Description: ' ' Input Parameters: ' ' Return Values: ' ' ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Sub RedirectIfSiteIsPublished(ByRef dbConn) ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Dim dnk Dim menuID Dim FSO Dim filename dim publishpath menuID = Trim(Request.QueryString("MenuID")) if menuID <> "" AND IsNumeric(menuID) then menuID = CLng(menuID) else menuID = Trim(Request.Form("MenuID")) if menuID <> "" AND IsNumeric("MenuID") then menuID = CLng(menuID) else menuID = 0 end if end if if menuID = "" OR NOT IsNumeric(menuID) then menuID = 0 end if 'Response.Write("menuID = '" & menuID & "'
") Dim myCallingPage myCallingPage = Replace(Request("callingPage"), "\", "/") '-- This is passed by n-tmenu/publish_site.asp and ace/ace.asp 'Response.Write("myCallingPage = '" & myCallingPage & "'
") if menuID <> 0 then If InStr(myCallingPage, "n-tmenu/publish_site.asp") > 0 Then '-- The request is being made from the page publisher. '-- Don't redirect, just let it have its way with us. 'Response.Write("Doing nothing
") 'Response.End() Else '-- Redirect to /GetSitePublishPath(dbConn)/index.html (if it exists) 'Response.Write("SELECT c.content_id, c.MenuID, c.meta_filename, m.Parent, m.TxtToShow FROM content c LEFT OUTER JOIN menu m ON c.MenuID = m.ID WHERE [Password] IS NULL OR [Password] = '' AND c.MenuID = " & menuID & "
") Set dnk = dbConn.Execute("SELECT c.content_id, c.MenuID, c.meta_filename, m.Parent, m.TxtToShow FROM content c LEFT OUTER JOIN menu m ON c.MenuID = m.ID WHERE ([Password] IS NULL OR [Password] = '') AND c.MenuID = " & menuID & " AND m.site_id = " & siteId) if NOT dnk.EOF then 'response.Write("we have records
") Set FSO = Server.CreateObject("Scripting.FileSystemObject") 'filename = Replace(acePublish_path, "\", "/") publishpath = Replace(GetSitePublishPath(dbConn), "\", "/") if Right(publishpath, 1) <> "/" then publishpath = publishpath & "/" end if 'Response.Write("filename = '" & filename & "'
") 'filename = filename & siteId & "/" filename = getPublishedPageName(dnk.fields("meta_filename").value, dnk.fields("TxtToShow").value, dnk.fields("content_id").value) '-- '-- Aaron 8-18-2006 '-- Added the below line. Without it the redirect never happens since the '-- myFile-ID file does not exist. It needs to be something like '-- /acePublish_path/[siteId]/myFile-ID.html. '-- 'Response.Write("filename = '" & filename & "'
") 'filename = acePublish_path & "/" & siteId & "/" & filename & acePublish_extension filename = publishpath & filename & acePublish_extension 'Response.Write("filename = '" & filename & "'
") 'Response.End() if FSO.FileExists(Server.MapPath(filename)) then 'response.Write("redirecting now: '" & filename & "'
") 'response.end Response.Redirect(filename) Else '-- Can't redirect. 'response.Write("not redirecting: '" & filename & "'
") 'response.end end if Set FSO = Nothing end if if dnk.State <> 0 then dnk.Close end if Set dnk = Nothing End If Else If InStr(myCallingPage, "n-tmenu/publish_site.asp") > 0 Then '-- The request is being made from the page publisher. '-- Don't redirect, just let it have its way with us. 'Response.Write("Doing nothing
") 'Response.End() Else '-- Redirect to /acePublish_path/[siteId]/index.html (if it exists) Dim oFs Set oFs = Server.CreateObject("Scripting.FileSystemObject") 'filename = Replace(acePublish_path & "/" & siteId, "\", "/") filename = Replace(GetSitePublishPath(dbConn), "\", "/") if Right(filename, 1) <> "/" then filename = filename & "/" end if filename = filename & "index.html" If oFs.FileExists(Server.MapPath(filename)) Then '-- Redirect to the published index. 'Response.Write("Redirecting from ELSE.
") 'Response.End() Response.Redirect(GetSitePublishPath(dbConn) & "/index.html") Else '-- The index.html file does not exist. End If End If end if ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - End Sub 'RedirectIfSiteIsPublished ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Function GetDefaultDocumentId(ByRef dbConn) Dim myRs Set myRs = Server.CreateObject("ADODB.Recordset") Dim sql sql = "SELECT [ID] FROM [Menu] WHERE [site_id] = " & clng(siteId) & " AND IsIndex=1" 'Response.Write("sql: '" & sql & "'
") ON ERROR RESUME NEXT Set myRs = dbConn.Execute(sql) if Err.Number <> 0 then dbConn.close set dbConn = Nothing server.transfer("/index.uc.htm") end if ON ERROR GOTO 0 If NOT myRs.EOF Then GetDefaultDocumentId = myRs("ID") Else GetDefaultDocumentId = "" End If myRs.close Set myRs = Nothing End Function Function IsThisTheIndexPage(ByVal contentId, ByRef dbConn) Dim sql sql = "SELECT Menu.IsIndex FROM Menu WHERE Menu.ID = " & clng(contentId) Dim myRs Set myRs = Server.CreateObject("ADODB.Recordset") Set myRs = dbConn.Execute(sql) If NOT myRs.EOF Then 'Response.Write("Record found: '" & myRs("IsIndex") & "'
") IsThisTheIndexPage = CBool(myRs("IsIndex")) Else 'Response.Write("No record found.
") IsThisTheIndexPage = False End If myRs.close Set myRs = Nothing End Function %> <% Function GetSitePublishPath(ByRef dbConn) GetSitePublishPath = acePublish_path Dim myRs Set myRs = GetSites(siteId, dbConn) If NOT myRs.EOF Then GetSitePublishPath = GetSitePublishPath & "/" & myRs("publish_directory") End If myRs.close Set myRs = Nothing End Function %>