最近在弄一个客户的网站,需要使用Asp+JMail发送邮件,在确定空间是支持Jmail组件之后,终于决定要把两年前的老伙计搬出来了,下面是全部的函数代码:
'判断服务器是否支持Jmail发信组建
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'创建Jmail发信函数
function SendMail(EMail,Subject,MailBody,Priority)
On error resume next
Set JMail=Server.CreateObject("JMail.Message") '建立发送邮件的对象
if err then
SendMail= "<br><li>没有安装JMail组件</li>"
err.clear
exit function
end if
JMail.silent=true '屏蔽例外错误,返回FALSE跟TRUE两值
JMail.logging = true '启用邮件日志
jmail.Charset = "GB2312" '邮件的文字编码为国标
JMail.ContentType = "text/html" '邮件的格式为HTML格式
JMail.AddRecipient Email '邮件收件人的地址
JMail.From = "china@feisky.com" '发件人的E-MAIL地址
JMail.MailServerUserName = "china@feisky.com"'登录邮件服务器所需的用户名
JMail.MailServerPassWord = "456123"'登录邮件服务器所需的密码
JMail.Subject=Subject'邮件的标题
JMail.Body=MailBody'邮件的内容
JMail.Priority=Priority '邮件的紧急程序,1 为最快,5 为最慢, 3 为默认值
JMail.Send("smtp.feisky.com")'执行邮件发送(通过邮件服务器地址)
JMail.Close
Set JMail=nothing
end function
Function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
End function
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'创建Jmail发信函数
function SendMail(EMail,Subject,MailBody,Priority)
On error resume next
Set JMail=Server.CreateObject("JMail.Message") '建立发送邮件的对象
if err then
SendMail= "<br><li>没有安装JMail组件</li>"
err.clear
exit function
end if
JMail.silent=true '屏蔽例外错误,返回FALSE跟TRUE两值
JMail.logging = true '启用邮件日志
jmail.Charset = "GB2312" '邮件的文字编码为国标
JMail.ContentType = "text/html" '邮件的格式为HTML格式
JMail.AddRecipient Email '邮件收件人的地址
JMail.From = "china@feisky.com" '发件人的E-MAIL地址
JMail.MailServerUserName = "china@feisky.com"'登录邮件服务器所需的用户名
JMail.MailServerPassWord = "456123"'登录邮件服务器所需的密码
JMail.Subject=Subject'邮件的标题
JMail.Body=MailBody'邮件的内容
JMail.Priority=Priority '邮件的紧急程序,1 为最快,5 为最慢, 3 为默认值
JMail.Send("smtp.feisky.com")'执行邮件发送(通过邮件服务器地址)
JMail.Close
Set JMail=nothing
end function
Function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
End function
代码其实很简单,以前也是网络上收藏的,只是比较经典吧而且是有效可以使用的,现在Baidu方便是方便,就是急用的时候经常会搜索不出你真正想要的东西,诶,网络垃圾泛滥了。有一点需要注意的是,中国频道的空间,那些都是一样的,就是发送帐号需要写全,不然不能正确发送的。