<%
'#################################################################################
'## 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=D:\HTTP\WEB\TRINITYSHARED.COM\www.usbankforeclosures.com\fpdb\usbk2005.mdb" '## MS Access 2000
'strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("/fpdb/forum2000.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=D:\HTTP\WEB\TRINITYSHARED.COM\http://www.usbankforeclosures.com\fpdb\forum2005.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
'### Integration MOD ###
Dim strSiteHeader, strSiteLeft, strSiteRight, strSiteFooter, strSiteIntegEnabled, strSiteBorder
'### Integration MOD ###
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")
'### Integration MOD ###
strSiteHeader = Application(strCookieURL & "STRSITEHEADER")
strSiteLeft = Application(strCookieURL & "STRSITELEFT")
strSiteRight = Application(strCookieURL & "STRSITERIGHT")
strSiteFooter = Application(strCookieURL & "STRSITEFOOTER")
strSiteIntegEnabled = Application(strCookieURL & "STRSITEINTEGENABLED")
strSiteBorder = Application(strCookieURL & "STRSITEBORDER")
'### Integration MOD ###
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
'##
'#################################################################################
%>
<%
'##############################################
'## 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
if strSiteIntegEnabled = "1" then
if strSiteRight = "1" then
Response.Write " " & vbNewLine & _
" " & vbNewLine
%>
US bank foreclosures is New Jersey's foreclosure distressed property and short sale investing portal. We provide you with critical foreclosure and short sale training required to buy foreclosure and distressed properties, reo foreclosures, home foreclosures, bank foreclosures, foreclosure auctions, government foreclosures, hud foreclosures, and real estate foreclosure forums.
<%
end if
Response.Write " | " & vbNewLine & _
" " & vbNewLine
if strSiteFooter = "1" then
Response.write " " & vbNewLine & _
" "
%>
 |
Copyright
© 2006 Usbankforeclosures.com All rights reserved |
<%
Response.write " " & vbNewLine & _
" " & vbNewLine
end if
Response.write " " & vbNewLine
end if
response.write "" & vbNewLine & _
"" & vbNewLine & _
" |