⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pm_message.asp

📁 简单的asp论坛源码系统,很适用于初学者!界面简洁,功能齐全
💻 ASP
📖 第 1 页 / 共 2 页
字号:
<% @ Language=VBScript %>
<% Option Explicit %>
<!--#include file="common.asp" -->
<!--#include file="language_files/pm_language_file_inc.asp" -->
<!--#include file="functions/functions_date_time_format.asp" -->
<!--#include file="functions/functions_send_mail.asp" -->
<!--#include file="functions/functions_format_post.asp" -->
<%
'****************************************************************************************
'**  Copyright Notice    
'**
'**  Web Wiz Forums(TM)
'**  http://www.webwizforums.com
'**                            
'**  Copyright (C)2001-2008 Web Wiz(TM). All Rights Reserved.
'**  
'**  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS UNDER LICENSE FROM 'WEB WIZ'.
'**  
'**  IF YOU DO NOT AGREE TO THE LICENSE AGREEMENT THEN 'WEB WIZ' IS UNWILLING TO LICENSE 
'**  THE SOFTWARE TO YOU, AND YOU SHOULD DESTROY ALL COPIES YOU HOLD OF 'WEB WIZ' SOFTWARE
'**  AND DERIVATIVE WORKS IMMEDIATELY.
'**  
'**  If you have not received a copy of the license with this work then a copy of the latest
'**  license contract can be found at:-
'**
'**  http://www.webwizguide.com/license
'**
'**  For more information about this software and for licensing information please contact
'**  'Web Wiz' at the address and website below:-
'**
'**  Web Wiz, Unit 10E, Dawkins Road Industrial Estate, Poole, Dorset, BH15 4JD, England
'**  http://www.webwizguide.com
'**
'**  Removal or modification of this copyright notice will violate the license contract.
'**
'****************************************************************************************



'*************************** SOFTWARE AND CODE MODIFICATIONS **************************** 
'**
'** MODIFICATION OF THE FREE EDITIONS OF THIS SOFTWARE IS A VIOLATION OF THE LICENSE  
'** AGREEMENT AND IS STRICTLY PROHIBITED
'**
'** If you wish to modify any part of this software a license must be purchased
'**
'****************************************************************************************




'Set the buffer to true
Response.Buffer = True

'Make sure this page is not cached
Response.Expires = -1
Response.ExpiresAbsolute = Now() - 2
Response.AddHeader "pragma","no-cache"
Response.AddHeader "cache-control","private"
Response.CacheControl = "No-Store"

'Declare variables
Dim lngPmMessageID		'Private message id
Dim strPmSubject 		'Holds the subject of the private message
Dim strMessage			'Holds the message body of the thread
Dim lngMessageID		'Holds the message ID number
Dim lngFromUserID		'Holds the from user ID
Dim lngToUserID			'Holds the to user ID
Dim dtmTopicDate		'Holds the date the thread was made
Dim strUsername 		'Holds the Username of the thread
Dim strAuthorHomepage		'Holds the homepage of the Username if it is given
Dim strAuthorLocation		'Holds the location of the user if given
Dim strAuthorAvatar		'Holds the authors avatar	
Dim lngAuthorNumOfPosts		'Holds the number of posts the user has made to the forum
Dim dtmAuthorRegistration	'Holds the registration date of the user
Dim intRecordLoopCounter	'Holds the loop counter numeber
Dim intTopicPageLoopCounter	'Holds the number of pages there are of pm messages
Dim strEmailBody		'Holds the body of the e-mail message
Dim strEmailSubject		'Holds the subject of the e-mail
Dim blnEmailSent		'set to true if an e-mail is sent
Dim strGroupName		'Holds the authors group name
Dim intRankStars		'Holds the number of stars for the group
Dim strMemberTitle		'Holds the members title
Dim strRankCustomStars		'Holds custom stars for the user group

'Raed in the pm mesage number to display
lngPmMessageID = CLng(Request.QueryString("ID"))

'If Priavte messages are not on then send them away
If blnPrivateMessages = False OR blnACode Then 
	
	'Clean up
	Call closeDatabase()
	
	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()
	
	Response.Redirect("insufficient_permission.asp" & strQsSID1)
End If


	
'Initlise the sql statement
strSQL = "SELECT " & strDbTable & "PMMessage.*, " & strDbTable & "Author.Username, " & strDbTable & "Author.Author_email, " & strDbTable & "Author.Join_date, " & strDbTable & "Author.Signature, " & strDbTable & "Author.Active, " & strDbTable & "Author.Avatar, " & strDbTable & "Group.Name, " & strDbTable & "Group.Stars, " & strDbTable & "Group.Custom_stars " & _
"FROM " & strDbTable & "Author" & strDBNoLock & ", " & strDbTable & "PMMessage" & strDBNoLock & ", " & strDbTable & "Group" & strDBNoLock & " " & _
"WHERE " & strDbTable & "Author.Author_ID = " & strDbTable & "PMMessage.From_ID " & _
	"AND " & strDbTable & "Author.Group_ID = " & strDbTable & "Group.Group_ID " & _
	"AND " & strDbTable & "PMMessage.PM_ID=" & lngPmMessageID & " "
	
'If this is a link from the out box then check the from author ID to check the user can view the message
If Request.QueryString("M") = "OB" Then
	strSQL = strSQL & " AND " & strDbTable & "PMMessage.From_ID=" & lngLoggedInUserID & ";"
'Else use the to author ID to check the user can view the message
Else
	strSQL = strSQL & " AND " & strDbTable & "PMMessage.Author_ID=" & lngLoggedInUserID & ";"
End If



'Query the database
rsCommon.Open strSQL, adoCon


'If a mesage is found then send a mail if the sender wants notifying
If NOT rsCommon.EOF Then 
	
	'Read in some of the details
	strPmSubject = rsCommon("PM_Tittle")
	strUsername = rsCommon("Username")
	strMessage = rsCommon("PM_Message")
	lngFromUserID = CLng(rsCommon("From_ID"))
	lngToUserID = CLng(rsCommon("Author_ID"))
	dtmTopicDate = CDate(rsCommon("PM_Message_date")) 
	strAuthorAvatar = rsCommon("Avatar")
	strGroupName = rsCommon("Name")
	intRankStars = CInt(rsCommon("Stars"))
	strRankCustomStars = rsCommon("Custom_stars")
	
	'If the sender wants notifying then send a mail as long as e-mail notify is on and the message hasn't already been read
	If CBool(rsCommon("Email_notify")) AND rsCommon("Author_email") <> "" AND blnEmail AND CBool(rsCommon("Read_Post")) = False AND Request.QueryString("M") <> "OB" Then
		
		'Set the subject
		strEmailSubject = strMainForumName & " " & strTxtNotificationPM
	
		'Initailise the e-mail body variable with the body of the e-mail
		strEmailBody = strTxtHi & " " & decodeString(strUsername) & "," & _
		vbCrLf & vbCrLf & strTxtThisIsToNotifyYouThat & " '" & strLoggedInUsername & "' " & strTxtHasReadPM & ", '" & decodeString(strPmSubject) & "', " & strTxtYouSentToThemOn & " " & strMainForumName & "." & _
		vbCrLf & vbCrLf & strTxtToViewThePrivateMessage & " " & strTxtForumClickOnTheLinkBelow & ": -" & _
                vbCrLf & vbCrLf & strForumPath & "pm_message.asp?ID=" & lngPmMessageID
		
		'Call the function to send the e-mail
		blnEmailSent = SendMail(strEmailBody, decodeString(strUsername), decodeString(rsCommon("Author_email")), strMainForumName, decodeString(strForumEmailAddress), strEmailSubject, strMailComponent, false)
	
	End If
	
	'Filter for CSS hacks
	strPmSubject = formatInput(strPmSubject)
	
	'If the pm contains a quote or code block then format it
	If InStr(1, strMessage, "[QUOTE=", 1) > 0 AND InStr(1, strMessage, "[/QUOTE]", 1) > 0 Then strMessage = formatUserQuote(strMessage)
	If InStr(1, strMessage, "[QUOTE]", 1) > 0 AND InStr(1, strMessage, "[/QUOTE]", 1) > 0 Then strMessage = formatQuote(strMessage)
	If InStr(1, strMessage, "[CODE]", 1) > 0 AND InStr(1, strMessage, "[/CODE]", 1) > 0 Then strMessage = formatCode(strMessage)

	
	'If the Post or signature contains Flash or YouTube BBcodes then display them
	If blnFlashFiles Then
		'Flash
		If InStr(1, strMessage, "[FLASH", 1) > 0 AND InStr(1, strMessage, "[/FLASH]", 1) > 0 Then strMessage = formatFlash(strMessage)
		'YouTube
		If InStr(1, strMessage, "[TUBE]", 1) > 0 AND InStr(1, strMessage, "[/TUBE]", 1) > 0 Then strMessage = formatYouTube(strMessage)
	End If
End If



'Close recordset
rsCommon.Close



'If this is not from the outbox then update the read field
If Request.QueryString("M") <> "OB" Then
	
	'Inittilise the sql veriable to update the database
	strSQL = "UPDATE " & strDbTable & "PMMessage " & strRowLock & " " & _
	"SET " & strDbTable & "PMMessage.Read_Post= " & strDBTrue & " " & _
	"WHERE " & strDbTable & "PMMessage.PM_ID=" & lngPmMessageID & ";"

	'Execute the sql statement to set the pm to read
	adoCon.Execute(strSQL)
	
	
	'Update the number of unread PM's 
	Call updateUnreadPM(lngLoggedInUserID)
	
	
	'Update the notified PM session variable
	If intNoOfPms = 0 Then

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -