functions_send_mail.asp

简单的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
'**
'****************************************************************************************



'Function to send an e-mail
Function SendMail(ByVal strEmailBodyMessage, ByVal strRecipientName, ByVal strRecipientEmailAddress, ByVal strFromEmailName, ByVal strFromEmailAddress, ByVal strSubject, strMailComponent, blnHTML)

	'Dimension variables
	Dim objCDOSYSMail		'Holds the CDOSYS mail object
	Dim objCDOMail			'Holds the CDONTS mail object
	Dim objJMail			'Holds the Jmail object
	Dim objAspEmail			'Holds the Persits AspEmail email object
	Dim objAspMail			'Holds the Server Objects AspMail email object
	Dim strEmailBodyAppendMessage	'Holds the appended email message
	
	
	'If we are in demo mode we don't want to send emails so exit function
	If blnDemoMode Then 
		SendMail = False
		Exit Function
	End If
	
	
	'Set error trapping
	On Error Resume Next
	
	
	
	'Remove unwanted cahracters that may course the email component to throw an exception
	'or be used by a spammer to send out BCC spam emails using a malformed form entry
	
	strSubject = Trim(Mid(Replace(strSubject, vbCrLf, ""), 1, 100))
	
	strRecipientName = Trim(Mid(strRecipientName, 1, 35))
	strFromEmailName = Trim(Mid(strFromEmailName, 1, 35))
	strRecipientEmailAddress = Trim(Mid(strRecipientEmailAddress, 1, 50))
	strFromEmailAddress = Trim(Mid(strFromEmailAddress, 1, 50))
	
	strRecipientName = Replace(strRecipientName, vbCrLf, "", 1, -1, 1)
	strFromEmailName = Replace(strFromEmailName, vbCrLf, "", 1, -1, 1)
	strRecipientEmailAddress = Replace(strRecipientEmailAddress, vbCrLf, "", 1, -1, 1)
	strFromEmailAddress = Replace(strFromEmailAddress, vbCrLf, "", 1, -1, 1)
	
	strRecipientName = Replace(strRecipientName, ",", "", 1, -1, 1)
	strFromEmailName = Replace(strFromEmailName, ",", "", 1, -1, 1)
	strRecipientEmailAddress = Replace(strRecipientEmailAddress, ",", "", 1, -1, 1)
	strFromEmailAddress = Replace(strFromEmailAddress, ",", "", 1, -1, 1)
	
	strRecipientName = Replace(strRecipientName, ";", "", 1, -1, 1)
	strFromEmailName = Replace(strFromEmailName, ";", "", 1, -1, 1)
	strRecipientEmailAddress = Replace(strRecipientEmailAddress, ";", "", 1, -1, 1)
	strFromEmailAddress = Replace(strFromEmailAddress, ";", "", 1, -1, 1)
	
	strRecipientName = Replace(strRecipientName, ":", "", 1, -1, 1)
	strFromEmailName = Replace(strFromEmailName, ":", "", 1, -1, 1)
	strRecipientEmailAddress = Replace(strRecipientEmailAddress, ":", "", 1, -1, 1)
	strFromEmailAddress = Replace(strFromEmailAddress, ":", "", 1, -1, 1)
	
	strRecipientName = Replace(strRecipientName, "<", "", 1, -1, 1)
	strFromEmailName = Replace(strFromEmailName, "<", "", 1, -1, 1)
	strRecipientEmailAddress = Replace(strRecipientEmailAddress, "<", "", 1, -1, 1)
	strFromEmailAddress = Replace(strFromEmailAddress, "<", "", 1, -1, 1)
	
	strRecipientName = Replace(strRecipientName, ">", "", 1, -1, 1)
	strFromEmailName = Replace(strFromEmailName, ">", "", 1, -1, 1)
	strRecipientEmailAddress = Replace(strRecipientEmailAddress, ">", "", 1, -1, 1)
	strFromEmailAddress = Replace(strFromEmailAddress, ">", "", 1, -1, 1)
	
	


	'Check the email body doesn't already have Web Wiz Forums
	If blnLCode Then
		
		
		'***** START WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******

		'If HTML format then make an HTML link
		If blnHTML = True Then
			strEmailBodyAppendMessage = "<br /><br /><br /><hr />Software provided by <a href=""http://www.webwizforums.com"">Web Wiz Forums&reg;</a> version " & strVersion & " - http://www.webwizforums.com<br />Free Bulletin Board System - Download today!"
		'Else do a text link
		Else
			strEmailBodyAppendMessage = VbCrLf & VbCrLf & "---------------------------------------------------------------------------------------"  & _
			vbCrLf & "Software provided by Web Wiz Forums(TM) version " & strVersion& " - http://www.webwizforums.com"  & _
			vbCrLf & "Free Bulletin Board System - Download today!"
		End If
		
		'***** END WARNING - REMOVAL OR MODIFICATION OF THIS CODE WILL VIOLATE THE LICENSE AGREEMENT ******
	End If
	
	
	'Check to see if an error has occurred
	'If an error has occurred write an error to the page
	If Err.Number <> 0 Then Call errorMsg("An error has occurred while sending an email.", "send_mail_header", "functions_send_mail.asp")



	'******************************************
	'***	        Mail components        ****
	'******************************************

	'Select which email component to use
	Select Case strMailComponent



		'******************************************
		'***	  MS CDOSYS mail component     ****
		'******************************************

		'CDOSYS mail component
		Case "CDOSYS", "CDOSYSp"

			'Dimension variables
			Dim objCDOSYSCon
			Dim intSendUsing
			
			'Port or pick up directory (1=pick up directory(localhost) 2=port(network))
			If strMailComponent = "CDOSYSp" Then
				intSendUsing = 1
			Else
				intSendUsing = 2
			End If

			'Create the e-mail server object
			Set objCDOSYSMail = Server.CreateObject("CDO.Message")
		    	Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration")
		    	
		    	'Check to see if an error has occurred
			'If an error has occurred write an error to the page
			If Err.Number <> 0 Then Call errorMsg("An error has occurred while sending an email.<br />Please check that the CDOSYS email component is installed on the server.", "create_CDOSYS_object", "functions_send_mail.asp")
		

		    	'Set and update fields properties
		    	With objCDOSYSCon
		    		
		    		'Use SMTP Server authentication if required
		    		If strMailServerUser <> "" AND strMailServerPass <> "" Then 
			    		' Specify the authentication mechanism to basic (clear-text) authentication cdoBasic = 1
			        	.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
			        	
			        	'SMTP Server username
			        	.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = strMailServerUser
			        	
			        	'SMTP Server password
			        	.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strMailServerPass
			        End If
		        	
		        	
		        	'Out going SMTP server
		        	.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailServer
		        	
		        	'SMTP port
		        	.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport")  = 25
		        	
		        	'CDO Port (1=localhost 2=network)
		        	.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = intSendUsing
		        	
		        	'Set CDO pickup directory if using localhost (CDO Port 1)
		        	If intSendUsing = 1 Then
		        		'CDO pickup directory (used for localhost service)
		        		.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory") = "c:\inetpub\mailroot\pickup" 
		        	End If
		        	
		        	'Timeout
		        	.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
	        		.Fields.Update
	        	End With

				'Update the CDOSYS Configuration
				Set objCDOSYSMail.Configuration = objCDOSYSCon

			With objCDOSYSMail
				'Who the e-mail is from
				.From = strFromEmailName & " <" & strFromEmailAddress & ">"

				'Who the e-mail is sent to
				.To = strRecipientName & " <" & strRecipientEmailAddress & ">"

				'The subject of the e-mail
				.Subject = strSubject

				'Set the e-mail body format (HTMLBody=HTML TextBody=Plain)
				If blnHTML = True Then
				 	.HTMLBody = strEmailBodyMessage & strEmailBodyAppendMessage
				Else
					.TextBody = strEmailBodyMessage & strEmailBodyAppendMessage
				End If

				'Send the e-mail
				If NOT strMailServer = "" Then .Send
			End with

			'Close the server mail object
			Set objCDOSYSMail = Nothing
			Set objCDOSYSCon = Nothing




		'******************************************
		'***  	  MS CDONTS mail component     ****
		'******************************************

		'CDONTS mail component
		Case "CDONTS"

			'Create the e-mail server object
			Set objCDOMail = Server.CreateObject("CDONTS.NewMail")
			
			'Check to see if an error has occurred
			'If an error has occurred write an error to the page
			If Err.Number <> 0 Then Call errorMsg("An error has occurred while sending an email.<br />Please check that the CDONTS email component is installed on the server.", "create_CDONTS_object", "functions_send_mail.asp")