ASP实现邮件的发送需要组件来支持,可以使用微软自带的CDO或者用第三方组件(如JMail、ASPMail)来发送邮件。微软自带的发邮件组件可以在添加WINDOWS组件中找到,关于第三方组件的获得方法自己去网上搜索,我就不多说了。不管是自带的组件或第三方组件我们都要写不同的程序,随着服务器支持组件的不同,我们要开发不同的程序,感觉有点麻烦,虽然写个发mail的程序是很容易的事。那我们能否写个class支持一些常用的组件,这样我们只要一个程序,调用这个class就行了。不用写多个程序了,维护起来应该也比较方便吧!好了,不多说废话了,下面是我写的class的源码,感兴趣的人可以玩玩。由于本人水平有限,写得很烂,愿意进一步完善的人可以把它写得好一些,由于没有什么条件来试,里面估计有错误存在,在使用如出现问题,希望能通知我加以改正,谢谢email:cjj8110@hotmail.com。
cls_Email.ASP的源码:
<%Option Explicit
'#########声明变量########
'以下定义邮件组件类型常量
Const SWEmail_JMail43 = 0
Const SWEmail_JMail = 1
Const SWEmail_ASPMail = 2
Const SWEmail_CDO = 3
'本类支持的组件数,由于数组的下标是从0开始的,所以实际是支持3个组件
Const SWEmail_intMailobjects = 3
'邮件组件数组
ReDim SWEmail_aryMailObject(SWEmail_intMailobjects,2)
'JMail 4.3
SWEmail_aryMailObject(0,0) = "JMail.Message" '创建组件的字符串,此字符串固定
SWEmail_aryMailObject(0,1) = SWEmail_JMail43 '组件的类型,自定义
'JMail 早期版本
SWEmail_aryMailObject(1,0) = "JMail.SmtpMail"
SWEmail_aryMailObject(1,1) = SWEmail_JMail
'ASP Mail
SWEmail_aryMailObject(2,0) = "Persits.MailSender"
SWEmail_aryMailObject(2,1) = SWEmail_ASPMail
'微软自带的组件
SWEmail_aryMailObject(3,0) = "CDONTS.NewMail"
SWEmail_aryMailObject(3,1) = SWEmail_CDO
'记录邮件组件创建字符串
Dim SWEmail_strMailObject
'邮件组件的类型
Dim SWEmail_intMailType
'邮件组件的名称(描述)
Dim strMailName
'邮件附件信息
Dim SWEmail_strFiles
SWEmail_strFiles = ""
Dim SWEmail_strFrom '发件人Email地址
Dim SWEmail_strFromName '发件人姓名
Dim SWEmail_strTo '收件人Email地址
Dim SWEmail_strSubject '邮件主题
Dim SWEmail_strBody '邮件内容
Dim SWEmail_strBCC '密送人Email地址
Dim SWEmail_strCC '抄送人Email地址
Dim SWEmail_strSMTPServer '邮件服务器地址
Dim SWEmail_intSpeed '邮件等级
Dim SWEmail_blnIsHTML '是否HTML邮件,True为HTML邮件,FASLE为纯文本邮件
Dim SWEmail_strUserName '身份验证时输入的用户名
Dim SWEmail_strPassword '身份验证时输入的密码
'#########声明结束########
'#########数据初始化########
'默认为普通
SWEmail_intSpeed = 1
'默认为HTML邮件
SWEmail_blnIsHTML = True
'设置默认发件服务器地址
'SWEmail_strSMTPServr = "SMTP.163.com"
'设置默认组件字符串
'SWEmail_strMailObject = "JMail.Message"
'#########初始化结束########
Class SWEmail
'检测服务支持的邮件组件
Sub Check(sFrom,sFromName,sTo,sSubject,sBody)
Dim i,objTest,sReturn
Response.Write("
" & vbcrlf)
Response.Write(" " & vbcrlf)
Response.Write(" Name" & vbcrlf & " Enable" & vbcrlf & " IsSent" & vbcrlf)
Response.Write(" " & vbcrlf)
For i = 0 To SWEmail_intMailobjects
On Error Resume Next
Set objTest = CreateObject(CStr(SWEmail_aryMailObject(i,0)))
Response.Write(" " & vbcrlf)
Response.Write(" " & SWEmail_aryMailObject(i,0) & "" & vbcrlf)
If err.Number 0 Then '查看错误原因
On Error Goto 0
Response.Write( " No" & vbcrlf)
Response.Write( " No" & vbcrlf)
Else
SWEmail_strMailObject = SWEmail_aryMailObject(i,0)
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Response.Write( " Yes" & vbcrlf)
sReturn = Send(sFrom,sFromName,sTo,sSubject,sBody)
If (sReturn = True) Then
Response.Write(" Success" & vbcrlf)
Else
If sReturn = False Then
Response.Write(" Failed" & vbcrlf)
Else
Response.Write(" " & sReturn & "" & vbcrlf)
End If
End If
End If
Response.Write(" " & vbcrlf)
Next
Response.Write("
" & vbcrlf)
End Sub
'自动检测服务器支持的组件并设置,如果成功返回True,否则返回False
Function AutoSet()
Dim i,objTest
'没检测到发送邮件的组件
AutoSet = False
SWEmail_strMailObject = ""
SWEmail_intMailType = ""
For i = 0 To SWEmail_intMailobjects
On Error Resume Next
Set objTest = CreateObject(SWEmail_aryMailObject(i,0))
If err.Number = 0 Then
'只要检测到就退出,不继续检测!
AutoSet = True
SWEmail_strMailObject = SWEmail_aryMailObject(i,0)
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Exit Function
End If
Next
Set objTest = Nothing
End Function
'邮件等级设置
Sub Speed(str)
'0:最慢,1:默认,2,最快
If Trim(str) = "" Then str = 1
Select Case SWEmail_intMailType
Case SWEmail_JMail43
If str = 0 Then
SWEmail_intSpeed = 5
ElseIf str = 1 Then
SWEmail_intSpeed = 3
Else
SWEmail_intSpeed = 1
End If
Case SWEmail_JMail
If str = 0 Then
SWEmail_intSpeed = 5
ElseIf str = 1 Then
SWEmail_intSpeed = 3
Else
SWEmail_intSpeed = 1
End If
Case SWEmail_CDO
SWEmail_intSpeed = str
End Select
End Sub
'是否支持HTML邮件
Sub IsHTML(bln)
SWEmail_blnIsHTML = bln
End Sub
'SMTP服务器地址
Sub Server(str)
SWEmail_strSMTPServer = str
End Sub
'发信
Function Send(from,fromname,go,subject,body)
Dim sReturn
'发信人的Email地址
SWEmail_strFrom = from
'发信人的名字
SWEmail_strFromName = fromname
'收信人Email地址
SWEmail_strTo = go
'邮件主题
SWEmail_strSubject = subject
'邮件内容
SWEmail_strBody = body
sReturn = Execute()
If sReturn = True Then
Send = True
Else
Send = sReturn
End If
End Function
'密送
Sub BCC(str)
SWEmail_strBCC = str
End Sub
'抄送
Sub CC(str)
SWEmail_strCC = str
End Sub
'添加附件
Sub AddFile(str)
SWEmail_strFiles = SWEmail_strFiles & str & "$"
End Sub
'SMTP验证
Sub SMTPCheck(username,password)
SWEmail_strUsername = username
SWEmail_strPassword = password
End Sub
'设置邮件组件对象
Sub SetObject(str)
Dim i
For i = 0 To SWEmail_intMailObjects
If SWEmail_aryMailObject(i,0) = str Then
SWEmail_strMailObject = str
SWEmail_intMailType = SWEmail_aryMailObject(i,1)
Exit For
End If
Next
End Sub
'发送邮件主体
Function Execute()
Dim i,sFilePath,sFileName,strTemp,aryTemp1,aryTemp2,iContentID
Dim objMail
If Trim(SWEmail_strMailObject) = "" Then
Execute = "It's can't create a null string object."
Exit Function
End If
On Error Resume Next
Set objMail = CreateObject(SWEmail_strMailObject)
If Err.Number 0 Then
Execute = "Can't create object " & SWEmail_strMailObject & "."
Exit Function
End If
Select Case SWEmail_intMailType
Case SWEmail_JMail43 'Jmail4.3 发信主体
'屏蔽例外错误
objMail.Silent = True
'启用邮件日志
objMail.logging = True
objMail.Charset = "GB2312"
objMail.ContentType = "text/HTML"
objMail.AddRecipient SWEmail_strTo
objMail.AddRecipientBCC SWEmail_strBCC
objMail.AddRecipientCC SWEmail_strCC
objMail.From = SWEmail_strFrom
objMail.MailServerUserName = SWEmail_strUserName
objMail.MailServerPassword = SWEmail_strPassword
objMail.Subject = SWEmail_strSubject
objMail.Body = SWEmail_strBody
objMail.Priority = SWEmail_intSpeed
If Trim(SWEmail_strFiles) "" Then
SWEmail_strFiles = Mid(SWEmail_strFiles,1,Len(SWEmail_strFiles)-1)
If Instr(SWEmail_strFiles,"$") 0 Then
aryTemp1 = Split(SWEmail_strFiles,"$")
For i = 0 To UBound(aryTemp1)
strTemp = Trim(aryTemp(i))
If strTemp = "" Then Exit For
If Instr(strTemp,",") 0 Then
aryTemp2 = Split(strTemp,",")
sFilePath = aryTemp2(0)
sFileName = aryTemp2(1)
iContentId = objMail.AddAttachment (sFilePath & "\" & sFileName, True)
' objMail.AttachFile sFilePath,sFileName
End If
Next
Else
sFilePath = SWEmail_strFiles
sFileName = ""
End If
End If
objMail.Send(SWEmail_strSMTPServer)
objMail.Close()
Case SWEmail_JMail
'Jmail早期版本发信主体
objMail.Silent = True
objMail.logging = True
objMail.Charset = "GB2312"
objMail.ContentType = "text/HTML"
objMail.ServerAddress = SWEmail_strSMTPServer
objMail.AddRecipient SWEmail_strTo
objMail.AddRecipientBCC SWEmail_strBCC
objMail.AddRecipientCC SWEmail_strCC
objMail.SenderName = SWEmail_strFromName
objMail.Sender = SWEmail_strFrom
objMail.Priority = SWEmail_intSpeed
objMail.Subject = SWEmail_strSubject
objMail.Body = SWEmail_strBody
If Trim(SWEmail_strFiles) "" Then
SWEmail_strFiles = Mid(SWEmail_strFiles,1,Len(SWEmail_strFiles)-1)
If Instr(SWEmail_strFiles,"$") 0 Then
aryTemp1 = Split(SWEmail_strFiles,"$")
For i = 0 To UBound(aryTemp1)
strTemp = Trim(aryTemp(i))
If strTemp = "" Then Exit For
If Instr(strTemp,",") 0 Then
aryTemp2 = Split(strTemp,",")
sFilePath = aryTemp2(0)
sFileName = aryTemp2(1)
objMail.AddAttachment sFilePath & "\" & sFileName '添加文件附件
' objMail.AttachFile sFilePath,sFileName
End If
Next
Else
sFilePath = SWEmail_strFiles
sFileName = ""
End If
End If
objMail.Execute()
objMail.Close
Case SWEmail_ASPMail
'ASPMail组件
objMail.Host = SWEmail_strServer
objMail.Subject = SWEmail_strSubject
objMail.From = SWEmail_strFrom
objMail.Body = SWEmail_strBody
objMail.AddAddress SWEmail_strTo
objMail.IsHTML = SWEmail_blnIsHTML
objMail.CharSet = "gb2312"
If Trim(SWEmail_strFiles) "" Then
SWEmail_strFiles = Mid(SWEmail_strFiles,1,Len(SWEmail_strFiles)-1)
If Instr(SWEmail_strFiles,"$") 0 Then
aryTemp1 = Split(SWEmail_strFiles,"$")
For i = 0 To UBound(aryTemp1)
strTemp = Trim(aryTemp(i))
If strTemp = "" Then Exit For
If Instr(strTemp,",") 0 Then
aryTemp2 = Split(strTemp,",")
sFilePath = aryTemp2(0)
sFileName = aryTemp2(1)
objMail.AddAttachment sFilePath & "\" & sFileName
End If
Next
Else
sFilePath = SWEmail_strFiles
sFileName = ""
End If
End If
Case SWEmail_CDO
'微软自带发信主体
objMail.Subject = SWEmail_strSubject
objMail.From = SWEmail_strFrom
objMail.To = SWEmail_strTo
If SWEmail_blnIsHTML Then
objMail.BodyFormat = 0 '支持HTML
Else
objMail.BodyFormat = 1 '支持纯文本
End If
'0 表示将采用 MIME 格式
'1 表示将采用连续的纯文本(默认值)
'objMail.MailFormat = 0
objMail.Body = SWEmail_strBody
If Trim(SWEmail_strFiles) "" Then
SWEmail_strFiles = Mid(SWEmail_strFiles,1,Len(SWEmail_strFiles)-1)
If Instr(SWEmail_strFiles,"$") 0 Then
aryTemp1 = Split(SWEmail_strFiles,"$")
For i = 0 To UBound(aryTemp1)
strTemp = Trim(aryTemp(i))
If strTemp = "" Then Exit For
If Instr(strTemp,",") 0 Then
aryTemp2 = Split(strTemp,",")
sFilePath = aryTemp2(0)
sFileName = aryTemp2(1)
objMail.AttachFile sFilePath,sFileName
End If
Next
Else
sFilePath = SWEmail_strFiles
sFileName = ""
End If
End If
objMail.Send
End Select
If Err.Number 0 Then
If Trim(err.Description) "" Then Execute = Err.Description & "
"
Else
Execute = True
End If
Set objMail = Nothing
End Function
'清空内容
Sub Close()
SWEmail_strMailObject = ""
SWEmail_intMailType = ""
strMailName = ""
SWEmail_strFiles = ""
SWEmail_intSpeed = ""
'释放数组
Erase SWEmail_aryMailObject
End Sub
End Class
%>
SendMail.ASP的代码:
剩下还有点东西,将于11月15日之后补上来。

