检查组件是否已经安装,用Jmail组件发送邮件

 '***************************************************
'函数名:IsObjInstalled
'作  用:检查组件是否已经安装
'参  数:strClassString ----组件名
'返回值:True  ----已经安装
'       False ----没有安装
'***************************************************
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

'**************************************************
'函数名:SendMail
'作  用:用Jmail组件发送邮件
'参  数:MailtoAddress  ----收信人地址
'        MailtoName    -----收信人姓名
'        Subject       -----主题
'        MailBody      -----信件内容
'        FromName      -----发信人姓名
'        MailFrom      -----发信人地址
'        Priority      -----信件优先级
'**************************************************
function SendMail(Email,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
 on error resume next
 Dim JMail
 Set JMail=Server.CreateObject("JMAIL.Message")
 if err then
  SendMail= "<br><li>没有安装JMail组件</li>"
  err.clear
  exit function
 end if 
 JMail.Charset="gb2312"          '邮件编码
 JMail.silent=true
 JmailMsg.Logging = true
 JMail.ContentType = "text/html"     '邮件正文格式
 JMail.ServerAddress=MailServer     '用来发送邮件的SMTP服务器
    '如果服务器需要SMTP身份验证则还需指定以下参数
 JMail.MailServerUserName = MailServerUserName    '登录用户名
    JMail.MailServerPassWord = MailServerPassword        '登录密码
    JMail.MailDomain = MailDomain       '域名(如果用“name@domain.com”这样的用户名登录时,请指明domain.com
 JMail.AddRecipient Email,MailtoName     '收信人
 JMail.Subject = Subject         '主题
 JMail.HMTLBody = MailBody       '邮件正文(HTML格式)
 JMail.Body = MailBody          '邮件正文(纯文本格式)
 JMail.FromName = FromName         '发信人姓名
 JMail.From = MailFrom         '发信人Email
 JMail.Priority=Priority              '邮件等级,1为加急,3为普通,5为低级
 JMail.Send MailServer
 SendMail =JMail.ErrorMessage
 JMail.Close
 Set JMail=nothing
end function
 
 '********************************************
'函数名:IsValidEmail
'作  用:检查Email地址合法性
'参  数:email ----要检查的Email地址
'返回值:True  ----Email地址合法
'       False ----Email地址不合法
'********************************************
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

posted @ 2008-09-26 18:48  Lee Vane  阅读(622)  评论(0)    收藏  举报