<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
%>
<%
'--------------------------------------------------------------------
' Microsoft ADO
'
' Copyright (c) 1996-1998 Microsoft Corporation.
'
' ADO constants include file for VBScript
' (This is a trimmed down version with only the required constants)
'--------------------------------------------------------------------
on error resume next
'---- CursorTypeEnum Values ----
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'---- LockTypeEnum Values ----
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4
'---- ExecuteOptionEnum Values ----
Const adAsyncExecute = &H00000010
Const adAsyncFetch = &H00000020
Const adAsyncFetchNonBlocking = &H00000040
Const adExecuteNoRecords = &H00000080
Const adExecuteStream = &H00000400
'---- CursorLocationEnum Values ----
Const adUseServer = 2
Const adUseClient = 3
'---- GetRowsOptionEnum Values ----
Const adGetRowsRest = -1
'---- CommandTypeEnum Values ----
Const adCmdUnknown = &H0008
Const adCmdText = &H0001
Const adCmdTable = &H0002
Const adCmdStoredProc = &H0004
Const adCmdFile = &H0100
Const adCmdTableDirect = &H0200
err.clear
on error goto 0
%>
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
Session.LCID = 1033 '## Do Not Edit
Response.Buffer = true
dim strDBType, strConnString, strTablePrefix, strMemberTablePrefix, strFilterTablePrefix '## Do Not Edit
Dim counter, ConnErrorNumber, ConnErrorDesc, blnSetup '## Do Not Edit
'#################################################################################
'## SELECT YOUR DATABASE TYPE AND CONNECTION TYPE (access, sqlserver or mysql)
'#################################################################################
'strDBType = "sqlserver"
strDBType = "access"
'strDBType = "mysql"
'## Make sure to uncomment one of the strConnString lines and edit it so that it points to where your database is!
strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("../comicsindisguise/new_forum/comyxs_d4rum_2006.mdb") '## MS Access 2000 using virtual path
'strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("/forum/sf2k_v34_05/comyxs_d4rum_2006.mdb") '## MS Access 2000 on Brinkster
'strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\inetpub\dbroot\snitz_forums_2000.mdb" '## MS Access 2000
'strConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("snitz_forums_2000.mdb") '## MS Access 97 using virtual path
'strConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("/USERNAME/db/snitz_forums_2000.mdb") '## MS Access 97 on Brinkster
'strConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\inetpub\dbroot\snitz_forums_2000.mdb" '## MS Access 97
'strConnString = "Provider=SQLOLEDB;Data Source=SERVER_NAME;database=DB_NAME;uid=UID;pwd=PWD;" '## MS SQL Server 6.x/7.x/2000 (OLEDB connection)
'strConnString = "driver={SQL Server};server=SERVER_NAME;uid=UID;pwd=PWD;database=DB_NAME" '## MS SQL Server 6.x/7.x/2000 (ODBC connection)
'strConnString = "driver=MySQL;server=SERVER_IP;uid=UID;pwd=PWD;database=DB_NAME" '## MySQL w/ MyODBC v2.50
'strConnString = "driver={MySQL ODBC 3.51 Driver};option=4;server=SERVER_IP;user=UID;password=PWD;DATABASE=DB_NAME;" '##MySQL w/ MyODBC v3.51
'strConnString = "DSN_NAME" '## DSN
strTablePrefix = "FORUM_"
strMemberTablePrefix = "FORUM_"
strFilterTablePrefix = "FORUM_" 'used for BADWORDS and NAMEFILTER tables
'#################################################################################
'## If you have deleted the default Admin account, you may need to change the
'## value below. Otherwise, it should be left unchanged. (such as with a new
'## installation)
'#################################################################################
Const intAdminMemberID = 1
'#################################################################################
'## intCookieDuration is the amount of days before the forum cookie expires
'## You can set it to a higher value
'## For example for one year you can set it to 365
'## (default is 30 days)
'#################################################################################
Const intCookieDuration = 30
%>
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
'## Const variable_name = "icon_filename|width|height"
Const strIconAIM = "icon_aim.gif|15|15"
Const strIconBar = "icon_bar.gif|15|15"
Const strIconBlank = "icon_blank.gif|15|15"
Const strIconCalendar = "icon_calendar.gif|34|21"
Const strIconClosedTopic = "icon_closed_topic.gif|15|15"
Const strIconDeleteReply = "icon_delete_reply.gif|15|15"
Const strIconEditTopic = "icon_edit_topic.gif|15|15"
Const strIconEditorBold = "icon_editor_bold.gif|23|22"
Const strIconEditorCenter = "icon_editor_center.gif|23|22"
Const strIconEditorCode = "icon_editor_code.gif|23|22"
Const strIconEditorEmail = "icon_editor_email.gif|23|22"
Const strIconEditorHR = "icon_editor_hr.gif|23|22"
Const strIconEditorLeft = "icon_editor_left.gif|23|22"
Const strIconEditorImage = "icon_editor_image.gif|23|22"
Const strIconEditorItalicize = "icon_editor_italicize.gif|23|22"
Const strIconEditorList = "icon_editor_list.gif|23|22"
Const strIconEditorQuote = "icon_editor_quote.gif|23|22"
Const strIconEditorRight = "icon_editor_right.gif|23|22"
Const strIconEditorSmilie = "icon_editor_smilie.gif|23|22"
Const strIconEditorStrike = "icon_editor_strike.gif|23|22"
Const strIconEditorUnderline = "icon_editor_underline.gif|23|22"
Const strIconEditorUrl = "icon_editor_url.gif|23|22"
Const strIconEmail = "icon_email.gif|15|15"
Const strIconFolder = "icon_folder.gif|15|15"
Const strIconFolderArchive = "icon_folder_archive.gif|16|16"
Const strIconFolderArchived = "icon_folder_archived.gif|15|15"
Const strIconFolderClosed = "icon_folder_closed.gif|15|15"
Const strIconFolderClosedTopic = "icon_folder_closed_topic.gif|15|15"
Const strIconFolderDelete = "icon_folder_delete.gif|15|15"
Const strIconFolderHold = "icon_folder_hold.gif|15|15"
Const strIconFolderHot = "icon_folder_hot.gif|15|17"
Const strIconFolderLocked = "icon_folder_locked.gif|15|15"
Const strIconFolderModerate = "icon_folder_moderate.gif|15|15"
Const strIconFolderNew = "icon_folder_new.gif|15|15"
Const strIconFolderNewHot = "icon_folder_new_hot.gif|15|17"
Const strIconFolderNewLocked = "icon_folder_new_locked.gif|15|15"
Const strIconFolderNewSticky = "icon_folder_new_sticky.gif|15|15"
Const strIconFolderNewStickyLocked = "icon_folder_new_sticky_locked.gif|15|15"
Const strIconFolderNewTopic = "icon_folder_new_topic.gif|15|15"
Const strIconFolderOpen = "icon_folder_open.gif|15|15"
Const strIconFolderOpenTopic = "icon_folder_open_topic.gif|15|15"
Const strIconFolderPencil = "icon_folder_pencil.gif|15|15"
Const strIconFolderSticky = "icon_folder_sticky.gif|15|15"
Const strIconFolderStickyLocked = "icon_folder_sticky_locked.gif|15|15"
Const strIconFolderUnlocked = "icon_folder_unlocked.gif|15|15"
Const strIconFolderUnmoderated = "icon_folder_unmoderated.gif|15|15"
Const strIconGoDown = "icon_go_down.gif|15|15"
Const strIconGoLeft = "icon_go_left.gif|15|15"
Const strIconGoRight = "icon_go_right.gif|15|15"
Const strIconGoUp = "icon_go_up.gif|15|15"
Const strIconGroup = "icon_group.gif|15|15"
Const strIconGroupCategories = "icon_group_categories.gif|21|22"
Const strIconHomepage = "icon_homepage.gif|15|15"
Const strIconICQ = "icon_icq.gif|15|15"
Const strIconIP = "icon_ip.gif|15|15"
Const strIconLastpost = "icon_lastpost.gif|12|10"
Const strIconLock = "icon_lock.gif|12|12"
Const strIconMinus = "icon_minus.gif|10|10"
Const strIconMSNM = "icon_msnm.gif|15|15"
Const strIconPencil = "icon_pencil.gif|12|12"
Const strIconPhotoNone = "icon_photo_none.gif|150|150"
Const strIconPlus = "icon_plus.gif|10|10"
Const strIconPosticon = "icon_posticon.gif|15|15"
Const strIconPosticonHold = "icon_posticon_hold.gif|15|15"
Const strIconPosticonUnmoderated = "icon_posticon_unmoderated.gif|15|15"
Const strIconPrint = "icon_print.gif|16|17"
Const strIconPrivateAdd = "icon_private_add.gif|23|22"
Const strIconPrivateAddAll = "icon_private_addall.gif|23|22"
Const strIconPrivateRemAll = "icon_private_remall.gif|23|22"
Const strIconPrivateRemove = "icon_private_remove.gif|23|22"
Const strIconProfile = "icon_profile.gif|15|15"
Const strIconProfileLocked = "icon_profile_locked.gif|15|15"
Const strIconReplyTopic = "icon_reply_topic.gif|15|15"
Const strIconSendTopic = "icon_send_topic.gif|15|15"
Const strIconSmile = "icon_smile.gif|15|15"
Const strIconSmile8ball = "icon_smile_8ball.gif|15|15"
Const strIconSmileAngry = "icon_smile_angry.gif|15|15"
Const strIconSmileApprove = "icon_smile_approve.gif|15|15"
Const strIconSmileBig = "icon_smile_big.gif|15|15"
Const strIconSmileBlackeye = "icon_smile_blackeye.gif|15|15"
Const strIconSmileBlush = "icon_smile_blush.gif|15|15"
Const strIconSmileClown = "icon_smile_clown.gif|15|15"
Const strIconSmileCool = "icon_smile_cool.gif|15|15"
Const strIconSmileDead = "icon_smile_dead.gif|15|15"
Const strIconSmileDisapprove = "icon_smile_disapprove.gif|15|15"
Const strIconSmileEvil = "icon_smile_evil.gif|15|15"
Const strIconSmileKisses = "icon_smile_kisses.gif|15|15"
Const strIconSmileQuestion = "icon_smile_question.gif|15|15"
Const strIconSmileSad = "icon_smile_sad.gif|15|15"
Const strIconSmileShock = "icon_smile_shock.gif|15|15"
Const strIconSmileShy = "icon_smile_shy.gif|15|15"
Const strIconSmileSleepy = "icon_smile_sleepy.gif|15|15"
Const strIconSmileTongue = "icon_smile_tongue.gif|15|15"
Const strIconSmileWink = "icon_smile_wink.gif|15|15"
Const strIconSort = "icon_sort.gif|15|15"
Const strIconStarBlue = "icon_star_blue.gif|13|12"
Const strIconStarBronze = "icon_star_bronze.gif|13|12"
Const strIconStarCyan = "icon_star_cyan.gif|13|12"
Const strIconStarGold = "icon_star_gold.gif|13|12"
Const strIconStarGreen = "icon_star_green.gif|13|12"
Const strIconStarOrange = "icon_star_orange.gif|13|12"
Const strIconStarPurple = "icon_star_purple.gif|13|12"
Const strIconStarRed = "icon_star_red.gif|13|12"
Const strIconStarSilver = "icon_star_silver.gif|13|12"
Const strIconSubscribe = "icon_subscribe.gif|15|15"
Const strIconTopicAllRead = "icon_topic_all_read.gif|15|15"
Const strIconTrashcan = "icon_trashcan.gif|12|12"
Const strIconUnlock = "icon_unlock.gif|12|12"
Const strIconUnsubscribe = "icon_unsubscribe.gif|15|15"
Const strIconUrl = "icon_url.gif|16|16"
Const strIconYahoo = "icon_yahoo.gif|16|15"
function getCurrentIcon(fIconName,fAltText,fOtherTags)
if fIconName = "" then exit function
if fOtherTags <> "" then fOtherTags = " " & fOtherTags
if Instr(fIconName,"http://") > 0 then strTempImageUrl = "" else strTempImageUrl = strImageUrl
tmpicons = split(fIconName,"|")
if tmpicons(1) <> "" then fWidth = " width=""" & tmpicons(1) & """"
if tmpicons(2) <> "" then fHeight = " height=""" & tmpicons(2) & """"
getCurrentIcon = "![]()
"
end function
%>
<%
'#################################################################################
'## Do Not Edit Below This Line - It could destroy your forums and lose data
'#################################################################################
Dim mLev, strLoginStatus, MemberID, strArchiveTablePrefix
Dim strVersion, strForumTitle, strCopyright, strTitleImage, strHomeURL
Dim strForumURL, strAuthType, strSetCookieToForum, strEmail, strUniqueEmail
Dim strMailMode, strMailServer, strSender, strDateType, strTimeAdjust
Dim strTimeType, strMoveTopicMode, strMoveNotify, strIPLogging, strPrivateForums
Dim strShowModerators, strAllowForumCode, strIMGInPosts, strAllowHTML, strNoCookies
Dim strHotTopic, intHotTopicNum, strSecureAdmin
Dim strAIM, strICQ, strMSN, strYAHOO
Dim strFullName, strPicture, strSex, strCity, strState
Dim strAge, strAgeDOB, strCountry, strOccupation, strBio
Dim strHobbies, strLNews, strQuote, strMarStatus, strFavLinks
Dim strRecentTopics, strAllowHideEmail, strHomepage, strUseExtendedProfile, strIcons
Dim strGfxButtons, strEditedByDate, strBadWordFilter, strBadWords, strDefaultFontFace
Dim strDefaultFontSize, strHeaderFontSize, strFooterFontSize, strPageBGColor, strDefaultFontColor
Dim strLinkColor, strLinkTextDecoration, strVisitedLinkColor, strVisitedTextDecoration
Dim strActiveLinkColor, strActiveTextDecoration, strHoverFontColor, strHoverTextDecoration
Dim strHeadCellColor, strHeadFontColor, strCategoryCellColor, strCategoryFontColor
Dim strForumFirstCellColor, strForumCellColor, strAltForumCellColor, strForumFontColor
Dim strForumLinkColor, strForumLinkTextDecoration, strForumVisitedLinkColor, strForumVisitedTextDecoration
Dim strForumActiveLinkColor, strForumActiveTextDecoration, strForumHoverFontColor, strForumHoverTextDecoration
Dim strTableBorderColor, strPopUpTableColor, strPopUpBorderColor, strNewFontColor, strHiLiteFontColor, strSearchHiLiteColor
Dim strTopicWidthLeft, strTopicNoWrapLeft, strTopicWidthRight, strTopicNoWrapRight, strShowRank
Dim strRankAdmin, strRankMod, strRankColorAdmin, strRankColorMod
Dim strRankLevel0, strRankLevel1, strRankLevel2, strRankLevel3, strRankLevel4, strRankLevel5
Dim strRankColor0, strRankColor1, strRankColor2, strRankColor3, strRankColor4, strRankColor5
Dim intRankLevel0, intRankLevel1, intRankLevel2, intRankLevel3, intRankLevel4, intRankLevel5
Dim strSignatures, strDSignatures, strShowStatistics, strShowImagePoweredBy, strLogonForMail
Dim strShowPaging, strShowTopicNav, strPageSize, strPageNumberSize, strForumTimeAdjust
Dim strNTGroups, strAutoLogon, strModeration, strSubscription, strArchiveState, strUserNameFilter
Dim strFloodCheck, strFloodCheckTime, strTimeLimit, strEmailVal, strProhibitNewMembers, strRequireReg, strRestrictReg
Dim strGroupCategories, strPageBGImageUrl, strImageUrl, strJumpLastPost, strStickyTopic, strShowSendToFriend
Dim strShowPrinterFriendly, strShowTimer, strTimerPhrase, strShowFormatButtons, strShowSmiliesTable, strShowQuickReply
Dim SubCount, MySubCount
strCookieURL = Left(Request.ServerVariables("Path_Info"), InstrRev(Request.ServerVariables("Path_Info"), "/"))
strUniqueID = "Snitz00"
If Application(strCookieURL & "ConfigLoaded")= "" Or IsNull(Application(strCookieURL & "ConfigLoaded")) Or blnSetup="Y" Then
on error resume next
blnLoadConfig = TRUE
set my_Conn = Server.CreateObject("ADODB.Connection")
my_Conn.Errors.Clear
Err.Clear
my_Conn.Open strConnString
for counter = 0 to my_conn.Errors.Count -1
ConnErrorNumber = Err.Number
ConnErrorDesc = my_Conn.Errors(counter).Description
If ConnErrorNumber <> 0 Then
If blnSetup <> "Y" Then
my_Conn.Errors.Clear
Err.Clear
Response.Redirect "setup.asp?RC=1&CC=1&strDBType=" & strDBType & "&EC=" & ConnErrorNumber & "&ED=" & Server.URLEncode(ConnErrorDesc)
else
blnLoadConfig = FALSE
end if
end if
next
my_Conn.Errors.Clear
Err.Clear
'## if the configvariables aren't loaded into the Application object
'## or after the admin has changed the configuration
'## the variables get (re)loaded
'## Forum_SQL
strSql = "SELECT * FROM " & strTablePrefix & "CONFIG_NEW "
set rsConfig = my_Conn.Execute (strSql)
for counter = 0 to my_conn.Errors.Count -1
ConnErrorNumber = Err.Number
If ConnErrorNumber <> 0 Then
If blnSetup <> "Y" Then
my_Conn.Errors.Clear
Err.Clear
strSql = "SELECT C_STRVERSION, C_STRSENDER "
strSql = strSql & " FROM " & strTablePrefix & "CONFIG "
set rsInfo = my_Conn.Execute (StrSql)
strVersion = rsInfo("C_STRVERSION")
strSender = rsInfo("C_STRSENDER")
rsInfo.Close
set rsInfo = nothing
if strVersion = "" then
strSql = "SELECT C_VALUE "
strSql = strSql & " FROM " & strTablePrefix & "CONFIG_NEW "
strSql = strSql & " WHERE C_VARIABLE = 'strVersion' "
set rsInfo = my_Conn.Execute (StrSql)
strVersion = rsInfo("C_VALUE")
rsInfo.Close
set rsInfo = nothing
strSql = "SELECT C_VALUE "
strSql = strSql & " FROM " & strTablePrefix & "CONFIG_NEW "
strSql = strSql & " WHERE C_VARIABLE = 'strSender' "
set rsInfo = my_Conn.Execute (StrSql)
strSender = rsInfo("C_VALUE")
rsInfo.Close
set rsInfo = nothing
end if
my_Conn.Close
set my_Conn = nothing
Response.Redirect "setup.asp?RC=2&MAIL=" & Server.UrlEncode(strSender) & "&VER=" & Server.URLEncode(strVersion) & "&strDBType="& strDBType & "&EC=" & ConnErrorNumber
else
my_Conn.Errors.Clear
blnLoadConfig = FALSE
end if
end if
next
my_Conn.Errors.Clear
if blnLoadConfig then
Application.Lock
do while not rsConfig.EOF
Application(strCookieURL & Trim(UCase(rsConfig("C_VARIABLE")))) = Trim(rsConfig("C_VALUE"))
rsConfig.MoveNext
loop
Application.UnLock
rsConfig.close
end if
my_Conn.Close
set my_Conn = nothing
on error goto 0
Application.Lock
Application(strCookieURL & "ConfigLoaded")= "YES"
Application.UnLock
End If
' ## Read the config-info from the application variables...
strVersion = Application(strCookieURL & "STRVERSION")
strForumTitle = Application(strCookieURL & "STRFORUMTITLE")
strCopyright = Application(strCookieURL & "STRCOPYRIGHT")
strTitleImage = Application(strCookieURL & "STRTITLEIMAGE")
strHomeURL = Application(strCookieURL & "STRHOMEURL")
strForumURL = Application(strCookieURL & "STRFORUMURL")
strAuthType = Application(strCookieURL & "STRAUTHTYPE")
strSetCookieToForum = Application(strCookieURL & "STRSETCOOKIETOFORUM")
strEmail = Application(strCookieURL & "STREMAIL")
strUniqueEmail = Application(strCookieURL & "STRUNIQUEEMAIL")
strMailMode = Application(strCookieURL & "STRMAILMODE")
strMailServer = Application(strCookieURL & "STRMAILSERVER")
strSender = Application(strCookieURL & "STRSENDER")
strDateType = Application(strCookieURL & "STRDATETYPE")
strTimeAdjust = Application(strCookieURL & "STRTIMEADJUST")
strTimeType = Application(strCookieURL & "STRTIMETYPE")
strMoveTopicMode = Application(strCookieURL & "STRMOVETOPICMODE")
strMoveNotify = Application(strCookieURL & "STRMOVENOTIFY")
strIPLogging = Application(strCookieURL & "STRIPLOGGING")
strPrivateForums = Application(strCookieURL & "STRPRIVATEFORUMS")
strShowModerators = Application(strCookieURL & "STRSHOWMODERATORS")
strAllowForumCode = Application(strCookieURL & "STRALLOWFORUMCODE")
strIMGInPosts = Application(strCookieURL & "STRIMGINPOSTS")
strAllowHTML = Application(strCookieURL & "STRALLOWHTML")
strNoCookies = Application(strCookieURL & "STRNOCOOKIES")
strSecureAdmin = Application(strCookieURL & "STRSECUREADMIN")
strHotTopic = Application(strCookieURL & "STRHOTTOPIC")
intHotTopicNum = cLng(Application(strCookieURL & "INTHOTTOPICNUM"))
strAIM = Application(strCookieURL & "STRAIM")
strICQ = Application(strCookieURL & "STRICQ")
strMSN = Application(strCookieURL & "STRMSN")
strYAHOO = Application(strCookieURL & "STRYAHOO")
strFullName = Application(strCookieURL & "STRFULLNAME")
strPicture = Application(strCookieURL & "STRPICTURE")
strSex = Application(strCookieURL & "STRSEX")
strCity = Application(strCookieURL & "STRCITY")
strState = Application(strCookieURL & "STRSTATE")
strAge = Application(strCookieURL & "STRAGE")
strAgeDOB = Application(strCookieURL & "STRAGEDOB")
strCountry = Application(strCookieURL & "STRCOUNTRY")
strOccupation = Application(strCookieURL & "STROCCUPATION")
strBio = Application(strCookieURL & "STRBIO")
strHobbies = Application(strCookieURL & "STRHOBBIES")
strLNews = Application(strCookieURL & "STRLNEWS")
strQuote = Application(strCookieURL & "STRQUOTE")
strMarStatus = Application(strCookieURL & "STRMARSTATUS")
strFavLinks = Application(strCookieURL & "STRFAVLINKS")
strRecentTopics = Application(strCookieURL & "STRRECENTTOPICS")
strAllowHideEmail = "1" '##not yet used !
strHomepage = Application(strCookieURL & "STRHOMEPAGE")
strSignatures = Application(strCookieURL & "STRSIGNATURES")
strDSignatures = Application(strCookieURL & "STRDSIGNATURES")
strUseExtendedProfile = (cLng(strSignatures) + cLng(strBio) + cLng(strHobbies) + cLng(strLNews) + cLng(strRecentTopics) + cLng(strPicture) + cLng(strQuote)) > 0
strUseExtendedProfile = strUseExtendedProfile or ((cLng(strAIM) + cLng(strICQ) + cLng(strMSN) + cLng(strYAHOO) + (cLng(strFullName)*2) + cLng(strSex) + cLng(strCity) + cLng(strState) + cLng(strAge) + cLng(strCountry) + cLng(strOccupation) + (cLng(strFavLinks)*2)) > 5)
strIcons = Application(strCookieURL & "STRICONS")
strGfxButtons = Application(strCookieURL & "STRGFXBUTTONS")
strEditedByDate = Application(strCookieURL & "STREDITEDBYDATE")
strBadWordFilter = Application(strCookieURL & "STRBADWORDFILTER")
strBadWords = Application(strCookieURL & "STRBADWORDS")
strUserNameFilter = Application(strCookieURL & "STRUSERNAMEFILTER")
strDefaultFontFace = Application(strCookieURL & "STRDEFAULTFONTFACE")
strDefaultFontSize = Application(strCookieURL & "STRDEFAULTFONTSIZE")
strHeaderFontSize = Application(strCookieURL & "STRHEADERFONTSIZE")
strFooterFontSize = Application(strCookieURL & "STRFOOTERFONTSIZE")
strPageBGColor = Application(strCookieURL & "STRPAGEBGCOLOR")
strDefaultFontColor = Application(strCookieURL & "STRDEFAULTFONTCOLOR")
strLinkColor = Application(strCookieURL & "STRLINKCOLOR")
strLinkTextDecoration = Application(strCookieURL & "STRLINKTEXTDECORATION")
strVisitedLinkColor = Application(strCookieURL & "STRVISITEDLINKCOLOR")
strVisitedTextDecoration = Application(strCookieURL & "STRVISITEDTEXTDECORATION")
strActiveLinkColor = Application(strCookieURL & "STRACTIVELINKCOLOR")
strActiveTextDecoration = Application(strCookieURL & "STRACTIVETEXTDECORATION")
strHoverFontColor = Application(strCookieURL & "STRHOVERFONTCOLOR")
strHoverTextDecoration = Application(strCookieURL & "STRHOVERTEXTDECORATION")
strHeadCellColor = Application(strCookieURL & "STRHEADCELLCOLOR")
strHeadFontColor = Application(strCookieURL & "STRHEADFONTCOLOR")
strCategoryCellColor = Application(strCookieURL & "STRCATEGORYCELLCOLOR")
strCategoryFontColor = Application(strCookieURL & "STRCATEGORYFONTCOLOR")
strForumFirstCellColor = Application(strCookieURL & "STRFORUMFIRSTCELLCOLOR")
strForumCellColor = Application(strCookieURL & "STRFORUMCELLCOLOR")
strAltForumCellColor = Application(strCookieURL & "STRALTFORUMCELLCOLOR")
strForumFontColor = Application(strCookieURL & "STRFORUMFONTCOLOR")
strForumLinkColor = Application(strCookieURL & "STRFORUMLINKCOLOR")
strForumLinkTextDecoration = Application(strCookieURL & "STRFORUMLINKTEXTDECORATION")
strForumVisitedLinkColor = Application(strCookieURL & "STRFORUMVISITEDLINKCOLOR")
strForumVisitedTextDecoration = Application(strCookieURL & "STRFORUMVISITEDTEXTDECORATION")
strForumActiveLinkColor = Application(strCookieURL & "STRFORUMACTIVELINKCOLOR")
strForumActiveTextDecoration = Application(strCookieURL & "STRFORUMACTIVETEXTDECORATION")
strForumHoverFontColor = Application(strCookieURL & "STRFORUMHOVERFONTCOLOR")
strForumHoverTextDecoration = Application(strCookieURL & "STRFORUMHOVERTEXTDECORATION")
strTableBorderColor = Application(strCookieURL & "STRTABLEBORDERCOLOR")
strPopUpTableColor = Application(strCookieURL & "STRPOPUPTABLECOLOR")
strPopUpBorderColor = Application(strCookieURL & "STRPOPUPBORDERCOLOR")
strNewFontColor = Application(strCookieURL & "STRNEWFONTCOLOR")
strHiLiteFontColor = Application(strCookieURL & "STRHILITEFONTCOLOR")
strSearchHiLiteColor = Application(strCookieURL & "STRSEARCHHILITECOLOR")
strTopicWidthLeft = Application(strCookieURL & "STRTOPICWIDTHLEFT")
strTopicNoWrapLeft = Application(strCookieURL & "STRTOPICNOWRAPLEFT")
strTopicWidthRight = Application(strCookieURL & "STRTOPICWIDTHRIGHT")
strTopicNoWrapRight = Application(strCookieURL & "STRTOPICNOWRAPRIGHT")
strShowRank = Application(strCookieURL & "STRSHOWRANK")
strRankAdmin = Application(strCookieURL & "STRRANKADMIN")
strRankMod = Application(strCookieURL & "STRRANKMOD")
strRankLevel0 = Application(strCookieURL & "STRRANKLEVEL0")
strRankLevel1 = Application(strCookieURL & "STRRANKLEVEL1")
strRankLevel2 = Application(strCookieURL & "STRRANKLEVEL2")
strRankLevel3 = Application(strCookieURL & "STRRANKLEVEL3")
strRankLevel4 = Application(strCookieURL & "STRRANKLEVEL4")
strRankLevel5 = Application(strCookieURL & "STRRANKLEVEL5")
strRankColorAdmin = Application(strCookieURL & "STRRANKCOLORADMIN")
strRankColorMod = Application(strCookieURL & "STRRANKCOLORMOD")
strRankColor0 = Application(strCookieURL & "STRRANKCOLOR0")
strRankColor1 = Application(strCookieURL & "STRRANKCOLOR1")
strRankColor2 = Application(strCookieURL & "STRRANKCOLOR2")
strRankColor3 = Application(strCookieURL & "STRRANKCOLOR3")
strRankColor4 = Application(strCookieURL & "STRRANKCOLOR4")
strRankColor5 = Application(strCookieURL & "STRRANKCOLOR5")
intRankLevel0 = Application(strCookieURL & "INTRANKLEVEL0")
intRankLevel1 = Application(strCookieURL & "INTRANKLEVEL1")
intRankLevel2 = Application(strCookieURL & "INTRANKLEVEL2")
intRankLevel3 = Application(strCookieURL & "INTRANKLEVEL3")
intRankLevel4 = Application(strCookieURL & "INTRANKLEVEL4")
intRankLevel5 = Application(strCookieURL & "INTRANKLEVEL5")
strShowStatistics = Application(strCookieURL & "STRSHOWSTATISTICS")
strShowImagePoweredBy = Application(strCookieURL & "STRSHOWIMAGEPOWEREDBY")
strLogonForMail = Application(strCookieURL & "STRLOGONFORMAIL")
strShowPaging = Application(strCookieURL & "STRSHOWPAGING")
strShowTopicNav = Application(strCookieURL & "STRSHOWTOPICNAV")
strPageSize = Application(strCookieURL & "STRPAGESIZE")
strPageNumberSize = Application(strCookieURL & "STRPAGENUMBERSIZE")
strForumTimeAdjust = DateAdd("h", strTimeAdjust , Now())
strNTGroups = Application(strCookieURL & "STRNTGROUPS")
strAutoLogon = Application(strCookieURL & "STRAUTOLOGON")
strModeration = Application(strCookieURL & "STRMODERATION")
strSubscription = Application(strCookieURL & "STRSUBSCRIPTION")
strArchiveState = Application(strCookieURL & "STRARCHIVESTATE")
strFloodCheck = Application(strCookieURL & "STRFLOODCHECK")
strFloodCheckTime = Application(strCookieURL & "STRFLOODCHECKTIME")
strEmailVal = Application(strCookieURL & "STREMAILVAL")
strPageBGImageUrl = Application(strCookieURL & "STRPAGEBGIMAGEURL")
strImageUrl = Application(strCookieURL & "STRIMAGEURL")
strJumpLastPost = Application(strCookieURL & "STRJUMPLASTPOST")
strStickyTopic = Application(strCookieURL & "STRSTICKYTOPIC")
strShowSendToFriend = Application(strCookieURL & "STRSHOWSENDTOFRIEND")
strShowPrinterFriendly = Application(strCookieURL & "STRSHOWPRINTERFRIENDLY")
strProhibitNewMembers = Application(strCookieURL & "STRPROHIBITNEWMEMBERS")
strRequireReg = Application(strCookieURL & "STRREQUIREREG")
strRestrictReg = Application(strCookieURL & "STRRESTRICTREG")
strGroupCategories = Application(strCookieURL & "STRGROUPCATEGORIES")
strShowTimer = Application(strCookieURL & "STRSHOWTIMER")
strTimerPhrase = Application(strCookieURL & "STRTIMERPHRASE")
strShowFormatButtons = Application(strCookieURL & "STRSHOWFORMATBUTTONS")
strShowSmiliesTable = Application(strCookieURL & "STRSHOWSMILIESTABLE")
strShowQuickReply = Application(strCookieURL & "STRSHOWQUICKREPLY")
if strSecureAdmin = "0" then
Session(strCookieURL & "Approval") = "15916941253"
end if
if strAuthType = "db" then
strDBNTSQLName = "M_NAME"
strAutoLogon = "0"
strNTGroups = "0"
else
strDBNTSQLName = "M_USERNAME"
end if
%>
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
function getMemberName(fUser_Number)
dim strSql
dim rsGetmemberName
'## Forum_SQL
if isNull(fUser_Number) then exit function
strSql = "SELECT M_NAME "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE MEMBER_ID = " & cLng(fUser_Number)
set rsGetMemberName = Server.CreateObject("ADODB.Recordset")
rsGetMemberName.open strSql, my_Conn
if rsGetMemberName.EOF or rsGetMemberName.BOF then
getMemberName = ""
else
getMemberName = chkString(rsGetMemberName("M_NAME"),"display")
end if
rsGetMemberName.close
set rsGetMemberName = nothing
end function
function getMemberID(fUser_Name)
dim strSql
dim rsGetMemberID
'## Forum_SQL
strSql = "SELECT MEMBER_ID "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & ChkString(fUser_Name, "SQLString") & "'"
set rsGetMemberID = Server.CreateObject("ADODB.Recordset")
rsGetMemberID.open strSql, my_Conn
if rsGetMemberID.EOF then
getMemberID = 0
else
getMemberID = cLng(rsGetMemberID("MEMBER_ID"))
end if
rsGetMemberID.close
set rsGetMemberID = nothing
end function
function chkDisplayForum(fPrivateForums,fFPasswordNew,fForum_ID,UserNum)
dim strSql
dim rsAccess
chkDisplayForum = false
if (mLev = 4) or (mLev = 3 and ModerateAllowed = "Y") then
chkDisplayForum = true
exit function
end if
select case cLng(fPrivateForums)
case 0, 1, 2, 3, 4, 7, 9
chkDisplayForum = true
exit function
case 5
if UserNum = -1 then
chkDisplayForum = false
exit function
else
chkDisplayForum = true
exit function
end if
case 6
if UserNum = -1 then
chkDisplayForum = false
exit function
end if
if isAllowedMember(fForum_ID,UserNum) = 1 then
chkDisplayForum = true
else
chkDisplayForum = false
end if
case 8
chkDisplayForum = false
if strAuthType ="nt" THEN
NTGroupSTR = Split(Session(strCookieURL & "strNTGroupsSTR"), ", ")
for j = 0 to ubound(NTGroupSTR)
NTGroupDBSTR = Split(fFPasswordNew, ", ")
for i = 0 to ubound(NTGroupDBSTR)
if NTGroupDBSTR(i) = NTGroupSTR(j) then
chkDisplayForum = true
exit function
end if
next
next
end if
case else
chkDisplayForum = true
end select
end function
function chkForumAccess(fForum, UserNum, Display)
if MemberID = UserNum then
if mLev < 1 then
chkForumAccess = false
elseif mLev = 3 then
chkForumAccess = true
elseif mLev = 4 then
chkForumAccess = true
exit function
end if
end if
'## Forum_SQL
strSql = "SELECT F_PRIVATEFORUMS, F_SUBJECT, F_PASSWORD_NEW "
strSql = strSql & " FROM " & strTablePrefix & "FORUM "
strSql = strSql & " WHERE FORUM_ID = " & cLng(fForum)
Set rsStatus = Server.CreateObject("ADODB.Recordset")
rsStatus.open strSql, my_Conn
if rsStatus.EOF or rsStatus.BOF then
rsStatus.close
set rsStatus = nothing
Response.Redirect("default.asp")
else
dim Users
dim MatchFound
If rsStatus("F_PRIVATEFORUMS") <> 0 then
Select case rsStatus("F_PRIVATEFORUMS")
case 0
chkForumAccess = true
case 1, 6 '## Allowed Users
if isAllowedMember(fForum,UserNum) = 1 then
chkForumAccess = true
else
if Display then
doNotAllowed
Response.end
else
chkForumAccess = false
end if
end if
case 2 '## password
select case Request.Cookies(strUniqueID & "Forum")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_PASSWORD_NEW")
chkForumAccess = true
case else
if Request("pass") = "" then
if Display then
doPasswordForm
Response.End
else
chkForumAccess = false
end if
else
if Request("pass") <> rsStatus("F_PASSWORD_NEW") then
if Display then
Response.Write " Invalid password!
" & vbNewLine & _
" Go Back to Enter Data
" & vbNewLine
WriteFooter
Response.End
else
chkForumAccess = false
end if
else
if strSetCookieToForum = 1 then
Response.Cookies(strUniqueID & "Forum").Path = strCookieURL
end if
Response.Cookies(strUniqueID & "Forum")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
chkForumAccess = true
end if
end if
end select
case 3 '## Either Password or Allowed
if isAllowedMember(fForum,UserNum) = 1 then
chkForumAccess = true
else
chkForumAccess = false
end if
if not(chkForumAccess) then
select case Request.Cookies(strUniqueID & "Forum")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_PASSWORD_NEW")
chkForumAccess = true
case else
if Request("pass") = "" then
if Display then
doPasswordForm
Response.End
else
chkForumAccess = false
end if
else
if Request("pass") <> rsStatus("F_PASSWORD_NEW") then
if Display then
Response.Write " Invalid password!
" & vbNewLine & _
" Go Back to Enter Data
" & vbNewLine
WriteFooter
Response.End
else
chkForumAccess = false
end if
else
if strSetCookieToForum = 1 then
Response.Cookies(strUniqueID & "Forum").Path = strCookieURL
end if
Response.Cookies(strUniqueID & "Forum")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
chkForumAccess = true
end if
end if
end select
end if
'## code added 07/13/2000
case 7 '## members or password
if strDBNTUserName = "" then
select case Request.Cookies(strUniqueID & "Forum")("PRIVATE_" & rsStatus("F_SUBJECT"))
case rsStatus("F_PASSWORD_NEW")
chkForumAccess = true
case else
if Request("pass") = "" then
if Display then
doLoginForm
response.end
else
chkForumAccess = false
end if
else
if Request("pass") <> rsStatus("F_PASSWORD_NEW") then
if Display then
Response.Write " Invalid password!
" & vbNewLine & _
" Go Back to Enter Data
" & vbNewLine
WriteFooter
Response.End
else
chkForumAccess = false
end if
else
if strSetCookieToForum = 1 then
Response.Cookies(strUniqueID & "Forum").Path = strCookieURL
end if
Response.Cookies(strUniqueID & "Forum")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass")
chkForumAccess = true
end if
end if
end select
else
chkForumAccess = true
end if
'## end code added 07/13/2000
case 4, 5 '## members only
if Usernum = -1 or Usernum = "" then
if Display then
doNotLoggedInForm
else
chkForumAccess = false
end if
else '## V3.1 SR4
chkForumAccess = true
end if
case 8, 9
test="test db"
chkForumAccess = FALSE
if strAuthType="db" then
chkForumAccess = true
rsStatus.close
set rsStatus = nothing
exit function
end if
NTGroupSTR = Split(Session(strCookieURL & "strNTGroupsSTR"), ", ")
for j = 0 to ubound(NTGroupSTR)
NTGroupDBSTR = Split(rsStatus("F_PASSWORD_NEW"), ", ")
for i = 0 to ubound(NTGroupDBSTR)
if NTGroupDBSTR(i) = NTGroupSTR(j) then
chkForumAccess = True
rsStatus.close
set rsStatus = nothing
exit function
end if
next
next
if Display then
doNotAllowed
end if
case else
chkForumAccess = true
end select
else
chkForumAccess = true
end if
end if
rsStatus.close
set rsStatus = nothing
end function
function chkForumAccessNew(fPrivateForums,fFPasswordNew,fForum_Subject,fForum_ID,UserNum)
if MemberID = UserNum then
if mLev < 1 then
chkForumAccessNew = false
elseif mLev = 3 then
chkForumAccessNew = true
elseif mLev = 4 then
chkForumAccessNew = true
exit function
end if
end if
dim Users
dim MatchFound
Select case fPrivateForums
case 0
chkForumAccessNew = true
case 1, 6 '## Allowed Members List
if isAllowedMember(fForum_ID,UserNum) = 1 then
chkForumAccessNew = true
else
chkForumAccessNew = false
end if
case 2 '## password
select case Request.Cookies(strUniqueID & "Forum")("PRIVATE_" & fForum_Subject)
case fFPasswordNew
chkForumAccessNew = true
case else
chkForumAccessNew = false
end select
case 3 '## Either Password or Allowed Members List
if isAllowedMember(fForum_ID,UserNum) = 1 then
chkForumAccessNew = true
else
chkForumAccessNew = false
end if
if not(chkForumAccessNew) then
select case Request.Cookies(strUniqueID & "Forum")("PRIVATE_" & fForum_Subject)
case fFPasswordNew
chkForumAccessNew = true
case else
chkForumAccessNew = false
end select
end if
case 7 '## Members or Password
if Usernum = -1 or Usernum = "" then
select case Request.Cookies(strUniqueID & "Forum")("PRIVATE_" & fForum_Subject)
case fFPasswordNew
chkForumAccessNew = true
case else
chkForumAccessNew = false
end select
else
chkForumAccessNew = true
end if
case 4, 5 '## Members only
if Usernum = -1 or Usernum = "" then
chkForumAccessNew = false
else
chkForumAccessNew = true
end if
case 8, 9 '## NT Global Groups
test="test db"
chkForumAccessNew = false
if strAuthType="db" then
chkForumAccessNew = true
end if
NTGroupSTR = Split(Session(strCookieURL & "strNTGroupsSTR"), ", ")
for j = 0 to ubound(NTGroupSTR)
NTGroupDBSTR = Split(fFPasswordNew, ", ")
for i = 0 to ubound(NTGroupDBSTR)
if NTGroupDBSTR(i) = NTGroupSTR(j) then
chkForumAccessNew = True
exit function
end if
next
next
case else
chkForumAccessNew = true
end select
end function
sub doLoginForm()
Response.Write " There Was A Problem
" & vbNewLine & _
" You do not have access to this forum.
" & vbNewLine & _
" If you have been given special permission by the administrator to view and/or post in this forum, enter the password here:" & vbNewLine & _
"
" & vbNewLine & _
" Go Back To Enter Data
" & vbNewLine & _
" Return to the forum
" & vbNewLine
WriteFooter
Response.End
end sub
sub doNotAllowed()
Response.Write " There Was A Problem
" & vbNewLine & _
" You do not have access to this forum.
" & vbNewLine & _
" Go Back
" & vbNewLine & _
" Return to the forum
" & vbNewLine
WriteFooter
Response.End
end sub
sub doPasswordForm()
if Request.QueryString <> "" then strRqQryString = "?" & Request.QueryString else strRqQryString = ""
Response.Write " There Was A Problem
" & vbNewLine & _
" You must enter the password for this forum." & vbNewLine & _
"
" & vbNewLine & _
" Go Back
" & vbNewLine & _
" Return to the forum
" & vbNewLine
WriteFooter
Response.End
end sub
sub doNotLoggedInForm()
Response.Write " There Was A Problem
" & vbNewLine & _
" You must be logged in to enter this forum
" & vbNewLine & _
" Go Back
" & vbNewLine & _
" Return to the forum
" & vbNewLine
WriteFooter
Response.End
end sub
%>
<%
' See the VB6 project that accompanies this sample for full code comments on how
' it works.
'
' ASP VBScript code for generating a SHA256 'digest' or 'signature' of a string. The
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for SHA256 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack.
'
' If you are using the routine for passwords, you can make it a little more secure
' by concatenating some known random characters to the password before you generate
' the signature and on subsequent tests, so even if a hacker knows you are using
' SHA-256 for your passwords, the random characters will make it harder to dictionary
' attack.
'
' NOTE: Due to the way in which the string is processed the routine assumes a
' single byte character set. VB passes unicode (2-byte) character strings, the
' ConvertToWordArray function uses on the first byte for each character. This
' has been done this way for ease of use, to make the routine truely portable
' you could accept a byte array instead, it would then be up to the calling
' routine to make sure that the byte array is generated from their string in
' a manner consistent with the string type.
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on this code provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site: http://www.frez.co.uk
' E-mail: sales@frez.co.uk
Private m_lOnBits(30)
Private m_l2Power(30)
Private K(63)
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
m_lOnBits(0) = CLng(1)
m_lOnBits(1) = CLng(3)
m_lOnBits(2) = CLng(7)
m_lOnBits(3) = CLng(15)
m_lOnBits(4) = CLng(31)
m_lOnBits(5) = CLng(63)
m_lOnBits(6) = CLng(127)
m_lOnBits(7) = CLng(255)
m_lOnBits(8) = CLng(511)
m_lOnBits(9) = CLng(1023)
m_lOnBits(10) = CLng(2047)
m_lOnBits(11) = CLng(4095)
m_lOnBits(12) = CLng(8191)
m_lOnBits(13) = CLng(16383)
m_lOnBits(14) = CLng(32767)
m_lOnBits(15) = CLng(65535)
m_lOnBits(16) = CLng(131071)
m_lOnBits(17) = CLng(262143)
m_lOnBits(18) = CLng(524287)
m_lOnBits(19) = CLng(1048575)
m_lOnBits(20) = CLng(2097151)
m_lOnBits(21) = CLng(4194303)
m_lOnBits(22) = CLng(8388607)
m_lOnBits(23) = CLng(16777215)
m_lOnBits(24) = CLng(33554431)
m_lOnBits(25) = CLng(67108863)
m_lOnBits(26) = CLng(134217727)
m_lOnBits(27) = CLng(268435455)
m_lOnBits(28) = CLng(536870911)
m_lOnBits(29) = CLng(1073741823)
m_lOnBits(30) = CLng(2147483647)
m_l2Power(0) = CLng(1)
m_l2Power(1) = CLng(2)
m_l2Power(2) = CLng(4)
m_l2Power(3) = CLng(8)
m_l2Power(4) = CLng(16)
m_l2Power(5) = CLng(32)
m_l2Power(6) = CLng(64)
m_l2Power(7) = CLng(128)
m_l2Power(8) = CLng(256)
m_l2Power(9) = CLng(512)
m_l2Power(10) = CLng(1024)
m_l2Power(11) = CLng(2048)
m_l2Power(12) = CLng(4096)
m_l2Power(13) = CLng(8192)
m_l2Power(14) = CLng(16384)
m_l2Power(15) = CLng(32768)
m_l2Power(16) = CLng(65536)
m_l2Power(17) = CLng(131072)
m_l2Power(18) = CLng(262144)
m_l2Power(19) = CLng(524288)
m_l2Power(20) = CLng(1048576)
m_l2Power(21) = CLng(2097152)
m_l2Power(22) = CLng(4194304)
m_l2Power(23) = CLng(8388608)
m_l2Power(24) = CLng(16777216)
m_l2Power(25) = CLng(33554432)
m_l2Power(26) = CLng(67108864)
m_l2Power(27) = CLng(134217728)
m_l2Power(28) = CLng(268435456)
m_l2Power(29) = CLng(536870912)
m_l2Power(30) = CLng(1073741824)
K(0) = &H428A2F98
K(1) = &H71374491
K(2) = &HB5C0FBCF
K(3) = &HE9B5DBA5
K(4) = &H3956C25B
K(5) = &H59F111F1
K(6) = &H923F82A4
K(7) = &HAB1C5ED5
K(8) = &HD807AA98
K(9) = &H12835B01
K(10) = &H243185BE
K(11) = &H550C7DC3
K(12) = &H72BE5D74
K(13) = &H80DEB1FE
K(14) = &H9BDC06A7
K(15) = &HC19BF174
K(16) = &HE49B69C1
K(17) = &HEFBE4786
K(18) = &HFC19DC6
K(19) = &H240CA1CC
K(20) = &H2DE92C6F
K(21) = &H4A7484AA
K(22) = &H5CB0A9DC
K(23) = &H76F988DA
K(24) = &H983E5152
K(25) = &HA831C66D
K(26) = &HB00327C8
K(27) = &HBF597FC7
K(28) = &HC6E00BF3
K(29) = &HD5A79147
K(30) = &H6CA6351
K(31) = &H14292967
K(32) = &H27B70A85
K(33) = &H2E1B2138
K(34) = &H4D2C6DFC
K(35) = &H53380D13
K(36) = &H650A7354
K(37) = &H766A0ABB
K(38) = &H81C2C92E
K(39) = &H92722C85
K(40) = &HA2BFE8A1
K(41) = &HA81A664B
K(42) = &HC24B8B70
K(43) = &HC76C51A3
K(44) = &HD192E819
K(45) = &HD6990624
K(46) = &HF40E3585
K(47) = &H106AA070
K(48) = &H19A4C116
K(49) = &H1E376C08
K(50) = &H2748774C
K(51) = &H34B0BCB5
K(52) = &H391C0CB3
K(53) = &H4ED8AA4A
K(54) = &H5B9CCA4F
K(55) = &H682E6FF3
K(56) = &H748F82EE
K(57) = &H78A5636F
K(58) = &H84C87814
K(59) = &H8CC70208
K(60) = &H90BEFFFA
K(61) = &HA4506CEB
K(62) = &HBEF9A3F7
K(63) = &HC67178F2
Private Function LShift(lValue, iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function RShift(lValue, iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise 6
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function AddUnsigned(lX, lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function Ch(x, y, z)
Ch = ((x And y) Xor ((Not x) And z))
End Function
Private Function Maj(x, y, z)
Maj = ((x And y) Xor (x And z) Xor (y And z))
End Function
Private Function S(x, n)
S = (RShift(x, (n And m_lOnBits(4))) Or LShift(x, (32 - (n And m_lOnBits(4)))))
End Function
Private Function R(x, n)
R = RShift(x, cLng(n And m_lOnBits(4)))
End Function
Private Function Sigma0(x)
Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22))
End Function
Private Function Sigma1(x)
Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25))
End Function
Private Function Gamma0(x)
Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3))
End Function
Private Function Gamma1(x)
Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10))
End Function
Private Function ConvertToWordArray(sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Dim lByte
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
lMessageLength = Len(sMessage)
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(lByte, lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Public Function SHA256(sMessage)
Dim HASH(7)
Dim M
Dim W(63)
Dim a
Dim b
Dim c
Dim d
Dim e
Dim f
Dim g
Dim h
Dim i
Dim j
Dim T1
Dim T2
HASH(0) = &H6A09E667
HASH(1) = &HBB67AE85
HASH(2) = &H3C6EF372
HASH(3) = &HA54FF53A
HASH(4) = &H510E527F
HASH(5) = &H9B05688C
HASH(6) = &H1F83D9AB
HASH(7) = &H5BE0CD19
M = ConvertToWordArray(sMessage)
For i = 0 To UBound(M) Step 16
a = HASH(0)
b = HASH(1)
c = HASH(2)
d = HASH(3)
e = HASH(4)
f = HASH(5)
g = HASH(6)
h = HASH(7)
For j = 0 To 63
If j < 16 Then
W(j) = M(j + i)
Else
W(j) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))
End If
T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), Ch(e, f, g)), K(j)), W(j))
T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))
h = g
g = f
f = e
e = AddUnsigned(d, T1)
d = c
c = b
b = a
a = AddUnsigned(T1, T2)
Next
HASH(0) = AddUnsigned(a, HASH(0))
HASH(1) = AddUnsigned(b, HASH(1))
HASH(2) = AddUnsigned(c, HASH(2))
HASH(3) = AddUnsigned(d, HASH(3))
HASH(4) = AddUnsigned(e, HASH(4))
HASH(5) = AddUnsigned(f, HASH(5))
HASH(6) = AddUnsigned(g, HASH(6))
HASH(7) = AddUnsigned(h, HASH(7))
Next
SHA256 = LCase(Right("00000000" & Hex(HASH(0)), 8) & Right("00000000" & Hex(HASH(1)), 8) & Right("00000000" & Hex(HASH(2)), 8) & Right("00000000" & Hex(HASH(3)), 8) & Right("00000000" & Hex(HASH(4)), 8) & Right("00000000" & Hex(HASH(5)), 8) & Right("00000000" & Hex(HASH(6)), 8) & Right("00000000" & Hex(HASH(7)), 8))
End Function
%>
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
%>
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
%>
<%
'##############################################
'## Post Formatting ##
'##############################################
function chkQuoteOk(fString)
chkQuoteOk = not(InStr(1, fString, "'", 0) > 0)
end function
function ChkURLs(ByVal strToFormat, ByVal sPrefix, ByVal iType)
Dim strArray
Dim Counter
ChkURLs = strToFormat
if InStr(1, strToFormat, sPrefix) > 0 Then
strArray = Split(strToFormat, sPrefix, -1)
ChkURLs = strArray(0)
for Counter = 1 To UBound(strArray)
if ((strArray(Counter-1) = "" Or Len(strArray(Counter-1)) < 5) And strArray(Counter)<> "") then
ChkURLs = ChkURLs & edit_hrefs(sPrefix & strArray(Counter), iType)
elseif ((UCase(Right(strArray(Counter-1), 6)) <> "HREF=""") and _
(UCase(Right(strArray(Counter-1), 5)) <> "[IMG]") and _
(UCase(Right(strArray(Counter-1), 5)) <> "[URL]") and _
(UCase(Right(strArray(Counter-1), 6)) <> "[URL=""") and _
(UCase(Right(strArray(Counter-1), 6)) <> "FTP://") and _
(UCase(Right(strArray(Counter-1), 8)) <> "FILE:///") and _
(UCase(Right(strArray(Counter-1), 7)) <> "HTTP://") and _
(UCase(Right(strArray(Counter-1), 8)) <> "HTTPS://") and _
(UCase(Right(strArray(Counter-1), 5)) <> "SRC=""") and _
(UCase(Right(strArray(Counter-1), 1)) <> "-") and _
(UCase(Right(strArray(Counter-1), 1)) <> "=") and _
(strArray(Counter) <> "")) then
ChkURLs = ChkURLs & edit_hrefs(sPrefix & strArray(Counter), iType)
else
ChkURLs = ChkURLs & sPrefix & strArray(Counter)
end if
next
end if
end function
function ChkMail(ByVal strToFormat)
Dim strArray
Dim Counter
if InStr(1, strToFormat, " ") > 0 Then
strArray = Split(Replace(strToFormat, "
", "
", 1, -1, vbTextCompare), " ", -1)
'ChkMail = strArray(0)
for Counter = 0 to UBound(strArray)
If (InStr(strArray(Counter), "@") > 0) and _
not(InStr(UCase(strArray(Counter)), "MAILTO:") > 0) and _
not(InStr(UCase(strArray(Counter)), "FTP:") > 0) and _
not(InStr(UCase(strArray(Counter)), "[URL") > 0) then
ChkMail = ChkMail & " " & edit_hrefs(strArray(counter), 4)
else
ChkMail = ChkMail & " " & strArray(counter)
end if
next
ChkMail = Replace(ChkMail, "
", "
", 1, -1, vbTextCompare)
else
if (InStr(strToFormat, "@") > 0) and _
not(InStr(UCase(strToFormat), "MAILTO:") > 0) and _
not(InStr(UCase(strToFormat), "FTP:") > 0) and _
not(InStr(UCase(strToFormat), "[URL") > 0) then
ChkMail = ChkMail & " " & edit_hrefs(strToFormat, 4)
else
ChkMail = strToFormat
end if
end if
end function
function FormatStr(fString)
on Error resume next
fString = Replace(fString, CHR(13), "")
'fString = Replace(fString, CHR(10) & CHR(10), "
")
fString = Replace(fString, CHR(10), "
")
if strBadWordFilter = 1 or strBadWordFilter = "1" then
fString = ChkBadWords(fString)
end if
if strAllowForumCode = "1" then
fString = ReplaceURLs(fString)
fString = ReplaceCodeTags(fString)
if strIMGInPosts = "1" then
fString = ReplaceImageTags(fString)
end if
end if
fString = ChkURLs(fString, "http://", 1)
fString = ChkURLs(fString, "https://", 2)
fString = ChkURLs(fString, "www.", 3)
fString = ChkMail(fString)
fString = ChkURLs(fString, "ftp://", 5)
fString = ChkURLs(fString, "file:///", 6)
if strIcons = "1" then
fString = smile(fString)
end if
if strAllowForumCode = "1" then
fString = extratags(fString)
end if
FormatStr = fString
on Error goto 0
end function
function doCode(fString, fOTag, fCTag, fROTag, fRCTag)
fOTagPos = Instr(1, fString, fOTag, 1)
fCTagPos = Instr(1, fString, fCTag, 1)
while (fCTagPos > 0 and fOTagPos > 0)
fString = replace(fString, fOTag, fROTag, 1, 1, 1)
fString = replace(fString, fCTag, fRCTag, 1, 1, 1)
fOTagPos = Instr(1, fString, fOTag, 1)
fCTagPos = Instr(1, fString, fCTag, 1)
wend
doCode = fString
end function
function Smile(fString)
fString = replace(fString, "[:(!]", getCurrentIcon(strIconSmileAngry,"","align=""middle"""))
fString = replace(fString, "[B)]", getCurrentIcon(strIconSmileBlackeye,"","align=""middle"""))
fString = replace(fString, "[xx(]", getCurrentIcon(strIconSmileDead,"","align=""middle"""))
fString = replace(fString, "[XX(]", getCurrentIcon(strIconSmileDead,"","align=""middle"""))
fString = replace(fString, "[:I]", getCurrentIcon(strIconSmileBlush,"","align=""middle"""))
fString = replace(fString, "[:(]", getCurrentIcon(strIconSmileSad,"","align=""middle"""))
fString = replace(fString, "[:o]", getCurrentIcon(strIconSmileShock,"","align=""middle"""))
fString = replace(fString, "[:O]", getCurrentIcon(strIconSmileShock,"","align=""middle"""))
fString = replace(fString, "[:0]", getCurrentIcon(strIconSmileShock,"","align=""middle"""))
fString = replace(fString, "[|)]", getCurrentIcon(strIconSmileSleepy,"","align=""middle"""))
fString = replace(fString, "[:)]", getCurrentIcon(strIconSmile,"","align=""middle"""))
fString = replace(fString, "[:D]", getCurrentIcon(strIconSmileBig,"","align=""middle"""))
fString = replace(fString, "[}:)]", getCurrentIcon(strIconSmileEvil,"","align=""middle"""))
fString = replace(fString, "[:o)]", getCurrentIcon(strIconSmileClown,"","align=""middle"""))
fString = replace(fString, "[:O)]", getCurrentIcon(strIconSmileClown,"","align=""middle"""))
fString = replace(fString, "[:0)]", getCurrentIcon(strIconSmileClown,"","align=""middle"""))
fString = replace(fString, "[8)]", getCurrentIcon(strIconSmileShy,"","align=""middle"""))
fString = replace(fString, "[8D]", getCurrentIcon(strIconSmileCool,"","align=""middle"""))
fString = replace(fString, "[:P]", getCurrentIcon(strIconSmileTongue,"","align=""middle"""))
fString = replace(fString, "[:p]", getCurrentIcon(strIconSmileTongue,"","align=""middle"""))
fString = replace(fString, "[;)]", getCurrentIcon(strIconSmileWink,"","align=""middle"""))
fString = replace(fString, "[8]", getCurrentIcon(strIconSmile8ball,"","align=""middle"""))
fString = replace(fString, "[?]", getCurrentIcon(strIconSmileQuestion,"","align=""middle"""))
fString = replace(fString, "[^]", getCurrentIcon(strIconSmileApprove,"","align=""middle"""))
fString = replace(fString, "[V]", getCurrentIcon(strIconSmileDisapprove,"","align=""middle"""))
fString = replace(fString, "[v]", getCurrentIcon(strIconSmileDisapprove,"","align=""middle"""))
fString = replace(fString, "[:X]", getCurrentIcon(strIconSmileKisses,"","align=""middle"""))
fString = replace(fString, "[:x]", getCurrentIcon(strIconSmileKisses,"","align=""middle"""))
Smile = fString
end function
function extratags(fString)
fString = doCode(fString, "[spoiler]", "[/spoiler]", "", "")
extratags = fString
end function
function chkBadWords(fString)
if trim(Application(strCookieURL & "STRBADWORDWORDS")) = "" or trim(Application(strCookieURL & "STRBADWORDREPLACE")) = "" then
txtBadWordWords = ""
txtBadWordReplace = ""
'## Forum_SQL - Get Badwords from DB
strSqlb = "SELECT B_BADWORD, B_REPLACE "
strSqlb = strSqlb & " FROM " & strFilterTablePrefix & "BADWORDS "
set rsBadWord = Server.CreateObject("ADODB.Recordset")
rsBadWord.open strSqlb, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if rsBadWord.EOF then
recBadWordCount = ""
else
allBadWordData = rsBadWord.GetRows(adGetRowsRest)
recBadWordCount = UBound(allBadWordData,2)
end if
rsBadWord.close
set rsBadWord = nothing
if recBadWordCount <> "" then
bBADWORD = 0
bREPLACE = 1
for iBadword = 0 to recBadWordCount
BadWordWord = allBadWordData(bBADWORD,iBadWord)
BadWordReplace = allBadWordData(bREPLACE,iBadWord)
if txtBadWordWords = "" then
txtBadWordWords = BadWordWord
txtBadWordReplace = BadWordReplace
else
txtBadWordWords = txtBadWordWords & "," & BadWordWord
txtBadWordReplace = txtBadWordReplace & "," & BadWordReplace
end if
next
end if
Application.Lock
Application(strCookieURL & "STRBADWORDWORDS") = txtBadWordWords
Application(strCookieURL & "STRBADWORDREPLACE") = txtBadWordReplace
Application.UnLock
end if
txtBadWordWords = Application(strCookieURL & "STRBADWORDWORDS")
txtBadWordReplace = Application(strCookieURL & "STRBADWORDREPLACE")
if fString = "" or IsNull(fString) then fString = " "
bwords = split(txtBadWordWords, ",")
breplace = split(txtBadWordReplace, ",")
for i = 0 to ubound(bwords)
fString = Replace(fString, bwords(i), breplace(i), 1, -1, 1)
next
chkBadWords = fString
end function
function HTMLEncode(pString)
fString = trim(pString)
if fString = "" or IsNull(fString) then
fString = " "
else
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
end if
HTMLEncode = fString
end function
function HTMLDecode(pString)
fString = trim(pString)
if fString = "" then
fString = " "
else
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
end if
HTMLDecode = fString
end function
function chkString(pString,fField_Type) '## Types - name, password, title, message, url, urlpath, email, number, list
fString = trim(pString)
if fString = "" or isNull(fString) then
fString = " "
else
' chkBadWords(fString)
end if
Select Case lcase(fField_Type)
Case "refer"
fString = Replace(fString, "&#", "#")
fString = Replace(fString, """", """)
fString = HTMLEncode(fString)
ChkString = fString
exit function
Case "archive"
fString = Replace(fString, "'", "''")
if strDBType = "mysql" then
fString = Replace(fString, "\", "\\")
end if
chkString = fString
exit function
Case "displayimage"
fString = Replace(fString, " ", "")
fString = Replace(fString, """", "")
fString = Replace(fString, "<", "")
fString = Replace(fString, ">", "")
chkString = fString
exit function
Case "pagetitle"
if strBadWordFilter = "1" then
fString = chkBadWords(fString)
end if
fString = Replace(fString,"\","\\")
fString = Replace(fString,"'","\'")
fString = HTMLDecode(fString)
chkString = fString
exit function
Case "title"
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
if strBadWordFilter = "1" then
fString = chkBadWords(fString)
end if
chkString = fString
exit function
Case "password"
fString = trim(fString)
chkString = fString
Case "decode"
fString = HTMLDecode(fString)
chkString = fString
exit function
Case "urlpath"
fString = Server.URLEncode(fString)
chkString = fString
exit function
Case "sqlstring"
fString = Replace(fString, "'", "''")
if strDBType = "mysql" then
fString = Replace(fString, "\", "\\")
end if
fString = HTMLEncode(fString)
chkString = fString
exit function
Case "jsurlpath"
fString = Replace(fString, "'", "\'")
fString = Server.URLEncode(fString)
chkString = fString
exit function
Case "edit"
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
fString = Replace(fString, """", """)
ChkString = fString
exit function
Case "admindisplay"
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
chkString = fString
exit function
Case "display"
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
if strBadWordFilter = "1" then
fString = ChkBadWords(fString)
end if
fString = replace(fString,"+","+")
fString = replace(fString, """", """)
chkString = fString
exit function
Case "search"
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
if strBadWordFilter = "1" then
fString = ChkBadWords(fString)
end if
fString = Replace(fString, """", """)
chkString = fString
exit function
Case "message"
if strBadWordFilter = "1" then
fString = ChkBadWords(fString)
end if
fString = Replace(fString,"&#","#")
if strDBType = "mysql" then
fString = Replace(fString, "\", "\\")
end if
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
Case "preview"
if strBadWordFilter = "1" then
fString = ChkBadWords(fString)
end if
if strAllowHTML <> "1" then
fString = HTMLEncode(fString)
end if
Case "hidden"
fString = HTMLEncode(fString)
End Select
if fField_Type <> "signature" and fField_Type <> "title" then
fString = doCode(fString, "[quote]", "[/quote]", "quote:
", "
")
end if
if strAllowForumCode = "1" and fField_Type <> "signature" then
fString = doCode(fString, "[b]", "[/b]", "", "")
fString = doCode(fString, "[s]", "[/s]", "", "")
fString = doCode(fString, "[strike]", "[/strike]", "", "")
fString = doCode(fString, "[u]", "[/u]", "", "")
fString = doCode(fString, "[i]", "[/i]", "", "")
if fField_Type <> "title" then
fString = doCode(fString, "[font=Andale Mono]", "[/font=Andale Mono]", "", "")
fString = doCode(fString, "[font=Arial]", "[/font=Arial]", "", "")
fString = doCode(fString, "[font=Arial Black]", "[/font=Arial Black]", "", "")
fString = doCode(fString, "[font=Book Antiqua]", "[/font=Book Antiqua]", "", "")
fString = doCode(fString, "[font=Century Gothic]", "[/font=Century Gothic]", "", "")
fString = doCode(fString, "[font=Courier New]", "[/font=Courier New]", "", "")
fString = doCode(fString, "[font=Comic Sans MS]", "[/font=Comic Sans MS]", "", "")
fString = doCode(fString, "[font=Georgia]", "[/font=Georgia]", "", "")
fString = doCode(fString, "[font=Impact]", "[/font=Impact]", "", "")
fString = doCode(fString, "[font=Tahoma]", "[/font=Tahoma]", "", "")
fString = doCode(fString, "[font=Times New Roman]", "[/font=Times New Roman]", "", "")
fString = doCode(fString, "[font=Trebuchet MS]", "[/font=Trebuchet MS]", "", "")
fString = doCode(fString, "[font=Script MT Bold]", "[/font=Script MT Bold]", "", "")
fString = doCode(fString, "[font=Stencil]", "[/font=Stencil]", "", "")
fString = doCode(fString, "[font=Verdana]", "[/font=Verdana]", "", "")
fString = doCode(fString, "[font=Lucida Console]", "[/font=Lucida Console]", "", "")
fString = doCode(fString, "[red]", "[/red]", "", "")
fString = doCode(fString, "[green]", "[/green]", "", "")
fString = doCode(fString, "[blue]", "[/blue]", "", "")
fString = doCode(fString, "[white]", "[/white]", "", "")
fString = doCode(fString, "[purple]", "[/purple]", "", "")
fString = doCode(fString, "[yellow]", "[/yellow]", "", "")
fString = doCode(fString, "[violet]", "[/violet]", "", "")
fString = doCode(fString, "[brown]", "[/brown]", "", "")
fString = doCode(fString, "[black]", "[/black]", "", "")
fString = doCode(fString, "[pink]", "[/pink]", "", "")
fString = doCode(fString, "[orange]", "[/orange]", "", "")
fString = doCode(fString, "[gold]", "[/gold]", "", "")
fString = doCode(fString, "[beige]", "[/beige]", "", "")
fString = doCode(fString, "[teal]", "[/teal]", "", "")
fString = doCode(fString, "[navy]", "[/navy]", "", "")
fString = doCode(fString, "[maroon]", "[/maroon]", "", "")
fString = doCode(fString, "[limegreen]", "[/limegreen]", "", "")
fString = doCode(fString, "[h1]", "[/h1]", "", "
")
fString = doCode(fString, "[h2]", "[/h2]", "", "
")
fString = doCode(fString, "[h3]", "[/h3]", "", "
")
fString = doCode(fString, "[h4]", "[/h4]", "", "
")
fString = doCode(fString, "[h5]", "[/h5]", "", "
")
fString = doCode(fString, "[h6]", "[/h6]", "", "
")
fString = doCode(fString, "[size=1]", "[/size=1]", "", "")
fString = doCode(fString, "[size=2]", "[/size=2]", "", "")
fString = doCode(fString, "[size=3]", "[/size=3]", "", "")
fString = doCode(fString, "[size=4]", "[/size=4]", "", "")
fString = doCode(fString, "[size=5]", "[/size=5]", "", "")
fString = doCode(fString, "[size=6]", "[/size=6]", "", "")
fString = doCode(fString, "[list]", "[/list]", "")
fString = doCode(fString, "[list=1]", "[/list=1]", "", "
")
fString = doCode(fString, "[list=a]", "[/list=a]", "", "
")
fString = doCode(fString, "[*]", "[/*]", "", "")
fString = doCode(fString, "[left]", "[/left]", "", "
")
fString = doCode(fString, "[center]", "[/center]", "", "")
fString = doCode(fString, "[centre]", "[/centre]", "", "")
fString = doCode(fString, "[right]", "[/right]", "", "
")
'fString = doCode(fString, "[code]", "[/code]", "", "
")
fString = replace(fString, "[br]", "
", 1, -1, 1)
fString = replace(fString, "[hr]", "
", 1, -1, 1)
end if
end if
if fField_Type <> "hidden" and _
fField_Type <> "preview" then
fString = Replace(fString, "'", "''")
end if
if fField_Type = "message" and strDBType = "mysql" then
fString = Replace(fString, """", "\""")
end if
chkString = fString
end function
'##############################################
'## Date Formatting ##
'##############################################
function doublenum(fNum)
if fNum > 9 then
doublenum = fNum
else
doublenum = "0" & fNum
end if
end function
function chkDateFormat(strDateTime)
chkDateFormat = isdate("" & Mid(strDateTime, 5,2) & "/" & Mid(strDateTime, 7,2) & "/" & Mid(strDateTime, 1,4) & " " & Mid(strDateTime, 9,2) & ":" & Mid(strDateTime, 11,2) & ":" & Mid(strDateTime, 13,2) & "")
end function
function StrToDate(strDateTime)
if ChkDateFormat(strDateTime) then
'Testing for server format
if strComp(Month("04/05/2002"),"4") = 0 then
StrToDate = cdate("" & Mid(strDateTime, 5,2) & "/" & Mid(strDateTime, 7,2) & "/" & Mid(strDateTime, 1,4) & " " & Mid(strDateTime, 9,2) & ":" & Mid(strDateTime, 11,2) & ":" & Mid(strDateTime, 13,2) & "")
else
StrToDate = cdate("" & Mid(strDateTime, 7,2) & "/" & Mid(strDateTime, 5,2) & "/" & Mid(strDateTime, 1,4) & " " & Mid(strDateTime, 9,2) & ":" & Mid(strDateTime, 11,2) & ":" & Mid(strDateTime, 13,2) & "")
end if
else
if strComp(Month("04/05/2002"),"4") = 0 then
tmpDate = DatePart("m",strForumTimeAdjust) & "/" & DatePart("d",strForumTimeAdjust) & "/" & DatePart("yyyy",strForumTimeAdjust) & " " & DatePart("h",strForumTimeAdjust) & ":" & DatePart("n",strForumTimeAdjust) & ":" & DatePart("s",strForumTimeAdjust)
else
tmpDate = DatePart("d",strForumTimeAdjust) & "/" & DatePart("m",strForumTimeAdjust) & "/" & DatePart("yyyy",strForumTimeAdjust) & " " & DatePart("h",strForumTimeAdjust) & ":" & DatePart("n",strForumTimeAdjust) & ":" & DatePart("s",strForumTimeAdjust)
end if
StrToDate = tmpDate
end if
end function
function oldStrToDate(strDateTime)
if ChkDateFormat(strDateTime) then
StrToDate = cdate("" & Mid(strDateTime, 5,2) & "/" & Mid(strDateTime, 7,2) & "/" & Mid(strDateTime, 1,4) & " " & Mid(strDateTime, 9,2) & ":" & Mid(strDateTime, 11,2) & ":" & Mid(strDateTime, 13,2) & "")
else
tmpDate = DatePart("m",strForumTimeAdjust) & "/" & DatePart("d",strForumTimeAdjust) & "/" & DatePart("yyyy",strForumTimeAdjust) & " " & DatePart("h",strForumTimeAdjust) & ":" & DatePart("n",strForumTimeAdjust) & ":" & DatePart("s",strForumTimeAdjust)
StrToDate = "" & tmpDate
end if
end function
function DateToStr(dtDateTime)
if not isDate(dtDateTime) then
dtDateTime = strToDate(dtDateTime)
end if
DateToStr = year(dtDateTime) & doublenum(Month(dtdateTime)) & doublenum(Day(dtdateTime)) & doublenum(Hour(dtdateTime)) & doublenum(Minute(dtdateTime)) & doublenum(Second(dtdateTime)) & ""
end function
function ReadLastHereDate(UserName)
dim rs_date
dim strSql
if trim(UserName) = "" then
ReadLastHereDate = DateToStr(DateAdd("d", -10, strForumTimeAdjust))
exit function
end if
'## Forum_SQL
strSql = "SELECT M_LASTHEREDATE "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & ChkString(UserName, "SQLString") & "' "
Set rs_date = Server.CreateObject("ADODB.Recordset")
rs_date.open strSql, my_Conn
if (rs_date.BOF and rs_date.EOF) then
ReadLastHereDate = DateToStr(DateAdd("d",-10,strForumTimeAdjust))
else
if rs_date("M_LASTHEREDATE") = "" or IsNull(rs_date("M_LASTHEREDATE")) then
ReadLastHereDate = DateToStr(DateAdd("d",-10,strForumTimeAdjust))
else
ReadLastHereDate = rs_date("M_LASTHEREDATE")
end if
end if
rs_date.close
set rs_date = nothing
UpdateLastHereDate DateToStr(strForumTimeAdjust),UserName
end function
function UpdateLastHereDate(fTime,UserName)
'## Forum_SQL - Do DB Update
strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " SET M_LASTHEREDATE = '" & fTime & "'"
strSql = strSql & ", M_LAST_IP = '" & Request.ServerVariables("REMOTE_ADDR") & "'"
strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & ChkString(UserName, "SQLString") & "' "
my_conn.Execute (strSql),,adCmdText + adExecuteNoRecords
end function
function chkDate(fDate,separator,fTime)
if fDate = "" or isNull(fDate) then
if fTime then
chkTime(fDate)
end if
exit function
end if
select case strDateType
case "dmy"
chkDate = Mid(fDate,7,2) & "/" & _
Mid(fDate,5,2) & "/" & _
Mid(fDate,1,4)
case "mdy"
chkDate = Mid(fDate,5,2) & "/" & _
Mid(fDate,7,2) & "/" & _
Mid(fDate,1,4)
case "ymd"
chkDate = Mid(fDate,1,4) & "/" & _
Mid(fDate,5,2) & "/" & _
Mid(fDate,7,2)
case "ydm"
chkDate =Mid(fDate,1,4) & "/" & _
Mid(fDate,7,2) & "/" & _
Mid(fDate,5,2)
case "dmmy"
chkDate = Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),1) & " " & _
Mid(fDate,1,4)
case "mmdy"
chkDate = Monthname(Mid(fDate,5,2),1) & " " & _
Mid(fDate,7,2) & " " & _
Mid(fDate,1,4)
case "ymmd"
chkDate = Mid(fDate,1,4) & " " & _
Monthname(Mid(fDate,5,2),1) & " " & _
Mid(fDate,7,2)
case "ydmm"
chkDate = Mid(fDate,1,4) & " " & _
Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),1)
case "dmmmy"
chkDate = Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),0) & " " & _
Mid(fDate,1,4)
case "mmmdy"
chkDate = Monthname(Mid(fDate,5,2),0) & " " & _
Mid(fDate,7,2) & " " & _
Mid(fDate,1,4)
case "ymmmd"
chkDate = Mid(fDate,1,4) & " " & _
Monthname(Mid(fDate,5,2),0) & " " & _
Mid(fDate,7,2)
case "ydmmm"
chkDate = Mid(fDate,1,4) & " " & _
Mid(fDate,7,2) & " " & _
Monthname(Mid(fDate,5,2),0)
case else
chkDate = Mid(fDate,5,2) & "/" & _
Mid(fDate,7,2) & "/" & _
Mid(fDate,1,4)
end select
if fTime then
chkDate = chkDate & separator & chkTime(fDate)
end if
end function
function chkTime(fTime)
if fTime = "" or isNull(fTime) then
exit function
end if
if strTimeType = 12 then
if cLng(Mid(fTime, 9,2)) > 12 then
chkTime = ChkTime & " " & _
(cLng(Mid(fTime, 9,2)) -12) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "PM"
elseif cLng(Mid(fTime, 9,2)) = 12 then
chkTime = ChkTime & " " & _
cLng(Mid(fTime, 9,2)) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "PM"
elseif cLng(Mid(fTime, 9,2)) = 0 then
chkTime = ChkTime & " " & _
(cLng(Mid(fTime, 9,2)) +12) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "AM"
else
chkTime = ChkTime & " " & _
Mid(fTime, 9,2) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2) & " " & "AM"
end if
else
ChkTime = ChkTime & " " & _
Mid(fTime, 9,2) & ":" & _
Mid(fTime, 11,2) & ":" & _
Mid(fTime, 13,2)
end if
end function
function widenum(fNum)
if fNum > 9 then
widenum = ""
else
widenum = " "
end if
end function
'##############################################
'## Multi-Moderators ##
'##############################################
function chkForumModerator(fForum_ID, fMember_Name)
'## Forum_SQL
strSql = "SELECT mo.FORUM_ID "
strSql = strSql & " FROM " & strTablePrefix & "MODERATOR mo, " & strMemberTablePrefix & "MEMBERS me "
strSql = strSql & " WHERE mo.FORUM_ID = " & fForum_ID & " "
strSql = strSql & " AND mo.MEMBER_ID = me.MEMBER_ID "
strSql = strSql & " AND me." & strDBNTSQLName & " = '" & chkString(fMember_Name,"SQLString") & "'"
set rsChk = Server.CreateObject("ADODB.Recordset")
rsChk.open strSql, my_Conn
if rsChk.bof or rsChk.eof then
chkForumModerator = "0"
else
chkForumModerator = "1"
end if
rsChk.close
set rsChk = nothing
end function
'##############################################
'## NT Authentication ##
'##############################################
sub NTUser()
dim strSql
dim rs_chk
if Session(strCookieURL & "username")="" then
'## Forum_SQL
strSql ="SELECT MEMBER_ID, M_LEVEL, M_PASSWORD, M_USERNAME, M_NAME "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_USERNAME = '" & ChkString(Session(strCookieURL & "userid"), "SQLString") & "'"
strSql = strSql & " AND M_STATUS = " & 1
Set rs_chk = Server.CreateObject("ADODB.Recordset")
rs_chk.open strSql, my_Conn
if rs_chk.BOF or rs_chk.EOF then
strLoginStatus = 0
else
Session(strCookieURL & "username") = rs_chk("M_NAME")
if strSetCookieToForum = 1 then
Response.Cookies(strUniqueID & "User").Path = strCookieURL
end if
Response.Cookies(strUniqueID & "User")("Name") = rs_chk("M_NAME")
Response.Cookies(strUniqueID & "User")("Pword") = rs_chk("M_PASSWORD")
'Response.Cookies(strUniqueID & "User")("Cookies") = ""
Response.Cookies(strUniqueID & "User").Expires = dateAdd("d", intCookieDuration, strForumTimeAdjust)
Session(strCookieURL & "last_here_date") = ReadLastHereDate(Request.Form("Name"))
if strAuthType = "nt" then
Session(strCookieURL & "last_here_date") = ReadLastHereDate(Session(strCookieURL & "userID"))
end if
strLoginStatus = 1
mLev = cLng(chkUser(Session(strCookieURL & "userID"), Request.Cookies(strUniqueID & "User")("Pword"),-1))
if mLev = 4 then
Session(strCookieURL & "Approval") = "15916941253"
end if
end if
rs_chk.close
set rs_chk = nothing
end if
end sub
function chkAccountReg()
dim strSql
dim rs_chk
'## Forum_SQL
strSql ="SELECT M_LEVEL, M_USERNAME "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE M_USERNAME = '" & ChkString(Session(strCookieURL & "userid"), "SQLString") & "'"
strSql = strSql & " AND M_STATUS = " & 1
Set rs_chk = Server.CreateObject("ADODB.Recordset")
rs_chk.open strSql, my_Conn
if rs_chk.BOF or rs_chk.EOF then
chkAccountReg = "0"
else
chkAccountReg = "1"
end if
rs_chk.close
set rs_chk = nothing
end function
sub NTAuthenticate()
dim strUser, strNTUser, checkNT
strNTUser = Request.ServerVariables("AUTH_USER")
strNTUser = replace(strNTUser, "\", "/")
if Session(strCookieURL & "userid") = "" then
strUser = Mid(strNTUser,(instr(1,strNTUser,"/")+1),len(strNTUser))
Session(strCookieURL & "userid") = strUser
end if
if strNTGroups="1" then
strNTGroupsSTR = Session(strCookieURL & "strNTGroupsSTR")
if Session(strCookieURL & "strNTGroupsSTR") = "" then
Set strNTUserInfo = GetObject("WinNT://"+strNTUser)
For Each strNTUserInfoGroup in strNTUserInfo.Groups
strNTGroupsSTR=strNTGroupsSTR+", "+strNTUserInfoGroup.name
NEXT
Session(strCookieURL & "strNTGroupsSTR") = strNTGroupsSTR
end if
end if
if strAutoLogon="1" then
strNTUserFullName = Session(strCookieURL & "strNTUserFullName")
if Session(strCookieURL & "strNTUserFullName") = "" then
Set strNTUserInfo = GetObject("WinNT://"+strNTUser)
strNTUserFullName=strNTUserInfo.FullName
Session(strCookieURL & "strNTUserFullName") = strNTUserFullName
end if
end if
end sub
'##############################################
'## Cookie functions and Subs ##
'##############################################
sub doCookies(fSavePassWord)
if strSetCookieToForum = 1 then
Response.Cookies(strUniqueID & "User").Path = strCookieURL
else
Response.Cookies(strUniqueID & "User").Path = "/"
end if
Response.Cookies(strUniqueID & "User")("Name") = strDBNTFUserName
Response.Cookies(strUniqueID & "User")("Pword") = strEncodedPassword
'Response.Cookies(strUniqueID & "User")("Cookies") = Request.Form("Cookies")
if fSavePassWord = "true" then
Response.Cookies(strUniqueID & "User").Expires = dateAdd("d", intCookieDuration, strForumTimeAdjust)
end if
Session(strCookieURL & "last_here_date") = ReadLastHereDate(strDBNTFUserName)
end sub
sub ClearCookies()
if strSetCookieToForum = 1 then
Response.Cookies(strUniqueID & "User").Path = strCookieURL
else
Response.Cookies(strUniqueID & "User").Path = "/"
end if
Response.Cookies(strUniqueID & "User") = ""
Session(strCookieURL & "Approval") = ""
Session.Abandon
'Response.Cookies(strUniqueID & "User").Expires = dateadd("d", -2, strForumTimeAdjust)
end sub
'##############################################
'## Private Forums ##
'##############################################
function chkUser(fName, fPassword, fAuthor)
dim rsCheck
dim strSql
'## Forum_SQL
strSql = "SELECT MEMBER_ID, M_LEVEL, M_NAME, M_PASSWORD "
strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS "
strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & ChkString(fName, "SQLString") & "' "
if strAuthType="db" then
strSql = strSql & " AND M_PASSWORD = '" & ChkString(fPassword, "SQLString") &"'"
End If
strSql = strSql & " AND M_STATUS = " & 1
Set rsCheck = my_Conn.Execute(strSql)
if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then
MemberID = -1
chkUser = 0 '## Invalid Password
if strDBNTUserName <> "" and chkCookie = 1 then
Call ClearCookies()
strDBNTUserName = ""
end if
else
MemberID = rsCheck("MEMBER_ID")
if (rsCheck("MEMBER_ID") & "" = fAuthor & "") and (cLng(rsCheck("M_LEVEL")) <> 3) then
chkUser = 1 '## Author
else
select case cLng(rsCheck("M_LEVEL"))
case 1
chkUser = 2 '## Normal User
case 2
chkUser = 3 '## Moderator
case 3
chkUser = 4 '## Admin
case else
chkUser = cLng(rsCheck("M_LEVEL"))
end select
end if
end if
rsCheck.close
set rsCheck = nothing
end function
Function ReplaceURLs(ByVal strToFormat)
Dim oTag, c1Tag, oTag2, c2Tag
Dim roTag, rc1Tag, rc2Tag
Dim oTagPos, c1TagPos, oTagPos2, c1TagPos2
Dim Counter
Dim strArray, strArray2
Dim strFirstPart, strSecondPart
oTag = "[url="""
c1Tag = """]"
oTag2 = "[url]"
c2Tag = "[/url]"
roTag = ""
rc2Tag = ""
oTagPos = InStr(1, strToFormat, oTag, 1) 'Position of opening tag
c1TagPos = InStr(1, strToFormat, c1Tag, 1) 'Position of closing tag
'if opening tag and closing tag is found...
If (oTagpos > 0) And (c1TagPos > 0) Then
'Split string at the opening tag
strArray = Split(strToFormat, oTag, -1, 1)
'Loop through array
For Counter = 0 To UBound(strArray)
'if the closing tag is found in the string then...
If (InStr(1, strArray(Counter), c1Tag, 1) > 0) Then
'split string at the closing tag...
strArray2 = Split(strArray(Counter), c1Tag, -1, 1)
strArray2(0) = replace(strArray2(0), """", " ") ' ## filter out "
'strArray2(0) = replace(strArray2(0), "&", " ", 1, -1, 1) ' ## filter out &
'strArray2(0) = replace(strArray2(0), "#", " ", 1, -1, 1) ' ## filter out #
strArray2(0) = replace(strArray2(0), ";", " ", 1, -1, 1) ' ## filter out ;
strArray2(0) = replace(strArray2(0), "+", " ", 1, -1, 1) ' ## filter out +
strArray2(0) = replace(strArray2(0), "(", " ", 1, -1, 1) ' ## filter out (
strArray2(0) = replace(strArray2(0), ")", " ", 1, -1, 1) ' ## filter out )
'strArray2(0) = replace(strArray2(0), "[", " ", 1, -1, 1) ' ## filter out [
'strArray2(0) = replace(strArray2(0), "]", " ", 1, -1, 1) ' ## filter out ]
'strArray2(0) = replace(strArray2(0), "=", " ", 1, -1, 1) ' ## filter out =
strArray2(0) = replace(strArray2(0), "*", " ", 1, -1, 1) ' ## filter out *
strArray2(0) = replace(strArray2(0), "'", " ", 1, -1, 1) ' ## filter out '
strArray2(0) = replace(strArray2(0), ">", " ", 1, -1, 1) ' ## filter out >
strArray2(0) = replace(strArray2(0), "<", " ", 1, -1, 1) ' ## filter out <
strArray2(0) = replace(strArray2(0), vbTab, " ", 1, -1, 1) ' ## filter out Tabs
strArray2(0) = replace(strArray2(0), "view-source", " ", 1, -1, 1) ' ## filter out view-source
strArray2(0) = replace(strArray2(0), "javascript", " ", 1, -1, 1) ' ## filter out javascript
strArray2(0) = replace(strArray2(0), "jscript", " ", 1, -1, 1) ' ## filter out jscript
strArray2(0) = replace(strArray2(0), "vbscript", " ", 1, -1, 1) ' ## filter out vbscript
'if the closing url tag is found in the string and
'[URL] is not found in the string then...
If InStr(1, strArray2(1), c2Tag, 1) And _
Not InStr(1, UCase(strArray2(1)), "[URL]", 1) Then
strFirstPart = Left(strArray2(1), InStr(1, strArray2(1), c2Tag, 1)-1)
strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1, strArray2(1), c2Tag,1) - len(c2Tag)+1))
If strFirstPart <> "" Then
If UCase(Left(strFirstPart, 5)) = "[IMG]" Then
ReplaceURLs = ReplaceURLs & "" & strFirstPart & "" & strSecondPart
ElseIf UCase(Left(strArray2(0), 7)) = "HTTP://" Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 1) & strSecondPart
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 8)) = "HTTPS://" Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 2) & strSecondPart
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 4)) = "WWW." Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 3) & strSecondPart
ReplaceURLs = ReplaceURLs & roTag & "http://" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 7)) = "MAILTO:" Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 4) & strSecondPart
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 6)) = "FTP://" Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 5) & strSecondPart
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf InStr(strArray2(0), "@") > 0 Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 4) & strSecondPart
ReplaceURLs = ReplaceURLs & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 6)) = "FILE:///" Then
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
Else
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
End If
Else
If UCase(Left(strArray2(0), 7)) = "HTTP://" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 1) & strSecondPart
'ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 8)) = "HTTPS://" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 2) & strSecondPart
'ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 4)) = "WWW." Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 3) & strSecondPart
'ReplaceURLs = ReplaceURLs & roTag & "http://" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 7)) = "MAILTO:" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 4) & strSecondPart
'ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 6)) = "FTP://" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 5) & strSecondPart
'ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf InStr(strArray2(0), "@") > 0 Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 4) & strSecondPart
'ReplaceURLs = ReplaceURLs & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart
ElseIf UCase(Left(strArray2(0), 6)) = "FILE:///" Then
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart
Else
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart
End If
End If
Else
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
End If
Else
ReplaceURLs = ReplaceURLs & strArray(Counter)
End If
Next
Else
ReplaceURLs = strToFormat
End If
oTagPos2 = InStr(1, ReplaceURLs, oTag2, 1)
c1TagPos2 = InStr(1, ReplaceURLs, c2Tag, 1)
'if opening tag and closing tag is found then...
If (oTagpos2 > 0) And (c1TagPos2 > 0) Then
'split string at opening tag
strArray = Split(ReplaceURLs, oTag2, -1, 1)
ReplaceURLs = ""
For Counter = 0 To Ubound(strArray)
'if closing url tag is found in string then...
If InStr(1, strArray(Counter), c2Tag, 1) > 0 Then
'split string at closing url tag
strArray2 = Split(strArray(Counter), c2Tag, -1, 1)
strArray2(0) = replace(strArray2(0), """", " ") ' ## filter out "
'strArray2(0) = replace(strArray2(0), "&", " ", 1, -1, 1) ' ## filter out &
'strArray2(0) = replace(strArray2(0), "#", " ", 1, -1, 1) ' ## filter out #
strArray2(0) = replace(strArray2(0), ";", " ", 1, -1, 1) ' ## filter out ;
strArray2(0) = replace(strArray2(0), "+", " ", 1, -1, 1) ' ## filter out +
strArray2(0) = replace(strArray2(0), "(", " ", 1, -1, 1) ' ## filter out (
strArray2(0) = replace(strArray2(0), ")", " ", 1, -1, 1) ' ## filter out )
'strArray2(0) = replace(strArray2(0), "[", " ", 1, -1, 1) ' ## filter out [
'strArray2(0) = replace(strArray2(0), "]", " ", 1, -1, 1) ' ## filter out ]
'strArray2(0) = replace(strArray2(0), "=", " ", 1, -1, 1) ' ## filter out =
strArray2(0) = replace(strArray2(0), "*", " ", 1, -1, 1) ' ## filter out *
strArray2(0) = replace(strArray2(0), "'", " ", 1, -1, 1) ' ## filter out '
strArray2(0) = replace(strArray2(0), ">", " ", 1, -1, 1) ' ## filter out >
strArray2(0) = replace(strArray2(0), "<", " ", 1, -1, 1) ' ## filter out <
strArray2(0) = replace(strArray2(0), vbTab, " ", 1, -1, 1) ' ## filter out Tabs
strArray2(0) = replace(strArray2(0), "view-source", " ", 1, -1, 1) ' ## filter out view-source
strArray2(0) = replace(strArray2(0), "javascript", " ", 1, -1, 1) ' ## filter out javascript
strArray2(0) = replace(strArray2(0), "jscript", " ", 1, -1, 1) ' ## filter out jscript
strArray2(0) = replace(strArray2(0), "vbscript", " ", 1, -1, 1) ' ## filter out vbscript
If UCase(Left(strArray2(0), 7)) = "HTTP://" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 1) & strArray2(1)
ElseIf UCase(Left(strArray2(0), 8)) = "HTTPS://" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 2) & strArray2(1)
ElseIf UCase(Left(strArray2(0), 4)) = "WWW." Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 3) & strArray2(1)
ElseIf UCase(Left(strArray2(0), 7)) = "MAILTO:" Then
'ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 4) & strArray2(1)
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
ElseIf UCase(Left(strArray2(0), 6)) = "FTP://" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 5) & strArray2(1)
ElseIf InStr(strArray2(0), "@") > 0 Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 4) & strArray2(1)
ElseIf UCase(Left(strArray2(0), 6)) = "FILE:///" Then
ReplaceURLs = ReplaceURLs & edit_hrefs(strArray2(0), 7) & strArray2(1)
Else
ReplaceURLs = ReplaceURLs & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1)
End If
Else
ReplaceURLs = ReplaceURLs & strArray(Counter)
End If
Next
End If
End Function
function isAllowedMember(fForum_ID,fMemberID)
if fMemberID <> MemberID then
isAllowedMember = OldisAllowedMember(fForum_ID,fMemberID)
exit function
end if
if Session(strCookieURL & "AllowedForums" & MemberID) = "" or IsNull(Session(strCookieURL & "AllowedForums" & MemberID)) then
strSql = "SELECT FORUM_ID FROM " & strTablePrefix & "ALLOWED_MEMBERS "
strSql = strSql & " WHERE MEMBER_ID = " & cLng(fMemberID)
Set rsAllowedMember = Server.CreateObject("ADODB.Recordset")
rsAllowedMember.open strSql, my_Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
if (rsAllowedMember.EOF or rsAllowedMember.BOF) then
isAllowedMember2 = "-1"
Session(strCookieURL & "AllowedForums" & MemberID) = isAllowedMember2
Session(strCookieURL & "AllowedForums" & MemberID) = isAllowedMember2
else
arrAllowedForums = rsAllowedMember.GetRows(adGetRowsRest)
For AllowCount = 0 to ubound(arrAllowedForums,2) ' Total Numer of Rows
if AllowCount = 0 then
isAllowedMember2 = arrAllowedForums(0,AllowCount)
else
isAllowedMember2 = isAllowedMember2 & "," & arrAllowedForums(0,AllowCount)
end if
next
Session(strCookieURL & "AllowedForums" & MemberID) = isAllowedMember2
Session(strCookieURL & "AllowedForums" & MemberID) = isAllowedMember2
end if
rsAllowedMember.close
set rsAllowedMember = nothing
end if
if Session(strCookieURL & "AllowedForums" & MemberID) = "-1" then
isAllowedMember = 0
elseif InStr("," & Session(strCookieURL & "AllowedForums" & MemberID) & ",","," & fForum_ID & ",") then
isAllowedMember = 1
else
isAllowedMember = 0
end if
end function
function OldisAllowedMember(fForum_ID,fMemberID)
OldisAllowedMember = 0
strSql = "SELECT MEMBER_ID, FORUM_ID FROM " & strTablePrefix & "ALLOWED_MEMBERS "
strSql = strSql & " WHERE FORUM_ID = " & cLng(fForum_ID)
strSql = strSql & " AND MEMBER_ID = " & cLng(fMemberID)
Set rsAllowedMember = Server.CreateObject("ADODB.Recordset")
rsAllowedMember.open strSql, my_Conn
if (rsAllowedMember.EOF or rsAllowedMember.BOF) then
OldisAllowedMember = 0
rsAllowedMember.close
set rsAllowedMember = nothing
exit function
else
OldisAllowedMember = 1
rsAllowedMember.close
set rsAllowedMember = nothing
end if
end function
Function ReplaceImageTags(fString)
Dim oTag, cTag
Dim roTag, rcTag
Dim oTagPos, cTagPos
Dim nTagPos
Dim counter1, counter2, counter3
Dim strUrlText
Dim Tagcount
Dim strTempString, strResultString
TagCount = 6
Dim ImgTags(6,2,2)
Dim strArray, strArray2
ImgTags(1,1,1) = "[img]"
ImgTags(1,2,1) = "[/img]"
ImgTags(1,1,2) = "![]()
"
ImgTags(2,1,1) = "[image]"
ImgTags(2,2,1) = "[/image]"
ImgTags(2,1,2) = ImgTags(1,1,2)
ImgTags(2,2,2) = ImgTags(1,2,2)
ImgTags(3,1,1) = "[img=right]"
ImgTags(3,2,1) = "[/img=right]"
ImgTags(3,1,2) = "![]()
"
ImgTags(4,1,1) = "[image=right]"
ImgTags(4,2,1) = "[/image=right]"
ImgTags(4,1,2) = ImgTags(3,1,2)
ImgTags(4,2,2) = ImgTags(3,2,2)
ImgTags(5,1,1) = "[img=left]"
ImgTags(5,2,1) = "[/img=left]"
ImgTags(5,1,2) = "![]()
"
ImgTags(6,1,1) = "[image=left]"
ImgTags(6,2,1) = "[/image=left]"
ImgTags(6,1,2) = ImgTags(5,1,2)
ImgTags(6,2,2) = ImgTags(5,2,2)
strResultString = ""
strTempString = fString
for counter1 = 1 to TagCount
oTag = ImgTags(counter1,1,1)
roTag = ImgTags(counter1,1,2)
cTag = ImgTags(counter1,2,1)
rcTag = ImgTags(counter1,2,2)
oTagPos = InStr(1, strTempString, oTag, 1)
cTagPos = InStr(1, strTempString, cTag, 1)
if (oTagPos > 0) and (cTagPos > oTagPos) then
strArray = Split(strTempString, oTag, -1, 1)
for counter2 = 0 to Ubound(strArray)
if (Instr(1, strArray(counter2), cTag, 1) > 0) then
strArray2 = split(strArray(counter2), cTag, -1, 1)
strUrlText = trim(strArray2(0))
strUrlText = replace(strUrlText, """", " ") ' ## filter out "
'## Added to exclude Javascript and other potentially hazardous characters
strUrlText = replace(strUrlText, "&", " ", 1, -1, 1) ' ## filter out &
strUrlText = replace(strUrlText, "#", " ", 1, -1, 1) ' ## filter out #
strUrlText = replace(strUrlText, ";", " ", 1, -1, 1) ' ## filter out ;
strUrlText = replace(strUrlText, "+", " ", 1, -1, 1) ' ## filter out +
strUrlText = replace(strUrlText, "(", " ", 1, -1, 1) ' ## filter out (
strUrlText = replace(strUrlText, ")", " ", 1, -1, 1) ' ## filter out )
strUrlText = replace(strUrlText, "[", " ", 1, -1, 1) ' ## filter out [
strUrlText = replace(strUrlText, "]", " ", 1, -1, 1) ' ## filter out ]
strUrlText = replace(strUrlText, "=", " ", 1, -1, 1) ' ## filter out =
strUrlText = replace(strUrlText, "*", " ", 1, -1, 1) ' ## filter out *
strUrlText = replace(strUrlText, "'", " ", 1, -1, 1) ' ## filter out '
strUrlText = replace(strUrlText, vbTab, " ", 1, -1, 1) ' ## filter out Tabs
strUrlText = replace(strUrlText, "view-source", " ", 1, -1, 1) ' ## filter out view-source
strUrlText = replace(strUrlText, "javascript", " ", 1, -1, 1) ' ## filter out javascript
strUrlText = replace(strUrlText, "jscript", " ", 1, -1, 1) ' ## filter out jscript
strUrlText = replace(strUrlText, "vbscript", " ", 1, -1, 1) ' ## filter out vbscript
strUrlText = replace(strUrlText, "mailto", " ", 1, -1, 1) ' ## filter out mailto
'## End Added
strUrlText = replace(strUrlText, "<", " ") ' ## filter out <
strUrlText = replace(strUrlText, ">", " ") ' ## filter out >
strResultString = strResultString & roTag & strUrlText & rcTag & strArray2(1)
for counter3 = 2 to UBound(strArray2)
strResultString = strResultString & strArray2(counter3)
next
else
strResultString = strResultString & strArray(counter2)
end if
next
strTempString = strResultString
strResultString = ""
end if
next
ReplaceImageTags = strTempString
end function
Function ReplaceCodeTags(fString)
Dim oTag, cTag
Dim roTag, rcTag
Dim oTagPos, cTagPos
Dim nTagPos
Dim counter1, counter2
Dim strCodeText
Dim Tagcount
Dim strTempString, strResultString
TagCount = 1
Dim CodeTags(1,2,2)
Dim strArray, strArray2
CodeTags(1,1,1) = "[code]"
CodeTags(1,2,1) = "[/code]"
CodeTags(1,1,2) = ""
CodeTags(1,2,2) = "
"
strResultString = ""
strTempString = fString
for counter1 = 1 to TagCount
oTag = CodeTags(counter1,1,1)
roTag = CodeTags(counter1,1,2)
cTag = CodeTags(counter1,2,1)
rcTag = CodeTags(counter1,2,2)
oTagPos = InStr(1, strTempString, oTag, 1)
cTagPos = InStr(1, strTempString, cTag, 1)
if (oTagpos > 0) and (cTagPos > 0) then
strArray = Split(strTempString, oTag, -1, 1)
for counter2 = 0 to Ubound(strArray)
if (Instr(1, strArray(counter2), cTag) > 0) then
strArray2 = split(strArray(counter2), cTag, -1, 1)
strCodeText = trim(strArray2(0))
strCodeText = replace(strCodeText, "
", vbNewLine)
strResultString = strResultString & roTag & strCodeText & rcTag & strArray2(1)
else
strResultString = strResultString & strArray(counter2)
end if
next
strTempString = strResultString
strResultString = ""
end if
next
ReplaceCodeTags = strTempString
end function
'##############################################
'## Page Title ##
'##############################################
Function GetNewTitle(strTempScriptName)
Dim StrTempScript
Dim strNewTitle
arrTempScript = Split(strTempScriptName, "/")
strTempScript = arrTempScript(Ubound(arrTempScript))
strTempScript = lcase(strTempScript)
Select Case strTempScript
Case "topic.asp"
strTempTopic = cLng(request.querystring("TOPIC_ID"))
if strTempTopic <> 0 then
strsql = "SELECT FORUM_ID, T_SUBJECT FROM " & strActivePrefix & "TOPICS WHERE TOPIC_ID=" & strTempTopic
set ttopics = my_conn.execute(strsql)
if ttopics.bof or ttopics.eof then
GetNewTitle = strForumTitle
set ttopics = nothing
else
if mLev = 4 then
ForumChkSkipAllowed = 1
elseif mLev = 3 then
if chkForumModerator(ttopics("FORUM_ID"), ChkString(strDBNTUserName, "decode")) = "1" then
ForumChkSkipAllowed = 1
else
ForumChkSkipAllowed = 0
end if
else
ForumChkSkipAllowed = 0
end if
intShowTopicTitle = 1
if strPrivateForums = "1" and ForumChkSkipAllowed = 0 then
if not(chkForumAccess(ttopics("FORUM_ID"),MemberID,false)) then
intShowTopicTitle = 0
end if
end if
if intShowTopicTitle = 1 then strTempTopicTitle = " - " & chkString(ttopics("T_SUBJECT"),"display")
set ttopics = nothing
strNewTitle = strForumTitle & strTempTopicTitle
end if
else
GetNewTitle = strForumTitle
end if
Case "forum.asp"
strTempForum = cLng(request.querystring("FORUM_ID"))
if strTempForum <> 0 then
strsql = "SELECT F_SUBJECT FROM " & strTablePrefix & "FORUM WHERE FORUM_ID=" & strTempForum
set tforums = my_conn.execute(strsql)
if tforums.bof or tforums.eof then
strNewTitle = strForumTitle
set tforums = nothing
else
strTempForumTitle = chkString(tforums("F_SUBJECT"),"display")
set tforums = nothing
strNewTitle = strForumTitle & " - " & strTempForumTitle
end if
else
strNewTitle = strForumTitle
end if
Case "members.asp"
strNewTitle = strForumTitle & " - Members"
Case "active.asp"
strNewTitle = strForumTitle & " - Active Topics"
Case "faq.asp"
strNewTitle = strForumTitle & " - Frequently Asked Questions"
Case "search.asp"
strNewTitle = strForumTitle & " - Search"
Case "pop_profile.asp"
if request.querystring("mode") = "display" then
strNewTitle = strForumTitle & " - View Profile"
elseif request.querystring("mode") = "edit" then
strNewTitle = strForumTitle & " - Edit Profile"
else
strNewTitle = strForumTitle & " - Profile"
end if
Case "policy.asp"
strNewTitle = strForumTitle & " - User Agreement"
Case "register.asp"
strNewTitle = strForumTitle & " - Register"
Case "down.asp"
strNewTitle = strForumTitle & " is currently closed."
Case "default.asp"
strNewTitle = strForumTitle
Case else
strNewTitle = strForumTitle
End Select
GetNewTitle = strNewTitle
End Function
'## Function to limit the amount of records to retrieve from the database
Function TopSQL(strSQL, lngRecords)
if ucase(left(strSQL,7)) = "SELECT " then
select case strDBType
case "sqlserver"
TopSQL = "SET ROWCOUNT " & lngRecords & vbNewLine & strSQL & vbNewLine & "SET ROWCOUNT 0"
case "access"
TopSQL = "SELECT TOP " & lngRecords & mid(strSQL,7)
case "mysql"
if instr(strSQL,";") > 0 then
strSQL1 = Mid(strSQL, 1, Instr(strSQL, ";")-1)
strSQL2 = Mid(strSQL, InstrRev(strSQL, ";"))
TopSQL = strSQL1 & " LIMIT " & lngRecords & strSQL2
else
TopSQL = strSQL & " LIMIT " & lngRecords
end if
end select
else
TopSQL = strSQL
end if
End Function
Function sGetColspan(lIN, lOUT)
if (strShowModerators = "1") then lOut = lOut + 1
if (mlev = "4" or mlev = "3") and (strShowModerators = "1") then lOut = lOut + 1
if (mlev = "4" or mlev = "3") and (strShowModerators <> "1") then lOut = lOut + 2
if lOut > lIn then
sGetColspan = lIN
else
sGetColspan = lOUT
end if
End Function
function dWStatus(strMsg)
dWStatus = " onMouseOver=""(window.status='" & Replace(strMsg, "'", "\'") & "'); return true"" onMouseOut=""(window.status=''); return true"""
end function
function profileLink(fName, fID)
if instr(fName,"img src=") > 0 then
strExtraStuff = ""
else
strExtraStuff = " title=""View " & fName & "'s Profile""" & dWStatus("View " & fName & "'s Profile")
end if
if strUseExtendedProfile then
strReturn = ""
else
strReturn = ""
end if
profileLink = strReturn & fName & ""
end function
function chkSelect(actualValue, thisValue)
if isNumeric(actualValue) then actualValue = cLng(actualValue)
if actualValue = thisValue then
chkSelect = " selected"
else
chkSelect = ""
end if
end function
function chkExist(actualValue)
if trim(actualValue) <> "" then
chkExist = actualValue
else
chkExist = ""
end if
end function
function chkExistElse(actualValue, elseValue)
if trim(actualValue) <> "" then
chkExistElse = actualValue
else
chkExistElse = elseValue
end if
end function
function chkRadio(actualValue, thisValue, boltf)
if isNumeric(actualValue) then actualValue = cLng(actualValue)
if actualValue = thisValue EQV boltf then
chkRadio = " checked"
else
chkRadio = ""
end if
end function
function chkCheckbox(actualValue, thisValue, boltf)
if isNumeric(actualValue) then actualValue = cLng(actualValue)
if actualValue = thisValue EQV boltf then
chkCheckbox = " checked"
else
chkCheckbox = ""
end if
end function
function InArray(strArray,strValue)
if strArray <> "" and strArray <> "0" then
if (instr("," & strArray & "," ,"," & strValue & ",") > 0) then
InArray = True
exit function
end if
end if
InArray = False
end function
function oldInArray(strArray,strValue)
if IsArray(strArray) then
Dim Ix
for Ix = 0 To UBound(strArray)
if cLng(strArray(Ix)) = cLng(strValue) then
oldInArray = True
exit function
end if
next
end if
oldInArray = False
end function
Sub WriteFooter() %>
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.05
'#################################################################################
'## Copyright (C) 2000-05 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute it and/or
'## modify it under the terms of the GNU General Public License
'## as published by the Free Software Foundation; either version 2
'## of the License, or (at your option) any later version.
'##
'## All copyright notices regarding Snitz Forums 2000
'## must remain intact in the scripts and in the outputted HTML
'## The "powered by" text/logo with a link back to
'## http://forum.snitz.com in the footer of the pages MUST
'## remain visible when the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful,
'## but WITHOUT ANY WARRANTY; without even the implied warranty of
'## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
'## GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License
'## along with this program; if not, write to the Free Software
'## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'##
'## Support can be obtained from our support forums at:
'## http://forum.snitz.com
'##
'## Correspondence and Marketing Questions can be sent to:
'## manderson@snitz.com
'##
'#################################################################################
Response.Write " " & vbNewLine & _
" " & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
" " & vbNewLine & _
" | " & vbNewLine & _
" " & vbNewLine & _
" | " & vbNewLine & _
"
" & vbNewLine & _
"
" & vbNewLine & _
"" & vbNewLine & _
" " & vbNewLine
if strShowTimer = "1" then
Response.Write " | " & chkString(replace(strTimerPhrase, "[TIMER]", abs(round(StopTimer(1), 2)), 1, -1, 1),"display") & " | " & vbNewLine
end if
Response.Write " "
'## START - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write ""
if strShowImagePoweredBy = "1" then
Response.Write getCurrentIcon("logo_powered_by.gif||","Powered By: " & strVersion,"")
else
Response.Write "Snitz Forums 2000"
end if
Response.Write " | " & vbNewline
'## END - REMOVAL, MODIFICATION OR CIRCUMVENTING THIS CODE WILL VIOLATE THE SNITZ FORUMS 2000 LICENSE AGREEMENT
Response.Write "
" & vbNewLine & _
"
" & vbNewLine & _
" " & vbNewLine & _
"