?? class_email.asp
字號:
<%
'----------------------------------------------------------
'Oblog4.0 郵件發(fā)送模塊
'不支持附件發(fā)送/支持部分HTML格式/支持郵箱認證/不支持批量操作
'用于注冊認證/郵箱認證/找回密碼
'為了防止效率影響，系統(tǒng)默認為1分鐘發(fā)送一次
'其中管理員信箱由系統(tǒng)配置Application中獲取
'----------------------------------------------------------
Class Oblog_Email
Private oMail,Email_ContentType,Email_CharSet
Private Email_AdminMail,Email_AdminName,Email_SMTP,Email_LoginName,Email_LgoinPwd
Private Sub Class_Initialize()
Email_ContentType = "text/html"
Email_CharSet = "gb2312"
Email_AdminMail=Application(C_Cache_Name & "_Compont")(5)
Email_AdminName=Application(C_Cache_Name & "_Compont")(6)
Email_SMTP=Application(C_Cache_Name & "_Compont")(7)
Email_LoginName=Application(C_Cache_Name & "_Compont")(8)
Email_LgoinPwd=Application(C_Cache_Name & "_Compont")(9)
Email_validateSMTP=Application(C_Cache_Name & "_Compont")(10)
'記錄Application Last
End Sub
Private Sub Class_Terminate()
On Error Resume Next
If Isobject(oMail) Then
Set oMail = Nothing
End If
End Sub
Public Function SendMail(emailTo,emailCC,emailTopic,emailBody,iRet)
Dim sRet
On Error Resume Next
select Case Application(C_Cache_Name & "_Compont")(4)
Case "1"
'---------------------------------------
'CDONTS
'---------------------------------------
Set oMail = Server.CreateObject("CDONTS.NewMail")
If Err<>0 Then
sRet = "創(chuàng)建組件：CDONTS.NewMail 失敗，您的服務器不支持該組件"
Exit Function
End If
oMail.From = Email_AdminEmail
oMail.To = emailTo
oMail.Subject = emailTopic
oMail.BodyFormat = 0
oMail.MailFormat = 0
oMail.Body = emailBody
If Err<>0 Then
sRet = sRet & "發(fā)送失敗!原因：" & Err.Description
Else
oMail.Send
If Err<>0 Then
sRet = sRet & "發(fā)送失敗!原因：" & Err.Description
Else
sRet = sRet & "發(fā)送成功!"
End If
End If
Case "2"
'---------------------------------------
'JMail4.x
'---------------------------------------
Set oMail = Server.CreateObject("JMail.Message")
If Err<>0 Then
sRet = "創(chuàng)建組件：JMail.Message 失敗，您的服務器不支持JMail組件"
Exit Function
End If
oMail.Silent = True
oMail.Logging = True
oMail.Charset = Email_CharSet
If Not(LoginName = "" Or LoginPass = "") Then
oMail.MailServerUserName = Email_LoginName '您的郵件服務器登錄名
oMail.MailServerPassword = Email_LoginPwd '登錄密碼
End If
oMail.ContentType = Email_ContentType
oMail.Priority = 1
oMail.From = Email_AdminEmail
oMail.Email_AdminName = Email_AdminName
oMail.AddRecipient emailTo
oMail.Subject = emailTopic
oMail.Body = emailBody
If Err<>0 Then
sRet = sRet & "發(fā)送失敗!原因：" & Err.Description
Else
oMail.Send Admin_SMTP
oMail.ClearRecipients()
If Err<>0 Then
sRet = sRet & "發(fā)送失敗!原因：" & Err.Description
Else
sRet = sRet & "發(fā)送成功!"
End If
End If
Case "3"
'---------------------------------------
'AspEmail
'---------------------------------------
Set Obj = Server.CreateObject("Persits.MailSender")
If Err<>0 Then
sRet = "創(chuàng)建組件：Persits.MailSender 失敗，您的服務器不支持ASPMail組件"
Exit Function
End If
oMail.Charset = Email_CharSet
oMail.IsHTML = True
oMail.username = Admin_LoginName '服務器上有效的用戶名
oMail.password = Admin_LoginPwd '服務器上有效的密碼
oMail.Priority = 1
oMail.Host = Admin_SMTP
'oMail.Port = 25 ' 該項可選.端口25是默認值
oMail.From = Email_AdminEmail
oMail.Email_AdminName = Email_AdminName ' 該項可選
oMail.AddAddress emailTo,emailTo
oMail.Subject = emailTopic
oMail.Body = emailBody
If Err<>0 Then
sRet = sRet & "發(fā)送失敗!原因：" & Err.Description
Else
oMail.Send
If Err<>0 Then
sRet = sRet & "發(fā)送失敗!原因：" & Err.Description
Else
sRet = sRet & "發(fā)送成功!"
End If
End If
Case Else
sRet="系統(tǒng)未指定任何郵件發(fā)送組件"
End select
SendMail=sRet
End Function
'發(fā)送給初次注冊用戶
Public Function SendValidAccountMail(sUserName,sEmail)
Dim sObCode,sUserName,sUserId,sUrl,iRet,Sql
sObCode=GetGUID
rs.Open "select userid From oblog_user Where email='" & sEmail & "'",conn,1,3
If rs.RecordCount>1 Then
ErrMsg="您的郵件地址[" & sEmail & "]在系統(tǒng)中存在多個，不能進行驗證!"
Set rs=Nothing
Exit Function
End If
sUserId=rs(0)
rs.Close
Set rs=Nothing
Sql="Insert Into oblog_obcodes(obcode,createuser,createtime,createip,itype,istate) Values('"
Sql= Sql & sObcode & "'," & sUserId &",'" & Now & "','" & oblog.UserIp & "',1,0)"
oblog.Execute Sql
sContent=sUserName & " , 您好<br/><br/>"
sContent=sContent & "感謝您注冊為" & blogurl & "的會員，請訪問該地址完成您的帳號驗證<br/>"
sUrl=blogurl & "check.asp?user=" & sUserName & "&sn=" & sObCode
sContent=sContent & "<a href=" & sUrl & " target=_blank>" & sUrl & "</a><br>"
sContent=sContent & "如果您的郵件因為安全限制不能直接訪問呢上述地址，請將下面地址拷貝到地址欄中訪問：<br/>"
sContent=sContent & sUrl
sContent=sContent & "<p> </p>"
sContent=sContent & Email_AdminName
sContent=sContent & "<p> </p>"
sContent=sContent & Now
SendValidAccountMail=SendMail(sEmail,sUserName & " 您好，請驗證您的帳號",sContent,iRet)
End Function
'后期補郵件驗證[對于重復的郵件地址不進行驗證]
Public Function SendValidUserMail(sEmail)
Dim rs,sContent,sUserName,sUserId,sObCode,sUrl,iRet,Sql
rs.Open "select userid,username,isMailValid From oblog_user Where email='" & sEmail & "'",conn,1,3
If rs.RecordCount>1 Then
ErrMsg="您的郵件地址[" & sEmail & "]在系統(tǒng)中存在多個，不能進行驗證!"
Set rs=Nothing
Exit Function
End If
sUserId=rs(0)
sUserName=rs(1)
rs(2)=1
rs.Update
Set rs=Nothing
sObCode=GetGuid
oblog.Execute
Sql="Insert Into oblog_obcodes(obcode,createuser,createtime,createip,itype,istate) Values('"
Sql= Sql & sObcode & "',"& sUserId &",'" & Now & "','" & oblog.UserIp & "',2,0)"
oblog.Execute Sql
sContent=sUserName & " , 您好<br/><br/>"
sContent=sContent & "為了能更好的為廣大網(wǎng)友提供優(yōu)質服務，我們需要對您的郵件地址進行驗證。<br/>"
sContent=sContent & "請訪問該地址完成您的郵件驗證"
sUrl=blogurl & "check.asp?user=" & sUserName & "&sn=" & sObCode
sContent=sContent & "<a href=" & sUrl & " target=_blank>" & sUrl & "</a><br>"
sContent=sContent & "如果您的郵件因為安全限制不能直接訪問呢上述地址，請將下面地址拷貝到地址欄中訪問：<br/>"
sContent=sContent & sUrl
sContent=sContent & "<p> </p>"
sContent=sContent & Email_AdminName
sContent=sContent & "<p> </p>"
sContent=sContent & Now
SendValidUserMail=SendMail(sEmail,sUserName & " 您好，郵件有效性驗證",sContent,iRet)
End Function
'用戶丟失密碼后的找回[首先該郵件需要已被驗證]
Public Function SendGetPwdMail(sEmail)
Dim rs,sContent,sUserName,sUserId,sObCode,sUrl,iRet,Sql
rs.Open "select userid,username,isMailValid From oblog_user Where email='" & sEmail & "'",conn,1,3
If rs.RecordCount>1 Then
ErrMsg="您的郵件地址[" & sEmail & "]在系統(tǒng)中存在多個，不能進行密碼找回的后續(xù)操作!"
Set rs=Nothing
Exit Function
End If
sUserId=rs(0)
sUserName=rs(1)
rs(2)=1
rs.Update
Set rs=Nothing
sObCode=GetGuid
oblog.Execute
Sql="Insert Into oblog_obcodes(obcode,createuser,createtime,createip,itype,istate) Values('"
Sql= Sql & sObcode & "',"& sUserId &",'" & Now & "','" & oblog.UserIp & "',3,0)"
oblog.Execute Sql
sContent=sUserName & " , 您好<br/><br/>"
sContent=sContent & "您使用了" & blogurl & "的密碼找回功能<br/>"
sContent=sContent & "請訪問該地址依照提示重新設置您的密碼<br/>"
sUrl=blogurl & "check.asp?user=" & sUserName & "&sn=" & sObCode
sContent=sContent & "<a href=" & sUrl & " target=_blank>" & sUrl & "</a><br>"
sContent=sContent & "如果您的郵件因為安全限制不能直接訪問呢上述地址，請將下面地址拷貝到地址欄中訪問：<br/>"
sContent=sContent & sUrl
sContent=sContent & "<p> </p>"
sContent=sContent & Email_AdminName
sContent=sContent & "<p> </p>"
sContent=sContent & Now
SendGetPwdMail=SendMail(sEmail,sUserName & " 您好，密碼找回",sContent,iRet)
End Function
End Class
%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -