<% @ Language=VBScript %> <% Option Explicit %> <% '**************************************************************************************** '** Copyright Notice '** '** Web Wiz Guide - Web Wiz Forums '** http://www.webwizforums.com '** '** Copyright 2001-2006 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: - '** '** Web Wiz Guide, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, UK, BH15 4JD '** '**************************************************************************************** '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 Dim intTmpPMno 'Temporary store for PM number the user has Dim blnFloodControl 'Set to tru if flood control has been exceeded Dim dtmFloodControlDate 'Holds the flood control date for the database search Dim intSentPMs 'Holds the number of PM sent 'Initilaise varaibles blnToUsernameOK = False blnMaxPMsOK = False blnMessageSent = False blnBlocked = False blnNoSubject = False blnFloodControl = False 'If the user is user is using a banned IP redirect to an error page If bannedIP() Then 'Clean up Call closeDatabase() 'Redirect Response.Redirect("insufficient_permission.asp?M=IP" & strQsSID2) End If 'If Priavte messages are not on then send them away If blnPrivateMessages = False Then 'Clean up Call closeDatabase() 'Redirect Response.Redirect("default.asp" & strQsSID1) End If 'If the user is not allowed then send them away If intGroupID = 2 OR blnActiveMember = False OR blnBanned Then 'Clean up Call closeDatabase() 'Redirect Response.Redirect("insufficient_permission.asp" & strQsSID1) 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 " & _ "FROM " & strDbTable & "Author" & strDBNoLock & " " & _ "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" & strDBNoLock & " " & _ "WHERE " & strDbTable & "BuddyList.Block = " & strDBTrue & " " & _ "AND " & strDbTable & "BuddyList.Buddy_ID = " & lngLoggedInUserID & " " & _ "AND " & strDbTable & "BuddyList.Author_ID = " & lngToUserID & ";" '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" & strDBNoLock & " " & _ "WHERE " & 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 'PM Flood control, make sure the user has not sent to many PM's If blnAdmin = False Then 'Get the date with 1 hour taken off dtmFloodControlDate = internationalDateTime(DateAdd("h", -1, now())) 'SQL Server doesn't like ISO dates with '-' in them, so remove the '-' part If strDatabaseType = "SQLServer" Then dtmFloodControlDate = Replace(dtmFloodControlDate, "-", "", 1, -1, 1) 'Place the date in SQL safe # or ' If strDatabaseType = "Access" Then dtmFloodControlDate = "#" & dtmFloodControlDate & "#" Else dtmFloodControlDate = "'" & dtmFloodControlDate & "'" End If '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 CountOfSentPM " & _ "FROM " & strDbTable & "PMMessage" & strDBNoLock & " " & _ "WHERE " & strDbTable & "PMMessage.From_ID = " & lngLoggedInUserID & " " & _ "AND " & strDbTable & "PMMessage.PM_Message_Date >= " & dtmFloodControlDate & ";" 'Open the recordset rsCommon.Open strSQL, adoCon 'If the user has exceeded the number of sent PM's in this hour don't let them send the PM If NOT rsCommon.EOF Then intSentPMs = CInt(rsCommon("CountOfSentPM")) If intSentPMs >= intPmFlood Then blnFloodControl = True End If 'Relese sever objects rsCommon.Close End If 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 AND blnFloodControl = 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) 'Get rid of scripting tags in the subject strSubject = removeAllTags(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" & strDBNoLock & ";" '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 (save) the private message 'Initalise the SQL string (ADO is used for more security) strSQL = "SELECT" & strDBTop1 & " " & strDbTable & "PMMessage.* " & _ "FROM " & strDbTable & "PMMessage" & strRowLock & " " & _ "WHERE " & strDbTable & "PMMessage.Author_ID = " & lngToUserID & " " & _ "ORDER BY " & strDbTable & "PMMessage.PM_Message_date DESC" & strDBLimit1 & ";" With rsCommon '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") = internationalDateTime(Now()) 'Check to see if they want e-mail notification of read pm If blnLoggedInUserEmail = True AND blnReadEmailNotify = True Then .Fields("Email_notify") = strDBTrue Else .Fields("Email_notify") = strDBFalse End If .Update 'Update booleon that message is sent blnMessageSent = true End If 'Clean up .Close End With 'When calling the updateUnreadPM function next, it can change the number of displayed un-read PM's for the PM sender 'To prevent this bug, we store the number of un-read PM's for the sender in a temp store intTmpPMno = intNoOfPms 'Update the number of unread PM's for the recepient Call updateUnreadPM(lngToUserID) 'Restore the number of un-read PM's for the PM sender intNoOfPms = intTmpPMno '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) & "," & _ vbCrLf & vbCrLf & strTxtThisIsToNotifyYouThat & " " & strLoggedInUsername & " " & strTxtHasSentYouPM & ", " & decodeString(strSubject) & ", " & strTxtOn & " " & strMainForumName & "." & _ vbCrLf & vbCrLf & strTxtToViewThePrivateMessage & " " & strTxtForumClickOnTheLinkBelow & ": -" & _ 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 %> Özel Mesaj : Özel Mesaj Gönder <% '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** Response.Write("" & vbCrLf & vbCrLf) '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** %>
<% = strTxtPrivateMessenger %>
 <% = strMainForumName %><% = strNavSpacer %><% = strTxtPrivateMessenger %>

<% = strTxtSubjectFolder %> <% = strTxtPrivateMessenger & ": " & strTxtSendPrivateMessage %> <% = strTxtPrivateMessenger & " border="0"><% = strTxtPrivateMessenger & " border="0"><% = strTxtPrivateMessenger & " border="0"><% = strTxtNewPrivateMessage %>

<% 'If the pm has been sent show a message saying so If blnMessageSent Then %>
<% = strTxtSendPrivateMessage %>
<% = strTxtYourPrivateMessage %> "<% = Server.HTMLEncode(strSubject) %>", <% = strTxtHasBeenSentTo & " " & strToUsername %>.

<% = strTxtReturnToYourPrivateMessenger %>
<% 'Else an error has occured Else %>
<% = strTxtError %>
<% '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 & "") 'Max PM's recieved ElseIf blnMaxPMsOK = False Then 'Display an error message Response.Write(strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasNotBeenSent) Response.Write("

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

" & strTxtReturnToYourPrivateMessenger & "") 'Flood Control ElseIf blnFloodControl Then 'Display an error message Response.Write(strTxtYourPrivateMessage & " "" & strSubject & "", " & strTxtHasNotBeenSent) Response.Write("

" & strTxtYouAreOnlyPerToSend & " " & intPmFlood & " " & strTxtYouHaveExceededLimit & ".") 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 & " ") End If %>
<% End If %>
<% '***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** If blnLCode = True Then Response.Write(strFooterAds) If blnTextLinks = True Then Response.Write("Powered by Web Wiz Forums version " & strVersion & "") Else Response.Write("") End If Response.Write("
Copyright ©2001-2006 Web Wiz Guide") End If '***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ****** 'Release server objects Call closeDatabase() 'Display the process time If blnShowProcessTime Then Response.Write "

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