'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************
Dim MailType
Select Case MailObject
Case 0
FoundErr = True
ErrMsg = ErrMsg & "对不起，服务器没有选定任何邮件发送组件！所以不能使用本功能。"
Case 1
If Not IsObjInstalled("JMail.Message") Then
FoundErr = True
ErrMsg = ErrMsg & "JMail邮件发送组件没有安装！所以不能使用本功能。"
End If
Case 2
If Not IsObjInstalled("CDONTS.NewMail") Then
FoundErr = True
ErrMsg = ErrMsg & "CDONTS邮件发送组件没有安装！所以不能使用本功能。"
End If
Case 3
If Not IsObjInstalled("Persits.MailSender") Then
FoundErr = True
ErrMsg = ErrMsg & "ASPEMAIL邮件发送组件没有安装！所以不能使用本功能。"
End If
Case 4
If Not IsObjInstalled("easymail.mailsend") Then
FoundErr = True
ErrMsg = ErrMsg & "WebEasyMail邮件发送组件没有安装！所以不能使用本功能。"
End If
Case Else
FoundErr = True
ErrMsg = ErrMsg & "对不起，服务器邮件发送组件不对！所以不能使用本功能。"
End Select
ArticleID = PE_CLng(Request("ArticleID"))
If ArticleID = 0 Then
FoundErr = True
ErrMsg = ErrMsg & "请指定要发送给好友的文章ID！"
End If
If UserLogined = False Then
FoundErr = True
ErrMsg = ErrMsg & " 你还没注册？或者没有登录？只有本站的注册用户才能使用“告诉好友”功能！ 如果你还没注册，请赶紧点此注册吧！ 如果你已经注册但还没登录，请赶紧点此登录吧！"
End If
If FoundErr True Then
If Action = "MailToFriend" Then
Call MailToFriend
Else
Call SendMailMain
End If
Else
Call WriteErrMsg(ErrMsg, ComeUrl)
End If
Set PE_Content = Nothing
Call CloseConn
Sub SendMailMain()
Dim rs, sql, Title, Author, UpdateTime
sql = "Select Title,UpdateTime,Author from PE_Article where ArticleID=" & ArticleID & ""
Set rs = Server.CreateObject("adodb.recordset")
rs.Open sql, Conn, 1, 1
If rs.BOF And rs.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "找不到文章"
FoundErr = True
Else
Title = rs("Title")
Author = rs("Author")
UpdateTime = rs("UpdateTime")
End If
rs.Close
Set rs = Nothing
strHtml = GetTemplate(ChannelID, 20, 0)
Call ReplaceCommonLabel
strHtml = PE_Replace(strHtml, "{$Skin_CSS}", GetSkin_CSS(0))
strHtml = PE_Replace(strHtml, "{$Title}", Title)
strHtml = PE_Replace(strHtml, "{$ComeUrl}", ComeUrl)
strHtml = PE_Replace(strHtml, "{$ArticleID}", ArticleID)
strHtml = PE_Replace(strHtml, "{$Author}", Author)
strHtml = PE_Replace(strHtml, "{$UpdateTime}", UpdateTime)
strHtml = Replace(strHtml, "value= ", "value='' ")
strHtml = Replace(strHtml, "Value= ", "value='' ")
Response.Write strHtml
End Sub
Sub MailToFriend()
Dim MailtoName, MailtoAddress, Subject, MailBody
MailtoName = Trim(Request.Form("MailToName"))
MailtoAddress = Trim(Request.Form("MailToAddress"))
If MailtoName = "" Then
ErrMsg = ErrMsg & "收信人姓名为空！"
FoundErr = True
End If
If IsValidEmail(MailtoAddress) = False Then
ErrMsg = ErrMsg & "收信人的Email地址有错误！"
FoundErr = True
End If
If FoundErr Then Exit Sub
Dim rs, sql, strContent
sql = "Select A.ChannelID,A.Title,A.Content,A.UpdateTime,A.Author,A.InfoPoint,C.ClassPurview from PE_Article A left join PE_Class C on A.ClassID=C.ClassID where A.ArticleID=" & ArticleID & ""
Set rs = Server.CreateObject("adodb.recordset")
rs.Open sql, Conn, 1, 1
If rs.BOF And rs.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "找不到文章"
Else
Subject = Replace(Replace("您的朋友{$UserName}从{$SiteName}给您发来的文章资料料", "{$UserName}", UserName), "{$SiteName}", SiteName)
If rs("ClassPurview") > 0 Or rs("InfoPoint") > 0 Then
strContent = "点击查看此页面的内容"
Else
strContent = Replace(Replace(rs("Content") & "", "[InstallDir_ChannelDir]", Trim(Request.ServerVariables("HTTP_HOST")) & ChannelUrl & "/"), "{$UploadDir}", UploadDir)
End If
MailBody = Replace(Replace(Replace(Replace(Replace(Replace("A:visited { TEXT-DECORATION: none }A:active { TEXT-DECORATION: none }A:hover { TEXT-DECORATION: underline overline }A:link { text-decoration: none;}A:visited { text-decoration: none;}A:active { TEXT-DECORATION: none;}A:hover { TEXT-DECORATION: underline overline}BODY { FONT-FAMILY: 宋体; FONT-SIZE: 9pt;}TD { FONT-FAMILY: 宋体; FONT-SIZE: 9pt }-- 作者：{$Author}-- 发布时间：{$Time}-- {$title}-- {$Content}{$SiteName}", "{$Author}", rs("Author")), "{$Time}", rs("UpdateTime")), "{$title}", rs("title")), "{$Content}", strContent), "{$SiteUrl}", SiteUrl), "{$SiteName}", SiteName)
End If
rs.Close
Set rs = Nothing
Dim PE_Mail
Set PE_Mail = New SendMail
If ErrMsg "" Then
FoundErr = True
Set PE_Mail = Nothing
Exit Sub
End If
ErrMsg = PE_Mail.Send(MailtoAddress, MailtoName, Subject, MailBody, UserName, Email, 3)
Set PE_Mail = Nothing
If ErrMsg = "" Then
Call WriteSuccessMsg("已经成功将此文章发送给你的好友！", ComeUrl)
Else
FoundErr = True
End If
End Sub
%>
