推荐订阅源

 '***************************************************
'函数名：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