<% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** CurPageType = "home" CurPageInfoChk = "1" function CurPageInfo () strOnlineQueryString = ChkActUsrUrl(Request.QueryString) PageName = "Home" PageAction = "Browsing
" PageLocation = "Default.asp" CurPageInfo = PageAction & " " & "" & PageName & "" end function %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** on error resume next Session.LCID = 1033 Response.Buffer = true dim strDBType, strConnString, strTablePrefix, strMemberTablePrefix '## 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! 'strConnString = "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=c:\inetpub\dbroot\db2000.mdb" '## MS Access 97 'strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("database/db2000.mdb") '## MS Access 2000 using virtual path strConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=e:\home\Default\basictennis.com\htdocs\maxwebportal\database\db2000.mdb" '## MS Access 2000 'strConnString = "driver={SQL Server};server=SERVER_NAME;uid=SQL_USER;pwd=PASSWORD;database=DATABASE_NAME" '## MS SQL Server 7 'strConnString = "driver=MySQL;server=SERVER_NAME;uid=MYSQL_USER;pwd=PARRWORD;database=DATABASE_NAME" '## MySQL 'strWebMaster should always end with a comma strWebMaster = "admin," strShowImagePoweredBy = "0" '################################################################################# '## Do Not Edit Below This Line - It could destroy your database and lose data '################################################################################# strTablePrefix = "PORTAL_" strMemberTablePrefix = "PORTAL_" dim strSiteTitle, strCopyright, strTitleImage, strHomeURL, strForumURL, strCookieURL, strWebMaster, strWebSiteVersion dim strAuthType, strSetCookieToForum, strForumStatus dim strEmail, strUniqueEmail, strMailMode, strMailServer, strSender dim strDateType, strTimeAdjust, strTimeType, strForumTimeAdjust, strForumDateAdjust dim strMoveTopicMode, strIPLogging, strPrivateForums, strShowModerators, strShowRank, strAllowForumCode, strAllowHTML dim strNoCookies, strEditedByDate dim intHotTopicNum, strHotTopic dim strIMGInPosts, strEmailVal dim strHomepage, strICQ, strAIM, strInForumAdmin, strSecureAdmin, strIcons, strGfxButtons dim strBadWordFilter, strBadWords dim strDefaultFontFace, strDefaultFontSize, strHeaderFontSize, strFooterFontSize dim strPageBGColor, strDefaultFontColor dim strLinkColor, strLinkTextDecoration, strVisitedLinkColor, strVisitedTextDecoration, strActiveLinkColor, strHoverFontColor, strHoverTextDecoration dim strHeadCellColor, strAltHeadCellColor, strHeadFontColor, strCategoryCellColor, strCategoryFontColor dim strForumFirstCellColor, strForumCellColor, strAltForumCellColor, strForumFontColor, strForumLinkColor dim strTableBorderColor, strPopUpTableColor, strPopUpBorderColor, strNewFontColor, strTopicWidthLeft, strTopicNoWrapLeft, strTopicWidthRight, strTopicNoWrapRight dim strRankColor1, strRankColor2, strRankColor3 dim strRankLevel0, strRankLevel1, strRankLevel2, strRankLevel3, strRankLevel4, strRankLevel5 dim intRankLevel0, intRankLevel1, intRankLevel2, intRankLevel3, intRankLevel4, intRankLevel5 dim strShowStatistics, strLogonForMail, strShowPaging, strShowTopicNav, strPageSize, strPageNumberSize dim strNTGroupsSTR, strPollCreate, strFeaturedPoll dim strNewReg, pEnPrefix dim strJokeOfTheWeek, strQuickReply dim strFloodCheck, strFloodCheckTime, strTimeLimit sysDebugMode = "0" strCookieURL = Left(Request.ServerVariables("Path_Info"), InstrRev(Request.ServerVariables("Path_Info"), "/")) strUniqueID = "MWP" pEnPrefix = "" strWebMaster = lcase(strWebMaster) if Application(strCookieURL & "ConfigLoaded")= "" or IsNull(Application(strCookieURL & "ConfigLoaded")) or blnSetup="Y" then '## if the configvariables aren't loaded into the Application object '## or after the admin has changed the configuration '## the variables get (re)loaded set my_Conn = Server.CreateObject("ADODB.Connection") my_Conn.Errors.Clear my_Conn.Open strConnString if blnSetup <> "Y" then for counter = 0 to my_conn.Errors.Count -1 ConnErrorNumber = my_conn.Errors(counter).Number if my_conn.Errors(counter).Number <> 0 then my_conn.Errors.Clear Response.Redirect "site_setup.asp?RC=1&CC=1&strDBType=" & strDBType & "&EC=" & ConnErrorNumber end if next end if my_conn.Errors.Clear '## Forum_SQL strSql = "SELECT C_STRSITETITLE " strSql = strSql & ", C_STRCOPYRIGHT " strSql = strSql & ", C_STRTITLEIMAGE " strSql = strSql & ", C_STRHOMEURL " strSql = strSql & ", C_STRFORUMURL " strSql = strSql & ", C_STRAUTHTYPE " strSql = strSql & ", C_STRSETCOOKIETOFORUM " strSql = strSql & ", C_STREMAIL " strSql = strSql & ", C_STRUNIQUEEMAIL " strSql = strSql & ", C_STRMAILMODE " strSql = strSql & ", C_STRMAILSERVER " strSql = strSql & ", C_STRSENDER " strSql = strSql & ", C_STRDATETYPE " strSql = strSql & ", C_STRTIMEADJUST " strSql = strSql & ", C_STRTIMETYPE " strSql = strSql & ", C_STRMOVETOPICMODE " strSql = strSql & ", C_STRIPLOGGING " strSql = strSql & ", C_STRPRIVATEFORUMS " strSql = strSql & ", C_STRSHOWMODERATORS " strSql = strSql & ", C_STRALLOWFORUMCODE " strSql = strSql & ", C_STRALLOWHTML " strSql = strSql & ", C_STRNOCOOKIES " strSql = strSql & ", C_STRSECUREADMIN " strSql = strSql & ", C_STRHOTTOPIC " strSql = strSql & ", C_INTHOTTOPICNUM " strSql = strSql & ", C_STRIMGINPOSTS " strSql = strSql & ", C_STRHOMEPAGE " strSql = strSql & ", C_STRICQ " strSql = strSql & ", C_STRYAHOO " strSql = strSql & ", C_STRAIM " strSql = strSql & ", C_STRICONS " strSql = strSql & ", C_STRGFXBUTTONS " strSql = strSql & ", C_STREDITEDBYDATE " strSql = strSql & ", C_STRBADWORDFILTER " strSql = strSql & ", C_STRBADWORDS " strSql = strSql & ", C_STRDEFAULTFONTFACE " strSql = strSql & ", C_STRDEFAULTFONTSIZE " strSql = strSql & ", C_STRHEADERFONTSIZE " strSql = strSql & ", C_STRFOOTERFONTSIZE " strSql = strSql & ", C_STRPAGEBGCOLOR " strSql = strSql & ", C_STRDEFAULTFONTCOLOR " strSql = strSql & ", C_STRLINKCOLOR " strSql = strSql & ", C_STRLINKTEXTDECORATION " strSql = strSql & ", C_STRVISITEDLINKCOLOR " strSql = strSql & ", C_STRVISITEDTEXTDECORATION " strSql = strSql & ", C_STRACTIVELINKCOLOR " strSql = strSql & ", C_STRHOVERFONTCOLOR " strSql = strSql & ", C_STRHOVERTEXTDECORATION " strSql = strSql & ", C_STRHEADCELLCOLOR " strSql = strSql & ", C_STRALTHEADCELLCOLOR " strSql = strSql & ", C_STRHEADFONTCOLOR " strSql = strSql & ", C_STRCATEGORYCELLCOLOR " strSql = strSql & ", C_STRCATEGORYFONTCOLOR " strSql = strSql & ", C_STRFORUMFIRSTCELLCOLOR " strSql = strSql & ", C_STRFORUMCELLCOLOR " strSql = strSql & ", C_STRALTFORUMCELLCOLOR " strSql = strSql & ", C_STRFORUMFONTCOLOR " strSql = strSql & ", C_STRFORUMLINKCOLOR " strSql = strSql & ", C_STRTABLEBORDERCOLOR " strSql = strSql & ", C_STRPOPUPTABLECOLOR " strSql = strSql & ", C_STRPOPUPBORDERCOLOR " strSql = strSql & ", C_STRNEWFONTCOLOR " strSql = strSql & ", C_STRTOPICWIDTHLEFT " strSql = strSql & ", C_STRTOPICNOWRAPLEFT " strSql = strSql & ", C_STRTOPICWIDTHRIGHT " strSql = strSql & ", C_STRTOPICNOWRAPRIGHT " strSql = strSql & ", C_STRSHOWRANK " strSql = strSql & ", C_STRRANKADMIN " strSql = strSql & ", C_STRRANKMOD " strSql = strSql & ", C_STRRANKLEVEL0 " strSql = strSql & ", C_STRRANKLEVEL1 " strSql = strSql & ", C_STRRANKLEVEL2 " strSql = strSql & ", C_STRRANKLEVEL3 " strSql = strSql & ", C_STRRANKLEVEL4 " strSql = strSql & ", C_STRRANKLEVEL5 " strSql = strSql & ", C_STRRANKCOLORADMIN " strSql = strSql & ", C_STRRANKCOLORMOD " strSql = strSql & ", C_STRRANKCOLOR0 " strSql = strSql & ", C_STRRANKCOLOR1 " strSql = strSql & ", C_STRRANKCOLOR2 " strSql = strSql & ", C_STRRANKCOLOR3 " strSql = strSql & ", C_STRRANKCOLOR4 " strSql = strSql & ", C_STRRANKCOLOR5 " strSql = strSql & ", C_INTRANKLEVEL0 " strSql = strSql & ", C_INTRANKLEVEL1 " strSql = strSql & ", C_INTRANKLEVEL2 " strSql = strSql & ", C_INTRANKLEVEL3 " strSql = strSql & ", C_INTRANKLEVEL4 " strSql = strSql & ", C_INTRANKLEVEL5 " strSql = strSql & ", C_STRSIGNATURES " strSql = strSql & ", C_STRSHOWSTATISTICS " strSql = strSql & ", C_STRLOGONFORMAIL " strSql = strSql & ", C_STRSHOWPAGING " strSql = strSql & ", C_STRSHOWTOPICNAV " strSql = strSql & ", C_STRPAGESIZE " strSql = strSql & ", C_STRPAGENUMBERSIZE " strSql = strSql & ", C_STRFULLNAME" strSql = strSql & ", C_STRPICTURE" strSql = strSql & ", C_STRSEX" strSql = strSql & ", C_STRCITY" strSql = strSql & ", C_STRSTATE" strSql = strSql & ", C_STRAGE" strSql = strSql & ", C_STRCOUNTRY" strSql = strSql & ", C_STROCCUPATION" strSql = strSql & ", C_STRBIO" strSql = strSql & ", C_STRHOBBIES" strSql = strSql & ", C_STRLNEWS" strSql = strSql & ", C_STRQUOTE" strSql = strSql & ", C_STRMARSTATUS" strSql = strSql & ", C_STRFAVLINKS" strSql = strSql & ", C_STRRECENTTOPICS" strSql = strSql & ", C_STRHOMEPAGE" strSql = strSql & ", C_STRNTGROUPS" strSql = strSql & ", C_STRAUTOLOGON" strSql = strSql & ", C_STREMAILVAL" strSql = strSql & ", C_JOKEOFTHEWEEK" strSql = strSql & ", C_FORUMSTATUS" strSql = strSql & ", C_STRFLOODCHECK" strSql = strSql & ", C_STRFLOODCHECKTIME" strSql = strSql & ", C_POLLCREATE" strSql = strSql & ", C_FEATUREDPOLL" strSql = strSql & ", C_STRNEWREG" strSql = strSql & ", C_STRQUICKREPLY" strSql = strSql & " FROM " & strTablePrefix & "CONFIG " set rsConfig = my_Conn.Execute (strSql) Application.Lock Application(strCookieURL & "strSiteTitle") = rsConfig("C_STRSITETITLE") Application(strCookieURL & "strCopyright") = rsConfig("C_STRCOPYRIGHT") Application(strCookieURL & "strTitleImage") = rsConfig("C_STRTITLEIMAGE") Application(strCookieURL & "strHomeURL") = rsConfig("C_STRHOMEURL") Application(strCookieURL & "strForumURL") = rsConfig("C_STRFORUMURL") Application(strCookieURL & "strAuthType") = rsConfig("C_STRAUTHTYPE") Application(strCookieURL & "strSetCookieToForum") = rsConfig("C_STRSETCOOKIETOFORUM") Application(strCookieURL & "strEmail") = rsConfig("C_STREMAIL") Application(strCookieURL & "strUniqueEmail") = rsConfig("C_STRUNIQUEEMAIL") Application(strCookieURL & "strMailMode") = rsConfig("C_STRMAILMODE") Application(strCookieURL & "strMailServer") = rsConfig("C_STRMAILSERVER") Application(strCookieURL & "strSender") = rsConfig("C_STRSENDER") Application(strCookieURL & "strDateType") = rsConfig("C_STRDATETYPE") Application(strCookieURL & "strTimeAdjust") = rsConfig("C_STRTIMEADJUST") Application(strCookieURL & "strTimeType") = rsConfig("C_STRTIMETYPE") Application(strCookieURL & "strMoveTopicMode") = rsConfig("C_STRMOVETOPICMODE") Application(strCookieURL & "strIPLogging") = rsConfig("C_STRIPLOGGING") Application(strCookieURL & "strPrivateForums") = rsConfig("C_STRPRIVATEFORUMS") Application(strCookieURL & "strShowModerators") = rsConfig("C_STRSHOWMODERATORS") Application(strCookieURL & "strAllowForumCode") = rsConfig("C_STRALLOWFORUMCODE") Application(strCookieURL & "strIMGInPosts") = rsConfig("C_STRIMGINPOSTS") Application(strCookieURL & "strAllowHTML") = rsConfig("C_STRALLOWHTML") Application(strCookieURL & "strNoCookies") = rsConfig("C_STRNOCOOKIES") Application(strCookieURL & "strSecureAdmin") = rsConfig("C_STRSECUREADMIN") Application(strCookieURL & "strHotTopic") = rsConfig("C_STRHOTTOPIC") Application(strCookieURL & "intHotTopicNum") = rsConfig("C_INTHOTTOPICNUM") Application(strCookieURL & "strHomepage") = rsConfig("C_STRHOMEPAGE") Application(strCookieURL & "strICQ") = rsConfig("C_STRICQ") Application(strCookieURL & "strYAHOO") = rsConfig("C_STRYAHOO") Application(strCookieURL & "strAIM") = rsConfig("C_STRAIM") Application(strCookieURL & "strIcons") = rsConfig("C_STRICONS") Application(strCookieURL & "strGfxButtons") = rsConfig("C_STRGFXBUTTONS") Application(strCookieURL & "strEditedByDate") = rsConfig("C_STREDITEDBYDATE") Application(strCookieURL & "strBadWordFilter") = rsConfig("C_STRBADWORDFILTER") Application(strCookieURL & "strBadWords") = rsConfig("C_STRBADWORDS") Application(strCookieURL & "strDefaultFontFace") = rsConfig("C_STRDEFAULTFONTFACE") Application(strCookieURL & "strDefaultFontSize") = rsConfig("C_STRDEFAULTFONTSIZE") Application(strCookieURL & "strHeaderFontSize") = rsConfig("C_STRHEADERFONTSIZE") Application(strCookieURL & "strFooterFontSize") = rsConfig("C_STRFOOTERFONTSIZE") Application(strCookieURL & "strPageBGColor") = rsConfig("C_STRPAGEBGCOLOR") Application(strCookieURL & "strDefaultFontColor") = rsConfig("C_STRDEFAULTFONTCOLOR") Application(strCookieURL & "strLinkColor") = rsConfig("C_STRLINKCOLOR") Application(strCookieURL & "strLinkTextDecoration") = rsConfig("C_STRLINKTEXTDECORATION") Application(strCookieURL & "strVisitedLinkColor") = rsConfig("C_STRVISITEDLINKCOLOR") Application(strCookieURL & "strVisitedTextDecoration") = rsConfig("C_STRVISITEDTEXTDECORATION") Application(strCookieURL & "strActiveLinkColor") = rsConfig("C_STRACTIVELINKCOLOR") Application(strCookieURL & "strHoverFontColor") = rsConfig("C_STRHOVERFONTCOLOR") Application(strCookieURL & "strHoverTextDecoration") = rsConfig("C_STRHOVERTEXTDECORATION") Application(strCookieURL & "strHeadCellColor") = rsConfig("C_STRHEADCELLCOLOR") Application(strCookieURL & "strAltHeadCellColor") = rsConfig("C_STRALTHEADCELLCOLOR") Application(strCookieURL & "strHeadFontColor") = rsConfig("C_STRHEADFONTCOLOR") Application(strCookieURL & "strCategoryCellColor") = rsConfig("C_STRCATEGORYCELLCOLOR") Application(strCookieURL & "strCategoryFontColor") = rsConfig("C_STRCATEGORYFONTCOLOR") Application(strCookieURL & "strForumFirstCellColor") = rsConfig("C_STRFORUMFIRSTCELLCOLOR") Application(strCookieURL & "strForumCellColor") = rsConfig("C_STRFORUMCELLCOLOR") Application(strCookieURL & "strAltForumCellColor") = rsConfig("C_STRALTFORUMCELLCOLOR") Application(strCookieURL & "strForumFontColor") = rsConfig("C_STRFORUMFONTCOLOR") Application(strCookieURL & "strForumLinkColor") = rsConfig("C_STRFORUMLINKCOLOR") Application(strCookieURL & "strTableBorderColor") = rsConfig("C_STRTABLEBORDERCOLOR") Application(strCookieURL & "strPopUpTableColor") = rsConfig("C_STRPOPUPTABLECOLOR") Application(strCookieURL & "strPopUpBorderColor") = rsConfig("C_STRPOPUPBORDERCOLOR") Application(strCookieURL & "strNewFontColor") = rsConfig("C_STRNEWFONTCOLOR") Application(strCookieURL & "strTopicWidthLeft") = rsConfig("C_STRTOPICWIDTHLEFT") Application(strCookieURL & "strTopicNoWrapLeft") = rsConfig("C_STRTOPICNOWRAPLEFT") Application(strCookieURL & "strTopicWidthRight") = rsConfig("C_STRTOPICWIDTHRIGHT") Application(strCookieURL & "strTopicNoWrapRight") = rsConfig("C_STRTOPICNOWRAPRIGHT") Application(strCookieURL & "strShowRank") = rsConfig("C_STRSHOWRANK") Application(strCookieURL & "strRankAdmin") = rsConfig("C_STRRANKADMIN") Application(strCookieURL & "strRankMod") = rsConfig("C_STRRANKMOD") Application(strCookieURL & "strRankLevel0") = rsConfig("C_STRRANKLEVEL0") Application(strCookieURL & "strRankLevel1") = rsConfig("C_STRRANKLEVEL1") Application(strCookieURL & "strRankLevel2") = rsConfig("C_STRRANKLEVEL2") Application(strCookieURL & "strRankLevel3") = rsConfig("C_STRRANKLEVEL3") Application(strCookieURL & "strRankLevel4") = rsConfig("C_STRRANKLEVEL4") Application(strCookieURL & "strRankLevel5") = rsConfig("C_STRRANKLEVEL5") Application(strCookieURL & "strRankColorAdmin") = rsConfig("C_STRRANKCOLORADMIN") Application(strCookieURL & "strRankColorMod") = rsConfig("C_STRRANKCOLORMOD") Application(strCookieURL & "strRankColor0") = rsConfig("C_STRRANKCOLOR0") Application(strCookieURL & "strRankColor1") = rsConfig("C_STRRANKCOLOR1") Application(strCookieURL & "strRankColor2") = rsConfig("C_STRRANKCOLOR2") Application(strCookieURL & "strRankColor3") = rsConfig("C_STRRANKCOLOR3") Application(strCookieURL & "strRankColor4") = rsConfig("C_STRRANKCOLOR4") Application(strCookieURL & "strRankColor5") = rsConfig("C_STRRANKCOLOR5") Application(strCookieURL & "intRankLevel0") = rsConfig("C_INTRANKLEVEL0") Application(strCookieURL & "intRankLevel1") = rsConfig("C_INTRANKLEVEL1") Application(strCookieURL & "intRankLevel2") = rsConfig("C_INTRANKLEVEL2") Application(strCookieURL & "intRankLevel3") = rsConfig("C_INTRANKLEVEL3") Application(strCookieURL & "intRankLevel4") = rsConfig("C_INTRANKLEVEL4") Application(strCookieURL & "intRankLevel5") = rsConfig("C_INTRANKLEVEL5") Application(strCookieURL & "strShowStatistics") = rsconfig("C_STRSHOWSTATISTICS") Application(strCookieURL & "strLogonForMail") = rsconfig("C_STRLOGONFORMAIL") Application(strCookieURL & "strShowPaging") = rsconfig("C_STRSHOWPAGING") Application(strCookieURL & "strShowTopicNav") = rsconfig("C_STRSHOWTOPICNAV") Application(strCookieURL & "strPageSize") = rsconfig("C_STRPAGESIZE") Application(strCookieURL & "strPageNumberSize") = rsconfig("C_STRPAGENUMBERSIZE") Application(strCookieURL & "strFullName") = rsconfig("C_STRFULLNAME") Application(strCookieURL & "strPicture") = rsconfig("C_STRPICTURE") Application(strCookieURL & "strSex") = rsconfig("C_STRSEX") Application(strCookieURL & "strCity") = rsconfig("C_STRCITY") Application(strCookieURL & "strState") = rsconfig("C_STRSTATE") Application(strCookieURL & "strAge") = rsconfig("C_STRAGE") Application(strCookieURL & "strCountry") = rsconfig("C_STRCOUNTRY") Application(strCookieURL & "strOccupation") = rsconfig("C_STROCCUPATION") Application(strCookieURL & "strBio") = rsconfig("C_STRBIO") Application(strCookieURL & "strHobbies") = rsconfig("C_STRHOBBIES") Application(strCookieURL & "strLNews") = rsconfig("C_STRLNEWS") Application(strCookieURL & "strQuote") = rsconfig("C_STRQUOTE") Application(strCookieURL & "strMarStatus") = rsconfig("C_STRMARSTATUS") Application(strCookieURL & "strFavLinks") = rsconfig("C_STRFAVLINKS") Application(strCookieURL & "strRecentTopics") = rsconfig("C_STRRECENTTOPICS") Application(strCookieURL & "strHomePage") = rsconfig("C_STRHOMEPAGE") Application(strCookieURL & "STRNTGROUPS") = rsConfig("C_STRNTGROUPS") Application(strCookieURL & "STRAUTOLOGON") = rsConfig("C_STRAUTOLOGON") Application(strCookieURL & "strEmailVal") = rsConfig("C_STREMAILVAL") Application(strCookieURL & "strJokeOfTheWeek") = rsConfig("C_JOKEOFTHEWEEK") Application(strCookieURL & "strForumStatus") = rsConfig("C_FORUMSTATUS") Application(strCookieURL & "strFloodCheck") = rsConfig("C_STRFLOODCHECK") Application(strCookieURL & "strFloodCheckTime") = rsConfig("C_STRFLOODCHECKTIME") Application(strCookieURL & "strPollCreate") = rsConfig("C_POLLCREATE") Application(strCookieURL & "strFeaturedPoll") = rsConfig("C_FEATUREDPOLL") Application(strCookieURL & "strNewReg") = rsConfig("C_STRNEWREG") Application(strCookieURL & "strQuickReply") = rsConfig("C_STRQUICKREPLY") Application.UnLock if blnSetup <> "Y" then for counter = 0 to my_Conn.Errors.Count -1 if my_Conn.Errors(counter).Number <> 0 or Err.number > 0 then myConnError = my_Conn.Errors(counter).Number my_Conn.Errors.Clear Err.Clear my_Conn.Close set my_Conn = nothing Response.Redirect "site_setup.asp?RC=2&CC=1&strDBType="& strDBType & "&EC=" & myConnError end if next end if my_Conn.Close set my_Conn = nothing Application.Lock Application(strCookieURL & "ConfigLoaded")= "YES" Application.UnLock end if okoame = 1 ' ## Read the config-info from the application variables... strSiteTitle = Application(strCookieURL & "strSiteTitle") 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") 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 = Application(strCookieURL & "intHotTopicNum") strICQ = Application(strCookieURL & "strICQ") strYAHOO = Application(strCookieURL & "strYAHOO") strAIM = Application(strCookieURL & "strAIM") strFullName = Application(strCookieURL & "strFullName") strPicture = Application(strCookieURL & "strPicture") strSex = Application(strCookieURL & "strSex") strCity= Application(strCookieURL & "strCity") strState = Application(strCookieURL & "strState") strAge = Application(strCookieURL & "strAge") 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") strUseExtendedProfile = (strBio + strHobbies + strLNews + strRecentTopics + strPicture) > 0 strUseExtendedProfile = strUseExtendedProfile or ((strICQ + strYAHOO + strAIM + strFullName*2 + strSex + strCity + strState + strAge + strCountry + strOccupation + strFavLinks*2) > 5) strIcons = Application(strCookieURL & "strIcons") strGfxButtons = Application(strCookieURL & "strGfxButtons") strEditedByDate = Application(strCookieURL & "strEditedByDate") strBadWordFilter = Application(strCookieURL & "strBadWordFilter") strBadWords = Application(strCookieURL & "strBadWords") 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") strHoverFontColor = Application(strCookieURL & "strHoverFontColor") strHoverTextDecoration = Application(strCookieURL & "strHoverTextDecoration") strHeadCellColor = Application(strCookieURL & "strHeadCellColor") strAltHeadCellColor = Application(strCookieURL & "strAltHeadCellColor") 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") strTableBorderColor = Application(strCookieURL & "strTableBorderColor") strPopUpTableColor = Application(strCookieURL & "strPopUpTableColor") strPopUpBorderColor = Application(strCookieURL & "strPopUpBorderColor") strNewFontColor = Application(strCookieURL & "strNewFontColor") 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") 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()) strForumDateAdjust = strToDate(DateToStr(ChkDate(DateToStr(strForumTimeAdjust)))) strNTGroups = Application(strCookieURL & "STRNTGROUPS") strAutoLogon = Application(strCookieURL & "STRAUTOLOGON") strEmailVal = Application(strCookieURL & "STREMAILVAL") strJokeOfTheWeek = Application(strCookieURL & "strJokeOfTheWeek") strForumStatus = Application(strCookieURL & "strForumStatus") strFloodCheck = Application(strCookieURL & "STRFLOODCHECK") strFloodCheckTime = Application(strCookieURL & "STRFLOODCHECKTIME") strPollCreate = Application(strCookieURL & "STRPOLLCREATE") strFeaturedPoll = Application(strCookieURL & "STRFEATUREDPOLL") strNewReg = Application(strCookieURL & "STRNEWREG") strQuickReply = Application(strCookieURL & "STRQUICKREPLY") if strSecureAdmin = "0" then Session(strCookieURL & "Approval") = "256697926329" end if on error goto 0 if strAuthType = "db" then strDBNTSQLName = "M_NAME" strAutoLogon ="0" strNTGroups ="0" else strDBNTSQLName = "M_USERNAME" end if %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# Function ChkActUsrUrl(strTString) strTString = replace(strTString, "<"," ", 1, -1, 1) strTString = replace(strTString, ">"," ", 1, -1, 1) strTString = replace(strTString, """"," ", 1, -1, 1) strTString = replace(strTString, "'"," ", 1, -1, 1) strTString = replace(strTString, ";"," ", 1, -1, 1) ChkActUsrUrl = strTString end function Function ReplaceImageTags(fString) Dim oTag, cTag Dim roTag, rcTag Dim oTagPos, cTagPos Dim nTagPos Dim counter1, counter2 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 > 0) then strArray = Split(strTempString, oTag, -1) for counter2 = 0 to Ubound(strArray) if (Instr(1, strArray(counter2), cTag) > 0) then strArray2 = split(strArray(counter2), cTag, -1) strUrlText = strArray2(0) strUrlText = replace(strUrlText, """", "") ' ## filter out " strUrlText = replace(strUrlText, "<", "") ' ## filter out < strUrlText = replace(strUrlText, ">", "") ' ## filter out > strUrlText = replace(strUrlText, "+", "") ' ## filter out + strUrlText = replace(strUrlText, "(", "") ' ## filter out ( strUrlText = replace(strUrlText, ")", "") ' ## filter out ) strUrlText = replace(strUrlText, ";", "") ' ## filter out ; strUrlText = replace(strUrlText, "'", "") ' ## filter out ' strUrlText = replace(strUrlText, "=", "") ' ## filter out = strUrlText = replace(strUrlText, "&", "") ' ## filter out & strUrlText = replace(strUrlText, "#", "") ' ## 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 strResultString = strResultString & roTag & strUrlText & rcTag & strArray2(1) else strResultString = strResultString & strArray(counter2) end if next strTempString = strResultString strResultString = "" end if next ReplaceImageTags = strTempString end function function CheckSelected(ByVal chkval1, chkval2) if IsNumeric(chkval1) Then chkval1 = CInt(chkval1) if (chkval1 = chkval2) then CheckSelected = " selected" else CheckSelected = "" end if end function function ChkUrls(fString, fTestTag, fType) Dim strArray Dim Counter Dim strTempString strTempString = fString if Instr(1, fString, fTestTag) > 0 then strArray = Split(fString, fTestTag, -1) strTempString = strArray(0) for counter = 1 to UBound(strArray) if ((strArray(counter-1) = "" or len(strArray(counter-1)) < 5) and strArray(counter)<> "") then strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType) elseif ((UCase(right(strArray(counter-1),6)) <> "HREF=""") and (UCase(right(strArray(counter-1),5)) <> "[URL]") and (UCase(right(strArray(counter-1),6)) <> "[URL=""") and (UCase(right(strArray(counter-1),7)) <> "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),5)) <> "SRC=""") and strArray(counter)<> "") then strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType) else strTempString = strTempString & fTestTag & strArray(counter) end if next end if ChkUrls = strTempString end function function ChkMail(fString, fTestTag, fType) Dim strArray Dim Counter Dim strTempString strTempString = fString if Instr(1, fString, fTestTag) > 0 then strArray = Split(fString, fTestTag, -1) strTempString = "" ' strTempString = strArray(0) for counter = 0 to UBound(strArray) if (Instr(strArray(counter), "@") > 0) and not(Instr(strArray(counter), "mailto:") > 0) and not(Instr(UCase(strArray(counter)), "[URL") > 0) then strTempString = strTempString & edit_hrefs("" & fTestTag & strArray(counter), fType) else strTempString = strTempString & fTestTag & strArray(counter) end if next end if ChkMail = strTempString 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 then fString = ChkBadWords(fString) end if fString = ChkUrls(fString,"http://", 1) fString = ChkUrls(fString,"https://", 2) fString = ChkUrls(fString,"file:///", 3) fString = ChkUrls(fString,"www.", 4) fString = ChkUrls(fString,"mailto:",5) fString = ChkMail(fString," ",5) 'fString = edit_hrefs(fString, 5) fString = ReplaceUrls(fString) FormatStr = fString end function okoame=26314564+okoame function doublenum(fNum) if fNum > 9 then doublenum = fNum else doublenum = "0" & fNum end if end function function widenum(fNum) if fNum > 9 then widenum = "" else widenum = " " end if end function function Chked(fYN) if fYN = "yes" or fYN = "1" or fYN = 1 then '** Chked = " Checked" else Chked = "" end if 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 CleanCode(fString) if fString = "" then fString = " " else if strAllowForumCode = "1" then fString = replace(fString, "", "[marquee]", 1, -1, 1) fString = replace(fString, "", "[/marquee]", 1, -1, 1) fString = replace(fString, "", "[sup]", 1, -1, 1) fString = replace(fString, "", "[/sup]", 1, -1, 1) fString = replace(fString, "", "[sub]", 1, -1, 1) fString = replace(fString, "", "[/sub]", 1, -1, 1) fString = replace(fString, "", "[tt]", 1, -1, 1) fString = replace(fString, "", "[/tt]", 1, -1, 1) fString = replace(fString, "", "[hl]", 1, -1, 1) fString = replace(fString, "", "[/hl]", 1, -1, 1) fString = replace(fString, "

", "[pre]", 1, -1, 1)
			fString = replace(fString, "
", "[/pre]", 1, -1, 1) fString = replace(fString, "
","[hr]", 1, -1, 1) fString = replace(fString, "","[b]", 1, -1, 1) fString = replace(fString, "","[/b]", 1, -1, 1) fString = replace(fString, "", "[s]", 1, -1, 1) fString = replace(fString, "", "[/s]", 1, -1, 1) fString = replace(fString, "","[u]", 1, -1, 1) fString = replace(fString, "","[/u]", 1, -1, 1) fString = replace(fString, "","[i]", 1, -1, 1) fString = replace(fString, "","[/i]", 1, -1, 1) fString = replace(fString, "", "[font=Andale Mono]", 1, -1, 1) fString = replace(fString, "", "[/font=Andale Mono]", 1, -1, 1) fString = replace(fString, "", "[font=Arial]", 1, -1, 1) fString = replace(fString, "", "[/font=Arial]", 1, -1, 1) fString = replace(fString, "", "[font=Arial Black]", 1, -1, 1) fString = replace(fString, "", "[/font=Arial Black]", 1, -1, 1) fString = replace(fString, "", "[font=Book Antiqua]", 1, -1, 1) fString = replace(fString, "", "[/font=Book Antiqua]", 1, -1, 1) fString = replace(fString, "", "[font=Century Gothic]", 1, -1, 1) fString = replace(fString, "", "[/font=Century Gothic]", 1, -1, 1) fString = replace(fString, "", "[font=Comic Sans MS]", 1, -1, 1) fString = replace(fString, "", "[/font=Comic Sans MS]", 1, -1, 1) fString = replace(fString, "", "[font=Courier New]", 1, -1, 1) fString = replace(fString, "", "[/font=Courier New]", 1, -1, 1) fString = replace(fString, "", "[font=Georgia]", 1, -1, 1) fString = replace(fString, "", "[/font=Georgia]", 1, -1, 1) fString = replace(fString, "", "[font=Impact]", 1, -1, 1) fString = replace(fString, "", "[/font=Impact]", 1, -1, 1) fString = replace(fString, "", "[font=Tahoma]", 1, -1, 1) fString = replace(fString, "", "[/font=Tahoma]", 1, -1, 1) fString = replace(fString, "", "[font=Times New Roman]", 1, -1, 1) fString = replace(fString, "", "[/font=Times New Roman]", 1, -1, 1) fString = replace(fString, "", "[font=Trebuchet MS]", 1, -1, 1) fString = replace(fString, "", "[/font=Trebuchet MS]", 1, -1, 1) fString = replace(fString, "", "[font=Script MT Bold]", 1, -1, 1) fString = replace(fString, "", "[/font=Script MT Bold]", 1, -1, 1) fString = replace(fString, "", "[font=Stencil]", 1, -1, 1) fString = replace(fString, "", "[/font=Stencil]", 1, -1, 1) fString = replace(fString, "", "[font=Verdana]", 1, -1, 1) fString = replace(fString, "", "[/font=Verdana]", 1, -1, 1) fString = replace(fString, "", "[font=Lucida Console]", 1, -1, 1) fString = replace(fString, "", "[/font=Lucida Console]", 1, -1, 1) fString = replace(fString, "", "[red]", 1, -1, 1) fString = replace(fString, "", "[/red]", 1, -1, 1) fString = replace(fString, "", "[green]", 1, -1, 1) fString = replace(fString, "", "[/green]", 1, -1, 1) fString = replace(fString, "", "[blue]", 1, -1, 1) fString = replace(fString, "", "[/blue]", 1, -1, 1) fString = replace(fString, "", "[white]", 1, -1, 1) fString = replace(fString, "", "[/white]", 1, -1, 1) fString = replace(fString, "", "[purple]", 1, -1, 1) fString = replace(fString, "", "[/purple]", 1, -1, 1) fString = replace(fString, "", "[yellow]", 1, -1, 1) fString = replace(fString, "", "[/yellow]", 1, -1, 1) fString = replace(fString, "", "[violet]", 1, -1, 1) fString = replace(fString, "", "[/violet]", 1, -1, 1) fString = replace(fString, "", "[brown]", 1, -1, 1) fString = replace(fString, "", "[/brown]", 1, -1, 1) fString = replace(fString, "", "[black]", 1, -1, 1) fString = replace(fString, "", "[/black]", 1, -1, 1) fString = replace(fString, "", "[pink]", 1, -1, 1) fString = replace(fString, "", "[/pink]", 1, -1, 1) fString = replace(fString, "", "[orange]", 1, -1, 1) fString = replace(fString, "", "[/orange]", 1, -1, 1) fString = replace(fString, "", "[gold]", 1, -1, 1) fString = replace(fString, "", "[/gold]", 1, -1, 1) fString = replace(fString, "", "[beige]", 1, -1, 1) fString = replace(fString, "", "[/beige]", 1, -1, 1) fString = replace(fString, "", "[teal]", 1, -1, 1) fString = replace(fString, "", "[/teal]", 1, -1, 1) fString = replace(fString, "", "[navy]", 1, -1, 1) fString = replace(fString, "", "[/navy]", 1, -1, 1) fString = replace(fString, "", "[maroon]", 1, -1, 1) fString = replace(fString, "", "[/maroon]", 1, -1, 1) fString = replace(fString, "", "[limegreen]", 1, -1, 1) fString = replace(fString, "", "[/limegreen]", 1, -1, 1) fString = replace(fString, "

", "[h1]", 1, -1, 1) fString = replace(fString, "

", "[/h1]", 1, -1, 1) fString = replace(fString, "

", "[h2]", 1, -1, 1) fString = replace(fString, "

", "[/h2]", 1, -1, 1) fString = replace(fString, "

", "[h3]", 1, -1, 1) fString = replace(fString, "

", "[/h3]", 1, -1, 1) fString = replace(fString, "

", "[h4]", 1, -1, 1) fString = replace(fString, "

", "[/h4]", 1, -1, 1) fString = replace(fString, "
", "[h5]", 1, -1, 1) fString = replace(fString, "
", "[/h5]", 1, -1, 1) fString = replace(fString, "
", "[h6]", 1, -1, 1) fString = replace(fString, "
", "[/h6]", 1, -1, 1) fString = replace(fString, "", "[size=1]", 1, -1, 1) fString = replace(fString, "", "[/size=1]", 1, -1, 1) fString = replace(fString, "", "[size=2]", 1, -1, 1) fString = replace(fString, "", "[/size=2]", 1, -1, 1) fString = replace(fString, "", "[size=3]", 1, -1, 1) fString = replace(fString, "", "[/size=3]", 1, -1, 1) fString = replace(fString, "", "[size=4]", 1, -1, 1) fString = replace(fString, "", "[/size=4]", 1, -1, 1) fString = replace(fString, "", "[size=5]", 1, -1, 1) fString = replace(fString, "", "[/size=5]", 1, -1, 1) fString = replace(fString, "", "[size=6]", 1, -1, 1) fString = replace(fString, "", "[/size=6]", 1, -1, 1) fString = replace(fString, "
","[br]", 1, -1, 1) fString = replace(fString, "
", "[left]", 1, -1, 1) fString = replace(fString, "
", "[/left]", 1, -1, 1) fString = replace(fString, "
","[center]", 1, -1, 1) fString = replace(fString, "
","[/center]", 1, -1, 1) fString = replace(fString, "
", "[right]", 1, -1, 1) fString = replace(fString, "
", "[/right]", 1, -1, 1) fString = replace(fString, "","[/list]", 1, -1, 1) fString = replace(fString, "
    ","[list=1]", 1, -1, 1) fString = replace(fString, "
","[/list=1]", 1, -1, 1) fString = replace(fString, "
    ","[list=a]", 1, -1, 1) fString = replace(fString, "
","[/list=a]", 1, -1, 1) fString = replace(fString, "
  • ","[*]", 1, -1, 1) fString = replace(fString, "
  • ","[/*]", 1, -1, 1) fString = replace(fString, "
    quote:
    ","[quote]", 1, -1, 1) fString = replace(fString, "
    ","[/quote]", 1, -1, 1) fString = replace(fString, "
    ","[code]", 1, -1, 1)
    			fString = replace(fString, "
    ","[/code]", 1, -1, 1) if strIMGInPosts = "1" then fString = replace(fString, "","[/img]", 1, -1, 1) fString = replace(fString, """ id=right border=0>","[/img=right]", 1, -1, 1) fString = replace(fString, """ id=left border=0>","[/img=left]", 1, -1, 1) end if end if if strIcons = "1" then fString= replace(fString, "", "[:(!]", 1, -1, 1) fString= replace(fString, "", "[B)]", 1, -1, 1) fString= replace(fString, "", "[xx(]", 1, -1, 1) fString= replace(fString, "", "[XX(]", 1, -1, 1) fString= replace(fString, "", "[:O]", 1, -1, 1) fString= replace(fString, "", "[:o]", 1, -1, 1) fString= replace(fString, "", "[:0]", 1, -1, 1) fString= replace(fString, "", "[:I]", 1, -1, 1) fString= replace(fString, "", "[:(]", 1, -1, 1) fString= replace(fString, "", "[8)]", 1, -1, 1) fString= replace(fString, "", "[:)]", 1, -1, 1) fString= replace(fString, "", "[}:)]", 1, -1, 1) fString= replace(fString, "", "[:D]", 1, -1, 1) fString= replace(fString, "", "[8D]", 1, -1, 1) fString= replace(fString, "", "[|)]", 1, -1, 1) fString= replace(fString, "", "[:o)]", 1, -1, 1) fString= replace(fString, "", "[:O)]", 1, -1, 1) fString= replace(fString, "", "[:0)]", 1, -1, 1) fString= replace(fString, "", "[:P]", 1, -1, 1) fString= replace(fString, "", "[:p]", 1, -1, 1) fString= replace(fString, "", "[;)]", 1, -1, 1) fString= replace(fString, "", "[8]", 1, -1, 1) fString= replace(fString, "", "[?]", 1, -1, 1) fString= replace(fString, "", "[^]", 1, -1, 1) fString= replace(fString, "", "[V]", 1, -1, 1) fString= replace(fString, "", "[v]", 1, -1, 1) fString= replace(fString, "", "[:X]", 1, -1, 1) fString= replace(fString, "", "[:x]", 1, -1, 1) end if end if fString = Replace(fString, "'", "'") CleanCode = fString end function function Smile(fString) fString = replace(fString, "[:(!]", "") fString = replace(fString, "[B)]", "") fString = replace(fString, "[xx(]", "") fString = replace(fString, "[XX(]", "") fString = replace(fString, "[:I]", "") fString = replace(fString, "[:(]", "") fString = replace(fString, "[:o]", "") fString = replace(fString, "[:O]", "") fString = replace(fString, "[:0]", "") fString = replace(fString, "[|)]", "") fString = replace(fString, "[:)]", "") fString = replace(fString, "[:D]", "") fString = replace(fString, "[}:)]", "") fString = replace(fString, "[:o)]", "") fString = replace(fString, "[:O)]", "") fString = replace(fString, "[:0)]", "") fString = replace(fString, "[8)]", "") fString = replace(fString, "[8D]", "") fString = replace(fString, "[:P]", "") fString = replace(fString, "[:p]", "") fString = replace(fString, "[;)]", "") fString = replace(fString, "[8]", "") fString = replace(fString, "[?]", "") fString = replace(fString, "[^]", "") fString = replace(fString, "[V]", "") fString = replace(fString, "[v]", "") fString = replace(fString, "[:X]", "") fString = replace(fString, "[:x]", "") Smile = fString end function function ChkBadWords(fString) bwords = split(strBadWords, "|") for i = 0 to ubound(bwords) fString = Replace(fString, bwords(i), string(len(bwords(i)),"*"), 1,-1,1) next ChkBadWords = fString end function function HTMLEncode(fString) if trim(fString) = "" or isNull(fString) then HTMLEncode = " " else fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") HTMLEncode = fString end if end function function HTMLDecode(fString) if trim(fString) = "" or isNull(fString) then HTMLDecode = " " else fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") HTMLDecode = fString end if end function function ChkString(fString,fField_Type) '## Types - name, password, title, message, url, urlpath, email, number, list fString = trim(fString) if fString = "" then fString = " " else ' ChkBadWords(fString) end if if fField_Type = "decode" then fString = HTMLDecode(fString) ChkString = fString exit function end if if fField_Type = "urlpath" then fString = Server.URLEncode(fString) ChkString = fString exit function end if if fField_Type = "SQLString" then fString = Replace(fString, "'", "''") fString = HTMLEncode(fString) ChkString = fString exit function end if if fField_Type = "JSurlpath" then fString = Replace(fString, "'", "\'") fString = Server.URLEncode(fString) ChkString = fString exit function end if if fField_Type = "edit" then if strAllowHTML <> "1" then fString = HTMLEncode(fString) end if fString = Replace(fString, """", """) ChkString = fString exit function end if if fField_Type = "display" then 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 elseif fField_Type = "message" then if strAllowHTML <> "1" then fString = HTMLEncode(fString) end if elseif fField_Type = "hidden" then fString = HTMLEncode(fString) end if if fField_Type = "displayimage" then fString = Replace(fString, " ", "") fString = Replace(fString, """", "") fString = Replace(fString, "<", "") fString = Replace(fString, ">", "") chkString = fString exit function end if if strAllowForumCode = "1" and fField_Type <> "signature" then fString = doCode(fString, "[marquee]", "[/marquee]", "", "") fString = doCode(fString, "[sup]", "[/sup]", "", "") fString = doCode(fString, "[sub]", "[/sub]", "", "") fString = doCode(fString, "[tt]", "[/tt]", "", "") fString = doCode(fString, "[hl]", "[/hl]", "", "") fString = doCode(fString, "[pre]", "[/pre]", "
    ", "
    ") fString = replace(fString, "[hr]", "
    ", 1, -1, 1) 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 = doCode(fString, "[quote]", "[/quote]", "
    quote:
    ", "
    ") fString = replace(fString, "[br]", "
    ", 1, -1, 1) if strIMGInPosts = "1" then fString = ReplaceImageTags(fString) end if end if end if if strIcons = "1" and _ fField_Type <> "title" and _ fField_Type <> "hidden" then fString= smile(fString) end if if fField_Type = "preview" then if strAllowHTML <> "1" then fString = HTMLEncode(fString) end if end if if fField_Type <> "hidden" and _ fField_Type <> "preview" then fString = Replace(fString, "'", "''") end if ChkString = fString end function function ChkDateTime(fDateTime) if fDateTime = "" then exit function end if if IsDate(fDateTime) then select case strDateType case "dmy" ChkDateTime = Mid(fDateTime,7,2) & "/" & _ Mid(fDateTime,5,2) & "/" & _ Mid(fDateTime,1,4) case "mdy" ChkDateTime = Mid(fDateTime,5,2) & "/" & _ Mid(fDateTime,7,2) & "/" & _ Mid(fDateTime,1,4) case "ymd" ChkDateTime = Mid(fDateTime,1,4) & "/" & _ Mid(fDateTime,5,2) & "/" & _ Mid(fDateTime,7,2) case "ydm" ChkDateTime =Mid(fDateTime,1,4) & "/" & _ Mid(fDateTime,7,2) & "/" & _ Mid(fDateTime,5,2) case "dmmy" ChkDateTime = Mid(fDateTime,7,2) & " " & _ Monthname(Mid(fDateTime,5,2),1) & " " & _ Mid(fDateTime,1,4) case "mmdy" ChkDateTime = Monthname(Mid(fDateTime,5,2),1) & " " & _ Mid(fDateTime,7,2) & " " & _ Mid(fDateTime,1,4) case "ymmd" ChkDateTime = Mid(fDateTime,1,4) & " " & _ Monthname(Mid(fDateTime,5,2),1) & " " & _ Mid(fDateTime,7,2) case "ydmm" ChkDateTime = Mid(fDateTime,1,4) & " " & _ Mid(fDateTime,7,2) & " " & _ Monthname(Mid(fDateTime,5,2),1) case "dmmmy" ChkDateTime = Mid(fDateTime,7,2) & " " & _ Monthname(Mid(fDateTime,5,2),0) & " " & _ Mid(fDateTime,1,4) case "mmmdy" ChkDateTime = Monthname(Mid(fDateTime,5,2),0) & " " & _ Mid(fDateTime,7,2) & " " & _ Mid(fDateTime,1,4) case "ymmmd" ChkDateTime = Mid(fDateTime,1,4) & " " & _ Monthname(Mid(fDateTime,5,2),0) & " " & _ Mid(fDateTime,7,2) case "ydmmm" ChkDateTime = Mid(fDateTime,1,4) & " " & _ Mid(fDateTime,7,2) & " " & _ Monthname(Mid(fDateTime,5,2),0) case else ChkDateTime = doublenum(Mid(fDateTime,5,2)) & "/" & _ Mid(fDateTime,7,2) & "/" & _ Mid(fDateTime,1,4) end select if strTimeType = 12 then if cint(Mid(fDateTime, 9,2)) > 12 then ChkDateTime = ChkDateTime & " " & _ (cint(Mid(fDateTime, 9,2)) -12) & ":" & _ Mid(fDateTime, 11,2) & ":" & _ Mid(fDateTime, 13,2) & " " & "PM" elseif cint(Mid(fDateTime, 9,2)) = 12 then ChkDateTime = ChkDateTime & " " & _ cint(Mid(fDateTime, 9,2)) & ":" & _ Mid(fDateTime, 11,2) & ":" & _ Mid(fDateTime, 13,2) & " " & "PM" elseif cint(Mid(fDateTime, 9,2)) = 0 then ChkDateTime = ChkDateTime & " " & _ (cint(Mid(fDateTime, 9,2)) +12) & ":" & _ Mid(fDateTime, 11,2) & ":" & _ Mid(fDateTime, 13,2) & " " & "AM" else ChkDateTime = ChkDateTime & " " & _ Mid(fDateTime, 9,2) & ":" & _ Mid(fDateTime, 11,2) & ":" & _ Mid(fDateTime, 13,2) & " " & "AM" end if else ChkDateTime = ChkDateTime & " " & _ Mid(fDateTime, 9,2) & ":" & _ Mid(fDateTime, 11,2) & ":" & _ Mid(fDateTime, 13,2) end if 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 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 = "" & strForumTimeAdjust end if end function function DateToStr(dtDateTime) DateToStr = year(dtDateTime) & doublenum(Month(dtdateTime)) & doublenum(Day(dtdateTime)) & doublenum(Hour(dtdateTime)) & doublenum(Minute(dtdateTime)) & doublenum(Second(dtdateTime)) & "" end function function ReadLastHereDate(UserName) dim TempLastHereDate dim rs_date '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.M_LASTHEREDATE " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS."&Strdbntsqlname&" = '" & UserName & "' " set rs_date = my_conn.Execute (strSql) if (rs_date.BOF and rs_date.EOF) then TempLastHereDate = DateAdd("d",-10,strForumTimeAdjust) else TempLastHereDate = StrToDate(rs_date("M_LASTHEREDATE")) if TempLastHereDate = "" or IsNull(TempLastHereDate) then TempLastHereDate = DateAdd("d",-10,strForumTimeAdjust) end if end if rs_date.close set rs_date = nothing '## Forum_SQL - Do DB Update strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " SET M_LASTHEREDATE = '" & DateToStr(strForumTimeAdjust) & "', M_LAST_IP = '" & Request.ServerVariables("REMOTE_HOST") & "' " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & UserName & "' " my_conn.Execute (strSql) ReadLastHereDate = DateToStr(TempLastHereDate) end function function getMemberID(fUser_Name) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE M_NAME = '" & fUser_Name & "'" rsGetMemberID = my_Conn.Execute(strSql) getMemberID = rsGetMemberID("MEMBER_ID") end function function ChkDate(fDate) if fDate = "" then exit function end if 'if IsDate(fDate) then 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 'end if end function function ChkTime(fTime) if fTime = "" then exit function end if if strTimeType = 12 then if cint(Mid(fTime, 9,2)) > 12 then ChkTime = ChkTime & " " & _ (cint(Mid(fTime, 9,2)) -12) & ":" & _ Mid(fTime, 11,2) & ":" & _ Mid(fTime, 13,2) & " " & "PM" elseif cint(Mid(fTime, 9,2)) = 12 then ChkTime = ChkTime & " " & _ cint(Mid(fTime, 9,2)) & ":" & _ Mid(fTime, 11,2) & ":" & _ Mid(fTime, 13,2) & " " & "PM" elseif cint(Mid(fTime, 9,2)) = 0 then ChkTime = ChkTime & " " & _ (cint(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 EmailField(fTestString) TheAt = Instr(2, fTestString, "@") if TheAt = 0 then EmailField = 0 else TheDot = Instr(cint(TheAt) + 2, fTestString, ".") if TheDot = 0 then EmailField = 0 else if cint(TheDot) + 1 > Len(fTestString) then EmailField = 0 else EmailField = -1 end if end if end if end function function ChkIsNew(fDateTime) if strHotTopic = "1" then if fDateTime > Session(strCookieURL & "last_here_date") then if rs("T_REPLIES") >= intHotTopicNum then ChkIsNew = "HotTopic" else ChkIsNew = "NewTopic" end if else if rs("T_REPLIES") >= intHotTopicNum then ChkIsNew = "HotTopic" else ChkIsNew = "" end if end if else if fDateTime > Session(strCookieURL & "last_here_date") then ChkIsNew = "NewTopic" else ChkIsNew = "" end if end if end function function ChkQuoteOk(fString) ChkQuoteOk = not(InStr(1, fString, "'", 0) > 0) end function function ChkUser(fName, fPassword) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' " if strAuthType="db" then strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'" End IF strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1 set rsCheck = my_Conn.Execute (strSql) if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then ChkUser = 0 else if cstr(rsCheck("MEMBER_ID")) = Request.Form("Author") then ChkUser = 1 '## Author else Select case cint(rsCheck("M_LEVEL")) case 1 ChkUser = 2 '## Normal User case 2 ChkUser = 3 '## Moderator case 3 ChkUser = 4 '## Admin case else ChkUser = cint(rsCheck("M_LEVEL")) End Select end if end if rsCheck.close set rsCheck = nothing end function function ChkUser2(fName, fPassword) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " StrSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' " if strAuthType="db" then strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"'" End If strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1 on error resume next set rsCheck = my_Conn.Execute (strSql) for counter = 0 to my_Conn.Errors.Count -1 if my_Conn.Errors(counter).Number <> 0 or Err.number > 0 then ChkUser2 = -1 my_Conn.Errors.Clear end if next if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) or ChkUser2 = -1 then ChkUser2 = 0 '## Invalid Password else if cint(rsCheck("MEMBER_ID")) = cint(Request.QueryString("Author")) then ChkUser2 = 1 '## Author else select case cint(rsCheck("M_LEVEL")) case 1 ChkUser2 = 2 '## Normal User case 2 ChkUser2 = 3 '## Moderator case 3 ChkUser2 = 4 '## Admin case else ChkUser2 = cint(rsCheck("M_LEVEL")) end select end if end if rsCheck.close set rsCheck = nothing end function function ChkUser3(fName, fPassword, fReply) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_NAME, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD, " & strTablePrefix & "REPLY.R_AUTHOR " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS, " & strTablePrefix & "REPLY " StrSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fName & "' " if strAuthType="db" then strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_PASSWORD = '" & fPassword &"' " End If strSql = strSql & " AND " & strTablePrefix & "REPLY.REPLY_ID = " & fReply strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1 set rsCheck = my_Conn.Execute (strSql) if rsCheck.BOF or rsCheck.EOF or not(ChkQuoteOk(fName)) or not(ChkQuoteOk(fPassword)) then ChkUser3 = 0 '## Invalid Password else if cint(rsCheck("MEMBER_ID")) = cint(rsCheck("R_AUTHOR")) then ChkUser3 = 1 '## Author else Select case cint(rsCheck("M_LEVEL")) case 1 ChkUser3 = 2 '## Normal User case 2 ChkUser3 = 3 '## Moderator case 3 ChkUser3 = 4 '## Admin case else ChkUser3 = cint(rsCheck("M_LEVEL")) End Select end if end if rsCheck.close set rsCheck = nothing end function function GetSig(fUser_Name) '## Forum_SQL strSql = "SELECT M_SIG " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE M_NAME = '" & fUser_Name & "'" set rsSig = my_Conn.Execute (strSql) if rsSig.EOF or rsSig.BOF then '## Do Nothing else GetSig = rsSig("M_SIG") end if rsSig.close set rsSig = nothing end function function DoDropDown(fTableName, fDisplayField, fValueField, fSelectValue, fName) '## Forum_SQL strSql = "SELECT " & fDisplayField & ", " & fValueField strSql = strSql & " FROM " & fTableName rsdrop.Open strSql, my_Conn Response.Write "" & vbCrLf rsdrop.Close set rsdrop = nothing end function sub DoULastPost(sUser_Name) '## Forum_SQL - Updates the M_LASTPOSTDATE in the MEMBERS table strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " SET M_LASTPOSTDATE = '" & DateToStr(strForumTimeAdjust) & "' " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & sUser_Name & "'" my_Conn.Execute (strSql) end sub '############################################## '## Ranks and Stars ## '############################################## function getMember_Level(fM_TITLE, fM_LEVEL, fM_POSTS) dim Member_Level Member_Level = "" if Trim(fM_TITLE) <> "" then Member_Level = fM_TITLE else select case fM_LEVEL case "1" if (fM_POSTS < intRankLevel1) then Member_Level = Member_Level & strRankLevel0 if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Member_Level = Member_Level & strRankLevel1 if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Member_Level = Member_Level & strRankLevel2 if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Member_Level = Member_Level & strRankLevel3 if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Member_Level = Member_Level & strRankLevel4 if (fM_POSTS >= intRankLevel5) then Member_Level = Member_Level & strRankLevel5 case "2" Member_Level = Member_Level & strRankMod case "3" Member_Level = Member_Level & strRankAdmin case else Member_Level = Member_Level & "Error" end select end if getMember_Level = Member_Level end function function getStar_Level(fM_LEVEL, fM_POSTS) dim Star_Level Star_Level = "" select case fM_LEVEL case "1" if (fM_POSTS < intRankLevel1) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel5) then Star_Level = Star_Level & "" case "2" if fM_POSTS < intRankLevel1 then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel5) then Star_Level = Star_Level & "" case "3" if (fM_POSTS < intRankLevel1) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel1) and (fM_POSTS < intRankLevel2) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel2) and (fM_POSTS < intRankLevel3) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel3) and (fM_POSTS < intRankLevel4) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel4) and (fM_POSTS < intRankLevel5) then Star_Level = Star_Level & "" if (fM_POSTS >= intRankLevel5) then Star_Level = Star_Level & "" case else Star_Level = Star_Level & "Error" end select getStar_Level = Star_Level end function '############################################## '## Multi-Moderators ## '############################################## function chkForumModerator(fForum_ID, fMember_Name) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS." & strDBNTSQLName & " = '" & fMember_Name & "'" set rsUsrName = my_Conn.Execute (strSql) if rsUsrName.EOF or rsUsrName.BOF or not(ChkQuoteOk(fMember_Name)) or not(ChkQuoteOk(fForum_ID)) then chkForumModerator = "0" rsUsrName.close exit function else MEMBER_ID = rsUsrName("MEMBER_ID") rsUsrName.close end if set rsUsrName = nothing '## Forum_SQL strSql = "SELECT * " strSql = strSql & " FROM " & strTablePrefix & "MODERATOR " strSql = strSql & " WHERE FORUM_ID = " & fForum_ID & " " strSql = strSql & " AND MEMBER_ID = " & MEMBER_ID set rsChk = my_Conn.Execute (strSql) if rsChk.bof or rsChk.eof then chkForumModerator = "0" else chkForumModerator = "1" end if rsChk.close set rsChk = nothing end function exceer=26314565 function listForumModerators(fForum_ID) '## Forum_SQL strSql = "SELECT * " strSql = strSql & " FROM " & strTablePrefix & "MODERATOR " strSql = strSql & " WHERE FORUM_ID = " & fForum_ID set rsChk = my_Conn.Execute (strSql) if rsChk.EOF or not(ChkQuoteOk(fForum_ID)) then listForumModerators = "" exit function end if fMods = getMemberName(rsChk("MEMBER_ID")) rsChk.MoveNext do until rsChk.EOF fMods = fMods & ", " & getMemberName(rsChk("MEMBER_ID")) rsChk.MoveNext loop rsChk.close set rsChk = nothing listForumModerators = fMods end function function getMemberName(fUser_Number) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.M_NAME" strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE MEMBER_ID = " & fUser_Number set rsGetMemberID = my_Conn.Execute(strSql) if rsGetMemberID.EOF or rsGetMemberID.BOF then getMemberName = "" else getMemberName = rsGetMemberID("M_NAME") end if end function function getMemberNumber(fUser_Name) '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE M_NAME = '" & fUser_Name & "'" set rsGetMemberID = my_Conn.Execute(strSql) if rsGetMemberID.EOF or rsGetMemberID.BOF then getMemberNumber = -1 exit function end if getMemberNumber = rsGetMemberID("MEMBER_ID") end function '############################################## '## NT Authentication ## '############################################## sub NTUser() if Session(strCookieURL & "username")="" then '## Forum_SQL strSql ="SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID, " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_PASSWORD, " & strMemberTablePrefix & "MEMBERS.M_USERNAME, " & strMemberTablePrefix & "MEMBERS.M_NAME " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & Session(strCookieURL & "userid") & "'" strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1 set rs_chk = my_conn.Execute (strSql) 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", 30, 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 = cint(ChkUser2(Request.Cookies(strUniqueID & "User")("Name"), Request.Cookies(strUniqueID & "User")("Pword"))) if mLev = 4 then Session(strCookieURL & "Approval") = "256697926329" end if end if rs_chk.close set rs_chk = nothing end if end sub function ChkAccountReg() '## Forum_SQL strSql ="SELECT " & strMemberTablePrefix & "MEMBERS.M_LEVEL, " & strMemberTablePrefix & "MEMBERS.M_USERNAME " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_USERNAME = '" & Session(strCookieURL & "userid") & "'" strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.M_STATUS = " & 1 set rs_chk = my_conn.Execute (strSql) 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 function chkDisplayForum(fForum_ID) if (mlev = 4) then chkDisplayForum= true exit function end if '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_PASSWORD_NEW " strSql = strSql & " FROM " & strTablePrefix & "FORUM " strSql = strSql & " WHERE FORUM_ID = " & fForum_ID set rsAccess = my_Conn.Execute(strSql) select case rsAccess("F_PRIVATEFORUMS") case 0, 1, 2, 3, 4, 7, 9 chkDisplayForum= true exit function case 5 UserNum = getNewMemberNumber() if UserNum = - 1 then chkDisplayForum= false exit function else chkDisplayForum= true exit function end if case 6 UserNum = getNewMemberNumber() if UserNum = - 1 then chkDisplayForum= false exit function end if MatchFound = isAllowedMember(fForum_ID,UserNum) if MatchFound = 1 then chkDisplayForum= true Else chkDisplayForum= false end if case 8 chkDisplayForum= false if strAuthType="nt" THEN NTGroupSTR = Split(strNTGroupsSTR, ", ") for j = 0 to ubound(NTGroupSTR) NTGroupDBSTR = Split(rsAccess("F_PASSWORD_NEW"), ", ") 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 '############################################## '## 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") = pEncrypt(pEnPrefix & Request.Form("Password")) Response.Cookies(strUniqueID & "User")("Cookies") = Request.Form("Cookies") if fSavePassWord = "true" then Response.Cookies(strUniqueID & "User").Expires = dateAdd("d", 30, 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") = "" 'Response.Cookies(strUniqueID & "User").Expires = dateadd("d", -2, strForumTimeAdjust) end sub '############################################## '## Do Counts ## '############################################## sub DoPCount() '## Forum_SQL - Updates the totals Table strSql ="UPDATE " & strTablePrefix & "TOTALS SET " & strTablePrefix & "TOTALS.P_COUNT = " & strTablePrefix & "TOTALS.P_COUNT + 1" my_Conn.Execute (strSql) end sub sub DoTCount() '## Forum_SQL - Updates the totals Table strSql ="UPDATE " & strTablePrefix & "TOTALS SET " & strTablePrefix & "TOTALS.T_COUNT = " & strTablePrefix & "TOTALS.T_COUNT + 1" my_Conn.Execute (strSql) end sub sub DoUCount(sUser_Name) '## Forum_SQL - Update Total Post for user strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " SET " & strMemberTablePrefix & "MEMBERS.M_POSTS = " & strMemberTablePrefix & "MEMBERS.M_POSTS + 1 " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & sUser_Name & "'" ' my_Conn.Execute (strSql) end sub sub deleteCount(sUser_ID) '## Forum_SQL - Update Total Post for user strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " SET " & strMemberTablePrefix & "MEMBERS.M_POSTS = " & strMemberTablePrefix & "MEMBERS.M_POSTS - 1 " strSql = strSql & ", " & strMemberTablePrefix & "MEMBERS.M_REP = " & strMemberTablePrefix & "MEMBERS.M_REP - 1 " strSql = strSql & " WHERE MEMBER_ID = " & sUser_ID ' my_Conn.Execute (strSql) end sub sub DoRepAdd(sUser_Name) '## Forum_SQL - Update Total Reputation for user ADD strSql = "UPDATE " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " SET " & strMemberTablePrefix & "MEMBERS.M_REP = " & strMemberTablePrefix & "MEMBERS.M_REP + 1 " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & sUser_Name & "'" ' my_Conn.Execute (strSql) end sub '############################################## '## Private Forums ## '############################################## sub chkUser4() if mLev = 4 then exit sub end if '## Forum_SQL strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_SUBJECT, " & strTablePrefix & "FORUM.F_PASSWORD_NEW " strSql = strSql & " FROM " & strTablePrefix & "FORUM " strSql = strSql & " WHERE " & strTablePrefix & "FORUM.Forum_ID = " & Request.QueryString("FORUM_ID") set rsStatus = my_conn.Execute (strSql) dim Users If cint(rsStatus("F_PRIVATEFORUMS")) <> 0 then Select case cint(rsStatus("F_PRIVATEFORUMS")) case 0 '## Do Nothing case 1, 6 '## Allowed Users UserNum = getNewMemberNumber() MatchFound = isAllowedMember(Request.QueryString("FORUM_ID"), cint(UserNum)) if MatchFound then exit sub else doNotAllowed Response.end end if case 2 '## password select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") '## OK case else if Request("pass") = "" then doPasswordForm Response.End else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then Response.Write "Invalid password! Back" Response.End else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") end if end if end select case 3 '## Either Password or Allowed UserNum = getNewMemberNumber() MatchFound = isAllowedMember(Request.QueryString("FORUM_ID"), cint(UserNum)) if MatchFound then exit sub else select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") '## OK case else if Request("pass") = "" then doLoginForm Response.End else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then Response.Write "Invalid password! Back" Response.End else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") 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 & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") '## OK case else if Request("pass") = "" then doLoginForm Response.End else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then Response.Write "Invalid password! Back" Response.End else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") end if end if end select end if '## end code added 07/13/2000 case 4, 5 '## members only if strDBNTUserName = "" then doNotLoggedInForm end if case 8, 9 NTGroupSTR = Split(strNTGroupsSTR, ", ") NTGroupDBSTR = Split(rsStatus("F_PASSWORD_NEW"), ", ") For i = 0 to ubound(NTGroupDBSTR) for j = 0 to ubound(NTGroupSTR) if NTGroupDBSTR(i) = NTGroupSTR(j) then exit SUB end if next next doNotAllowed Response.end case else Response.Write "
    ERROR: Invalid forum type: " & rsStatus("F_PRIVATEFORUMS") Response.end end select end if 'my_Conn.Close 'set my_Conn = nothing end sub function chkForumAccess(fForum) if mLev = 4 then chkForumAccess = true exit function end if '## Forum_SQL strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS, " & strTablePrefix & "FORUM.F_SUBJECT, " & strTablePrefix & "FORUM.F_PASSWORD_NEW " strSql = strSql & " FROM " & strTablePrefix & "FORUM " strSql = strSql & " WHERE " & strTablePrefix & "FORUM.Forum_ID = " & fForum set rsStatus = my_conn.Execute (strSql) dim Users dim MatchFound If cint(rsStatus("F_PRIVATEFORUMS")) <> 0 then Select case cint(rsStatus("F_PRIVATEFORUMS")) case 0 chkForumAccess = true case 1, 6 '## Allowed Users UserNum = getNewMemberNumber() ' chkForumAccess = (isAllowedMember(fForum_ID,UserNum) = 1) chkForumAccess = (isAllowedMember(fForum,UserNum) = 1) case 2 '## password select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") chkForumAccess = true case else if Request("pass") = "" then chkForumAccess = false else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then chkForumAccess = false else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") chkForumAccess = true end if end if end select case 3 '## Either Password or Allowed UserNum = getNewMemberNumber() ' if countMembers(fForum) = 0 then ' chkForumAccess = false ' exit function ' end if if isAllowedMember(fForum,UserNum) = 1 then chkForumAccess = true else chkForumAccess = false end if if not(chkForumAccess) then select case Request.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") chkForumAccess = true case else if Request("pass") = "" then chkForumAccess = false else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then chkForumAccess = false else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("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 & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) case rsStatus("F_PASSWORD_NEW") chkForumAccess = true case else if Request("pass") = "" then chkForumAccess = false else if Request("pass") <> rsStatus("F_PASSWORD_NEW") then chkForumAccess = false else if strSetCookieToForum = 1 then Response.Cookies(strUniqueID & "User").Path = strCookieURL end if Response.Cookies(strUniqueID & "User")("PRIVATE_" & rsStatus("F_SUBJECT")) = Request("pass") chkForumAccess = true end if end if end select end if '## end code added 07/13/2000 case 4, 5 '## members only if strDBNTUserName = "" then chkForumAccess = false else chkForumAccess = true end if case 8, 9 test="test db" chkForumAccess = FALSE if strAuthType="db" then chkForumAccess = true exit function end if NTGroupSTR = Split(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 exit function end if next next case else chkForumAccess = true end select else chkForumAccess = true end if end function function chkAccess(fForum) if mLev = 4 then chkAccess = true exit function end if '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & fForum set rsAccess = my_Conn.Execute(strSql) if rsAccess("F_PRIVATEFORUMS") <> 1 then chkAccess = true exit function end if if Request.Cookies(strUniqueID & "User")("Name") = "" then chkAccess = false end if 'get the member number UserNum = getMemberNumber(Request.Cookies(strUniqueID & "User")("Name")) ' if isAllowedMember(fForum_ID,UserNum) = 1 then if isAllowedMember(fForum,UserNum) = 1 then chkAccess = true else chkAccess = false end if End function sub doLoginForm() %>

    There Was A Problem

    You do not have access to this forum.

    >If you have been given special permission by the administrator to view and/or post in this forum, enter the password here:

    " id=form2 name=form2> <% for each q in Request.QueryString Response.Write "" next %>

    >Go Back To Enter Data

    >Return to Home

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% end sub sub doNotAllowed() %>

    There Was A Problem

    You do not have access to this forum.

    >Go Back To Enter Data

    >Return to Home

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% end sub sub doPasswordForm() %>

    There Was A Problem

    You must enter the password for this forum.

    " id=form2 name=form2> <% for each q in Request.QueryString Response.Write "" next %>

    >Go Back To Enter Data

    >Return to Home

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% end sub sub doNotLoggedInForm() %>

    There Was A Problem

    You are not logged in.

    >Go Back To Enter Data

    >Return to Home

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% Response.End end sub mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" sub inc_exef19() %>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <% end sub sub doNotLoggedInGame() %>

    There Was A Problem

    You must Login to gamble.

    >Go Back To Enter your username and passowrd

    >Return to Home

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% Response.End end sub function getNewMemberNumber() dim my_Conn2 set my_Conn2 = Server.CreateObject("ADODB.Connection") my_Conn2.Open strConnString '## Forum_SQL strSql = "SELECT " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & strDBNTUserName & "'" set rsGetMemberID = my_Conn2.Execute(strSql) if rsGetMemberID.EOF or rsGetMemberID.BOF then getNewMemberNumber = -1 exit function end if getNewMemberNumber = rsGetMemberID("MEMBER_ID") my_Conn2.Close Set my_Conn2 = nothing end function Function ReplaceUrls(fString) Dim oTag, c1Tag, c2Tag Dim roTag, rc1Tag, rc2Tag Dim oTagPos, c1TagPos, c2TagPos Dim nTagPos Dim counter2 Dim strArray, strArray2, strArray3 oTag = "[url=""" oTag2 = "[url]" roTag = "" c2Tag = "[/url]" rc2Tag = "" oTagPos = InStr(1, fString, oTag, 1) c1TagPos = InStr(1, fString, c1Tag, 1) strTempString = "" if (oTagpos > 0) and (c1TagPos > 0) then strArray = Split(fString, oTag, -1) for counter2 = 0 to UBound(strArray) if (InStr(1, strArray(counter2), c2Tag, 1) > 0) and (InStr(1, strArray(counter2), c1Tag, 1) > 0) then strArray2 = Split(strArray(counter2), c1Tag, -1) if Instr(1, strArray2(1), c2Tag) and not( (Instr(1, UCase(strArray2(1)), "[URL]") >0) and not(Instr(1, UCase(strArray2(1)), "[/URL]") >0) ) then ' if Instr(1, strArray2(1), c2Tag) then strFirstPart = Left(strArray2(1), Instr(1, strArray2(1),c2Tag)-1) strSecondPart = Right(strArray2(1), (Len(strArray2(1)) - Instr(1, strArray2(1), c2Tag) - len(c2Tag)+1)) if strFirstPart <> "" then if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strFirstPart & rc2Tag & strSecondPart end if else if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then strTempString = strTempString & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strSecondPart end if end if else strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) end if elseif (InStr(1, strArray(counter2), c1Tag, 1) > 0) then strArray2 = Split(strArray(counter2), c1Tag, -1) strTempString = strTempString & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) else strTempString = strTempString & strArray(counter2) end if next else strTempString = fString end if oTagPos2 = InStr(1, strTempString, oTag2, 1) c1TagPos2 = InStr(1, strTempString, c1Tag2, 1) if (oTagpos2 > 0) and (c1TagPos2 > 0) then strTempString2 = "" strArray = Split(strTempString, oTag2, -1) for counter3 = 0 to Ubound(strArray) if (Instr(1, strArray(counter3), c1Tag2) > 0) then strArray2 = split(strArray(counter3), c1Tag2, -1) if (Instr(strArray2(0),"@") > 0) and UCase(Left(strArray2(0), 7)) <> "MAILTO:" then strTempString2 = strTempString2 & roTag & "mailto:" & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) else strTempString2 = strTempString2 & roTag & strArray2(0) & rc1Tag & strArray2(0) & rc2Tag & strArray2(1) end if else strTempString2 = strTempString2 & strArray(counter3) end if next strTempString = strTempString2 end if ReplaceUrls = strTempString end function function isAllowedMember(fForum_ID,fMemberID) isAllowedMember = 0 on error resume next strSql = "SELECT MEMBER_ID, FORUM_ID FROM " & strMemberTablePrefix & "ALLOWED_MEMBERS " strSql = strSql & " WHERE " & strMemberTablePrefix & "ALLOWED_MEMBERS.FORUM_ID = " & fForum_ID strSql = strSql & " AND " & strMemberTablePrefix & "ALLOWED_MEMBERS.MEMBER_ID = " & fMemberID set rsAllowedMember = my_Conn.execute (strSql) if (rsAllowedMember.EOF or rsAllowedMember.BOF) then isAllowedMember = 0 exit function else isAllowedMember = 1 end if end function function GetKey(action) intNumChars = 62 keyArray = Array("a","A","b","B","c","C","d","D","e","E","f","F","g","G","h","H","i","I","j","J","k","K","l","L", _ "m","M","n","N","o","O","p","P","q","Q","r","R","s","S","t","T","u","U","v","V","w","W","x","X", _ "y","Y","z","Z","1","2","3","4","5","6","7","8","9","0") Randomize key1 = (Int(((intNumChars - 1) * Rnd) + 1)) key2 = (Int(((intNumChars - 1) * Rnd) + 1)) key3 = (Int(((intNumChars - 1) * Rnd) + 1)) key4 = (Int(((intNumChars - 1) * Rnd) + 1)) key5 = (Int(((intNumChars - 1) * Rnd) + 1)) key6 = (Int(((intNumChars - 1) * Rnd) + 1)) key7 = (Int(((intNumChars - 1) * Rnd) + 1)) key8 = (Int(((intNumChars - 1) * Rnd) + 1)) key9 = (Int(((intNumChars - 1) * Rnd) + 1)) key10 = (Int(((intNumChars - 1) * Rnd) + 1)) strKey = keyArray(key1) & keyArray(key2) & keyArray(key3) & keyArray(key4) & _ keyArray(key5) & keyArray(key6) & keyArray(key7) & keyArray(key8) & keyArray(key9) & keyArray(key10) GetKey = strKey if action = "sendemail" then strRecipientsName = Request.Form("Name") strRecipients = Request.Form("Email") strFrom = strSender strFromName = strSiteTitle strsubject = Request.Form("name") & " Your Email Address Has Been Changed - " &strSiteTitle strMessage = "Hi " & Request.Form("name") & vbCrLf & vbCrLf if Request.QueryString("mode") <> "EditIt" then strMessage = strMessage & "You received this message from " & strSiteTitle & " because someone has changed your email address at " & strForumURL & vbCrLf & vbCrLf else strMessage = strMessage & "You received this message from " & strSiteTitle & " because you have changed your email address at " & strForumURL & vbCrLf & vbCrLf end if strMessage = strMessage & "To complete your email change, please click on the link below:" & vbCrLf strMessage = strMessage & strForumURL & "pop_profile.asp?verkey=" & strKey & vbCrLf & vbCrLf strMessage = strMessage & "Thank You!" & vbCrLf & vbCrLf strMessage = strMessage & "-This email is generated by MaxWebPortal-" %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# select case lcase(strMailMode) case "aspmail" Set objNewMail = Server.CreateObject("SMTPsvg.Mailer") objNewMail.FromName = strFromName objNewMail.FromAddress = strSender 'objNewMail.AddReplyTo = strSender objNewMail.RemoteHost = strMailServer objNewMail.AddRecipient strRecipientsName, strRecipients objNewMail.Subject = strSubject objNewMail.BodyText = strMessage on error resume next '## Ignore Errors SendOk = objNewMail.SendMail If not(SendOk) <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & objNewMail.Response & "
  • " End if case "aspemail" Set objNewMail = Server.CreateObject("Persits.MailSender") objNewMail.FromName = strFromName objNewMail.From = strSender objNewMail.AddReplyTo strSender objNewMail.Host = strMailServer objNewMail.AddAddress strRecipients, strRecipientsName objNewMail.Subject = strSubject objNewMail.Body = strMessage on error resume next '## Ignore Errors objNewMail.Send If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "aspqmail" Set objNewMail = Server.CreateObject("SMTPsvg.Mailer") objNewMail.QMessage = 1 objNewMail.FromName = strFromName objNewMail.FromAddress = strSender objNewMail.RemoteHost = strMailServer objNewMail.AddRecipient strRecipientsName, strRecipients objNewMail.Subject = strSubject objNewMail.BodyText = strMessage on error resume next '## Ignore Errors objNewMail.SendMail If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "cdonts" Set objNewMail = Server.CreateObject ("CDONTS.NewMail") objNewMail.BodyFormat = 1 objNewMail.MailFormat = 0 on error resume next '## Ignore Errors objNewMail.Send strSender, strRecipients, strSubject, strMessage If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if on error resume next '## Ignore Errors case "chilicdonts" Set objNewMail = Server.CreateObject ("CDONTS.NewMail") on error resume next '## Ignore Errors objNewMail.Send strSender, strRecipients, strSubject, strMessage If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if on error resume next '## Ignore Errors case "dkqmail" Set objNewMail = Server.CreateObject("dkQmail.Qmail") objNewMail.FromEmail = strSender objNewMail.ToEmail = strRecipients objNewMail.Subject = strSubject objNewMail.Body = strMessage objNewMail.CC = "" objNewMail.MessageType = "TEXT" on error resume next '## Ignore Errors objNewMail.SendMail() If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "geocel" set objNewMail = Server.CreateObject("Geocel.Mailer") objNewMail.AddServer strMailServer, 25 objNewMail.AddRecipient strRecipients, strRecipientsName objNewMail.FromName = strFromName objNewMail.FromAddress = strFrom objNewMail.Subject = strSubject objNewMail.Body = strMessage on error resume next '## Ignore Errors objNewMail.Send() if Err <> 0 then Response.Write "Your request was not sent due to the following error: " & Err.Description else Response.Write "Your mail has been sent..." end if case "iismail" Set objNewMail = Server.CreateObject("iismail.iismail.1") MailServer = strMailServer objNewMail.Server = strMailServer objNewMail.addRecipient(strRecipients) objNewMail.From = strSender objNewMail.Subject = strSubject objNewMail.body = strMessage on error resume next '## Ignore Errors objNewMail.Send If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "jmail" Set objNewMail = Server.CreateObject("Jmail.smtpmail") objNewMail.ServerAddress = strMailServer objNewMail.AddRecipient strRecipients objNewMail.Sender = strSender objNewMail.Subject = strSubject objNewMail.body = strMessage objNewMail.priority = 3 on error resume next '## Ignore Errors objNewMail.execute If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "smtp" Set objNewMail = Server.CreateObject("SmtpMail.SmtpMail.1") objNewMail.MailServer = strMailServer objNewMail.Recipients = strRecipients objNewMail.Sender = strSender objNewMail.Subject = strSubject objNewMail.Message = strMessage on error resume next '## Ignore Errors objNewMail.SendMail2 If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if end select Set objNewMail = Nothing %> <% end if if action = "passemail" then strRecipientsName = memName strRecipients = Request.Form("Email") strFrom = strSender strFromName = strSiteTitle strsubject = " Reset Password - " &strSiteTitle strMessage = strMessage & memName & ", You received this message from " & strSiteTitle & " because you have requested to change your password. " & vbCrLf & vbCrLf strMessage = strMessage & "To complete your password change, please click on the link below:" & vbCrLf strMessage = strMessage & strForumURL & "password.asp?mode=validateEmail&actkey=" & strKey & vbCrLf & vbCrLf strMessage = strMessage & "Thank You!" & vbCrLf & vbCrLf strMessage = strMessage & "-This email is generated by MaxWebPortal-" %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# select case lcase(strMailMode) case "aspmail" Set objNewMail = Server.CreateObject("SMTPsvg.Mailer") objNewMail.FromName = strFromName objNewMail.FromAddress = strSender 'objNewMail.AddReplyTo = strSender objNewMail.RemoteHost = strMailServer objNewMail.AddRecipient strRecipientsName, strRecipients objNewMail.Subject = strSubject objNewMail.BodyText = strMessage on error resume next '## Ignore Errors SendOk = objNewMail.SendMail If not(SendOk) <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & objNewMail.Response & "
  • " End if case "aspemail" Set objNewMail = Server.CreateObject("Persits.MailSender") objNewMail.FromName = strFromName objNewMail.From = strSender objNewMail.AddReplyTo strSender objNewMail.Host = strMailServer objNewMail.AddAddress strRecipients, strRecipientsName objNewMail.Subject = strSubject objNewMail.Body = strMessage on error resume next '## Ignore Errors objNewMail.Send If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "aspqmail" Set objNewMail = Server.CreateObject("SMTPsvg.Mailer") objNewMail.QMessage = 1 objNewMail.FromName = strFromName objNewMail.FromAddress = strSender objNewMail.RemoteHost = strMailServer objNewMail.AddRecipient strRecipientsName, strRecipients objNewMail.Subject = strSubject objNewMail.BodyText = strMessage on error resume next '## Ignore Errors objNewMail.SendMail If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "cdonts" Set objNewMail = Server.CreateObject ("CDONTS.NewMail") objNewMail.BodyFormat = 1 objNewMail.MailFormat = 0 on error resume next '## Ignore Errors objNewMail.Send strSender, strRecipients, strSubject, strMessage If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if on error resume next '## Ignore Errors case "chilicdonts" Set objNewMail = Server.CreateObject ("CDONTS.NewMail") on error resume next '## Ignore Errors objNewMail.Send strSender, strRecipients, strSubject, strMessage If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if on error resume next '## Ignore Errors case "dkqmail" Set objNewMail = Server.CreateObject("dkQmail.Qmail") objNewMail.FromEmail = strSender objNewMail.ToEmail = strRecipients objNewMail.Subject = strSubject objNewMail.Body = strMessage objNewMail.CC = "" objNewMail.MessageType = "TEXT" on error resume next '## Ignore Errors objNewMail.SendMail() If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "geocel" set objNewMail = Server.CreateObject("Geocel.Mailer") objNewMail.AddServer strMailServer, 25 objNewMail.AddRecipient strRecipients, strRecipientsName objNewMail.FromName = strFromName objNewMail.FromAddress = strFrom objNewMail.Subject = strSubject objNewMail.Body = strMessage on error resume next '## Ignore Errors objNewMail.Send() if Err <> 0 then Response.Write "Your request was not sent due to the following error: " & Err.Description else Response.Write "Your mail has been sent..." end if case "iismail" Set objNewMail = Server.CreateObject("iismail.iismail.1") MailServer = strMailServer objNewMail.Server = strMailServer objNewMail.addRecipient(strRecipients) objNewMail.From = strSender objNewMail.Subject = strSubject objNewMail.body = strMessage on error resume next '## Ignore Errors objNewMail.Send If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "jmail" Set objNewMail = Server.CreateObject("Jmail.smtpmail") objNewMail.ServerAddress = strMailServer objNewMail.AddRecipient strRecipients objNewMail.Sender = strSender objNewMail.Subject = strSubject objNewMail.body = strMessage objNewMail.priority = 3 on error resume next '## Ignore Errors objNewMail.execute If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if case "smtp" Set objNewMail = Server.CreateObject("SmtpMail.SmtpMail.1") objNewMail.MailServer = strMailServer objNewMail.Recipients = strRecipients objNewMail.Sender = strSender objNewMail.Subject = strSubject objNewMail.Message = strMessage on error resume next '## Ignore Errors objNewMail.SendMail2 If Err <> 0 Then Err_Msg = Err_Msg & "
  • Your request was not sent due to the following error: " & Err.Description & "
  • " End if end select Set objNewMail = Nothing %> <% end if end function %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** const strWebSiteMVersion = "1.310" tempArr = split(strWebMaster, ",") strSiteOwner = tempArr(0) if strForumStatus = "down" and CurPageType = "forums" and NOT lcase(Request.Cookies(strUniqueID & "User")("Name")) = strSiteOwner then response.redirect("down.asp") dim mLev, strLoginStatus set my_Conn = Server.CreateObject("ADODB.Connection") my_Conn.Open strConnString %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** mwpThemeName = "MaxWebPortal Alpha 3" mwpThemeBodyTag = "topmargin=""0"" leftmargin=""0"" marginwidth=""0"" marginheight=""0""" mwpThemeShortBodyTag = "onLoad=""window.focus()""" mwpThemeFixedVars = 1 sub mwpThemeStart() end sub sub mwpThemeHeader_javascript() end sub sub mwpThemeHeader_style()%> <%end sub sub mwpThemeHeader_open()%> <%end sub mwpThemeHeader_icon1 = "" mwpThemeHeader_icon1x = "" mwpThemeHeader_icon2 = "" mwpThemeHeader_icon2x = "" mwpThemeHeader_icon3 = "" mwpThemeHeader_icon3x = "" mwpThemeHeader_icon4 = "" mwpThemeHeader_icon4x = "" mwpThemeHeader_icon5 = "" mwpThemeHeader_icon5x = "" mwpThemeHeader_icon6 = "" mwpThemeHeader_icon6x = "" sub mwpThemeHeader_menu() If CurPageType = "home" then response.write mwpThemeHeader_icon1x else response.write mwpThemeHeader_icon1 If CurPageType = "features" then response.write mwpThemeHeader_icon2x else response.write mwpThemeHeader_icon2 If CurPageType = "forums" then response.write mwpThemeHeader_icon3x else response.write mwpThemeHeader_icon3 If CurPageType = "events" then response.write mwpThemeHeader_icon4x else response.write mwpThemeHeader_icon4 If CurPageType = "downloads" then response.write mwpThemeHeader_icon5x else response.write mwpThemeHeader_icon5 If CurPageType = "links" then response.write mwpThemeHeader_icon6x else response.write mwpThemeHeader_icon6 end sub sub mwpThemeHeader_close()%>
     Home  Home  Features  Features  Forums  Forums  Events  Events  Downloads  Downloads  Links  Links 
    <%end sub sub mwpThemeNavBar_open()%> <%end sub mwpThemeControlPanel = "" sub mwpThemeNavBar_close()%>
    <%end sub sub mwpThemeBlock_open() %> border="0" cellspacing="0" cellpadding="0" bgcolor="<% =strForumCellColor %>" width="100%">
    <%if not mwpThemeTitle = "" then%> <% end if mwpThemeTitle = "" mwpThemeCellCustomCode = "" end sub mwpThemeBlock_subTitleCell = "bgcolor=""#C4D1E6""" mwpThemeBlock_forumCategoryCell = "background=""tm3/fl.gif"" height=""25""" sub mwpThemeBlock_close() %>
    background="tm3/fl.gif"><% =mwpThemeTitle %>
     
     

    <% end sub sub mwpThemeSmallBlock_open() %> bordercolor="#C0CCDA" bgcolor="#E6E8ED"> <% mwpThemeTableCustomCode = "" end sub sub mwpThemeSmallBlock_close() %>
    <%end sub mwpThemeCustomFooter = "1" sub mwpThemeFooterBlock_open() %> bordercolor="#C0CCDA" bgcolor="#E6E8ED"> <% mwpThemeFooterCustomCode = "" end sub sub mwpThemeFooterBlock_close() %>
    <%end sub sub mwpThemeEnd() end sub %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** if not Request.Cookies(strUniqueID & "User")("Name") = "" and not mwpThemeFixedVars = 1 then id = getMemberID(Request.Cookies(strUniqueID & "User")("Name")) strSQL = "SELECT THEME_ID FROM " & strTablePrefix & "CP_CONFIG WHERE MEMBER_ID=" & id Set objRS = my_Conn.Execute(strSQL) strSQL3 = "SELECT MAX( CONFIG_ID ) AS MaxOfCONFIG_ID FROM " & strTablePrefix & "COLORS" Set objRS3 = my_Conn.Execute(strSQL3) if objRS.EOF or objRS.BOF then themeid = 1 'default theme is 1 else if objRS("THEME_ID") > objRS3("MaxOfCONFIG_ID") then themeid = 1 elseif objRS("THEME_ID") < 1 then themeid = 1 else themeid = objRS("THEME_ID") end if end if strSQL = "" strSQL = "SELECT * FROM " & strTablePrefix & "COLORS WHERE CONFIG_ID=" & themeid Set objRS2 = my_Conn.Execute(strSQL) if themeid <> 1 then if objRS2.EOF then else strDefaultFontFace = objRS2("C_STRDEFAULTFONTFACE") strDefaultFontSize = objRS2("C_STRDEFAULTFONTSIZE") strHeaderFontSize = objRS2("C_STRHEADERFONTSIZE") strFooterFontSize = objRS2("C_STRFOOTERFONTSIZE") strPageBgColor = objRS2("C_STRPAGEBGCOLOR") strDefaultFontColor = objRS2("C_STRDEFAULTFONTCOLOR") strLinkColor = objRS2("C_STRLINKCOLOR") strLinkTextDecoration = objRS2("C_STRLINKTEXTDECORATION") strVisitedLinkColor = objRS2("C_STRVISITEDLINKCOLOR") strVisitedTextDecoration = objRS2("C_STRVISITEDTEXTDECORATION") strActiveLinkColor = objRS2("C_STRACTIVELINKCOLOR") strHoverFontColor =objRS2("C_STRHOVERFONTCOLOR") strHoverTextDecoration = objRS2("C_STRHOVERTEXTDECORATION") strHeadCellColor = objRS2("C_STRHEADCELLCOLOR") strAltHeadCellColor = objRS2("C_STRALTHEADCELLCOLOR") strHeadFontColor = objRS2("C_STRHEADFONTCOLOR") strCategoryCellColor = objRS2("C_STRCATEGORYCELLCOLOR") strCategoryFontColor = objRS2("C_STRCATEGORYFONTCOLOR") strForumFirstCellColor = objRS2("C_STRFORUMFIRSTCELLCOLOR") strForumCellColor = objRS2("C_STRFORUMCELLCOLOR") strAltForumCellColor = objRS2("C_STRALTFORUMCELLCOLOR") strForumFontColor = objRS2("C_STRFORUMFONTCOLOR") strForumLinkColor = objRS2("C_STRFORUMLINKCOLOR") strTableBorderColor = objRS2("C_STRTABLEBORDERCOLOR") strPopUpTableColor = objRS2("C_STRPOPUPTABLECOLOR") strPopUpBorderColor = objRS2("C_STRPOPUPBORDERCOLOR") strNewFontColor = objRS2("C_STRNEWFONTCOLOR") end if end if objRS.close set objRS = nothing objRS2.close set objRS2 = nothing objRS3.close set objRS3 = nothing End if %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** ' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm, ' as set out in the memo RFC1321. ' ' See the VB6 project that accompanies this sample for full code comments on how ' it works. ' ' ASP VBScript code for generating an MD5 '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 MD5 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. ' ' 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 Const BITS_TO_A_BYTE = 8 Private Const BYTES_TO_A_WORD = 4 Private Const BITS_TO_A_WORD = 32 Private m_lOnBits(30) Private m_l2Power(30) 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) 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 RotateLeft(lValue, iShiftBits) RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) 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 F1(x, y, z) F = (x And y) Or ((Not x) And z) End Function Private Function G2(x, y, z) G = (x And z) Or (y And (Not z)) End Function Private Function H3(x, y, z) H = (x Xor y Xor z) End Function Private Function I4(x, y, z) I = (y Xor (x Or (Not z))) End Function Private Sub FF(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(F1(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub GG(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(G2(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub HH(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(H3(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub II(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(I4(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Function ConvertToWordArray(sMessage) Dim lMessageLength Dim lNumberOfWords Dim lWordArray() Dim lBytePosition Dim lByteCount Dim lWordCount 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 = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) lByteCount = lByteCount + 1 Loop lWordCount = lByteCount \ BYTES_TO_A_WORD lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition) lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3) lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29) ConvertToWordArray = lWordArray End Function Private Function WordToHex(lValue) Dim lByte Dim lCount For lCount = 0 To 3 lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) WordToHex = WordToHex & Right("0" & Hex(lByte), 2) Next End Function Public Function pEncrypt(sMessage) Dim x Dim k Dim AA Dim BB Dim CC Dim DD Dim a Dim b Dim c Dim d Const S11 = 7 Const S12 = 12 Const S13 = 17 Const S14 = 22 Const S21 = 5 Const S22 = 9 Const S23 = 14 Const S24 = 20 Const S31 = 4 Const S32 = 11 Const S33 = 16 Const S34 = 23 Const S41 = 6 Const S42 = 10 Const S43 = 15 Const S44 = 21 x = ConvertToWordArray(sMessage) a = &H67452301 b = &HEFCDAB89 c = &H98BADCFE d = &H10325476 For k = 0 To UBound(x) Step 16 AA = a BB = b CC = c DD = d FF a, b, c, d, x(k + 0), S11, &HD76AA478 FF d, a, b, c, x(k + 1), S12, &HE8C7B756 FF c, d, a, b, x(k + 2), S13, &H242070DB FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE FF a, b, c, d, x(k + 4), S11, &HF57C0FAF FF d, a, b, c, x(k + 5), S12, &H4787C62A FF c, d, a, b, x(k + 6), S13, &HA8304613 FF b, c, d, a, x(k + 7), S14, &HFD469501 FF a, b, c, d, x(k + 8), S11, &H698098D8 FF d, a, b, c, x(k + 9), S12, &H8B44F7AF FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 FF b, c, d, a, x(k + 11), S14, &H895CD7BE FF a, b, c, d, x(k + 12), S11, &H6B901122 FF d, a, b, c, x(k + 13), S12, &HFD987193 FF c, d, a, b, x(k + 14), S13, &HA679438E FF b, c, d, a, x(k + 15), S14, &H49B40821 GG a, b, c, d, x(k + 1), S21, &HF61E2562 GG d, a, b, c, x(k + 6), S22, &HC040B340 GG c, d, a, b, x(k + 11), S23, &H265E5A51 GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA GG a, b, c, d, x(k + 5), S21, &HD62F105D GG d, a, b, c, x(k + 10), S22, &H2441453 GG c, d, a, b, x(k + 15), S23, &HD8A1E681 GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 GG d, a, b, c, x(k + 14), S22, &HC33707D6 GG c, d, a, b, x(k + 3), S23, &HF4D50D87 GG b, c, d, a, x(k + 8), S24, &H455A14ED GG a, b, c, d, x(k + 13), S21, &HA9E3E905 GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 GG c, d, a, b, x(k + 7), S23, &H676F02D9 GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A HH a, b, c, d, x(k + 5), S31, &HFFFA3942 HH d, a, b, c, x(k + 8), S32, &H8771F681 HH c, d, a, b, x(k + 11), S33, &H6D9D6122 HH b, c, d, a, x(k + 14), S34, &HFDE5380C HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 HH a, b, c, d, x(k + 13), S31, &H289B7EC6 HH d, a, b, c, x(k + 0), S32, &HEAA127FA HH c, d, a, b, x(k + 3), S33, &HD4EF3085 HH b, c, d, a, x(k + 6), S34, &H4881D05 HH a, b, c, d, x(k + 9), S31, &HD9D4D039 HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 HH b, c, d, a, x(k + 2), S34, &HC4AC5665 II a, b, c, d, x(k + 0), S41, &HF4292244 II d, a, b, c, x(k + 7), S42, &H432AFF97 II c, d, a, b, x(k + 14), S43, &HAB9423A7 II b, c, d, a, x(k + 5), S44, &HFC93A039 II a, b, c, d, x(k + 12), S41, &H655B59C3 II d, a, b, c, x(k + 3), S42, &H8F0CCC92 II c, d, a, b, x(k + 10), S43, &HFFEFF47D II b, c, d, a, x(k + 1), S44, &H85845DD1 II a, b, c, d, x(k + 8), S41, &H6FA87E4F II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 II c, d, a, b, x(k + 6), S43, &HA3014314 II b, c, d, a, x(k + 13), S44, &H4E0811A1 II a, b, c, d, x(k + 4), S41, &HF7537E82 II d, a, b, c, x(k + 11), S42, &HBD3AF235 II c, d, a, b, x(k + 2), S43, &H2AD7D2BB II b, c, d, a, x(k + 9), S44, &HEB86D391 a = AddUnsigned(a, AA) b = AddUnsigned(b, BB) c = AddUnsigned(c, CC) d = AddUnsigned(d, DD) Next pEncrypt = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) End Function %> <% if (strAuthType = "nt") then call NTauthenticate() if (ChkAccountReg() = "1") then call NTUser() end if end if if strAuthType = "db" then if (Request.Cookies(strUniqueID & "User")("Name") <> "" and Request.Cookies(strUniqueID & "User")("PWord") <> "") then '## Forum_SQL strSql = "SELECT MEMBER_ID, M_NAME, M_PASSWORD " strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS " strSql = strSql & " WHERE " & strDBNTSQLName & " = '" & ChkString(Request.Cookies(strUniqueID & "User")("Name"), "SQLString") & "' " strSql = strSql & " AND M_PASSWORD = '" & ChkString(Request.Cookies(strUniqueID & "User")("Pword"), "SQLString") &"'" Set rsCheck = my_Conn.Execute(strSql) if rsCheck.BOF or rsCheck.EOF then Call ClearCookies() strDBNTUserName = "" else strDBNTUserName = rsCheck("M_NAME") end if rsCheck.close set rsCheck = nothing else strDBNTUserName = "" end if end if strDBNTFUserName = Request.Form("Name") if strAuthType = "nt" then strDBNTUserName = Session(strCookieURL & "userID") strDBNTFUserName = Session(strCookieURL & "userID") end if if strDBNTUserName <> "" then strUserMemberID = getMemberID(strDBNTUserName) else strUserMemberID = -1 select case Request.Form("Method_Type") case "login" select case ChkUser2(strDBNTFUserName, pEncrypt(pEnPrefix & Request.Form("Password"))) case 1, 2, 3, 4 Call DoCookies(Request.Form("SavePassword")) strLoginStatus = 1 case else strLoginStatus = 0 end select case "logout" Call ClearCookies() end select mLev = cint(ChkUser2(strDBNTUserName, Request.Cookies(strUniqueID & "User")("Pword"))) Dim strOnlinePathInfo, strOnlineQueryString, strOnlineLocation Dim strOnlineUser, strOnlineDate, strOnlineCheckInTime, strOnlineTimedOut Dim strOnlineUsersCount, strOnlineGuestsCount, strOnlineMembersCount Dim strOnlineGuestUserIP ' ****************************************************** ' ADD HERE WHAT YOU WANT THE PREFIX OF YOUR COOKIE TO BE ' it will either be 'strCookieURL' or 'strUniqueID' strTempCookieType = strCookieURL ' ****************************************************** Function OnlineSQLencode(byVal strPass) If not isNull(strPass) and strPass <> "" Then strPass = Replace(strPass, "'", "") strPass = Replace(strPass, "|", "") strPass = Replace(strPass, "(", "") strPass = Replace(strPass, ")", "") strPass = Replace(strPass, ";", "") OnlineSQLencode = strPass End If End Function Function OnlineSQLdecode(byVal strPass) If not isNull(strPass) and strPass <> "" Then strPass = Replace(strPass, "'%'", "%") strPass = Replace(strPass, "''", "'") strPass = Replace(strPass, "'|'", "|") OnlineSQLdecode = strPass End If End Function strOnlinePathInfo = Request.ServerVariables("Path_Info") ' FIND OUT IF THEY ARE A GUEST, OR A USER if strDBNTUserName = "" then strOnlineUser = "Guest" else strOnlineUser = strDBNTUserName end if if instr(strWebMaster,lcase(strOnlineUser)&",") <> 0 and not lcase(strOnlineUser) = "" and not lcase(strOnlineUser) = " " then strOnlineUserIP = "0.0.0.0" else strOnlineUserIP = Request.ServerVariables("REMOTE_ADDR") end if ' SET WHEN TO TIMEOUT THE USER ' DO THIS IN SECONDS strOnlineDate = DateToStr(Date) strOnlineCheckInTime = DateToStr(strForumTimeAdjust) if strDBType = "access" then strSqL = "SELECT count(UserID) AS [onlinecount] " else strSqL = "SELECT count(UserID) onlinecount " end if strSql = strSql & "FROM " & strTablePrefix & "ONLINE " Set rsOnline = my_Conn.Execute(strSql) onlinecount = rsOnline("onlinecount") strOnlineUsersCount = rsOnline("onlinecount") set rsGuests = Server.CreateObject("ADODB.Recordset") if strDBType = "access" then strSqL = "SELECT count(UserID) AS [Guests] " else strSqL = "SELECT count(UserID) Guests " end if strSql = strSql & "FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE Right(UserID, 5) = 'Guest' " Set rsGuests = my_Conn.Execute(strSql) Guests = rsGuests("Guests") strOnlineGuestsCount = rsGuests("Guests") set rsGuests = Server.CreateObject("ADODB.Recordset") if strDBType = "access" then strSqL = "SELECT count(UserID) AS [Members] " else strSqL = "SELECT count(UserID) Members " end if strSql = strSql & "FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE Right(UserID, 5) <> 'Guest' " Set rsMembers = my_Conn.Execute(strSql) Members = rsMembers("Members") strOnlineMembersCount = rsMembers("Members") CurPageTitle = UCase(Mid(CurPageType, 1, 1)) & Mid(CurPageType, 2, Len(CurPageType)) %> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MaxWebPortal LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MaxWebPortal LICENSE AGREEMENT%> <% tmpPageTitle = "" tmpPageTitle = strSiteTitle if not CurPageType = "" then tmpPageTitle = strSiteTitle & " | " & CurPageTitle select case CurPageType case "forums" if not ChkString(Request("FORUM_Title"),"display") = " " then CurForumTitle = " | " & ChkString(Request("FORUM_Title"),"display") else CurForumTitle = "" end if if not ChkString(Request("TOPIC_Title"),"display") = " " then CurTopicTitle = ChkString(Request("TOPIC_Title"),"display") & " - " else CurTopicTitle = "" end if tmpPageTitle = CurTopicTitle & strSiteTitle & " | " & CurPageTitle & CurForumTitle case else tmpPageTitle = strSiteTitle & " | " & CurPageTitle end select end if %> <% =tmpPageTitle%> <% mwpThemeHeader_style() %> > <% mwpThemeStart() mwpThemeHeader_open()%> <% =strSiteTitle %> <% mwpThemeHeader_menu() %>
    <% mwpThemeHeader_close() select case Request.Form("Method_Type") case "login" if strLoginStatus = 0 then%>

    Your username and/or password were incorrect.

    Please either try again or register for an account.

    <% else %>

    You logged on successfully!

    Thank you for your participation.

    <% end if %> ">

    ">Back

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% Response.End case "logout" %>

    You logged out successfully!

    Thank you for your participation.

    ">

    ">Back

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %> <% Response.End end select %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** strWebsiteDVersion = "20030617" strWebsiteBVersion = "771.3" strWebsiteVersion = strWebSiteMVersion & "." & strWebsiteDVersion & "." & strWebsiteBVersion%> <% if (ChkUser2((strDBNTUserName), (Request.Cookies(strUniqueID & "User")("Pword"))) = 0) then 'guest mwpThemeNavBar_open()%> <% select case CurPageType%> <%case "home"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register FAQ
    <%case "forums"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register Active Topics Members Search Bookmarks FAQ Games
    <%case "links"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register FAQ
    <%case "downloads"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register FAQ
    <%case "articles"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register FAQ
    <%case "pictures"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register FAQ
    <%case else%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register
    <%end select%> " method="post" id="form1" name="form1">
    Username:
    Password:
    <%if strGfxButtons <> "0" then %> <%else 'member if strGfxButtons = "0" then %> <%end if end if %>
    Save Password <%if (lcase(strEmail) = "1") then %> Forgot your password?<% end if %> <%else mwpThemeNavBar_open()%> <% select case CurPageType%> <%case "home"%>
    FAQ
    <%case "forums"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register Active Topics Private Messages Members Search Bookmarks <% if strUseExtendedProfile then %> Profile<% else %> Profile<% end if %> FAQ Games
    <%case "links"%>
    FAQ
    <%case "downloads"%>
    FAQ
    <%case "articles"%>
    FAQ
    <%case "pictures"%> <%if strAutoLogon <> 1 then %> <% end if %>
    Register FAQ
    <%case else%>
    <%end select%>
    " method="post" id="form2" name="form2"> You are logged on as
    <%if strAuthType="nt" then %> <% =Session(strCookieURL & "username")%> (<% =Session(strCookieURL & "userid") %>)
    <%else if strAuthType = "db" then %> <% = ChkString(strDBNTUserName, "display") %>
    <%if strGfxButtons <> "0" then %> <% else if strGfxButtons = "0" then %> <% end if end if end if end if %>
    <%= mwpThemeControlPanel %> <%end if mwpThemeNavBar_close() %> <% strSQL = "SELECT count(ARTICLE_ID) as ARTICLECOUNT FROM ARTICLE WHERE POST_DATE > '" & Session(strCookieURL & "last_here_date") & "' AND show = 1" set rsDay = server.CreateObject("adodb.recordset") rsDay.Open strSQL, my_Conn aCount = (rsDay("ARTICLECOUNT")) %> <% rsDay.Close set rsDay = nothing strSQL = "SELECT count(DL_ID) as DLCOUNT FROM DL WHERE POST_DATE > '" & Session(strCookieURL & "last_here_date") & "' AND show = 1" set rsDay = server.CreateObject("adodb.recordset") rsDay.Open strSQL, my_Conn dlCount = (rsDay("DLCOUNT")) %> <% rsDay.Close set rsDay = nothing if strDBType = "access" then strSqL = "SELECT count(M_TO) as [pmcount] " else strSqL = "SELECT count(M_TO) as pmcount " end if strSql = strSql & " FROM " & strMemberTablePrefix & "MEMBERS , " & strTablePrefix & "PM " strSql = strSql & " WHERE " & strMemberTablePrefix & "MEMBERS.M_NAME = '" & strDBNTUserName & "'" strSql = strSql & " AND " & strMemberTablePrefix & "MEMBERS.MEMBER_ID = " & strTablePrefix & "PM.M_TO " strSql = strSql & " AND " & strTablePrefix & "PM.M_READ = 0 " Set rsPM = my_Conn.Execute(strSql) pmcount = rsPM("pmcount") %> <% rsPM.close set rsPM = nothing %> <% if (mlev = 4) or (lcase(strNoCookies) = "1") then %> <% end if %> <% strSql = "SELECT " & strTablePrefix & "TOTALS.U_COUNT " strSql = strSql & " FROM " & strTablePrefix & "TOTALS" set rs1 = my_Conn.Execute(strSql) Users = rs1("U_COUNT") rs1.Close set rs1 = nothing %> <%mwpThemeBlock_close()%> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** sub displayDL %> <%end sub intPopular = 5 mwpThemeTitle= "Top " & intPopular & " Downloads" mwpThemeBlock_open() strSQL = "SELECT TOP " & intPopular & " DL_ID, NAME, DESCRIPTION, POST_DATE, HIT, SHOW FROM DL WHERE SHOW = 1 ORDER BY HIT DESC, POST_DATE DESC" dim rsPopular set rsPopular = server.CreateObject("adodb.recordset") rsPopular.Open strSQL, my_Conn if rsPopular.EOF then%> <%else Do While Not rsPopular.EOF strDescription = rsPopular("DESCRIPTION") if len(strDescription) > 50 then strDescription = Left(strDescription , 50) & "..." else strDescription = strDescription end if strDLName = rsPopular("NAME") strPostDate = strtodate(rsPopular("POST_DATE")) dateSince = DateDiff("d", strForumTimeAdjust, strPostDate)+7 intHit = rsPopular("Hit") intDLID = rsPopular("DL_ID") Call DisplayDL() rsPopular.MoveNext Loop end if rsPopular.Close Set rsPopular = Nothing mwpThemeBlock_close() %> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** intPop = 5 strJOTW = cInt(strJokeOfTheWeek) mwpThemeTitle= "Top " & intPop & " Articles" mwpThemeBlock_open() strSQL = "SELECT TOP " & intPop & " ARTICLE_ID, TITLE, HIT, SHOW, SUMMARY, POST_DATE FROM ARTICLE WHERE SHOW = 1 AND ARTICLE_ID <>" & strJOTW & " ORDER BY HIT DESC, POST_DATE DESC" set rsPop = my_Conn.Execute (strSql) if rsPop.EOF then%> <%else Do While Not rsPop.EOF strArticleTitle = rsPop("Title") strSummary = rsPop("Summary") if len(strSummary ) > 100 then strSummary = Left(strSummary , 100) & "..." else strSummary = strSummary end if intArticleID = rsPop("Article_ID") strPostDate = strtodate(rsPop("POST_DATE")) dateSince = DateDiff("d", strForumTimeAdjust, strPostDate)+7 Call DisplayArticle() rsPop.MoveNext Loop end if rsPop.Close Set rsPop= Nothing mwpThemeBlock_close() sub displayArticle %> <%end sub%> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** mwpThemeTitle= "Others" mwpThemeBlock_open()%> <%mwpThemeBlock_close()%> <%End if %> <%mwpThemeBlock_close()%> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** Set NobjRec = Server.CreateObject("ADODB.RecordSet") Set NobjDict = CreateObject("Scripting.Dictionary") strSQL = "SELECT m_code, m_value FROM " & strTablePrefix & "mods WHERE m_name = 'news';" set NobjRec = my_conn.Execute(strSQL) while not NobjRec.EOF NobjDict.Add NobjRec.Fields.Item("m_code").Value, NobjRec.Fields.Item("m_value").Value NobjRec.moveNext wend NslPosts = cint(NobjDict.Item("slPosts")) NslLength = cint(NobjDict.Item("slLength")) NslSort = cint(NobjDict.Item("slSort")) NslEncode = cint(NobjDict.Item("slEncode")) NstrIMGInPosts = cint(NobjDict.Item("slImages")) NstrIcons = 0 set NobjDict = nothing strSQL = "SELECT TOP " & NslPosts & " " & strTablePrefix & "TOPICS.TOPIC_ID, " & _ strTablePrefix & "TOPICS.T_SUBJECT, " & _ strTablePrefix & "TOPICS.T_AUTHOR, " & _ strTablePrefix & "MEMBERS.M_NAME, " & _ strTablePrefix & "TOPICS.T_REPLIES, " & _ strTablePrefix & "TOPICS.T_DATE, " & _ strTablePrefix & "TOPICS.T_MESSAGE " & _ "FROM " & strTablePrefix & "TOPICS, " & _ strTablePrefix & "FORUM, " & _ strMemberTablePrefix & "MEMBERS " & _ "WHERE " & strTablePrefix & "FORUM.F_PRIVATEFORUMS = 0 AND " & _ strTablePrefix & "TOPICS.FORUM_ID = " & strTablePrefix & "FORUM.FORUM_ID AND " & _ strTablePrefix & "TOPICS.T_NEWS = 1 AND " & _ strTablePrefix & "TOPICS.T_AUTHOR = " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " Select Case NslSort Case "2" ' last post strSQL = strSQL & "ORDER BY " & strTablePrefix & "TOPICS.T_LAST_POST DESC;" Case "3" ' hot topics strSQL = strSQL & "ORDER BY " & strTablePrefix & "TOPICS.T_REPLIES DESC;" Case Else ' last created strSQL = strSQL & "ORDER BY " & strTablePrefix & "TOPICS.TOPIC_ID DESC;" End Select set NobjRec = my_Conn.Execute(strSql) mwpThemeTitle= "News" mwpThemeCellCustomCode = "colspan=""3""" mwpThemeBlock_open() While NOT NobjRec.EOF NT_Subject = ChkString(NobjRec("T_SUBJECT"),"display") NT_Author = NobjRec("T_AUTHOR") NM_NAME = NobjRec("M_NAME") NT_Message = NobjRec("T_MESSAGE") NT_REPLIES = NobjRec("T_REPLIES") NT_DATE = NobjRec("T_DATE") NTOPIC_ID = NobjRec("TOPIC_ID") If Len(NT_Message) > CInt(NslLength) Then NT_Message = Left(NT_Message, NslLength) & "..." Else NT_Message = NT_Message End If if NslEncode = 1 then NT_Message = formatStr(NT_MESSAGE) else NT_Message = HTMLencode(NT_MESSAGE) end if %> <% NobjRec.MoveNext() Wend %> <% mwpThemeBlock_close() NobjRec.close Set NobjRec = nothing %> <%if trim(strPollAns2) <> "" then%> <%end if if trim(strPollAns3) <> "" then%> <%end if if trim(strPollAns4) <> "" then%> <%end if if trim(strPollAns5) <> "" then%> <%end if if trim(strPollAns6) <> "" then%> <%end if if trim(strPollAns7) <> "" then%> <%end if if trim(strPollAns8) <> "" then%> <%end if if trim(strPollAns9) <> "" then%> <%end if if trim(strPollAns10) <> "" then%> <%end if if trim(strPollAns11) <> "" then%> <%end if if trim(strPollAns12) <> "" then%> <%end if%> <%mwpThemeBlock_close() else mwpThemeTitle= "Poll Results:" mwpThemeCellCustomCode = "colspan=""2""" mwpThemeBlock_open()%> <%if trim(strPollAns2) <> "" then%> <%end if if trim(strPollAns3) <> "" then%> <%end if if trim(strPollAns4) <> "" then%> <%end if if trim(strPollAns5) <> "" then%> <%end if if trim(strPollAns6) <> "" then%> <%end if if trim(strPollAns7) <> "" then%> <%end if if trim(strPollAns8) <> "" then%> <%end if if trim(strPollAns9) <> "" then%> <%end if if trim(strPollAns10) <> "" then%> <%end if if trim(strPollAns11) <> "" then%> <%end if if trim(strPollAns12) <> "" then%> <%end if%> <%mwpThemeBlock_close() end if end if%> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** %><% if not strJokeOfTheWeek = 0 then strJOTW = cInt(strJokeOfTheWeek) mwpThemeTitle= "Joke of the week" mwpThemeBlock_open() strSQL = "SELECT ARTICLE_ID, TITLE, SHOW, SUMMARY FROM ARTICLE WHERE SHOW = 1 AND ARTICLE_ID =" & strJOTW & " ORDER BY HIT DESC" set rs = my_Conn.Execute (strSql) if rs.EOF then%> <%else strArticleTitle = rs("Title") strSummary = rs("Summary") intArticleID = rs("Article_ID") Call Displayjoke() end if rs.Close Set rs = Nothing %> <% sub displayjoke %> <%end sub mwpThemeBlock_close() end if%> <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** if not strForumStatus = "down" then Set objRec = Server.CreateObject("ADODB.RecordSet") Set objDict = CreateObject("Scripting.Dictionary") strSQL = "SELECT m_code, m_value FROM " & strTablePrefix & "mods WHERE m_name = 'slash';" set objRec = my_conn.Execute(strSQL) while not objRec.EOF objDict.Add objRec.Fields.Item("m_code").Value, objRec.Fields.Item("m_value").Value objRec.moveNext wend slPosts = cint(objDict.Item("slPosts")) slLength = cint(objDict.Item("slLength")) slSort = cint(objDict.Item("slSort")) slEncode = cint(objDict.Item("slEncode")) strIMGInPosts = cint(objDict.Item("slImages")) strIcons = 0 set objDict = nothing strSQL = "SELECT TOP " & slPosts & " " & strTablePrefix & "TOPICS.TOPIC_ID, " & _ strTablePrefix & "TOPICS.T_SUBJECT, " & _ strTablePrefix & "TOPICS.T_AUTHOR, " & _ strTablePrefix & "TOPICS.T_LAST_POST_AUTHOR, " & _ strTablePrefix & "MEMBERS.M_NAME, " & _ strTablePrefix & "TOPICS.T_REPLIES, " & _ strTablePrefix & "TOPICS.T_DATE, " & _ strTablePrefix & "TOPICS.T_LAST_POST, " & _ strTablePrefix & "TOPICS.T_MESSAGE, " & _ strTablePrefix & "TOPICS.T_POLL " & _ "FROM " & strTablePrefix & "TOPICS, " & _ strTablePrefix & "FORUM, " & _ strMemberTablePrefix & "MEMBERS " & _ "WHERE " & strTablePrefix & "FORUM.F_PRIVATEFORUMS = 0 AND " & _ strTablePrefix & "TOPICS.FORUM_ID = " & strTablePrefix & "FORUM.FORUM_ID AND " & _ strTablePrefix & "TOPICS.T_NEWS = 0 AND NOT " & _ strTablePrefix & "TOPICS.T_STATUS = 0 AND " & _ strTablePrefix & "TOPICS.T_AUTHOR = " & strMemberTablePrefix & "MEMBERS.MEMBER_ID " Select Case slSort Case "2" ' last post strSQL = strSQL & "ORDER BY " & strTablePrefix & "TOPICS.T_LAST_POST DESC;" DTString = "The Last [slPosts] topics" Case "3" ' hot topics strSQL = strSQL & "ORDER BY " & strTablePrefix & "TOPICS.T_REPLIES DESC;" DTString = "The Top [slPosts] hottest" Case Else ' last created strSQL = strSQL & "ORDER BY " & strTablePrefix & "TOPICS.TOPIC_ID DESC;" DTString = "The Last [slPosts] topics" End Select DTString = Replace(DTString,"[slPosts]", slPosts) DTString = Replace(DTString,"[ForumName]", strSiteTitle) set objRec = my_Conn.Execute(strSql) mwpThemeTitle= DTString mwpThemeBlock_open() While NOT objRec.EOF T_Subject = ChkString(objRec("T_SUBJECT"),"display") T_Author = objRec("T_AUTHOR") T_LastAuthor = objRec("T_LAST_POST_AUTHOR") M_NAME = objRec("M_NAME") T_Message = objRec("T_MESSAGE") T_REPLIES = objRec("T_REPLIES") T_DATE = objRec("T_DATE") TOPIC_ID = objRec("TOPIC_ID") T_LAST_POST = objRec("T_LAST_POST") 'if slEncode = 1 then 'T_Message = SlashCode(T_MESSAGE) 'else T_Message = HTMLencode(T_MESSAGE) 'end if T_Message = replace(T_Message, "/"," ", 1, -1, 1) T_Message = replace(T_Message, "_"," ", 1, -1, 1) T_Message = replace(T_Message, "&"," ", 1, -1, 1) T_Message = replace(T_Message, "*"," ", 1, -1, 1) T_Message = replace(T_Message, ""," ", 1, -1, 1) T_Message = replace(T_Message, "^"," ", 1, -1, 1) T_Message = replace(T_Message, "-"," ", 1, -1, 1) T_Message = replace(T_Message, ""," ", 1, -1, 1) T_Message = replace(T_Message, "#"," ", 1, -1, 1) T_Message = replace(T_Message, "%"," ", 1, -1, 1) T_Message = chkBadWords(T_Message) if instr(T_SUBJECT, " ") = 0 and Len(T_SUBJECT) > 18 then T_SUBJECT = Left(T_SUBJECT, 15) & "..." end if If Len(T_Message) > CInt(slLength) Then T_Message = Left(T_Message, slLength) & "..." Else T_Message = T_Message End If %> <%If not CInt(slLength) = 0 then%> <%end if%> <% objRec.MoveNext() Wend %> <% mwpThemeBlock_close() objRec.close Set objRec = nothing end if %>
    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** %> <% mwpThemeTitle= "Menu" mwpThemeBlock_open() if IsEmpty(Session(strCookieURL & "last_here_date")) then Session(strCookieURL & "last_here_date") = ReadLastHereDate(strDBNTUserName) end if ActiveTopicCount = -1 if not IsNull(Session(strCookieURL & "last_here_date")) then if not blnHiddenForums then strSql = "SELECT COUNT(" & strTablePrefix & "TOPICS.T_LAST_POST) AS NUM_ACTIVE " strSql = strSql & "FROM " & strTablePrefix & "TOPICS " strSql = strSql & "WHERE (((" & strTablePrefix & "TOPICS.T_LAST_POST)>'"& Session(strCookieURL & "last_here_date") & "'))" set rs = my_Conn.Execute(strSql) if not rs.EOF then ActiveTopicCount = rs("NUM_ACTIVE") else ActiveTopicCount = 0 end if end if end if rs.close set rs = nothing ShowLastHere = (cint(ChkUser2(strDBNTUserName, Request.Cookies(strUniqueID & "User")("Pword"))) > 0) %>
    <% if ActiveTopicCount > 0 then %>- Active <% if ActiveTopicCount = 1 then Response.Write("topic") else Response.Write("topics") end if %> (<%= ActiveTopicCount %>)<% else %>- Active topics (0)<% end if %>
    - New Articles (<%=rsDay("ARTICLECOUNT")%>)
    - New Downloads (<%=rsDay("DLCOUNT")%>)
    <% if strDBNTUserName = "" Then %>- Private messages<% else %><%if not pmcount = "0" then%>- Private messages (<% =pmcount %>)<%else%>- Private messages (0)<%end if%><% end if %>
    <% if strDBNTUserName = "" Then %>- My Bookmarks<% else %>- My Bookmarks<% end if%>
    <% if strDBNTUserName = "" Then %>- Site Statistics<% else %>- Site Statistics<% end if%>
    <% if strDBNTUserName = "" Then %>- PM Pager<% else %>- PM Pager<% end if%>
    - Admin Options

    Members: <% =Users%>
    Active Users:
    <%=strOnlineMembersCount%> Members and <%=strOnlineGuestsCount%> Guests
    <%=strDLName%><% if dateSince >= 0 then response.write ""%>
    (Hits: <%=intHit%>)
    <%=strDescription%>
    No Downloads Found!
    No Articles Found!
    <%=strArticleTitle%><% if dateSince >= 0 then response.write ""%>
    <%=strSummary%>

    The Store
    News Ticker
    Site Info/Affiliates
    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** mwpThemeTitle= "Announcements" mwpThemeBlock_open() %>
    <% 'Set days to 0 to show all announcements days = 60 days = cint(days) strSql = "SELECT " & strTablePrefix & "ANNOUNCE.A_ID, " strSql = strSql & strTablePrefix & "ANNOUNCE.A_SUBJECT, " strSql = strSql & strTablePrefix & "ANNOUNCE.A_START_DATE, " strSql = strSql & strTablePrefix & "ANNOUNCE.A_END_DATE " strSql = strSql & "FROM " & strTablePrefix & "ANNOUNCE " strSql = strSql & " WHERE " & strTablePrefix & "ANNOUNCE.A_START_DATE <= " & "'" & DatetoStr(strForumTimeAdjust) & "'" if days > 0 then strSql = strSql & " AND " & strTablePrefix & "ANNOUNCE.A_START_DATE >= " & "'" & DateToStr(dateadd("d", -days, strForumTimeAdjust)) & "'" end if strSql = strSql & " AND " & strTablePrefix & "ANNOUNCE.A_END_DATE > " & "'" & DatetoStr(strForumTimeAdjust) & "'" strSql = strSql & " ORDER BY " & strTablePrefix & "ANNOUNCE.A_START_DATE DESC" strSql = strSql & ", " & strTablePrefix & "ANNOUNCE.A_ID DESC;" set rsAnnounce = my_Conn.Execute (strSql) if rsAnnounce.eof or rsAnnounce.bof then%> No new announcements <%else Do While Not rsAnnounce.EOF%>Announcements  "><% =rsAnnounce("A_SUBJECT")%>
    <% rsAnnounce.MoveNext Loop %>
    <%= NT_SUBJECT%> Posted by <%= NM_NAME %> <%= ChkDate(NT_DATE) %>
    <%= ChkTime(NT_DATE) %>
    <%= NT_MESSAGE %>

    <%if (lcase(strEmail) = "1") then %><%end if%>
    Read entire message Last Comments (<%= NT_REPLIES %>)
    Archived News Search News
    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** if strFeaturedPoll <> 0 then strSql = "SELECT " & strTablePrefix & "TOPICS.TOPIC_ID, " & strTablePrefix & "TOPICS.FORUM_ID, " & strTablePrefix & "TOPICS.CAT_ID, " & strTablePrefix & "TOPICS.T_SUBJECT, " & strTablePrefix & "FORUM.F_SUBJECT " strSql = strSql & " FROM " & strTablePrefix & "TOPICS , " & strTablePrefix & "FORUM " strSql = strSql & " WHERE " & strTablePrefix & "TOPICS.T_POLL = " & strFeaturedPoll strSql = strSql & " AND " & strTablePrefix & "FORUM.FORUM_ID = " & strTablePrefix & "TOPICS.FORUM_ID" set rsPoll = my_Conn.Execute (strSql) if (rsPoll.EOF or rsPoll.BOF) then response.write "Invalid Poll ID, You must create a poll first" else strRqTopicID = rsPoll("TOPIC_ID") strRqForumID = rsPoll("FORUM_ID") strRqCatID = rsPoll("CAT_ID") strRqTopic_Title = rsPoll("T_SUBJECT") strRqForum_Title = rsPoll("F_SUBJECT") end if rsPoll.Close set rsPoll = nothing strSql = "SELECT POLL_TYPE, POLL_ID, POLL_ALLOW, POLL_QUESTION," strSql = strSql & " ANSWER1, ANSWER2, ANSWER3, ANSWER4, ANSWER5, ANSWER6, ANSWER7, ANSWER8, ANSWER9, ANSWER10, ANSWER11, ANSWER12," strSql = strSql & " RESULT1, RESULT2, RESULT3, RESULT4, RESULT5, RESULT6, RESULT7, RESULT8, RESULT9, RESULT10, RESULT11, RESULT12," strSql = strSql & " POST_DATE, END_DATE, POLL_AUTHOR " strSql = strSql & " FROM " & strTablePrefix & "POLLS " strSql = strSql & " WHERE POLL_ID = " & strFeaturedPoll set rs = my_Conn.Execute (strSql) if not(rs.eof or rs.bof) then if rs("POLL_TYPE") = "0" then strPollType = 0 else strPollType = 1 end if strPoll_ID = rs("POLL_ID") strPollAllow = rs("POLL_ALLOW") strPollQuestion = rs("POLL_QUESTION") strPollAns1 = rs("ANSWER1") strPollAns2 = rs("ANSWER2") strPollAns3 = rs("ANSWER3") strPollAns4 = rs("ANSWER4") strPollAns5 = rs("ANSWER5") strPollAns6 = rs("ANSWER6") strPollAns7 = rs("ANSWER7") strPollAns8 = rs("ANSWER8") strPollAns9 = rs("ANSWER9") strPollAns10 = rs("ANSWER10") strPollAns11 = rs("ANSWER11") strPollAns12 = rs("ANSWER12") if rs("RESULT1") <> "" then strPollRes1 = cInt(rs("RESULT1")) else strPollRes1 = 0 end if if rs("RESULT2") <> "" then strPollRes2 = cInt(rs("RESULT2")) else strPollRes2 = 0 end if if rs("RESULT3") <> "" then strPollRes3 = cInt(rs("RESULT3")) else strPollRes3 = 0 end if if rs("RESULT4") <> "" then strPollRes4 = cInt(rs("RESULT4")) else strPollRes4 = 0 end if if rs("RESULT5") <> "" then strPollRes5 = cInt(rs("RESULT5")) else strPollRes5 = 0 end if if rs("RESULT6") <> "" then strPollRes6 = cInt(rs("RESULT6")) else strPollRes6 = 0 end if if rs("RESULT7") <> "" then strPollRes7 = cInt(rs("RESULT7")) else strPollRes7 = 0 end if if rs("RESULT8") <> "" then strPollRes8 = cInt(rs("RESULT8")) else strPollRes8 = 0 end if if rs("RESULT9") <> "" then strPollRes9 = cInt(rs("RESULT9")) else strPollRes9 = 0 end if if rs("RESULT10") <> "" then strPollRes10 = cInt(rs("RESULT10")) else strPollRes10 = 0 end if if rs("RESULT11") <> "" then strPollRes11 = cInt(rs("RESULT11")) else strPollRes11 = 0 end if if rs("RESULT12") <> "" then strPollRes12 = cInt(rs("RESULT12")) else strPollRes12 = 0 end if strPostDate = rs("POST_DATE") strEndDate = rs("END_DATE") strPollAuthor = rs("POLL_AUTHOR") end if rs.Close set rs = nothing strResultTotal = cInt(strPollRes1 + strPollRes2 + strPollRes3 + strPollRes4 + strPollRes5 + strPollRes6 + strPollRes7 + strPollRes8 + strPollRes9 + strPollRes10 + strPollRes11 + strPollRes12) if not strResultTotal = 0 then barPercent1 = round((strPollRes1/strResultTotal)*100,0) barPercent2 = round((strPollRes2/strResultTotal)*100,0) barPercent3 = round((strPollRes3/strResultTotal)*100,0) barPercent4 = round((strPollRes4/strResultTotal)*100,0) barPercent5 = round((strPollRes5/strResultTotal)*100,0) barPercent6 = round((strPollRes6/strResultTotal)*100,0) barPercent7 = round((strPollRes7/strResultTotal)*100,0) barPercent8 = round((strPollRes8/strResultTotal)*100,0) barPercent9 = round((strPollRes9/strResultTotal)*100,0) barPercent10 = round((strPollRes10/strResultTotal)*100,0) barPercent11 = round((strPollRes11/strResultTotal)*100,0) barPercent12 = round((strPollRes12/strResultTotal)*100,0) else barPercent1 = 0 barPercent2 = 0 barPercent3 = 0 barPercent4 = 0 barPercent5 = 0 barPercent6 = 0 barPercent7 = 0 barPercent8 = 0 barPercent9 = 0 barPercent10 = 0 barPercent11 = 0 barPercent12 = 0 end if if strPostDate <> strEndDate then pollExpireT = 1 if strEndDate >= DateToStr(strForumTimeAdjust) then pollExpireT = 0 end if else pollExpireT = 0 end if if trim(strDBNTUserName) = "" then tmpUserId = 0 else tmpUserId = getMemberID(strDBNTUserName) end if if trim(strDBNTUserName) = "" then tmpUserId2 = -1 else tmpUserId2 = getMemberID(strDBNTUserName) end if strSql = "SELECT POLL_ID" strSql = strSql & " FROM " & strTablePrefix & "POLL_ANS " strSql = strSql & " WHERE POLL_ID = " & strFeaturedPoll & " AND MEMBER_ID = " & tmpUserId2 set rs = my_Conn.Execute (strSql) if not(rs.eof or rs.bof) then alreadyVoted = 1 else alreadyVoted = 0 end if rs.Close set rs = nothing if not trim(Request.Cookies("poll")(""&strFeaturedPoll&"")) = "" then cookied = 1 else cookied = 0 end if if (pollExpireT = 0 and strPollAllow = 1 and cookied = 0) or (pollExpireT = 0 and strPollAllow = 0 and alreadyVoted = 0) then%>
    <%mwpThemeTitle= "Featured Poll" mwpThemeCellCustomCode = "colspan=""2""" mwpThemeBlock_open()%>
     <% =strPollQuestion %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns1 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns2 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns3 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns4 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns5 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns6 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns7 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns8 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns9 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns10 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns11 %>
    type="radio"<%else%>type="checkbox"<%end if%>>  <% =strPollAns12 %>

    View Results
    <%if pollExpireT = 1 then%> Poll has expired
    <%end if%> Question: <% =strPollQuestion %>
    <% =strPollAns1 %>:  <% =strPollRes1 %> (<% =barPercent1%>%)
    <% =strPollAns2 %>:  <% =strPollRes2 %> (<% =barPercent2%>%)
    <% =strPollAns3 %>:  <% =strPollRes3 %> (<% =barPercent3%>%)
    <% =strPollAns4 %>:  <% =strPollRes4 %> (<% =barPercent4%>%)
    <% =strPollAns5 %>:  <% =strPollRes5 %> (<% =barPercent5%>%)
    <% =strPollAns6 %>:  <% =strPollRes6 %> (<% =barPercent6%>%)
    <% =strPollAns7 %>:  <% =strPollRes7 %> (<% =barPercent7%>%)
    <% =strPollAns8 %>:  <% =strPollRes8 %> (<% =barPercent8%>%)
    <% =strPollAns9 %>:  <% =strPollRes9 %> (<% =barPercent9%>%)
    <% =strPollAns10 %>:  <% =strPollRes10 %> (<% =barPercent10%>%)
    <% =strPollAns11 %>:  <% =strPollRes11 %> (<% =barPercent11%>%)
    <% =strPollAns12 %>:  <% =strPollRes12 %> (<% =barPercent12%>%)
    Total: <% =strResultTotal %><%if strResultTotal = "1" then response.write " vote" else response.write " votes"%>

    View Results
    No Jokes Found!
    <%=strArticleTitle%><% if dateSince >= 0 then response.write ""%>
    <%=strSummary%>

    <%= T_SUBJECT%><% if objRec("T_POLL") <> 0 then %> <% end if %>
    Posted by <%= M_NAME %><%if T_REPLIES <> 0 then%> Last replied by <%=getMemberName(T_LastAuthor)%><%end if%><%if T_REPLIES <> 0 then%> on <%= ChkDate(T_LAST_POST) %> @ <%= ChkTime(T_LAST_POST) %><%else%> on <%= ChkDate(T_DATE) %> @ <%= ChkTime(T_DATE) %><%end if%>
    <%= T_MESSAGE %>
    [Read Topic<%if not T_REPLIES = 0 then%>|Last Reply (<%= T_REPLIES %>)<%end if%>]

    <% '*********************************************************************** '** Copyright (C) 2001 - 2003 Max Yuan All Rights Reserved '** '** By using this program, you are agreeing to the terms of the '** GNU General Public License. '** '** 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 any later version. '** '** All copyright notices regarding MaxWebPortal must remain intact '** in the scripts and in the outputted HTML. '** The "powered by" text/logo with a link back to '** http://www.maxwebportal.com in the footer of the pages MUST '** remain visible when the pages are viewed on the internet or intranet. '** '** Support can be obtained from support forums at: '** http://www.maxwebportal.com '** '** Email: maxwebportal@hotmail.com '** ICQ: 148111300 '*********************************************************************** '** This Page Contains source code of Snitz Forums 2000 '*********************************************************************** '################################################################################# '## Copyright (C) 2000 Michael Anderson and Pierre Gorissen '## '## 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 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 support forums at: '## http://forum.snitz.com '## '## Correspondence and Marketing Questions can be sent to: '## reinhold@bigfoot.com '## '## or '## '## Snitz Communications '## C/O: Michael Anderson '## PO Box 200 '## Harpswell, ME 04079 '################################################################################# if exceer=okoame then if CurPageInfoChk = "" then strOnlineLocation = "Unknown page" else if CurPageType = "forums" and trim(strRqForumID) <> "" then '## Forum_SQL - load the user list strSql = "SELECT " & strTablePrefix & "FORUM.F_PRIVATEFORUMS FROM " & strTablePrefix & "FORUM WHERE FORUM_ID = " & strRqForumID & " AND F_PRIVATEFORUMS <> 0" set rsPrf = my_Conn.Execute(strSql) if not (rsPrf.BOF and rsPrf.EOF) then isPrivateForum = 1 else isPrivateForum = 0 end if rsPrf.Close set rsPrf = nothing end if if not CurPageInfo () = "" then if isPrivateForum = 1 then strOnlineLocation = "Private Page" else strOnlineLocation = CurPageInfo () end if else strOnlineLocation = "Hidden page" end if end if strOnlineUser = OnlineSQLencode(strOnlineUser) strOnlineLocation = OnlineSQLencode(strOnlineLocation) strOnlineTimedOut = strOnlineCheckInTime - 1500 'time out the user after 25 minutes strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "' AND " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "'" set rsWho = my_Conn.Execute (strSql) if rsWho.eof or rsWho.bof then ' THEY ARE A NEW USER SO INSERT THERE USERNAME on error resume next Set objRS2 = Server.CreateObject("ADODB.Recordset") strSQL = "INSERT INTO " & strTablePrefix & "ONLINE (UserID,UserIP,DateCreated,CheckedIn,LastChecked,M_BROWSE) VALUES ('" strSql = strSQL & strOnlineUser & "','" & strOnlineUserIP & "','" & strOnlineDate & "','" & strOnlineCheckInTime & "','" & strOnlineCheckInTime & "','" & strOnlineLocation & "')" my_Conn.Execute (strSql) if err.number <> 0 then response.write err.number & "|" & err.description else ' THEY ARE A ACTIVE USER strSql = "SELECT " & strTablePrefix & "ONLINE.UserID, " & strTablePrefix & "ONLINE.UserIP, " & strTablePrefix & "ONLINE.LastChecked" strSql = strSql & " FROM " & strTablePrefix & "ONLINE " strSql = strSql & " WHERE " & strTablePrefix & "ONLINE.UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP = '" & strOnlineUserIP & "'" set rsLastChecked = my_Conn.Execute (strSql) ' LETS UPDATE THE TABLE SO IT SHOWS THERE LAST ACTIVE VISIT strSql = "UPDATE " & strTablePrefix & "ONLINE SET M_BROWSE='" & strOnlineLocation & "' , LastChecked='" & strOnlineCheckInTime & "' WHERE UserID='" & strOnlineUser & "' AND " & strTablePrefix & "ONLINE.UserIP='" & strOnlineUserIP & "'" my_Conn.Execute (strSql) end if inc_exef19() ' LETS DELETE ALL INACTIVE USERS SQL = "DELETE FROM " & strTablePrefix & "ONLINE WHERE LastChecked < '" & strOnlineTimedOut & "'" my_Conn.Execute SQL my_Conn.Close set my_Conn = nothing else%>
    <%if mwpThemeCustomFooter = "1" then mwpThemeFooterCustomCode = " border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" align=""center"" width=""95%""" mwpThemeFooterBlock_open()%> <%else%>
    <%end if%> <%'** START - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%'** END - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE MAXWEBPORTAL LICENSE AGREEMENT%> <%if mwpThemeCustomFooter = "1" then%>
    Set as your default homepage Add favorite Privacy   Report Bugs <% =strCopyright %> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "MaxWebPortal" end if%> <%if strShowImagePoweredBy = "1" then Response.Write "" else Response.Write "Snitz Forums" end if%>Go To Top Of Page
    <%mwpThemeFooterBlock_close() else%> <%end if%> <%end if mwpThemeEnd() %>