<% Option Explicit Response.Buffer = True Response.Clear %> <% Const tstScript = "toast" Dim strScriptName, strSelectedSkin, strHelpLink, valAction, valSub, strLicense Dim strDisplayPage If Not tstDebugMode Then On Error Resume Next tstMain If Err.Number <> 0 Then shrRuntimeError Err.Number, Err.Description, Err.Source, "" shrRunCleanup strDisplayPage = Replace(strDisplayPage, "", shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\header.html")) strDisplayPage = Replace(strDisplayPage, "", shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\footer.html")) tstBeforeDisplayPage strDisplayPage If InStr(strDisplayPage, "") > 0 Then strDisplayPage = Replace(strDisplayPage, "", shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\header.html")) strDisplayPage = Replace(strDisplayPage, "", shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\footer.html")) End If strDisplayPage = tstInsertVars(strDisplayPage) Response.Write strDisplayPage '---------------------------------------------------------------------------------------- Sub tstMain() Response.Expires = -1000 If shrGetConfig("tstlngCharSet") <> "" Then Response.CharSet = shrGetConfig("tstlngCharSet") Else Response.CharSet = "iso-8859-1" End If strScriptName = Request.ServerVariables("SCRIPT_NAME") If IsNumeric(tstSessionTimeout) Then Session.Timeout = tstSessionTimeout End If If Session(tstUniqueBoardKey & "tstsesUID") = 0 Then If Request.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login")("username") <> "" Then If Not shrDoLogin(Request.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login")("username"), shrRC4Encrypt(shrPasswordKey, Request.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login")("password"))) Then Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login").Expires = DateAdd("m",-1,Now()) End If End If End If strSelectedSkin = Session(tstUniqueBoardKey & "tstsesSkin") If strSelectedSkin = "" Then strSelectedSkin = shrGetConfig("tstcfgDefaultSkin") intUserID = Session(tstUniqueBoardKey & "tstsesUID") strLicense = shrCheckLicense(shrGetConfig("tstcfgLicenseKey"), Request.ServerVariables("SERVER_NAME")) shrLogActiveUser shrActiveUserCleanup If shrGetConfig("tstcfgBoardAvailable") <> "True" Then tstDoError shrGetConfig("tstcfgBoardNotAvailableError") Exit Sub End If valAction = Request("action") If valAction = "" Then valAction = "forums" Select Case valAction Case "forums" valSub = Request("sub") If valSub = "" Then valSub = "show" Select Case valSub Case "show" tstShowForums Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "topics" valSub = Request("sub") If valSub = "" Then valSub = "show" Select Case valSub Case "show" tstShowTopics Case "new" tstShowNewTopic Case "submit" If Request("modify") <> "" Or Request("modify.x") <> "" Then tstShowNewTopic Else tstSubmitNewTopic End If Case "lock" tstLockTopic Case "unlock" tstUnlockTopic Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "posts" valSub = Request("sub") If valSub = "" Then valSub = "show" Select Case valSub Case "show" tstShowPosts Case "reply" tstShowNewReply Case "submit" If Request("modify") <> "" Or Request("modify.x") <> "" Then tstShowNewReply Else tstSubmitNewReply End If Case "showsearch" tstShowSearchPosts Case "search" tstSubmitSearchPosts Case "deleteconfirm" tstShowDeleteConfirm Case "delete" tstDeletePost Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "modify" valSub = Request("sub") If valSub = "" Then valSub = "show" Select Case valSub Case "show" tstShowModifyPost Case "submit" If Request("modify") <> "" Or Request("modify.x") <> "" Then tstShowModifyPost Else tstSubmitModifyPost End If Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "register" valSub = Request("sub") If valSub = "" Then valSub = "new" Select Case valSub Case "new" tstNewRegister Case "submit" tstSubmitRegister Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "login" valSub = Request("sub") If valSub = "" Then valSub = "showlogin" Select Case valSub Case "showlogin" tstShowLogin Case "submit" tstSubmitLogin Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "logout" tstLogout Case "profile" valSub = Request("sub") If valSub = "" Then shrRedirectTo strScriptName End If Select Case valSub Case "view" tstViewProfile Case "modify" tstModifyProfile Case "changeskin" tstChangeSkin Case "submit" tstSubmitProfile Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select Case "lostpassword" valSub = Request("sub") If valSub = "" Then valSub = "show" Select Case valSub Case "show" tstShowLostPassword Case "submit" tstSubmitLostPassword End Select Case "help" tstShowHelp Case "tstDoError" valSub = Request("sub") If valSub = "" Then valSub = "langGenericError" tstDoError shrGetConfig(valSub) Exit Sub Case Else tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End Select End Sub '---------------------------------------------------------------------------------------- Sub tstShowForums Dim aForumsList Dim ix Dim strForumName, strForumLink, strForumDescription, strForumModeratorProfileLink, strForumModerator, strTopicCount, strPostCount, strLastPostDate Dim strForumRowFile, strForumRow Dim objForumRows Dim rsMain 'Populate local vars '------------------------------------------------------- strForumRowFile = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\forumslist.html") Set objForumRows = New StringBuilder If tstCacheForumList Then If shrGetConfig("tstcfgForumsList") <> "" Then aForumsList = Split(shrGetConfig("tstcfgForumsList"), ",") For ix = 0 To UBound(aForumsList) strForumName = shrGetConfig("tstcfgForum" & aForumsList(ix) & "ForumName") strForumLink = strScriptName & "?sub=show&action=topics&fid=" & shrGetConfig("tstcfgForum" & aForumsList(ix) & "ID") strForumDescription = shrGetConfig("tstcfgForum" & aForumsList(ix) & "Description") strForumModeratorProfileLink = strScriptName & "?sub=view&action=profile&uid=" & shrGetConfig("tstcfgForum" & aForumsList(ix) & "ModeratorID") strForumModerator = shrGetConfig("tstcfgForum" & aForumsList(ix) & "Moderator") strTopicCount = shrGetConfig("tstcfgForum" & aForumsList(ix) & "TopicCount") strPostCount = shrGetConfig("tstcfgForum" & aForumsList(ix) & "PostCount") strLastPostDate = shrFormatDate(shrGetConfig("tstcfgForum" & aForumsList(ix) & "LastPostDate"), shrGetConfig("tstlngLastPostDateText")) strForumRow = strForumRowFile strForumRow = Replace(strForumRow, "", "notread") strForumRow = Replace(strForumRow, "", strForumName) strForumRow = Replace(strForumRow, "", strForumLink) strForumRow = Replace(strForumRow, "", strForumDescription) strForumRow = Replace(strForumRow, "", strForumModeratorProfileLink) strForumRow = Replace(strForumRow, "", strForumModerator) strForumRow = Replace(strForumRow, "", strTopicCount) strForumRow = Replace(strForumRow, "", strPostCount) strForumRow = Replace(strForumRow, "", strLastPostDate) objForumRows.Append(strForumRow) Next Else tstDoError shrGetConfig("tstlngNoForumsDefinedError") Exit Sub End If Else Set rsMain = shrFindForums(Null, False) If Not rsMain.EOF Then Do While Not rsMain.EOF strForumName = shrFixRSValue(rsMain(tstdbForumFieldName)) strForumLink = strScriptName & "?sub=show&action=topics&fid=" & rsMain(tstdbForumFieldID) strForumDescription = shrFixRSValue(rsMain(tstdbForumFieldDescription)) strForumModeratorProfileLink = strScriptName & "?sub=view&action=profile&uid=" & rsMain(tstdbForumFieldModeratorID) strForumModerator = shrFixRSValue(rsMain("Moderator")) strTopicCount = rsMain(tstdbForumFieldTopicCount) strPostCount = rsMain(tstdbForumFieldPostCount) strLastPostDate = rsMain(tstdbForumFieldLastPostDate) strForumRow = strForumRowFile strForumRow = Replace(strForumRow, "", "notread") strForumRow = Replace(strForumRow, "", strForumName) strForumRow = Replace(strForumRow, "", strForumLink) strForumRow = Replace(strForumRow, "", strForumDescription) strForumRow = Replace(strForumRow, "", strForumModeratorProfileLink) strForumRow = Replace(strForumRow, "", strForumModerator) strForumRow = Replace(strForumRow, "", strTopicCount) strForumRow = Replace(strForumRow, "", strPostCount) strForumRow = Replace(strForumRow, "", strLastPostDate) objForumRows.Append(strForumRow) rsMain.MoveNext Loop End If shrDestroyRS rsMain End If Session(tstUniqueBoardKey & "tstsesCurrentForum") = "" Session(tstUniqueBoardKey & "tstsesCurrentTopic") = "" strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\forumsmain.html") strDisplayPage = Replace(strDisplayPage, "", objForumRows.ToString()) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstShowTopics Dim valQueryString, valFID, valCurrentPage Dim strForumName Dim strNumberedPageLinkText, strGuestUsernameText, strRegisteredUsernameText Dim ix, intLB, intUB, intMax Dim strTopicSubject, strTopicLink, strIcon, strUsername, strReplyCount, strHits, strPageLink, strLastReplyDate Dim strTopicRowFile, strTopicRow Dim objTopicRows Dim rsMain 'Get Form and other Vars '------------------------------------------------------- valQueryString = Request.ServerVariables("QUERY_STRING") valFID = Request("fid") valCurrentPage = Request("page") strForumName = shrGetConfig("tstcfgForum" & valFID & "ForumName") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If Not shrCheckForumAccess(valFID, "R") Then If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(valQueryString) Else tstDoError shrGetConfig("tstlngReadNoAccessError") Exit Sub End If End If If valCurrentPage = "" Or Not IsNumeric(valCurrentPage) Then valCurrentPage = 1 Else valCurrentPage = Int(valCurrentPage) End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindPosts(valFID, 0, Null, Null, Null, Null, Null, Null, Null, Null, False, Null, Null, tstdbPostTable & "." & tstdbPostFieldLastReplyDate & " DESC", CInt(Session(tstUniqueBoardKey & "tstsesTopicsPerPage"))) 'Format recordset for viewing. '------------------------------------------------------- Set objTopicRows = New StringBuilder If Not rsMain.EOF Then rsMain.AbsolutePage = valCurrentPage If rsMain.PageCount > 1 Then intMax = shrGetConfig("tstcfgMaxPagesonPageLink") If valCurrentPage > 1 Then strPageLink = "" & shrGetConfig("tstlnkPreviousPageLinkText") & " " End If intLB = valCurrentPage - Int(((intMax / 2) + .5) - 1) intUB = valCurrentPage + Int(intMax / 2) For ix = intLB to intUB If ix < 1 Then intLB = intLB + 1 If intUB < rsMain.PageCount Then intUB = intUB + 1 End If Elseif ix > rsMain.PageCount Then intUB = intUB - 1 If intLB > 1 Then intLB = intLB - 1 End If End If Next strNumberedPageLinkText = shrGetConfig("tstlnkNumberedPageLinkText") For ix = intLB to intUB If valCurrentPage = ix Then strPageLink = strPageLink & Replace(shrGetConfig("tstlnkSelectedPageLinkText"), "", valCurrentPage) & " " Else strPageLink = strPageLink & "" & Replace(strNumberedPageLinkText, "", ix) & " " End If Next If valCurrentPage < rsMain.PageCount Then strPageLink = strPageLink & "" & shrGetConfig("tstlnkNextPageLinkText") & "" End If End If strTopicRowFile = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\topicslist.html") strGuestUsernameText = shrGetConfig("tstlnkGuestUsernameText") strRegisteredUsernameText = shrGetConfig("tstlnkRegisteredUsernameText") For ix = 1 to rsMain.PageSize strTopicSubject = shrFixRSValue(rsMain(tstdbPostFieldSubject)) strTopicSubject = shrApplyBadWordFilter(strTopicSubject) strTopicLink = strScriptName & "?sub=show&action=posts&fid=" & valFID & "&tid=" & rsMain(tstdbPostFieldID) strIcon = shrGetConfig("tstlngMessageIcon" & rsMain(tstdbPostFieldIcon)) If strIcon = "" Then strIcon = shrGetConfig("tstlngMessageIcon" & shrGetConfig("tstlngDefaultMessageIcon")) strUsername = shrFixRSValue(rsMain(tstdbMemberFieldUsername)) If strUsername = "" Then strUsername = Replace(strGuestUsernameText, "", shrFixRSValue(rsMain(tstdbPostFieldGuestName))) Else strUsername = strRegisteredUsernameText strUsername = Replace(strUsername, "", strScriptName & "?sub=view&action=profile&uid=" & rsMain(tstdbPostFieldMemberID)) strUsername = Replace(strUsername, "", shrFixRSValue(rsMain(tstdbMemberFieldUsername))) End If strUsername = shrApplyBadWordFilter(strUsername) strReplyCount = shrFixRSValue(rsMain(tstdbPostFieldReplyCount)) strHits = shrFixRSValue(rsMain(tstdbPostFieldHits)) strLastReplyDate = shrFormatDate(rsMain(tstdbPostFieldLastReplyDate), shrGetConfig("tstlngLastReplyDateText")) strTopicRow = strTopicRowFile strTopicRow = Replace(strTopicRow, "", "notread") strTopicRow = Replace(strTopicRow, "", strTopicSubject) strTopicRow = Replace(strTopicRow, "", strTopicLink) strTopicRow = Replace(strTopicRow, "", strIcon) strTopicRow = Replace(strTopicRow, "", strUsername) strTopicRow = Replace(strTopicRow, "", strReplyCount) strTopicRow = Replace(strTopicRow, "", strLastReplyDate) strTopicRow = Replace(strTopicRow, "", strHits) objTopicRows.Append(strTopicRow) rsMain.MoveNext If rsMain.EOF Then Exit For Next Else objTopicRows.Append(shrGetConfig("tstlngNoTopicsError")) End If Session(tstUniqueBoardKey & "tstsesCurrentForum") = strForumName Session(tstUniqueBoardKey & "tstsesCurrentForumID") = valFID Session(tstUniqueBoardKey & "tstsesCurrentTopic") = "" strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\topicsmain.html") strDisplayPage = Replace(strDisplayPage, "", strForumName) strDisplayPage = Replace(strDisplayPage, "", strScriptName & "?sub=new&action=topics&fid=" & valFID) strDisplayPage = Replace(strDisplayPage, "", objTopicRows.ToString()) strDisplayPage = Replace(strDisplayPage, "", strPageLink) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain End Sub '---------------------------------------------------------------------------------------- Sub tstShowNewTopic Dim valFID Dim strSubject, strMessage, strSelectedIcon, strGuestName Dim strIncludeSignature, strIcon, strIconList, strNotifyDefault Dim ix 'Get Form Vars '------------------------------------------------------- valFID = Request("fid") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If 'Populate local vars '------------------------------------------------------- If shrCheckForumAccess(valFID, "T") Then If intUserID = 0 Then strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\guestpostnewtopic.html") Else strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\postnewtopic.html") End If strDisplayPage = shrInsertToastEdit(strDisplayPage, "message", "") Else If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request.ServerVariables("QUERY_STRING")) Else tstDoError shrGetConfig("tstlngTopicNoAccessError") Exit Sub End If End If If Session(tstUniqueBoardKey & "tempPostQueryString") = Request.ServerVariables("QUERY_STRING") Then strGuestName = Session(tstUniqueBoardKey & "tempPostGuestName") strSubject = Session(tstUniqueBoardKey & "tempPostSubject") strMessage = Session(tstUniqueBoardKey & "tempPostMessage") strSelectedIcon = Session(tstUniqueBoardKey & "tempPostIcon") ElseIf Request("modify") <> "" Or Request("modify.x") <> "" Then strGuestName = Request("guestname") strSubject = Request("subject") strMessage = Request("message") strSelectedIcon = Request("icon") Else strGuestName = shrGetConfig("tstlngGuestName") strSubject = "" strMessage = "" strSelectedIcon = shrGetConfig("tstlngDefaultMessageIcon") End If strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(strSubject)) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(strMessage)) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(strGuestName)) For ix = 1 to 10 strIcon = shrGetConfig("tstlngSelectMessageIcon" & ix) If ix = Int(strSelectedIcon) Then strIcon = Replace(strIcon, "", shrGetConfig("tstlngSelectedMessageIconText")) Else strIcon = Replace(strIcon, "", "") End If strIconList = strIconList & strIcon Next If Session(tstUniqueBoardKey & "tstsesIncludeSignature") Then strIncludeSignature = "checked" Else strIncludeSignature = "" End If If Session(tstUniqueBoardKey & "tstsesNotifyDefault") Then strNotifyDefault = "checked" Else strNotifyDefault = "" End If strDisplayPage = Replace(strDisplayPage, "", valFID) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(Request.ServerVariables("QUERY_STRING"))) strDisplayPage = Replace(strDisplayPage, "", shrFixRSValue(Session(tstUniqueBoardKey & "tstsesUsername"))) strDisplayPage = Replace(strDisplayPage, "", strIconList) strDisplayPage = Replace(strDisplayPage, "", strIncludeSignature) strDisplayPage = Replace(strDisplayPage, "", strNotifyDefault) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Provide feedback '------------------------------------------------------- Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitNewTopic Dim valPreview Dim valFID, valGuestName, valUserID, valIcon, valSubject, valMessage, valNotify, valSignature Dim intTopicID Dim verifyError 'Get Form Vars '------------------------------------------------------- valPreview = Request("preview") valFID = Request("fid") valIcon = Request("icon") valGuestName = Request("guestname") valUserID = intUserID valSubject = Request("subject") valMessage = Request("message") valNotify = Request("notify") valSignature = Request("includesig") 'Save vars in case user presses back button or user's session times out and he has to login before posting Session(tstUniqueBoardKey & "tempPostGuestName") = valGuestName Session(tstUniqueBoardKey & "tempPostSubject") = valSubject Session(tstUniqueBoardKey & "tempPostMessage") = valMessage Session(tstUniqueBoardKey & "tempPostIcon") = valIcon Session(tstUniqueBoardKey & "tempPostQueryString") = Request("querystring") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If Not shrCheckForumAccess(valFID, "T") Then If valUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request("querystring")) Else tstDoError shrGetConfig("tstlngTopicNoAccessError") Exit Sub End If End If If valUserID = 0 Then If verifyError = "" Then verifyError = shrDoVerify(valGuestName, tstdbPostFieldGuestNameFriendly, tstdbPostFieldGuestNameLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If End If If verifyError = "" Then verifyError = shrDoVerify(valSubject, tstdbPostFieldSubjectFriendly, tstdbPostFieldSubjectLen, False) If verifyError = "" Then verifyError = shrDoVerify(valMessage, tstdbPostFieldMessageFriendly, tstdbPostFieldMessageLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If If valPreview = "True" Then tstShowPreview "topics" Exit Sub End If valMessage = shrFormatPostBeforeDatabaseSubmit(valMessage) If valIcon = "" Then valIcon = shrGetConfig("tstlngDefaultMessageIcon") If valNotify = "True" Then valNotify = True Else valNotify = False End If If valSignature = "True" Then valMessage = valMessage & Replace(Session(tstUniqueBoardKey & "tstsesSignature"), shrHTMLEditorMetaTag, "") End If 'Save vars to database '------------------------------------------------------- intTopicID = 0 If verifyError = "" Then verifyError = shrNewPost(valFID, intTopicID, 0, valUserID, valGuestName, valIcon, valSubject, valMessage, valNotify) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Delete temp session vars Session(tstUniqueBoardKey & "tempPostGuestName") = "" Session(tstUniqueBoardKey & "tempPostSubject") = "" Session(tstUniqueBoardKey & "tempPostMessage") = "" Session(tstUniqueBoardKey & "tempPostIcon") = "" Session(tstUniqueBoardKey & "tempPostQueryString") = "" 'Provide feedback '------------------------------------------------------- shrRedirectTo strScriptName & "?sub=show&action=posts&fid=" & valFID & "&tid=" & intTopicID End Sub '---------------------------------------------------------------------------------------- Sub tstLockTopic Dim valTID, valUserID Dim verifyError 'Get Form Vars '------------------------------------------------------- valTID = Request("tid") valUserID = intUserID 'Start verification of vars '------------------------------------------------------- If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrModifyPost(Null, Null, valTID, valUserID, Null, Null, Null, Null, Null, False, Null) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Provide feedback '------------------------------------------------------- tstDoMessage shrGetConfig("tstlngTopicLockedSuccess") End Sub '---------------------------------------------------------------------------------------- Sub tstUnlockTopic Dim valTID, valUserID Dim verifyError 'Get Form Vars '------------------------------------------------------- valTID = Request("tid") valUserID = intUserID 'Start verification of vars '------------------------------------------------------- If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrModifyPost(Null, Null, valTID, valUserID, Null, Null, Null, Null, Null, True, Null) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Provide feedback '------------------------------------------------------- tstDoMessage shrGetConfig("tstlngTopicUnlockedSuccess") End Sub '---------------------------------------------------------------------------------------- Sub tstShowSearchPosts Dim aForumsList Dim strForumRow, strForumList Dim ix, beginSearchResults, endSearchResults 'Populate local vars '------------------------------------------------------- aForumsList = Split(shrGetConfig("tstcfgForumsList"), ",") strForumRow = shrGetConfig("tstlnkForumListLinkText") strForumList = strForumList & Replace(strForumRow, "", "-1") strForumList = Replace(strForumList, "", shrGetConfig("tstlngSearchFormAllForumsText")) For ix = 0 To UBound(aForumsList) strForumList = strForumList & Replace(strForumRow, "", shrGetConfig("tstcfgForum" & aForumsList(ix) & "ID")) strForumList = Replace(strForumList, "", shrGetConfig("tstcfgForum" & aForumsList(ix) & "ForumName")) Next strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\searchmain.html") beginSearchResults = InStr(strDisplayPage, "") If beginSearchResults > 0 Then endSearchResults = InStr(strDisplayPage, "") If endSearchResults > beginSearchResults Then strDisplayPage = Left(strDisplayPage, beginSearchResults - 1) & Mid(strDisplayPage, endSearchResults + 25) End If End If strDisplayPage = Replace(strDisplayPage, "", strForumList) strDisplayPage = Replace(strDisplayPage, "", "") strDisplayPage = Replace(strDisplayPage, "", "") strDisplayPage = Replace(strDisplayPage, "", "") strDisplayPage = Replace(strDisplayPage, "", "-1") strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitSearchPosts Dim valQueryString, valFID, valAuthor, valSubject, valMessage, valDayPrune, valAdvanced, valCurrentPage Dim aForumsList Dim strForumRow, strForumList Dim ix, iy, intLB, intUB, intMax, intTopicID, intResultsFound Dim rsMain Dim strNumberedPageLinkText, strPageLink Dim strGuestUsernameText, strRegisteredUsernameText Dim strSearchListFile, strSearchListRow Dim objSearchListRows Dim strSubject, strIcon, strUsername, strGuestName, strReplyLink, strModifyPostLink, strDeletePostLink, strActive, strLockTopicLink, strSendEmailLink, strMessage, strPostDate, strModifyDate Dim aPostDate, aModifyDate, aWords Dim intFoundWordStart Dim strPostLink Dim strTopicName Dim strDecodedBrandingCode strDecodedBrandingCode = shrBase64Decode(shrBrandingCode) 'Get Form and other Vars '------------------------------------------------------- valQueryString = Request.ServerVariables("QUERY_STRING") valFID = Request("fid") valAuthor = Request("author") valSubject = Request("subject") valMessage = Request("message") valDayPrune = Request("dayprune") valCurrentPage = Request("page") aForumsList = Split(shrGetConfig("tstcfgForumsList"), ",") strForumRow = shrGetConfig("tstlnkForumListLinkText") If valFID <> "" And IsNumeric(valFID) And valFID <> "-1" Then strForumList = Replace(strForumRow, "", valFID) strForumList = Replace(strForumList, "", shrGetConfig("tstcfgForum" & valFID & "ForumName")) End If strForumList = strForumList & Replace(strForumRow, "", "-1") strForumList = Replace(strForumList, "", shrGetConfig("tstlngSearchFormAllForumsText")) For ix = 0 To UBound(aForumsList) If CInt(valFID) <> CInt(shrGetConfig("tstcfgForum" & aForumsList(ix) & "ID")) Or valFID = "" Then strForumList = strForumList & Replace(strForumRow, "", shrGetConfig("tstcfgForum" & aForumsList(ix) & "ID")) strForumList = Replace(strForumList, "", shrGetConfig("tstcfgForum" & aForumsList(ix) & "ForumName")) End If Next 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Or valFID = "-1" Then valFID = Null End If If valDayPrune = "-1" Then valDayPrune = Null End If If valCurrentPage = "" Or Not IsNumeric(valCurrentPage) Then valCurrentPage = 1 Else valCurrentPage = Int(valCurrentPage) End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindPosts(valFID, Null, Null, Null, valAuthor, Null, valSubject, valMessage, Null, Null, False, valDayPrune, Null, Null, CInt(Session(tstUniqueBoardKey & "tstsesPostsPerPage"))) If IsNull(valDayPrune) Then valDayPrune = "-1" If IsNull(valFID) Then valFID = "-1" 'Format recordset for viewing. '------------------------------------------------------- Set objSearchListRows = New StringBuilder intResultsFound = rsMain.RecordCount If Not rsMain.EOF Then rsMain.AbsolutePage = valCurrentPage If rsMain.PageCount > 1 Then intMax = shrGetConfig("tstcfgMaxPagesonPageLink") If valCurrentPage > 1 Then strPageLink = "" & shrGetConfig("tstlnkPreviousPageLinkText") & " " End If intLB = valCurrentPage - Int(((intMax / 2) + .5) - 1) intUB = valCurrentPage + Int(intMax / 2) For ix = intLB to intUB If ix < 1 Then intLB = intLB + 1 If intUB < rsMain.PageCount Then intUB = intUB + 1 End If Elseif ix > rsMain.PageCount Then intUB = intUB - 1 If intLB > 1 Then intLB = intLB - 1 End If End If Next strNumberedPageLinkText = shrGetConfig("tstlnkNumberedPageLinkText") For ix = intLB to intUB If valCurrentPage = ix Then strPageLink = strPageLink & Replace(shrGetConfig("tstlnkSelectedPageLinkText"), "", valCurrentPage) & " " Else strPageLink = strPageLink & "" & Replace(strNumberedPageLinkText, "", ix) & " " End If Next If valCurrentPage < rsMain.PageCount Then strPageLink = strPageLink & "" & shrGetConfig("tstlnkNextPageLinkText") & "" End If End If strSearchListFile = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\searchlist.html") strGuestUsernameText = shrGetConfig("tstlnkGuestUsernameText") strRegisteredUsernameText = shrGetConfig("tstlnkRegisteredUsernameText") For ix = 1 to rsMain.PageSize If shrCheckForumAccess(rsMain(tstdbPostFieldForumID), "R") Then intTopicID = rsMain(tstdbPostFieldTopicID) If intTopicID = 0 Then intTopicID = rsMain(tstdbPostFieldID) strSubject = shrFixRSValue(rsMain(tstdbPostFieldSubject)) strSubject = shrApplyBadWordFilter(strSubject) strIcon = shrGetConfig("tstlngMessageIcon" & rsMain(tstdbPostFieldIcon)) If strIcon = "" Then strIcon = shrGetConfig("tstlngMessageIcon" & shrGetConfig("tstlngDefaultMessageIcon")) aWords = Split(valSubject, " ") For iy = 0 To UBound(aWords) intFoundWordStart = 1 Do Until Instr(intFoundWordStart, strSubject, aWords(iy), 1) = 0 intFoundWordStart = Instr(intFoundWordStart, strSubject, aWords(iy), 1) If Not shrWithinBrackets(strSubject, intFoundWordStart) Then strSubject = Left(strSubject, intFoundWordStart - 1) & Replace(strSubject, aWords(iy), Replace(shrGetConfig("tstlnkFoundSearchWordLinkText"), "", aWords(iy)), intFoundWordStart, 1, 1) End If intFoundWordStart = intFoundWordStart + Len(Replace(shrGetConfig("tstlnkFoundSearchWordLinkText"), "", aWords(iy))) + 1 Loop Next strPostLink = strScriptName & "?sub=show&action=posts&fid=" & rsMain(tstdbPostFieldForumID) & "&tid=" & intTopicID strUsername = shrFixRSValue(rsMain(tstdbMemberFieldUsername)) strGuestName = shrFixRSValue(rsMain(tstdbPostFieldGuestName)) If strUsername = "" Then strUsername = Replace(strGuestUsernameText, "", strGuestName) Else strUsername = Replace(strRegisteredUsernameText, "", strUsername) strUsername = Replace(strUsername, "", strScriptName & "?sub=view&action=profile&uid=" & rsMain(tstdbPostFieldMemberID)) End If strUsername = shrApplyBadWordFilter(strUsername) aWords = Split(valAuthor, " ") For iy = 0 To UBound(aWords) intFoundWordStart = 1 Do Until Instr(intFoundWordStart, strUsername, aWords(iy), 1) = 0 intFoundWordStart = Instr(intFoundWordStart, strUsername, aWords(iy), 1) If Not shrWithinBrackets(strUsername, intFoundWordStart) Then strUsername = Replace(strUsername, aWords(iy), Replace(shrGetConfig("tstlnkFoundSearchWordLinkText"), "", aWords(iy)), intFoundWordStart, 1, 1) End If intFoundWordStart = intFoundWordStart + 1 Loop Next strMessage = shrFormatPost(rsMain(tstdbPostFieldMessage)) aWords = Split(valMessage, " ") For iy = 0 To UBound(aWords) intFoundWordStart = 1 Do Until Instr(intFoundWordStart, strMessage, aWords(iy), 1) = 0 intFoundWordStart = Instr(intFoundWordStart, strMessage, aWords(iy), 1) If Not shrWithinBrackets(strMessage, intFoundWordStart) Then strMessage = Left(strMessage, intFoundWordStart - 1) & Replace(strMessage, aWords(iy), Replace(shrGetConfig("tstlnkFoundSearchWordLinkText"), "", aWords(iy)), intFoundWordStart, 1, 1) End If intFoundWordStart = intFoundWordStart + Len(Replace(shrGetConfig("tstlnkFoundSearchWordLinkText"), "", aWords(iy))) + 1 Loop Next If strLicense = shrUnregistered Then strMessage = strMessage & "
 

---

" & strDecodedBrandingCode End If strPostDate = shrFormatDate(rsMain(tstdbPostFieldPostDate), shrGetConfig("tstlngPostDateText")) strModifyDate = shrFormatDate(rsMain(tstdbPostFieldModifyDate), shrGetConfig("tstlngModifyDateText")) If strModifyDate = "" Then strModifyDate = shrGetConfig("tstlngNeverModifiedText") strSearchListRow = strSearchListFile strSearchListRow = Replace(strSearchListRow, "", strIcon) strSearchListRow = Replace(strSearchListRow, "", strSubject) strSearchListRow = Replace(strSearchListRow, "", strPostLink) strSearchListRow = Replace(strSearchListRow, "", strUsername) strSearchListRow = Replace(strSearchListRow, "", strMessage) strSearchListRow = Replace(strSearchListRow, "", strPostDate) strSearchListRow = Replace(strSearchListRow, "", strModifyDate) objSearchListRows.Append(strSearchListRow) End If rsMain.MoveNext If rsMain.EOF Then Exit For Next End If strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\searchmain.html") strDisplayPage = Replace(strDisplayPage, "", strForumList) strDisplayPage = Replace(strDisplayPage, "", valAuthor) strDisplayPage = Replace(strDisplayPage, "", valSubject) strDisplayPage = Replace(strDisplayPage, "", valMessage) strDisplayPage = Replace(strDisplayPage, "", valDayPrune) strDisplayPage = Replace(strDisplayPage, "", objSearchListRows.ToString()) strDisplayPage = Replace(strDisplayPage, "", Replace(shrGetConfig("tstlngResultsFound"), "", intResultsFound)) strDisplayPage = Replace(strDisplayPage, "", strPageLink) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain End Sub '---------------------------------------------------------------------------------------- Sub tstShowPosts Dim valQueryString, valTID, valFID, valCurrentPage Dim strForumName Dim rsMain Dim ix, intLB, intUB, intMax Dim strPageLink, strNumberedPageLinkText Dim strGuestUsernameText, strRegisteredUsernameText, strUsernameText Dim strSubject, strIcon, strUsername, strGuestName, strReplyLink, strModifyPostLink, strDeletePostLink, strActive, strLockTopicLink, strSendEmailLink, strMessage, strPostDate, strModifyDate Dim strPostRowFile, strPostRow Dim objPostRows Dim strTopicName, strDecodedBrandingCode Dim strSortOrder strDecodedBrandingCode = shrBase64Decode(shrBrandingCode) 'Get Form and other Vars '------------------------------------------------------- valQueryString = Request.ServerVariables("QUERY_STRING") valFID = Request("fid") valTID = Request("tid") valCurrentPage = Request("page") strForumName = shrGetConfig("tstcfgForum" & valFID & "ForumName") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If Not shrCheckForumAccess(valFID, "R") Then If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(valQueryString) Else tstDoError shrGetConfig("tstlngReadNoAccessError") Exit Sub End If End If If valCurrentPage = "" Or Not IsNumeric(valCurrentPage) Then valCurrentPage = 1 Else valCurrentPage = Int(valCurrentPage) End If strSortOrder = shrGetConfig("tstcfgPostSortOrder") If strSortOrder = "" Then strSortOrder = tstdbPostTable & "." & tstdbPostFieldPostDate & " ASC" End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindPosts(valFID, valTID, valTID, Null, Null, Null, Null, Null, Null, Null, False, Null, Null, strSortOrder, CInt(Session(tstUniqueBoardKey & "tstsesPostsPerPage"))) shrUpdateTopicHits valTID If rsMain.EOF Then tstDoError shrGetConfig("tstlngPostNotFoundError") Exit Sub End If 'Format recordset for viewing. '------------------------------------------------------- rsMain.AbsolutePage = valCurrentPage If rsMain.PageCount > 1 Then intMax = shrGetConfig("tstcfgMaxPagesonPageLink") If valCurrentPage > 1 Then strPageLink = "" & shrGetConfig("tstlnkPreviousPageLinkText") & " " End If intLB = valCurrentPage - Int(((intMax / 2) + .5) - 1) intUB = valCurrentPage + Int(intMax / 2) For ix = intLB to intUB If ix < 1 Then intLB = intLB + 1 If intUB < rsMain.PageCount Then intUB = intUB + 1 End If Elseif ix > rsMain.PageCount Then intUB = intUB - 1 If intLB > 1 Then intLB = intLB - 1 End If End If Next strNumberedPageLinkText = shrGetConfig("tstlnkNumberedPageLinkText") For ix = intLB to intUB If valCurrentPage = ix Then strPageLink = strPageLink & Replace(shrGetConfig("tstlnkSelectedPageLinkText"), "", valCurrentPage) & " " Else strPageLink = strPageLink & "" & Replace(strNumberedPageLinkText, "", ix) & " " End If Next If valCurrentPage < rsMain.PageCount Then strPageLink = strPageLink & "" & shrGetConfig("tstlnkNextPageLinkText") & "" End If End If strTopicName = shrFixRSValue(rsMain(tstdbPostFieldSubject)) strTopicName = shrApplyBadWordFilter(strTopicName) strPostRowFile = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\postslist.html") Set objPostRows = New StringBuilder strGuestUsernameText = shrGetConfig("tstlnkGuestUsernameText") strRegisteredUsernameText = shrGetConfig("tstlnkRegisteredUsernameText") For ix = 1 to rsMain.PageSize strSubject = shrFixRSValue(rsMain(tstdbPostFieldSubject)) strSubject = shrApplyBadWordFilter(strSubject) strIcon = shrGetConfig("tstlngMessageIcon" & rsMain(tstdbPostFieldIcon)) If strIcon = "" Then strIcon = shrGetConfig("tstlngMessageIcon" & shrGetConfig("tstlngDefaultMessageIcon")) strUsername = shrFixRSValue(rsMain(tstdbMemberFieldUsername)) strGuestName = shrFixRSValue(rsMain(tstdbPostFieldGuestName)) If strUsername = "" Then strUsername = Replace(strGuestUsernameText, "", strGuestName) Else strUsernameText = strRegisteredUsernameText strUsernameText = Replace(strUsernameText, "", strScriptName & "?sub=view&action=profile&uid=" & rsMain(tstdbPostFieldMemberID)) strUsernameText = Replace(strUsernameText, "", strUsername) strUsername = strUsernameText End If strUsername = shrApplyBadWordFilter(strUsername) strReplyLink = strScriptName & "?sub=reply&action=posts&fid=" & valFID & "&tid=" & valTID &"&pid=" & rsMain(tstdbPostFieldID) strSendEmailLink = strScriptName & "?sub=sendemail&action=posts&fid=" & valFID & "&tid=" & valTID &"&pid=" & rsMain(tstdbPostFieldID) strMessage = shrFormatPost(rsMain(tstdbPostFieldMessage)) If strLicense = shrUnregistered Then strMessage = strMessage & "
 

---

" & strDecodedBrandingCode End If strPostDate = shrFormatDate(rsMain(tstdbPostFieldPostDate), shrGetConfig("tstlngPostDateText")) strModifyDate = shrFormatDate(rsMain(tstdbPostFieldModifyDate), shrGetConfig("tstlngModifyDateText")) If strModifyDate = "" Then strModifyDate = shrGetConfig("tstlngNeverModifiedText") strActive = rsMain(tstdbPostFieldActive) strLockTopicLink = "" If (rsMain(tstdbPostFieldMemberID) = intUserID And rsMain(tstdbPostFieldMemberID) <> 0) Or rsMain(tstdbForumFieldModeratorID) = intUserID Or Session(tstUniqueBoardKey & "tstsesAdmin") Then strModifyPostLink = shrGetConfig("tstlnkModifyPostEnabled") If rsMain(tstdbPostFieldTopic) Then If rsMain(tstdbForumFieldModeratorID) = intUserID Or Session(tstUniqueBoardKey & "tstsesAdmin") Then If rsMain(tstdbPostFieldActive) Then strLockTopicLink = shrGetConfig("tstlnkLockTopicEnabled") strLockTopicLink = Replace(strLockTopicLink, "", strScriptName & "?sub=lock&action=topics&tid=" & valTID) Else strLockTopicLink = shrGetConfig("tstlnkUnLockTopicEnabled") strLockTopicLink = Replace(strLockTopicLink, "", strScriptName & "?sub=unlock&action=topics&tid=" & valTID) End If strDeletePostLink = shrGetConfig("tstlnkDeletePostEnabled") Else strDeletePostLink = shrGetConfig("tstlnkDeletePostDisabled") End If Else strDeletePostLink = shrGetConfig("tstlnkDeletePostEnabled") End If Else strModifyPostLink = shrGetConfig("tstlnkModifyPostDisabled") If rsMain(tstdbPostFieldTopic) Then If rsMain(tstdbPostFieldActive) Then strLockTopicLink = shrGetConfig("tstlnkLockTopicDisabled") strLockTopicLink = Replace(strLockTopicLink, "", strScriptName & "?sub=lock&action=topics&tid=" & valTID) Else strLockTopicLink = shrGetConfig("tstlnkUnLockTopicDisabled") strLockTopicLink = Replace(strLockTopicLink, "", strScriptName & "?sub=unlock&action=topics&tid=" & valTID) End If End If strDeletePostLink = shrGetConfig("tstlnkDeletePostDisabled") End If strDeletePostLink = Replace(strDeletePostLink, "", strScriptName & "?sub=deleteconfirm&action=posts&fid=" & valFID & "&tid=" & valTID & "&pid=" & rsMain(tstdbPostFieldID)) strModifyPostLink = Replace(strModifyPostLink, "", strScriptName & "?sub=show&action=modify&fid=" & valFID & "&tid=" & valTID & "&pid=" & rsMain(tstdbPostFieldID)) strPostRow = strPostRowFile strPostRow = Replace(strPostRow, "", strSubject) strPostRow = Replace(strPostRow, "", strIcon) strPostRow = Replace(strPostRow, "", strUsername) strPostRow = Replace(strPostRow, "", strReplyLink) strPostRow = Replace(strPostRow, "", strModifyPostLink) strPostRow = Replace(strPostRow, "", strLockTopicLink) strPostRow = Replace(strPostRow, "", strDeletePostLink) strPostRow = Replace(strPostRow, "", strSendEmailLink) strPostRow = Replace(strPostRow, "", strMessage) strPostRow = Replace(strPostRow, "", strPostDate) strPostRow = Replace(strPostRow, "", strModifyDate) objPostRows.Append(strPostRow) rsMain.MoveNext If rsMain.EOF Then Exit For Next Session(tstUniqueBoardKey & "tstsesCurrentForum") = strForumName Session(tstUniqueBoardKey & "tstsesCurrentForumID") = valFID Session(tstUniqueBoardKey & "tstsesCurrentTopic") = strTopicName Session(tstUniqueBoardKey & "tstsesCurrentTopicID") = valTID strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\postsmain.html") strDisplayPage = Replace(strDisplayPage, "", strTopicName) strDisplayPage = Replace(strDisplayPage, "", objPostRows.ToString()) strDisplayPage = Replace(strDisplayPage, "", strPageLink) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain End Sub '---------------------------------------------------------------------------------------- Sub tstShowNewReply Dim valFID, valTID, valPID Dim rsMain Dim strReplySubject, strReplyMessage, strReplyBodyText, strUsername, strSelectedIcon, strGuestName Dim strIncludeSignature, strIcon, strIconList, strNotifyDefault Dim ix 'Get Form Vars '------------------------------------------------------- valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valPID = "" Or Not IsNumeric(valPID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If shrCheckForumAccess(valFID, "P") Then If intUserID = 0 Then strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\guestpostnewreply.html") Else strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\postnewreply.html") End If strDisplayPage = shrInsertToastEdit(strDisplayPage, "message", "") Else If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request.ServerVariables("QUERY_STRING")) Else tstDoError shrGetConfig("tstlngReplyNoAccessError") Exit Sub End If End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindPosts(Null, Null, valPID, Null, Null, Null, Null, Null, Null, Null, False, Null, Null, Null, -1) If rsMain.EOF Then tstDoError shrGetConfig("tstlngPostNotFoundError") Exit Sub End If If Not rsMain(tstdbPostFieldActive) Then tstDoError shrGetConfig("tstlngTopicLockedError") Exit Sub End If 'Populate local vars '------------------------------------------------------- strReplySubject = shrFixRSValue(rsMain(tstdbPostFieldSubject)) strReplySubject = shrApplyBadWordFilter(strReplySubject) If Left(strReplySubject, Len(shrGetConfig("tstcfgReplyPrefix"))) <> shrGetConfig("tstcfgReplyPrefix") Then strReplySubject = shrGetConfig("tstcfgReplyPrefix") & " " & strReplySubject End If strReplyMessage = shrFormatPost(rsMain(tstdbPostFieldMessage)) strUsername = shrFixRSValue(rsMain(tstdbMemberFieldUsername)) If strUsername = "" Then strUsername = shrFixRSValue(rsMain(tstdbPostFieldGuestName)) 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain 'Format output '------------------------------------------------------- strReplyBodyText = shrGetConfig("tstlngReplyBodyText") If strReplyBodyText <> "" Then strReplyBodyText = Replace(strReplyBodyText, "", strUsername) strReplyBodyText = Replace(strReplyBodyText, "", strReplyMessage) End If strDisplayPage = Replace(strDisplayPage, "", valFID) strDisplayPage = Replace(strDisplayPage, "", valTID) strDisplayPage = Replace(strDisplayPage, "", valPID) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(Request.ServerVariables("QUERY_STRING"))) strDisplayPage = Replace(strDisplayPage, "", shrFixRSValue(Session(tstUniqueBoardKey & "tstsesUsername"))) If Session(tstUniqueBoardKey & "tempPostQueryString") = Request.ServerVariables("QUERY_STRING") Then strGuestName = Session(tstUniqueBoardKey & "tempPostGuestName") strReplySubject = Session(tstUniqueBoardKey & "tempPostSubject") strReplyMessage = Session(tstUniqueBoardKey & "tempPostMessage") strSelectedIcon = Session(tstUniqueBoardKey & "tempPostIcon") ElseIf Request("modify") <> "" Or Request("modify.x") <> "" Then strGuestName = Request("guestname") strReplySubject = Request("subject") strReplyMessage = Request("message") strSelectedIcon = Request("icon") Else strGuestName = shrGetConfig("tstlngGuestName") strReplyMessage = "" strSelectedIcon = shrGetConfig("tstlngDefaultMessageIcon") End If strDisplayPage = Replace(strDisplayPage, "", strReplySubject) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(strReplyMessage)) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(strGuestName)) For ix = 1 to 10 strIcon = shrGetConfig("tstlngSelectMessageIcon" & ix) If ix = Int(strSelectedIcon) Then strIcon = Replace(strIcon, "", shrGetConfig("tstlngSelectedMessageIconText")) Else strIcon = Replace(strIcon, "", "") End If strIconList = strIconList & strIcon Next If Session(tstUniqueBoardKey & "tstsesIncludeSignature") Then strIncludeSignature = "checked" Else strIncludeSignature = "" End If If Session(tstUniqueBoardKey & "tstsesNotifyDefault") Then strNotifyDefault = "checked" Else strNotifyDefault = "" End If strDisplayPage = Replace(strDisplayPage, "", strReplyBodyText) strDisplayPage = Replace(strDisplayPage, "", strIncludeSignature) strDisplayPage = Replace(strDisplayPage, "", strNotifyDefault) strDisplayPage = Replace(strDisplayPage, "", strIconList) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Provide feedback '------------------------------------------------------- Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitNewReply Dim valPreview Dim valFID, valTID, valPID, valGuestName, valUserID, valIcon, valSubject, valMessage, valNotify, valSignature Dim verifyError 'Get Form Vars '------------------------------------------------------- valPreview = Request("preview") valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") valIcon = Request("icon") valGuestName = Request("guestname") valUserID = intUserID valSubject = Request("subject") valMessage = Request("message") valNotify = Request("notify") valSignature = Request("includesig") 'Save vars in case user presses back button or user's session times out and he has to login before posting Session(tstUniqueBoardKey & "tempPostGuestName") = valGuestName Session(tstUniqueBoardKey & "tempPostSubject") = valSubject Session(tstUniqueBoardKey & "tempPostMessage") = valMessage Session(tstUniqueBoardKey & "tempPostIcon") = valIcon Session(tstUniqueBoardKey & "tempPostQueryString") = Request("querystring") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valPID = "" Or Not IsNumeric(valPID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If Not shrCheckForumAccess(valFID, "P") Then If valUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request("querystring")) Else tstDoError shrGetConfig("tstlngReplyNoAccessError") Exit Sub End If End If If valUserID = 0 Then If verifyError = "" Then verifyError = shrDoVerify(valGuestName, tstdbPostFieldGuestNameFriendly, tstdbPostFieldGuestNameLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If End If If verifyError = "" Then verifyError = shrDoVerify(valSubject, tstdbPostFieldSubjectFriendly, tstdbPostFieldSubjectLen, False) If verifyError = "" Then verifyError = shrDoVerify(valMessage, tstdbPostFieldMessageFriendly, tstdbPostFieldMessageLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If If valPreview = "True" Then tstShowPreview "posts" Exit Sub End If valMessage = shrFormatPostBeforeDatabaseSubmit(valMessage) If valIcon = "" Then valIcon = shrGetConfig("tstlngDefaultMessageIcon") If valNotify = "True" Then valNotify = True Else valNotify = False End If If valSignature = "True" Then valMessage = valMessage & Replace(Session(tstUniqueBoardKey & "tstsesSignature"), shrHTMLEditorMetaTag, "") End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrNewPost(valFID, valTID, valPID, valUserID, valGuestName, valIcon, valSubject, valMessage, valNotify) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Delete temp session vars Session(tstUniqueBoardKey & "tempPostGuestName") = "" Session(tstUniqueBoardKey & "tempPostSubject") = "" Session(tstUniqueBoardKey & "tempPostMessage") = "" Session(tstUniqueBoardKey & "tempPostIcon") = "" Session(tstUniqueBoardKey & "tempPostQueryString") = "" 'Provide feedback '------------------------------------------------------- shrRedirectTo strScriptName & "?sub=show&action=posts&fid=" & valFID & "&tid=" & valTID End Sub '---------------------------------------------------------------------------------------- Sub tstShowModifyPost Dim valFID, valTID, valPID Dim rsMain Dim strSubject, strMessage, intAuthorID, intModeratorID, strUsername, strPostDate, intIcon, strIcon, strIconList, strNotify Dim ix If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request.ServerVariables("QUERY_STRING")) End If 'Get Form Vars '------------------------------------------------------- valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valPID = "" Or Not IsNumeric(valPID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindPosts(Null, Null, valPID, Null, Null, Null, Null, Null, Null, Null, False, Null, Null, Null, -1) If rsMain.EOF Then tstDoError shrGetConfig("tstlngPostNotFoundError") Exit Sub End If 'Populate local vars '------------------------------------------------------- intAuthorID = rsMain(tstdbPostFieldMemberID) intModeratorID = rsMain(tstdbForumFieldModeratorID) strSubject = shrFixRSValue(rsMain(tstdbPostFieldSubject)) strMessage = shrFixRSValue(rsMain(tstdbPostFieldMessage)) strPostDate = shrFixRSValue(rsMain(tstdbPostFieldPostDate)) strNotify = rsMain(tstdbPostFieldMailNotice) intIcon = rsMain(tstdbPostFieldIcon) strUsername = shrFixRSValue(rsMain(tstdbMemberFieldUsername)) If strUsername = "" Then strUsername = shrFixRSValue(rsMain(tstdbPostFieldGuestName)) 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain 'Format output '------------------------------------------------------- If intModeratorID <> intUserID And Not Session(tstUniqueBoardKey & "tstsesAdmin") Then If intAuthorID = 0 Or intAuthorID <> intUserID Then tstDoError shrGetConfig("tstlngNotAuthorError") Exit Sub End If End If If Session(tstUniqueBoardKey & "tempPostQueryString") = Request.ServerVariables("QUERY_STRING") Then strSubject = shrHTMLEncode(Session(tstUniqueBoardKey & "tempPostSubject")) strMessage = shrHTMLEncode(Session(tstUniqueBoardKey & "tempPostMessage")) intIcon = Int(Session(tstUniqueBoardKey & "tempPostIcon")) ElseIf Request("modify") <> "" Or Request("modify.x") <> "" Then strSubject = shrHTMLEncode(Request("subject")) strMessage = shrHTMLEncode(Request("message")) intIcon = Int(Request("icon")) End If If strNotify Then strNotify = "Checked" End If For ix = 1 to 10 strIcon = shrGetConfig("tstlngSelectMessageIcon" & ix) If ix = intIcon Then strIcon = Replace(strIcon, "", shrGetConfig("tstlngSelectedMessageIconText")) Else strIcon = Replace(strIcon, "", "") End If strIconList = strIconList & strIcon Next strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\modifypost.html") shrInsertToastEdit strDisplayPage, "message", "" strDisplayPage = Replace(strDisplayPage, "", valFID) strDisplayPage = Replace(strDisplayPage, "", valTID) strDisplayPage = Replace(strDisplayPage, "", valPID) strDisplayPage = Replace(strDisplayPage, "", intAuthorID) strDisplayPage = Replace(strDisplayPage, "", strUsername) strDisplayPage = Replace(strDisplayPage, "", strSubject) strDisplayPage = Replace(strDisplayPage, "", strMessage) strDisplayPage = Replace(strDisplayPage, "", strPostDate) strDisplayPage = Replace(strDisplayPage, "", strIconList) strDisplayPage = Replace(strDisplayPage, "", strNotify) strDisplayPage = Replace(strDisplayPage, "", "") strDisplayPage = Replace(strDisplayPage, "", Request.ServerVariables("QUERY_STRING")) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Provide feedback '------------------------------------------------------- Response.CacheControl = "no-cache" Response.AddHeader "Pragma", "no-cache" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitModifyPost Dim valPreview Dim valFID, valTID, valPID, valUserID, valSubject, valMessage, valIcon, valNotify, valSignature Dim verifyError 'Get Form Vars '------------------------------------------------------- valPreview = Request("preview") valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") valUserID = Request("uid") valSubject = Request("subject") valMessage = Request("message") valIcon = Request("icon") valNotify = Request("notify") valSignature = Request("includesig") 'Save vars in case user presses back button or user's session times out and he has to login before posting Session(tstUniqueBoardKey & "tempPostSubject") = valSubject Session(tstUniqueBoardKey & "tempPostMessage") = valMessage Session(tstUniqueBoardKey & "tempPostIcon") = valIcon Session(tstUniqueBoardKey & "tempPostQueryString") = Request("querystring") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valPID = "" Or Not IsNumeric(valPID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valIcon = "" Then valIcon = shrGetConfig("tstlngDefaultMessageIcon") If valNotify = "True" Then valNotify = True Else valNotify = False End If If verifyError = "" Then verifyError = shrDoVerify(valSubject, tstdbPostFieldSubjectFriendly, tstdbPostFieldSubjectLen, False) If verifyError = "" Then verifyError = shrDoVerify(valMessage, tstdbPostFieldMessageFriendly, tstdbPostFieldMessageLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If If valPreview = "True" Then tstShowPreview "modify" Exit Sub End If valMessage = shrFormatPostBeforeDatabaseSubmit(valMessage) If valSignature = "True" Then valMessage = valMessage & Replace(Session(tstUniqueBoardKey & "tstsesSignature"), shrHTMLEditorMetaTag, "") End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrModifyPost(valFID, valTID, valPID, intUserID, Null, valIcon, valSubject, valMessage, valNotify, Null, Null) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Provide feedback '------------------------------------------------------- shrRedirectTo strScriptName & "?sub=show&action=posts&fid=" & valFID & "&tid=" & valTID End Sub '---------------------------------------------------------------------------------------- Sub tstShowDeleteConfirm Dim valFID, valTID, valPID Dim strDeleteConfirmation 'Get Form Vars '------------------------------------------------------- valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valPID = "" Or Not IsNumeric(valPID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If 'Populate local vars '------------------------------------------------------- strDeleteConfirmation = shrGetConfig("tstlngDeleteConfirmation") strDeleteConfirmation = Replace(strDeleteConfirmation, "", valFID) strDeleteConfirmation = Replace(strDeleteConfirmation, "", valTID) strDeleteConfirmation = Replace(strDeleteConfirmation, "", valPID) 'Provide feedback '------------------------------------------------------- tstDoMessage strDeleteConfirmation End Sub '---------------------------------------------------------------------------------------- Sub tstDeletePost Dim valFID, valTID, valPID Dim verifyError 'Get Form Vars '------------------------------------------------------- valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") 'Start verification of vars '------------------------------------------------------- If valFID = "" Or Not IsNumeric(valFID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valTID = "" Or Not IsNumeric(valTID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If If valPID = "" Or Not IsNumeric(valPID) Then tstDoError shrGetConfig("tstlngInvalidPOSTorGET") Exit Sub End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrModifyPost(valFID, valTID, valPID, intUserID, Null, Null, Null, Null, Null, Null, True) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Provide feedback '------------------------------------------------------- Session(tstUniqueBoardKey & "tstsesCurrentForum") = shrGetConfig("tstcfgForum" & valFID & "ForumName") Session(tstUniqueBoardKey & "tstsesCurrentForumID") = valFID Session(tstUniqueBoardKey & "tstsesCurrentTopic") = "" tstDoMessage shrGetConfig("tstlngDeleteSuccessful") End Sub '---------------------------------------------------------------------------------------- Sub tstShowPreview(strType) Dim valTID, valFID, valPID, valUID, valSubject, valIconVal, valGuestName, valUsername, valIncludeSig, valNotify, valMessage, valPostDate Dim strIcon, strUsername, strReplyLink, strModifyLink, strSendEmailLink, strMessagePreview, strModifyDate, strSignature Dim strPostRowFile, strPostRow 'Get Form Vars '------------------------------------------------------- valFID = Request("fid") valTID = Request("tid") valPID = Request("pid") valUID = Request("uid") valSubject = shrFixRSValue(Request("subject")) valMessage = Request("message") valIncludeSig = Request("includesig") valIconVal = Request("icon") valNotify = Request("notify") valPostDate = Request("postdate") valGuestName = shrFixRSValue(Request("guestname")) valUsername = shrFixRSValue(Request("username")) 'Start verification of vars '------------------------------------------------------- If strType = "modify" Then strModifyDate = shrFormatDate(Now(), shrGetConfig("tstlngModifyDateText")) valPostDate = shrFormatDate(valPostDate, shrGetConfig("tstlngPostDateText")) Else strModifyDate = shrGetConfig("tstlngNeverModifiedText") valPostDate = shrFormatDate(Now(), shrGetConfig("tstlngPostDateText")) End If If intUserID = 0 Then strUsername = Replace(shrGetConfig("tstlnkGuestUsernameText"), "", valGuestName) Else strUsername = shrGetConfig("tstlnkRegisteredUsernameText") If valUID = "" Then valUID = intUserID valUsername = Session(tstUniqueBoardKey & "tstsesUsername") End If strUsername = Replace(strUsername, "", strScriptName & "?sub=view&action=profile&uid=" & valUID) strUsername = Replace(strUsername, "", valUsername) End If strUsername = shrApplyBadWordFilter(strUsername) 'Populate local vars '------------------------------------------------------- valMessage = shrFormatPostBeforeDatabaseSubmit(valMessage) strMessagePreview = valMessage If valIncludeSig = "True" Then strMessagePreview = strMessagePreview & Replace(Session(tstUniqueBoardKey & "tstsesSignature"), shrHTMLEditorMetaTag, "") End If strMessagePreview = shrFormatPost(strMessagePreview) strIcon = shrGetConfig("tstlngMessageIcon" & valIconVal) If strIcon = "" Then strIcon = shrGetConfig("tstlngMessageIcon" & shrGetConfig("tstlngDefaultMessageIcon")) strReplyLink = strScriptName & "?sub=tstlngPreviewModeError&action=tstDoError" strModifyLink = strScriptName & "?sub=tstlngPreviewModeError&action=tstDoError" strSendEmailLink = strScriptName & "?sub=tstlngPreviewModeError&action=tstDoError" strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\preview.html") strDisplayPage = Replace(strDisplayPage, "", valSubject) strDisplayPage = Replace(strDisplayPage, "", strIcon) strDisplayPage = Replace(strDisplayPage, "", strUsername) strDisplayPage = Replace(strDisplayPage, "", strReplyLink) strDisplayPage = Replace(strDisplayPage, "", strModifyLink) strDisplayPage = Replace(strDisplayPage, "", strSendEmailLink) strDisplayPage = Replace(strDisplayPage, "", strMessagePreview) strDisplayPage = Replace(strDisplayPage, "", shrApplyBadWordFilter(valSubject)) strDisplayPage = Replace(strDisplayPage, "", valPostDate) strDisplayPage = Replace(strDisplayPage, "", strModifyDate) strDisplayPage = Replace(strDisplayPage, "", strType) strDisplayPage = Replace(strDisplayPage, "", valIconVal) strDisplayPage = Replace(strDisplayPage, "", valGuestName) strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(valMessage)) strDisplayPage = Replace(strDisplayPage, "", valIncludeSig) strDisplayPage = Replace(strDisplayPage, "", valNotify) strDisplayPage = Replace(strDisplayPage, "", Request("querystring")) strDisplayPage = Replace(strDisplayPage, "", valFID) strDisplayPage = Replace(strDisplayPage, "", valTID) strDisplayPage = Replace(strDisplayPage, "", valPID) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstNewRegister 'Start verification of vars '------------------------------------------------------- If shrGetConfig("tstcfgTakingNewRegistrations") <> "True" Then tstDoError shrGetConfig("tstcfgNoRegistrationsError") Exit Sub End If 'Populate local vars '------------------------------------------------------- strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\register.html") strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitRegister Dim valUsername, valPassword, valEmail Dim strRegisterMessage Dim strMessage Dim verifyError 'Get Form Vars '------------------------------------------------------- valUsername = Request("username") valPassword = Request("password") valEmail = Request("email") 'Start verification of vars '------------------------------------------------------- If shrGetConfig("tstcfgTakingNewRegistrations") <> "True" Then tstDoError shrGetConfig("tstlngNoRegistrationsError") Exit Sub End If If verifyError = "" Then verifyError = shrDoVerify(valUsername, tstdbMemberFieldUsernameFriendly, tstdbMemberFieldUsernameLen, False) If verifyError = "" Then verifyError = shrDoVerify(valPassword, tstdbMemberFieldPasswordFriendly, tstdbMemberFieldPasswordLen, False) If verifyError = "" Then verifyError = shrDoVerify(valEmail, tstdbMemberFieldEmailFriendly, tstdbMemberFieldEmailLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If If valPassword <> Request("confirmpw") Then tstDoError shrGetConfig("tstlngVerifyPasswordError") Exit Sub End If If Not shrIsValidEmail(valEmail) Then tstDoError shrGetConfig("tstlngVerifyEmailError") Exit Sub End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrNewUser(-1, Null, Null, valUsername, valPassword, valEmail, Null, Null, Null, Null, Null, Null, Null) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Provide feedback '------------------------------------------------------- shrDoLogin valUsername, valPassword strMessage = shrGetConfig("tstlngRegistrationSuccess") & "
" strRegisterMessage = shrGetConfig("tstcfgRegisterMessage") strRegisterMessage = Replace(strRegisterMessage, "", valEmail) strRegisterMessage = Replace(strRegisterMessage, "", valUsername) strRegisterMessage = Replace(strRegisterMessage, "", valPassword) If shrGetConfig("tstcfgToastEmailURL") = "" Or shrGetConfig("tstcfgToastEmailURL") = "" Then strRegisterMessage = Replace(strRegisterMessage, "", "http://" & Request.ServerVariables("SERVER_NAME") & Mid(Request.ServerVariables("SCRIPT_NAME"), 1, InStrRev(Request.ServerVariables("SCRIPT_NAME"), "/")) & tstToastScriptName & "?sub=modify&action=profile") Else strRegisterMessage = Replace(strRegisterMessage, "", shrGetConfig("tstcfgToastEmailURL") & "?sub=modify&action=profile") End If strRegisterMessage = Replace(strRegisterMessage, "", vbCrLf) If shrSendMail(shrGetConfig("tstcfgEmailGateway"), shrGetConfig("tstcfgFromName"), shrGetConfig("tstcfgFromAddress"), valEmail, shrGetConfig("tstcfgRegisterSubject"), strRegisterMessage) = "" Then strRegisterMessage = shrGetConfig("tstlngEmailSent") strRegisterMessage = Replace(strRegisterMessage, "", valEmail) strMessage = strMessage & strRegisterMessage Else strRegisterMessage = shrGetConfig("tstlngEmailError") strRegisterMessage = Replace(strRegisterMessage, "", valEmail) strMessage = strMessage & strRegisterMessage End If tstDoMessage strMessage End Sub '---------------------------------------------------------------------------------------- Sub tstShowLogin Dim valUsername, valPassword, valReturn Dim strSavePassword 'Get Form Vars '------------------------------------------------------- valUsername = Request.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login")("username") valReturn = Request("return") 'Populate local vars '------------------------------------------------------- strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\login.html") strDisplayPage = Replace(strDisplayPage, "", shrHTMLEncode(valReturn)) strDisplayPage = Replace(strDisplayPage, "", valUsername) strDisplayPage = Replace(strDisplayPage, "", valPassword) strDisplayPage = Replace(strDisplayPage, "", strSavePassword) strDisplayPage = Replace(strDisplayPage, "", "" & shrGetConfig("tstlnkLostPasswordLinkText") & "") strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitLogin Dim valUsername, valPassword, valReturn, valRemember Dim verifyError 'Get Form Vars '------------------------------------------------------- valUsername = Request("username") valPassword = Request("password") valRemember = Request("remember") valReturn = Request("return") 'Start verification of vars '------------------------------------------------------- If verifyError = "" Then verifyError = shrDoVerify(valUsername, tstdbMemberFieldUsernameFriendly, tstdbMemberFieldUsernameLen, False) If verifyError = "" Then verifyError = shrDoVerify(valPassword, tstdbMemberFieldPasswordFriendly, tstdbMemberFieldPasswordLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Provide feedback '------------------------------------------------------- If shrDoLogin(valUsername, valPassword) Then If valRemember = "True" Then Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login")("username") = valUsername Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login")("password") = shrRC4Encrypt(shrPasswordKey, valPassword) Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login").Expires = DateAdd("m",1,Now()) Else Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login").Expires = DateAdd("m",-1,Now()) End If If valReturn <> "" And valReturn <> "action=logout" Then shrRedirectTo strScriptName & "?" & valReturn Else shrRedirectTo strScriptName End If Else Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login").Expires = DateAdd("m",-1,Now()) tstDoError shrGetConfig("tstlngLoginFailedError") Exit Sub End If End Sub '---------------------------------------------------------------------------------------- Sub tstLogout If intUserID = 0 Then tstDoMessage shrGetConfig("tstlngLoggedOut") Else Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login").Expires = DateAdd("m",-1,Now()) shrLogOffActiveUser Session.Abandon shrRedirectTo strScriptName & "?action=logout" End If End Sub '---------------------------------------------------------------------------------------- Const shrBrandingCode = "PGZvbnQgZmFjZT0iVmVyZGFuYSIgc2l6ZT0iMiIgY29sb3I9ImdyYXkiPlRoaXMgbWVzc2FnZSB3YXMgcG9zdGVkIHVzaW5nIHRoZSBQZXJzb25hbCBFZGl0aW9uIG9mIFRvYXN0IEZvcnVtcyAxLjYuICBHZXQgYSBmcmVlLCBza2lubmFibGUgQVNQIG1lc3NhZ2UgYm9hcmQgZm9yIHlvdXIgc2l0ZSBhdCA8YSBocmVmPSJodHRwOi8vd3d3LnRvYXN0Zm9ydW1zLmNvbSIgdGFyZ2V0PSJfYmxhbmsiPnRvYXN0Zm9ydW1zLmNvbTwvYT4hPC9mb250PiAg" Sub tstModifyProfile Dim rsMain Dim strFirstName, strLastName, strEmail, strHideEmail, strICQ, strHomepage, strSignature, strIncludeSignature, strNotifyDefault If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request.ServerVariables("QUERY_STRING")) End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindUser(intUserID, Null, Null, Null, Null, Null) 'Populate local vars '------------------------------------------------------- If Not rsMain.EOF Then strFirstName = shrFixRSValue(rsMain(tstdbMemberFieldFName)) strLastName = shrFixRSValue(rsMain(tstdbMemberFieldLName)) strEmail = shrFixRSValue(rsMain(tstdbMemberFieldEmail)) If shrFixRSValue(rsMain(tstdbMemberFieldHideEmail)) = "True" Then strHideEmail = "Checked" Else strHideEmail = "" End If strICQ = shrFixRSValue(rsMain(tstdbMemberFieldICQ)) strHomepage = shrFixRSValue(rsMain(tstdbMemberFieldHomepage)) strSignature = rsMain(tstdbMemberFieldSignature) strSignature = Replace(strSignature, shrHTMLEditorMetaTag, "") If rsMain(tstdbMemberFieldIncludeSignature) Then strIncludeSignature = "Checked" Else strIncludeSignature = "" End If If rsMain(tstdbMemberFieldNotifyDefault) Then strNotifyDefault = "Checked" Else strNotifyDefault = "" End If Else tstDoError shrGetConfig("tstlngUserNotFoundError") Exit Sub End If strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\modifyprofile.html") strDisplayPage = shrInsertToastEdit(strDisplayPage, "signature", shrHTMLEncode(strSignature)) strDisplayPage = Replace(strDisplayPage, "", strFirstName) strDisplayPage = Replace(strDisplayPage, "", strLastName) strDisplayPage = Replace(strDisplayPage, "", strEmail) strDisplayPage = Replace(strDisplayPage, "", strHideEmail) strDisplayPage = Replace(strDisplayPage, "", strICQ) strDisplayPage = Replace(strDisplayPage, "", strHomepage) strDisplayPage = Replace(strDisplayPage, "", strIncludeSignature) strDisplayPage = Replace(strDisplayPage, "", strNotifyDefault) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitProfile Dim valUserID, valFName, valLName, valPassword, valEmail, valHideEmail, valICQ, valHomePage, valSignature, valSkin, valIncludeSignature, valNotifyDefault, valUnsave Dim verifyError If intUserID = 0 Then shrRedirectTo strScriptName & "?action=login&return=" & Server.URLEncode(Request.ServerVariables("QUERY_STRING")) End If 'Get Form Vars '------------------------------------------------------- valUserID = intUserID valFName = Request("fname") valLName = Request("lname") valPassword = Request("password") valEmail = Request("email") valHideEmail = Request("hideemail") valICQ = Request("icq") valHomePage = Request("homepage") valSignature = Request("signature") valSkin = Request("skin") valIncludeSignature = Request("includesig") valNotifyDefault = Request("notifydefault") valUnsave = Request("unsave") 'Start verification of vars '------------------------------------------------------- valSignature = shrFormatPostBeforeDatabaseSubmit(valSignature) If verifyError = "" Then verifyError = shrDoVerify(valFName, tstdbMemberFieldFNameFriendly, tstdbMemberFieldFNameLen, True) If verifyError = "" Then verifyError = shrDoVerify(valLName, tstdbMemberFieldLNameFriendly, tstdbMemberFieldLNameLen, True) If verifyError = "" Then verifyError = shrDoVerify(valPassword, tstdbMemberFieldPasswordFriendly, tstdbMemberFieldPasswordLen, True) If verifyError = "" Then verifyError = shrDoVerify(valEmail, tstdbMemberFieldEmailFriendly, tstdbMemberFieldEmailLen, False) If verifyError = "" Then verifyError = shrDoVerify(valICQ, tstdbMemberFieldICQFriendly, tstdbMemberFieldICQLen, True) If verifyError = "" Then verifyError = shrDoVerify(valHomePage, tstdbMemberFieldHomepageFriendly, tstdbMemberFieldHomepageLen, True) If verifyError = "" Then verifyError = shrDoVerify(valSignature, tstdbMemberFieldSignatureFriendly, shrGetConfig("tstcfgMaxSignatureLength"), True) If verifyError <> "" Then tstDoError verifyError Exit Sub End If If valPassword <> Request("confirmpw") Then tstDoError shrGetConfig("tstlngVerifyPasswordError") Exit Sub End If If Not shrIsValidEmail(valEmail) Then tstDoError shrGetConfig("tstlngVerifyEmailError") Exit Sub End If If valPassword = "" Then valPassword = Null If valHideEmail = "" Then valHideEmail = False Else valHideEmail = True End If If valIncludeSignature = "" Then valIncludeSignature = False Else valIncludeSignature = True End If If valNotifyDefault = "" Then valNotifyDefault = False Else valNotifyDefault = True End If If InStr(shrGetConfig("tstcfgSkinsAvailable"), valSkin) = 0 Or valSkin = "" Then valSkin = shrGetConfig("tstcfgDefaultSkin") End If 'Save vars to database '------------------------------------------------------- If verifyError = "" Then verifyError = shrModifyUser(valUserID, valFName, valLName, Null, valPassword, valEmail, valHideEmail, valICQ, valHomePage, valSignature, valSkin, valIncludeSignature, valNotifyDefault, Null, Null, Null) If verifyError <> "" Then tstDoError verifyError Exit Sub End If Session(tstUniqueBoardKey & "tstsesSkin") = valSkin strSelectedSkin = valSkin If valUserID = 0 Then Session(tstUniqueBoardKey & "tstsesUsername") = shrGetConfig("tstlngGuestName") End If If valUnsave = "True" Then Response.Cookies(shrGetConfig("tstcfgBoardTitle") & "Login").Expires = DateAdd("m",-1,Now()) End If Session(tstUniqueBoardKey & "tstsesSignature") = valSignature If valIncludeSignature = "True" Then Session(tstUniqueBoardKey & "tstsesIncludeSignature") = True Else Session(tstUniqueBoardKey & "tstsesIncludeSignature") = False End If If valNotifyDefault = "True" Then Session(tstUniqueBoardKey & "tstsesNotifyDefault") = True Else Session(tstUniqueBoardKey & "tstsesNotifyDefault") = False End If 'Provide feedback '------------------------------------------------------- tstDoMessage shrGetConfig("tstlngUpdateProfileSuccess") End Sub '---------------------------------------------------------------------------------------- Sub tstChangeSkin Dim valSkin Dim valUserID Dim verifyError 'Get Form Vars '------------------------------------------------------- valSkin = Request("skin") valUserID = intUserID 'Start verification of vars '------------------------------------------------------- If InStr(shrGetConfig("tstcfgSkinsAvailable"), valSkin) = 0 Then valSkin = shrGetConfig("tstcfgDefaultSkin") End If 'Save vars to database '------------------------------------------------------- If valUserID <> 0 Then If verifyError = "" Then verifyError = shrModifyUser(valUserID, Null, Null, Null, Null, Null, Null, Null, Null, Null, valSkin, Null, Null, Null, Null, Null) If verifyError <> "" Then tstDoError verifyError Exit Sub End If End If Session(tstUniqueBoardKey & "tstsesSkin") = valSkin strSelectedSkin = valSkin If valUserID = 0 Then Session(tstUniqueBoardKey & "tstsesUsername") = shrGetConfig("tstlngGuestName") End If 'Provide feedback '------------------------------------------------------- shrRedirectTo strScriptName & "?" & Request("return") End Sub '---------------------------------------------------------------------------------------- Sub tstViewProfile Dim valUserID Dim rsMain Dim strUsername, strFirstName, strLastName, strEmail, strICQ, strHomepage, strPostCount, strLastLoginDate, strLastPostDate 'Get Form Vars '------------------------------------------------------- valUserID = Request("uid") 'Start verification of vars '------------------------------------------------------- If Not IsNumeric(valUserID) Then tstDoError shrGetConfig("tstlngUserNotFoundError") Exit Sub End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindUser(valUserID, Null, Null, Null, Null, Null) 'Populate local vars '------------------------------------------------------- If Not rsMain.EOF Then strUsername = shrFixRSValue(rsMain(tstdbMemberFieldUsername)) strFirstName = shrFixRSValue(rsMain(tstdbMemberFieldFName)) strLastName = shrFixRSValue(rsMain(tstdbMemberFieldLName)) If rsMain(tstdbMemberFieldHideEmail) Then strEmail = shrGetConfig("tstlngHiddenEmailText") Else strEmail = shrFixRSValue(rsMain(tstdbMemberFieldEmail)) End If strEmail = shrLinkURLs(strEmail) strICQ = shrFixRSValue(rsMain(tstdbMemberFieldICQ)) strHomepage = shrLinkURLs(shrFixRSValue(rsMain(tstdbMemberFieldHomepage))) strPostCount = shrFixRSValue(rsMain(tstdbMemberFieldPostCount)) strLastLoginDate = shrFormatDate(shrFixRSValue(rsMain(tstdbMemberFieldLastLoginDate)), shrGetConfig("tstlngMemberLastLoginDateText")) If strLastLoginDate = "" Then strLastLoginDate = shrGetConfig("tstlngMemberNeverLoggedInText") strLastPostDate = shrFormatDate(shrFixRSValue(rsMain(tstdbMemberFieldLastPostDate)), shrGetConfig("tstlngMemberLastPostDateText")) If strLastPostDate = "" Then strLastPostDate = shrGetConfig("tstlngMemberNeverPostedText") Else tstDoError shrGetConfig("tstlngProfileNotFoundError") Exit Sub End If strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\viewprofile.html") strDisplayPage = Replace(strDisplayPage, "", strUsername) strDisplayPage = Replace(strDisplayPage, "", strFirstName) strDisplayPage = Replace(strDisplayPage, "", strLastName) strDisplayPage = Replace(strDisplayPage, "", strEmail) strDisplayPage = Replace(strDisplayPage, "", strICQ) strDisplayPage = Replace(strDisplayPage, "", strHomepage) strDisplayPage = Replace(strDisplayPage, "", strPostCount) strDisplayPage = Replace(strDisplayPage, "", strLastLoginDate) strDisplayPage = Replace(strDisplayPage, "", strLastPostDate) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain End Sub '---------------------------------------------------------------------------------------- Sub tstShowLostPassword 'Populate local vars '------------------------------------------------------- strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\lostpassword.html") strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstSubmitLostPassword Dim valUsername Dim rsMain Dim strUserEmail, strUserPassword Dim strEmail Dim verifyError 'Get Form Vars '------------------------------------------------------- valUsername = Request("username") 'Start verification of vars '------------------------------------------------------- If verifyError = "" Then verifyError = shrDoVerify(valUsername, tstdbMemberFieldUsernameFriendly, tstdbMemberFieldUsernameLen, False) If verifyError <> "" Then tstDoError verifyError Exit Sub End If 'Retrieve recordset based on search criteria '------------------------------------------------------- Set rsMain = shrFindUser(Null, Null, Null, valUsername, Null, Null) 'Populate local vars '------------------------------------------------------- If Not rsMain.EOF Then strUserEmail = rsMain(tstdbMemberFieldEmail) strUserPassword = rsMain(tstdbMemberFieldPassword) Else tstDoError shrGetConfig("tstlngUserNotFoundError") Exit Sub End If strEmail = shrGetConfig("tstcfgLostPasswordMessage") strEmail = Replace(strEmail, "", valUsername) strEmail = Replace(strEmail, "", shrRC4Encrypt(shrPasswordKey, strUserPassword)) strEmail = Replace(strEmail, "", Request.ServerVariables("REMOTE_ADDR")) strEmail = Replace(strEmail, "", vbCrLf) 'Cleanup objects '------------------------------------------------------- shrDestroyRS rsMain 'Provide feedback '------------------------------------------------------- If shrSendMail(shrGetConfig("tstcfgEmailGateway"), shrGetConfig("tstcfgFromName"), shrGetConfig("tstcfgFromAddress"), strUserEmail, shrGetConfig("tstcfgLostPasswordSubject"), strEmail) = "" Then tstDoMessage shrGetConfig("tstlngLostPasswordSuccess") Else tstDoError shrGetConfig("tstlngEmailError") Exit Sub End If End Sub '---------------------------------------------------------------------------------------- Sub tstShowHelp Dim valHelpTopic Dim strHelpSubject, strHelpMessage 'Get Form Vars '------------------------------------------------------- valHelpTopic = Request("sub") 'Start verification of vars '------------------------------------------------------- If valHelpTopic = "" Then valHelpTopic = "NotFound" 'Populate local vars '------------------------------------------------------- strHelpSubject = shrGetConfig("tstlngHelp" & valHelpTopic & "Subject") strHelpMessage = shrGetConfig("tstlngHelp" & valHelpTopic & "Message") If strHelpSubject = "" Then strHelpSubject = shrGetConfig("tstlngHelpNotFoundSubject") If strHelpMessage = "" Then strHelpMessage = shrGetConfig("tstlngHelpNotFoundMessage") strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\help.html") strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstlngHelp" & valHelpTopic & "Subject")) strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstlngHelp" & valHelpTopic & "Message")) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstDoError(strErrorMessage) 'Start verification of vars '------------------------------------------------------- If strErrorMessage = "" Then Exit Sub 'Populate local vars '------------------------------------------------------- strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\error.html") strDisplayPage = Replace(strDisplayPage, "", strErrorMessage) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Sub tstDoMessage(strMessage) 'Populate local vars '------------------------------------------------------- strDisplayPage = shrOpenFile(Server.MapPath(tstSkinsPath) & "\" & strSelectedSkin & "\message.html") strDisplayPage = Replace(strDisplayPage, "", strMessage) strHelpLink = "" & shrGetConfig("tstlnkHelpLinkText") & "" End Sub '---------------------------------------------------------------------------------------- Function tstInsertVars(strDisplayPage) Dim strSkin, strSkins, aSkins, ix Dim strBannerCode Dim strDebug Dim strLoginLink, strRegisterLink, strSearchLink Dim strNavigationLink, strNavigationLinkText, strNavigationLinkSeperator strSkin = shrGetConfig("tstlnkSkinListLinkText") strSkins = Replace(strSkin, "", strSelectedSkin) aSkins = Split(shrGetConfig("tstcfgSkinsAvailable"), "|", -1) For ix = 0 To UBound(aSkins) aSkins(ix) = Trim(aSkins(ix)) If aSkins(ix) <> strSelectedSkin Then strSkins = strSkins & Replace(strSkin, "", shrFixRSValue(aSkins(ix))) End If Next If intUserID <> 0 Then strLoginLink = "" & shrGetConfig("tstlnkLogoutLinkText") & "" strRegisterLink = "" & shrGetConfig("tstlnkProfileLinkText") & "" Else If Request.QueryString("action") <> "login" Then strLoginLink = "" & shrGetConfig("tstlnkLoginLinkText") & "" Else strLoginLink = "" & shrGetConfig("tstlnkLoginLinkText") & "" End If strRegisterLink = "" & shrGetConfig("tstlnkRegisterLinkText") & "" End If strSearchLink = "" & shrGetConfig("tstlnkSearchLinkText") & "" If tstDebugMode Then strDebug = "
Debug information follows. To turn off debug information, open constants.asp and set tstDebugMode to False.
" & shrGetDebug & "
" Else strDebug = "" End If strNavigationLinkText = shrGetConfig("tstlnkNavigationLinkText") strNavigationLinkSeperator = shrGetConfig("tstlnkNavigationLinkSeparator") strNavigationLink = "" & Replace(strNavigationLinkText, "", shrGetConfig("tstcfgBoardTitle")) & " " & strNavigationLinkSeperator & " " If Session(tstUniqueBoardKey & "tstsesCurrentForum") <> "" Then strNavigationLink = strNavigationLink & "" & Replace(strNavigationLinkText, "", Session(tstUniqueBoardKey & "tstsesCurrentForum")) & " " & strNavigationLinkSeperator & " " End If If Session(tstUniqueBoardKey & "tstsesCurrentTopic") <> "" Then strNavigationLink = strNavigationLink & "" & Replace(strNavigationLinkText, "", Session(tstUniqueBoardKey & "tstsesCurrentTopic")) & " " & strNavigationLinkSeperator & " " End If strDisplayPage = Replace(strDisplayPage, "", tstToastVersion) strDisplayPage = Replace(strDisplayPage, "", strSkins) strDisplayPage = Replace(strDisplayPage, "", Server.URLEncode(Request.ServerVariables("QUERY_STRING"))) strDisplayPage = Replace(strDisplayPage, "", strScriptName) strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstcfgBoardTitle")) strDisplayPage = Replace(strDisplayPage, "", tstToastScriptName) strDisplayPage = Replace(strDisplayPage, "", tstAdminScriptName) strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstcfgWebSiteName")) strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstcfgWebSiteURL")) strDisplayPage = Replace(strDisplayPage, "", tstSkinsPath) strDisplayPage = Replace(strDisplayPage, "", strLoginLink) strDisplayPage = Replace(strDisplayPage, "", strRegisterLink) strDisplayPage = Replace(strDisplayPage, "", strNavigationLink) strDisplayPage = Replace(strDisplayPage, "", strSearchLink) strDisplayPage = Replace(strDisplayPage, "", strHelpLink) strDisplayPage = Replace(strDisplayPage, "", strSelectedSkin) strDisplayPage = Replace(strDisplayPage, "", tstSkinsPath & "/" & strSelectedSkin & "/") strDisplayPage = Replace(strDisplayPage, "", Session(tstUniqueBoardKey & "tstsesUsername")) strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstcfgRegisterMembersCount")) strDisplayPage = Replace(strDisplayPage, "", shrGetConfig("tstcfgActiveUsers")) strDisplayPage = Replace(strDisplayPage, "", strDebug) Select Case CInt(Left(strLicense, 1)) Case shrRegisteredNoBranding, shrNonProfitNoBranding, shrExpiringNoBranding Case shrRegistered, shrExpiring If shrGetConfig("tstcfgKillPoweredByBug") <> "True" Or Mid(strLicense, 2, 3) = "T16" Then strDisplayPage = shrInsertBug(strDisplayPage, shrRegistered) End If Case shrNonProfit If shrGetConfig("tstcfgKillPoweredByBug") <> "True" Or Mid(strLicense, 2, 3) = "T16" Then strDisplayPage = shrInsertBug(strDisplayPage, shrNonProfit) End If Case Else If Request("action") = "posts" And Request("sub") = "show" Then If Instr(strDisplayPage, shrBase64Decode(shrBrandingCode)) = 0 Then strDisplayPage = "Branding code not found." End If strDisplayPage = shrInsertBug(strDisplayPage, shrUnregistered) End Select tstInsertVars = strDisplayPage End Function '---------------------------------------------------------------------------------------- %>