% @ 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 ******
%>