<%
'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 adoCn
dim strSQL
'--
'-- 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]"
set adoCn = Server.CreateObject("ADODB.Connection")
adoCn.Open global_ACE_conn
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
' # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
' 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 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] = " & 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
'-- 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] = " & 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
isIndex = IsThisTheIndexPage(intDocumentId, adoCn)
'Response.Write("isIndex = '" & isIndex & "'
")
'response.write strSQL
'response.end
NoRecord = false
if intDocumentID >= 0 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
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
CheckForParentAccessLevel(adoRS("MenuID"))
strPagePassword = adoRS("Password")
if isnull(strPagePassword) then
strPagePassword = ""
end if
if strPagePassword = "" then
CheckForParentPagePassword(adoRS("MenuID"))
end if
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
else
NoRecord = True
End If
adoRs.Close
' get the page name and content group if
if enable_hitlens then
'Response.Write "SELECT ID, Parent, TxtToShow FROM Menu WHERE ID IN (SELECT Parent FROM Menu WHERE ID = " & intDocumentID & ") OR ID = " & intDocumentID & "
" & vbNewLine
Set adoRs = adoCn.Execute("SELECT ID, Parent, TxtToShow FROM Menu WHERE ID IN (SELECT Parent FROM Menu WHERE ID = " & intDocumentID & ") OR ID = " & intDocumentID & " ORDER BY Parent")
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
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
response.write(scrubHTML(strContent))
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
%>
")
end if
%>
<%
Sub CheckForParentPagePassword(menuid)
dim sql
dim rs
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 then
CheckForParentPagePassword(rs("parent"))
end if
end if
rs.close
set rs = nothing
End Sub
Sub CheckForParentAccessLevel(menuid)
dim sql
dim rs
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 then
CheckForParentAccessLevel(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
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, "\", "/")
filename = Replace(GetSitePublishPath(dbConn), "\", "/")
if Right(filename, 1) <> "/" then
filename = filename & "/"
end if
'Response.Write("filename = '" & filename & "'
")
'filename = filename & siteId & "/"
if dnk.fields("meta_filename").value = "" OR IsNull(dnk.fields("meta_filename").value) then
' check using content_id
'filename = filename & "page-" & dnk.fields("content_id").value & acePublish_extension
if NOT IsNull(dnk.fields("TxtToShow").value) then
filename = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(dnk.fields("TxtToShow").value, " ", "-"), ".", "-"), ":", "-"), "\", "-"), "/", "-"), ",", "-"), "<", "-"), ">", "-"), "&", "-"), "--", "-"), "--", "-") & "-" & dnk.fields("content_id").value
'Function ReturnAllowedCharacters(ByVal str, ByRef arrAllowedCharacters)
'--filename = ReturnAllowedCharacters(filename, Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-"))
filename = ReturnAllowedChars_RegEx(filename, "^[a-zA-Z0-9\-]+$") '-- Matches a-z, A-Z, and dash (-)
elseif IsNull(filename) then
filename = "page-" & dnk.fields("content_id").value
end if
'response.Write("filename = '" & filename & "'
")
else
' use the meta_filename
filename = filename & dnk.fields("meta_filename").value
'response.Write("filename = '" & filename & "'
")
end if
'--
'-- 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 = 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
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'--
'-- Aaron 8-18-2006
'--
'-- stringToSearch:
'-- The string to find the searchPatternIn
'-- searchPattern:
'-- Any valid regular expression, or the name of a built in regEx (listed in code)
'--
'--
'-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function ReturnAllowedChars_RegEx( ByVal stringToSearch, _
ByVal searchPattern)
Dim strReturn
strReturn = ""
Select Case(searchPattern)
Case "alphanum"
searchPattern = "^[a-zA-Z0-9]+$"
Case "alpha"
searchPattern = "^[a-zA-Z]+$"
Case Else
'-- Do nothing
End Select
Dim oRegEx
Set oRegEx = New RegExp
oRegEx.IgnoreCase = False
oRegEx.Global = True
oRegEx.Pattern = searchPattern
If oRegEx.Test(stringToSearch) Then
Dim oMatches, _
oMatch
Set oMatches = oRegEx.Execute(stringToSearch)
For Each oMatch In oMatches
strReturn = strReturn & oMatch.Value
Next
Set oMatch = Nothing
Set oMatches = Nothing
Else
'-- Nothing found. Return an empty string.
strReturn = ""
End If
Set oRegEx = Nothing
ReturnAllowedChars_RegEx = strReturn
End Function
%>
<%
Function GetDefaultDocumentId(ByRef dbConn)
Dim myRs
Set myRs = Server.CreateObject("ADODB.Connection")
Dim sql
sql = "SELECT ID FROM Menu WHERE site_id = " & siteId & " AND IsIndex = True"
'Response.Write("sql: '" & sql & "'
")
Set myRs = dbConn.Execute(sql)
If NOT myRs.EOF Then
GetDefaultDocumentId = myRs("ID")
Else
GetDefaultDocumentId = ""
End If
Set myRs = Nothing
End Function
%>
<%
Function IsThisTheIndexPage(ByVal contentId, ByRef dbConn)
Dim sql
sql = "SELECT Menu.IsIndex FROM Menu WHERE Menu.ID = " & 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
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
Set myRs = Nothing
End Function
%>