<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** '** Copyright 2001-2004 Bruce Corkhill All Rights Reserved. '** '** This program is free software; you can modify (at your own risk) any part of it '** under the terms of the License that accompanies this software and use it both '** privately and commercially. '** '** All copyright notices must remain in tacked in the scripts and the '** outputted HTML. '** '** You may use parts of this program in your own private work, but you may NOT '** redistribute, repackage, or sell the whole or any part of this program even '** if it is modified or reverse engineered in whole or in part without express '** permission from the author. '** '** You may not pass the whole or any part of this application off as your own work. '** '** All links to Web Wiz Guide and powered by logo's must remain unchanged and in place '** and must remain visible when the pages are viewed unless permission is first granted '** by the copyright holder. '** '** This program is distributed in the hope that it will be useful, '** but WITHOUT ANY WARRANTY; without even the implied warranty of '** MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER '** WARRANTIES WHETHER EXPRESSED OR IMPLIED. '** '** You should have received a copy of the License along with this program; '** if not, write to:- Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom. '** '** '** No official support is available for this program but you may post support questions at: - '** http://www.webwizguide.info/forum '** '** Support questions are NOT answered by e-mail ever! '** '** For correspondence or non support questions contact: - '** info@webwizguide.info '** '** or at: - '** '** Web Wiz Guide, PO Box 4982, Bournemouth, BH8 8XP, United Kingdom '** '**************************************************************************************** 'Set the buffer to true Response.Buffer = True 'Declare variables Dim strToUsername 'Holds the username the pm message is sent to Dim lngToUserID 'Holds author id of the person who the pm is for Dim strSubject 'Holds the subject of the pm Dim strMessage 'Holds the pm Dim blnReadEmailNotify 'Holds if the user is to be notified when the message is read Dim blnToUsernameOK 'Set to false if the to username is not found Dim blnMaxPMsOK 'Set to false if the max number of private messages is exceeded Dim blnMessageSent 'Set to true if the message is already sent Dim strEmailSubject 'Holds the subject of the e-mail Dim strEmailBody 'Holds the body of the e-mail message Dim blnEmailSent 'set to true if an e-mail is sent Dim blnBlocked 'Set to true if the user is blocked from messaging this person Dim blnNoSubject 'Set to true if there is no subject to the PM Dim intForumID 'Holds the forum ID Dim strToEmail 'To email address Dim blnPMNotify 'Set to true if the user wants notifying by emial 'Initilaise varaibles blnToUsernameOK = False blnMaxPMsOK = False blnMessageSent = False blnBlocked = False blnNoSubject = False 'If the user is user is using a banned IP redirect to an error page If bannedIP() Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect("insufficient_permission.asp?M=IP") End If 'If Priavte messages are not on then send them away If blnPrivateMessages = False Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect("default.asp") End If 'If the user is not allowed then send them away If intGroupID = 2 OR blnActiveMember = False Then 'Clean up Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Redirect Response.Redirect("insufficient_permission.asp") End If 'Read in the details for the pm strSubject = Trim(Mid(Request.Form("subject"), 1, 41)) strMessage = Request.Form("Message") blnReadEmailNotify = CBool(Request.Form("email")) strToUsername = Trim(Mid(Request.Form("member"), 1, 15)) 'If the buddy text box is empty then read in the buddy from the list box If strToUsername = "" Then strToUsername = Trim(Mid(Request.Form("selectMember"), 1, 15)) 'Take out parts of the username that are not permitted strToUsername = disallowedMemberNames(strToUsername) 'Run the to username through the same SQL filer it was created under otherwise it may not match strToUsername = formatSQLInput(strToUsername) 'If there is no subject or message then don't post the message as won't be able to link to it If strSubject = "" OR strMessage = "" Then blnNoSubject = True 'Check that the user the pm is being sent to exisits 'Initalise the SQL string with a query to read in the dteails of who the PM is to strSQL = "SELECT " & strDbTable & "Author.Author_ID, " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_email, " & strDbTable & "Author.PM_notify " strSQL = strSQL & "FROM " & strDbTable & "Author " strSQL = strSQL & "WHERE " & strDbTable & "Author.Username = '" & strToUsername & "';" 'Open the recordset rsCommon.Open strSQL, adoCon 'If the to buddy is found in the database run the rest of the code If NOT rsCommon.EOF Then 'Username found so set to true blnToUsernameOK = True 'Get details of who the PM is to lngToUserID = CLng(rsCommon("Author_ID")) strToEmail = rsCommon("Author_email") blnPMNotify = CBool(rsCommon("PM_notify")) 'Don't let user send private message to guest account If (lngToUserID = 2 OR intGroupID = 2) Then blnBlocked = True 'Close the recordset rsCommon.Close 'Check the user is not blocked from messaging this person 'Initalise the SQL string with a query to read count the number of pm's the user has recieved strSQL = "SELECT " & strDbTable & "BuddyList.Buddy_ID FROM " & strDbTable & "BuddyList " If strDatabaseType = "SQLServer" Then strSQL = strSQL & "WHERE " & strDbTable & "BuddyList.Block = 1 AND " & strDbTable & "BuddyList.Buddy_ID = " & lngLoggedInUserID & " AND " & strDbTable & "BuddyList.Author_ID = " & lngToUserID & ";" Else strSQL = strSQL & "WHERE " & strDbTable & "BuddyList.Block = True AND " & strDbTable & "BuddyList.Buddy_ID = " & lngLoggedInUserID & " AND " & strDbTable & "BuddyList.Author_ID = " & lngToUserID & ";" End If 'Open the recordset rsCommon.Open strSQL, adoCon 'If a record is returned then this user is blocked from messaging this person so don't send the pm, unless this is the forum admin If NOT rsCommon.EOF AND blnAdmin = False Then blnBlocked = True 'Clean up rsCommon.Close 'Check the user has not exceeded there allowed amount of private messages 'Initalise the SQL string with a query to read count the number of pm's the user has recieved strSQL = "SELECT Count(" & strDbTable & "PMMessage.PM_ID) AS CountOfPM FROM " & strDbTable & "PMMessage " strSQL = strSQL & "GROUP BY " & strDbTable & "PMMessage.Author_ID " strSQL = strSQL & "HAVING " & strDbTable & "PMMessage.Author_ID=" & lngToUserID & ";" 'Open the recordset rsCommon.Open strSQL, adoCon 'If there are records returned and the num of pm's is less than max alloed set blnMaxPMsOK to true If NOT rsCommon.EOF Then If (CInt(rsCommon("CountOfPM")) < intNumPrivateMessages) OR lngLoggedInUserID = 1 OR lngToUserID = 1 Then blnMaxPMsOK = True 'Else if no records returened they have no pm's set set blnMaxPMsOK to true anyway (it's intilised to false at the top) Else blnMaxPMsOK = True End If 'Relese sever objects rsCommon.Close Else 'Clean up rsCommon.Close End If 'If the user to send to is found and they don't exceed max num of pm's (unless the sender is admin) then send the pm If blnToUsernameOK AND blnMaxPMsOK AND blnBlocked = False AND blnNoSubject = False Then 'Place format posts posted with the WYSIWYG Editor If Request.Form("browser") = "RTE" Then 'Call the function to format WYSIWYG posts strMessage = WYSIWYGFormatPost(strMessage) 'Else standrd editor is used so convert forum codes Else 'Call the function to format posts strMessage = FormatPost(strMessage) End If 'If the user wants forum codes enabled then format the post using them If Request.Form("forumCodes") Then strMessage = FormatForumCodes(strMessage) 'Check the message for malicious HTML code strMessage = checkHTML(strMessage) 'Strip long text strings from message strMessage = removeLongText(strMessage) 'Get rid of scripting tags in the subject strSubject = removeAllTags(strSubject) strSubject = formatInput(strSubject) 'Replace swear words with other words with *** 'Initalise the SQL string with a query to read in all the words from the smut table strSQL = "SELECT " & strDbTable & "Smut.* FROM " & strDbTable & "Smut" 'Open the recordset rsCommon.Open strSQL, adoCon 'Loop through all the words to check for Do While NOT rsCommon.EOF 'Replace the swear words with the words in the database the swear words strMessage = Replace(strMessage, rsCommon("Smut"), rsCommon("Word_replace"), 1, -1, 1) strSubject = Replace(strSubject, rsCommon("Smut"), rsCommon("Word_replace"), 1, -1, 1) 'Move to the next word in the recordset rsCommon.MoveNext Loop 'Release server objects rsCommon.Close 'Send the private message 'Initalise the SQL string with a query to read in all the words from the smut table strSQL = "SELECT TOP 1 " & strDbTable & "PMMessage.* FROM " & strDbTable & "PMMessage WHERE " & strDbTable & "PMMessage.Author_ID = " & lngToUserID & " ORDER BY " & strDbTable & "PMMessage.PM_Message_Date DESC;" With rsCommon 'Set the cursor type property of the record set to Dynamic so we can navigate through the record set .CursorType = 2 'Set the Lock Type for the records so that the record set is only locked when it is updated .LockType = 3 'Open the recordset .Open strSQL, adoCon 'Check to make sure the message is not already sent to the user If NOT .EOF Then If strMessage = rsCommon("PM_Message") Then blnMessageSent = True End IF 'Save the pm If blnMessageSent = False Then 'Add new record to recordset .AddNew .Fields("Author_ID") = lngToUserID .Fields("From_ID") = lngLoggedInUserID .Fields("PM_Tittle") = strSubject .Fields("PM_Message") = strMessage .Fields("PM_Message_Date") = Now() 'Check to see if they want e-mail notification of read pm If blnLoggedInUserEmail = True AND blnReadEmailNotify = True Then .Fields("Email_notify") = 1 Else .Fields("Email_notify") = 0 End If .Update End If 'Clean up .Close End With 'If the person has requested an email sent to them notifying them of the PM then send it If blnEmail AND blnPMNotify AND strToEmail <> "" Then 'Set the subject strEmailSubject = strMainForumName & " " & strTxtNotificationPM 'Initailise the e-mail body variable with the body of the e-mail strEmailBody = strTxtHi & " " & decodeString(strToUsername) & "," strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtThisIsToNotifyYouThat & " " & strLoggedInUsername & " " & strTxtHasSentYouPM & ", " & decodeString(strSubject) & ", " & strTxtOn & " " & strMainForumName & "." strEmailBody = strEmailBody & vbCrLf & vbCrLf & strTxtToViewThePrivateMessage & " " & strTxtForumClickOnTheLinkBelow & ": -" strEmailBody = strEmailBody & vbCrLf & vbCrLf & strForumPath & "/pm_inbox.asp" 'Call the function to send the e-mail blnEmailSent = SendMail(strEmailBody, decodeString(strToUsername), decodeString(strToEmail), strMainForumName, decodeString(strForumEmailAddress), strEmailSubject, strMailComponent, false) End If End If %> Private Messenger : Send New Message
<% = strTxtPrivateMessenger %>
 <% = strMainForumName %><% = strNavSpacer %><% = strTxtPrivateMessenger %>
<% = strTxtSubjectFolder %> <% = strTxtPrivateMessenger & ": " & strTxtSendNewMessage %> <% = strTxtPrivateMessenger & " border="0"><% = strTxtPrivateMessenger & " border="0"><% = strTxtPrivateMessenger & " border="0"><% = strTxtNewPrivateMessage %>



<% 'Display message to user If blnToUsernameOK = False Then 'Display an error message Response.Write("" & strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasNotBeenSent & "") Response.Write("

" & strTxtTheUsernameCannotBeFound) Response.Write("

" & strTxtAmendYourPrivateMessage & "") 'Save the pm details so they can be edited Response.Write(vbCrLf & "") Response.Write(vbCrLf & "") Response.Write(vbCrLf & "") 'If the message is blocked ElseIf blnBlocked Then 'Display an error message Response.Write("" & strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasNotBeenSent & "") Response.Write("

" & strTxtYouAreBlockedFromSendingPMsTo & " " & strToUsername & ".") Response.Write("

" & strTxtReturnToYourPrivateMessenger & "") ElseIf blnMaxPMsOK = False Then 'Display an error message Response.Write("" & strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasNotBeenSent & "") Response.Write("

" & strToUsername & " " & strTxtHasExceededMaxNumPPMs & ".") Response.Write("

" & strTxtReturnToYourPrivateMessenger & "") 'If there is no message body or subject display an error message ElseIf blnNoSubject Then 'Display an error message Response.Write("" & strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasNotBeenSent & "") Response.Write("

" & strTxtYourMessageNoValidSubjectHeading) Response.Write("

" & strTxtAmendYourPrivateMessage & "") 'Save the pm details so they can be edited Response.Write(vbCrLf & "") Response.Write(vbCrLf & "") Response.Write(vbCrLf & "") 'Else display a message that the PM is sent Else 'Display a message to say the message is sent Response.Write(" " & strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasBeenSentTo & " " & strToUsername & ".") Response.Write("

" & strTxtReturnToYourPrivateMessenger & "") End If %>




<% '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode = True Then If blnTextLinks = True Then Response.Write("Powered by Web Wiz Forums version " & strVersion & "") Else Response.Write("") End If Response.Write("
Copyright ©2001-2004 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 'Release server objects Set rsCommon = Nothing adoCon.Close Set adoCon = Nothing 'Display the process time If blnShowProcessTime Then Response.Write "

" & strTxtThisPageWasGeneratedIn & " " & FormatNumber(Timer() - dblStartTime, 4) & " " & strTxtSeconds & "" %>