ASP发送邮件的Class-ASP技术-3P代码网
繁体中文
设为首页
加入收藏
当前位置:ASP技术首页 >> ASP基础 >> ASP发送邮件的Class

ASP发送邮件的Class

2006-02-15 08:00:00  作者:  来源:互联网  浏览次数:0  文字大小:【】【】【
简介:  ASP实现邮件的发送需要组件来支持,可以使用微软自带的CDO或者用第三方组件(如JMail、ASPMail)来发送邮件。微软自带的发邮件组件可以在添加WINDOWS组件中找到,关于第三方组件的获得方法自己去网上搜索,我...
关键字:邮件 Class ASP

  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日之后补上来。

责任编辑:admin
相关文章