<div style="text-indent: 2em; font-size: larger;">
使用ASP发送邮件的代码示例:
首先,建立一个Email的类文件,用来封装相关的邮件发送准备操作(如建立CDO.Message对象,以及做一些邮件服务器的配置工作等),命名为 CEmail.asp。
<% Class CEmail Private sFromEmail Private sToEmail Private sMessage Private sBCCEmail Private sSubject Private sBody ' 配置 Private sOrigSenderEmail Private lSendUsing Private lSmtpServerPort Private sSmtpServer Private lSmtpAuthenticate Private sSendUserName Private sSendPassword Private bSmtpUseSSLPrivate Function bValidateExp(ByRef sPattern, ByRef s) Dim regEx Set regEx = Server.CreateObject("VBScript.RegExp") regEx.Global = True regEx.IgnoreCase = True regEx.Pattern = sPattern bValidateExp = regEx.Test(s) Set regEx = Nothing End Function Private Sub Class_Initialize() sOrigSenderEmail = "***@myfootprints.cn" ' 2 - cdoSendUsingPort lSendUsing = 2 lSmtpServerPort = 25 sSmtpServer = "smtp.qq.com" ' 1 - cdoBasic lSmtpAuthenticate = 1 sSendUserName = "***@myfootprints.cn" sSendPassword = "***" bSmtpUseSSL = False End Sub Public Sub GetRequest() End Sub Public Function SendTextMail() Dim oMail On Error Resume Next Set oMail = Server.CreateObject("CDO.Message") ' 设置 With oMail.Configuration.Fields 'Original sender email address .Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = Me.OrigSenderEmail 'SMTP settings - without authentication, using standard port 25 on host smtp ' 2 - cdoSendUsingPort .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = Me.SendUsing .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Me.SmtpServerPort .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Me.SmtpServer 'SMTP Authentication ' 0 - cdoAnonymous ' 1 - cdoBasic .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Me.SmtpAuthenticate .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Me.SendUserName .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Me.SendPassword .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Me.SmtpUseSSL .Update End With oMail.To = Me.ToEmail oMail.From = Me.OrigSenderEmail oMail.BCC = Me.BCCEmail oMail.Subject = Me.Subject oMail.Textbody = Me.Body oMail.Send Set oMail = Nothing If Err.number = 0 Then SendTextMail = True Else AddInfo2 "发生错误:" & Err.Description, "ssnInfo_SendToFriend" SendTextMail = False End If On Error Goto 0 End Function Public Function Validate() Validate = True If Len(Me.FromEmail) <= 0 Then AddInfo2 "发送Email不能为空", "ssnInfo_SendToFriend" Validate = False End If If Len(Me.ToEmail) <= 0 Then AddInfo2 "接收Email不能为空", "ssnInfo_SendToFriend" Validate = False End If End Function Public Property Get FromEmail() FromEmail = sFromEmail End Property Public Property Let FromEmail(ByRef s) sFromEmail = s End Property Public Property Get ToEmail() ToEmail = sToEmail End Property Public Property Let ToEmail(ByRef s) sToEmail = s End Property Public Property Get Message() Message = sMessage End Property Public Property Let Message(ByRef s) sMessage = s End Property Public Property Get BCCEmail() BCCEmail = sBCCEmail End Property Public Property Let BCCEmail(ByRef s) sBCCEmail = s End Property Public Property Get Subject() Subject = sSubject End Property Public Property Let Subject(ByRef s) sSubject = s End Property Public Property Get URL() URL = sURL End Property Public Property Let URL(ByRef s) sURL = s End Property Public Property Get Body() Body = sBody End Property Public Property Let Body(ByRef s) sBody = s End Property Public Property Get OrigSenderEmail() OrigSenderEmail = sOrigSenderEmail End Property Public Property Let OrigSenderEmail(ByRef s) sOrigSenderEmail = s End Property Public Property Get SendUsing() SendUsing = lSendUsing End Property Public Property Let SendUsing(ByVal l) lSendUsing = l End Property Public Property Get SmtpServerPort() SmtpSErverPort = lSmtpServerPort ENd Property Public Property Let SmtpServerPort(ByVal l) lSmtpServerPort = l End Property Public Property Get SmtpServer() SmtpServer = sSmtpSErver End Property Public Property Let SmtpServer(ByRef s) sSmtpServer = s End Property Public Property Get SmtpAuthenticate() SmtpAuthenticate = lSmtpAuthenticate End Property Public Property Let SmtpAuthenticate(ByVal l) lSmtpAuthenticate = l End Property Public Property Get SendUserName() SendUserName = sSendUserName End Property Public Property Let SendUserName(ByRef s) sSendUserName = s End Property Public Property Get SendPassword() SendPassword = sSendPassword End Property Public Property Let SendPassword(ByRef s) sSendPassword = s End Property Public Property Get SmtpUseSSL() SmtpUseSSL = bSmtpUseSSL End Property Public Property Let SmtpUseSSL(ByVal b) bSmtpUseSSL = b ENd Property End Class
%>
然后就可以使用CMail来发送邮件了。比如在一个网页界面上提供一个填写发件人姓名,收件人邮件地址,以及消息内容的表单,表单提交后,可以使用类似如下的后台代码来利用CEmail来发送邮件:
<!--#include file="CEmail.asp"--> <% Class CBeanSendToFriend Private sFromEmail Private sToEmail Private sMessage Private sBCCEmail Private sSubject Private sURL Private sHeader Private sFooter Private sBodyPrivate Function bValidateExp(ByRef sPattern, ByRef s) Dim regEx Set regEx = Server.CreateObject("VBScript.RegExp") regEx.Global = True regEx.IgnoreCase = True regEx.Pattern = sPattern bValidateExp = regEx.Test(s) Set regEx = Nothing End Function Private Sub Class_Initialize() Me.GetRequest End Sub Public Sub GetRequest() Me.FromEmail = Replace(Trim(Request.Form("FromEmail")), "'", "") Me.ToEmail = Replace(Trim(Request.Form("ToEmail")), "'", "") Me.Message = Trim(Request.Form("Message")) Me.URL = Trim(Request.Form("URL")) Me.BCCEmail = "***@myfootprints.cn" Me.Subject = Trim(Request.Form("Subject")) Me.Header = (Request.Form("Header")) Me.Footer = Request.Form("Footer") End Sub Public Function Validate() Validate = True If Len(Me.ToEmail) <= 0 Then AddInfo2 "接收Email不能为空", "ssnInfo_SendToFriend" Validate = False End If If Validate Then Dim oEmail Set oEmail = New CEmail oEmail.FromEmail = Me.FromEmail oEmail.ToEmail = Me.ToEmail oEmail.BCCEmail = Me.BCCEmail oEmail.Subject = Me.Subject 'Me.Body = "您的朋友 " & Me.FromEmail & " 推荐您访问[我的涂鸦]网站:" & vbCrLf & vbCrLf & Me.URL & vbCrLf & vbCrLf & Me.Message & vbCrLf & vbCrLf & "此页面由涂鸦发送链接服务发送。您的 Email 地址没有被添加到任何清单里,也没有被记录到我的网站里。" Me.Body = "您的朋友 " & Me.FromEmail & " " & Me.Header & vbCrLf & vbCrLf & Me.Message & vbCrLf & Me.Footer oEmail.Body = Me.Body If oEmail.SendTextMail() Then Else Validate = False End If Set oEmail = Nothing End If End Function Public Property Get FromEmail() FromEmail = sFromEmail End Property Public Property Let FromEmail(ByRef s) sFromEmail = s End Property Public Property Get ToEmail() ToEmail = sToEmail End Property Public Property Let ToEmail(ByRef s) sToEmail = s End Property Public Property Get Message() Message = sMessage End Property Public Property Let Message(ByRef s) sMessage = s End Property Public Property Get BCCEmail() BCCEmail = sBCCEmail End Property Public Property Let BCCEmail(ByRef s) sBCCEmail = s End Property Public Property Get Subject() Subject = sSubject End Property Public Property Let Subject(ByRef s) sSubject = s End Property Public Property Get URL() URL = sURL End Property Public Property Let URL(ByRef s) sURL = s End Property Public Property Get Body() Body = sBody End Property Public Property Let Body(ByRef s) sBody = s End Property Public Property Get Header() Header = sHeader End Property Public Property Let Header(ByRef s) sHeader = s End Property Public Property Get Footer() Footer = sFooter End Property Public Property Let Footer(ByRef s) sFooter = s End Property End Class
%>