上一篇 |

作品展示

评论留言增加邮箱网址及博主回复通知评论留言人 For Pj3 157（11/2日修改网址判断）

作者:小戒日期:2008-11-02

字体大小: 小中大

温馨提示：请用Dreamweaver或EditPlus编辑修改，修改前请做好备份。
注意：此功能基于留言评论邮件通知博主(增加后台开关)For pj3(http://www.leoyung.com/article/7964.htm)，否则发送不了邮件。
打开class/cls_article.asp，找到：

复制内容到剪贴板

程序代码

<%if memName=empty or blog_validate=true then%><tr><td align="right" width="70">验证码:</td><td align="left" style="padding:3px;"><input name="validate" type="text" size="4" class="userpass" maxlength="4" onfocus="this.select()"/> <%=getcode()%></td></tr><%end if%>

在上面插入：

复制内容到剪贴板

程序代码

<%if memName=empty then%><tr><td align="right" width="70">邮　箱:</td><td align="left" style="padding:3px;"><input name="myblogemail" type="text" size="18" class="userpass" maxlength="24"/> 请填写您的邮箱.</td></tr><%end if%>
<%if memName=empty then%><tr><td align="right" width="70">网　址:</td><td align="left" style="padding:3px;"><input name="myblogsiteurl" type="text" class="userpass" value="http://" size="18" maxlength="24"/> 请填写您的网址.</td></tr><%end if%>

找到：

复制内容到剪贴板

程序代码

ShowComm = ShowComm&"<a href=""member.asp?action=view&memName="&Server.URLEncode(blog_CommAuthor)&""">"&blog_CommAuthor&"</a>"

在下面插入：

复制内容到剪贴板

程序代码

if trim(commArr(10,Pcount))<>"" then
 ShowComm = ShowComm&" <a href=mailto:"&trim(commArr(10,Pcount))&" target=_blank><img src=images/email1.gif border=0></a>"
 else
 ShowComm = ShowComm&" <img src=images/noemail1.gif>"
 end if

 if trim(commArr(11,Pcount))<>"" and trim(commArr(11,Pcount))<>"http://" then
 ShowComm = ShowComm&" <a href="&trim(commArr(11,Pcount))&" target=_blank><img src=images/url1.gif border=0></a>"
 else
 ShowComm = ShowComm&" <img src=images/nourl1.gif>"
 end if

找到：

复制内容到剪贴板

程序代码

SQL = "Select comm_ID,comm_Content,comm_Author,comm_PostTime,comm_DisSM,comm_DisUBB,comm_DisIMG,comm_AutoURL,comm_PostIP,comm_AutoKEY FROM blog_Comment Where blog_ID="&LogID&" orDER BY comm_PostTime "&comDesc

替换为：

复制内容到剪贴板

程序代码

SQL = "Select comm_ID,comm_Content,comm_Author,comm_PostTime,comm_DisSM,comm_DisUBB,comm_DisIMG,comm_AutoURL,comm_PostIP,comm_AutoKEY,email,siteurl FROM blog_Comment Where blog_ID="&LogID&" orDER BY comm_PostTime "&comDesc

打开Template/static.htm，找到：

复制内容到剪贴板

程序代码

<tr id="passArea">
 <td align="right" width="70">密　码:</td>
 <td align="left" style="padding:3px;"><input name="password" type="password" size="18" class="userpass" maxlength="24"/> 游客发言不需要密码.</td>
 </tr>

在下面插入：

复制内容到剪贴板

程序代码

<tr>
 <td align="right" width="70">邮　箱:</td>
 <td align="left" style="padding:3px;"><input name="myblogemail" type="text" size="18" class="userpass" maxlength="24"/> 博主回复后，系统将发送通知邮件到您的邮箱，可不填.</td>
 </tr>
 <tr>
 <td align="right" width="70">网　址:</td>
 <td align="left" style="padding:3px;"><input name="myblogsiteurl" type="text" size="18" value="http://" class="userpass" maxlength="24"/></td>
 </tr>

打开blogcomm.asp，找到：

复制内容到剪贴板

程序代码

password = Trim(CheckStr(request.Form("password")))

在下面插入：

复制内容到剪贴板

程序代码

    dim email,tsiteurl
    email=trim(CheckStr(request.form("myblogemail")))
    tsiteurl=trim(CheckStr(request.form("myblogsiteurl")))

找到：

复制内容到剪贴板

程序代码

If (memName=empty or blog_validate=true) and (cstr(lcase(Session("GetCode")))<>cstr(lcase(validate)) or IsEmpty(Session("GetCode"))) Then

在上面插入：

复制内容到剪贴板

程序代码

if memName=empty and email<>"" and IsValidEmail(email)=false then
 ReInfo(0)="评论发表错误信息"
 ReInfo(1)="邮箱格式错误 <a href=""javascript:history.go(-1);"">请返回重新输入</a>"
 ReInfo(2)="ErrorIcon"
 postcomm=ReInfo
 exit function
 end if

 if memName=empty and tsiteurl<>"" and tsiteurl<>"http://" and IsRightUrl(tsiteurl)=false then
 ReInfo(0)="评论发表错误信息"
 ReInfo(1)="网址格式错误 <a href=""javascript:history.go(-1);"">请返回重新输入</a>"
 ReInfo(2)="ErrorIcon"
 postcomm=ReInfo
 exit function
 end if

找到：

复制内容到剪贴板

程序代码

AddComm = Array(Array("blog_ID", post_logID), Array("comm_Content", post_Message), Array("comm_Author", username), Array("comm_DisSM", post_DisSM), Array("comm_DisUBB", post_DisUBB), Array("comm_DisIMG", post_disImg), Array("comm_AutoURL", post_DisURL), Array("comm_PostIP", getIP), Array("comm_AutoKEY", post_DisKEY)))

替换为：

复制内容到剪贴板

程序代码

找到：

复制内容到剪贴板

程序代码

Conn.Execute("update blog_Content set log_CommNums=log_CommNums+1 where log_ID="&post_logID)

将上面‘评论留言通知’之间的代码，全部替换：

复制内容到剪贴板

程序代码

    '评论邮件通知
    Dim email_commid, SQLcomm, log_commcomm
    SQLcomm="Select TOP 1 * FROM blog_Comment Where comm_Author='"&username&"' order By comm_ID Desc "
    Set log_commcomm=conn.execute(SQLcomm)
        email_commid=log_commcomm("comm_ID")
    log_commcomm.Close
    Set log_commcomm=Nothing
    dim email_log_title
    SQLcomm="Select * FROM blog_Content Where log_ID="&post_logID&""
    Set log_commcomm=conn.execute(SQLcomm)
        email_log_title=log_commcomm("log_Title")
    log_commcomm.Close
    Set log_commcomm=Nothing
    If blog_Isjmail Then
        dim emailcontent,emailtitle
        emailtitle = "您发表的文章《"&email_log_title&"》已有客人发表了评论"
        if blog_postFile = 2 then
            emailcontent = "["&username&"]在您的博客中发表了评论,请点击查"&siteURL&"article/"&post_logID&".htm#comm_"&email_commid&"。评论内容如下："&post_Message&""
        else
            emailcontent = "["&username&"]在您的博客中发表了评论,请点击查"&siteURL&"default.asp?id="&post_logID&"#comm_"&email_commid&"。评论内容如下："&post_Message&""
        end if
        call sendmail(blog_email,emailtitle,emailcontent)
'        call sendmail(username,post_logID,email_commid,email_log_title,1,post_Message)
    End If
    '评论邮件通知结束

打开reply.asp，找到：

复制内容到剪贴板

程序代码

set quest = Conn.Execute("select top 1 comm_Content from blog_Comment where comm_ID=" & cID)

替换为：

复制内容到剪贴板

程序代码

set quest = Conn.Execute("select top 1 a.comm_Content,a.comm_Author,b.log_title,b.log_ID,a.email from blog_Comment a inner join blog_Content b on a.blog_ID=b.log_ID where a.comm_ID=" & cID)

找到：

复制内容到剪贴板

程序代码

PostArticle logId, False

在上面插入：

复制内容到剪贴板

程序代码

If blog_Isjmail and trim(quest(4))<>"" Then
 dim emailcontent,emailtitle
 emailtitle = "您在"&siteName&"上发表的评论已被回复"
 dim CommUrl
 if blog_postFile = 2 then
 CommUrl = "请点击查看"&siteurl&"article/"&quest(3)&".htm#comm_"&cID&"。"
 else
 CommUrl = "请点击查看"&siteurl&"default.asp?id="&quest(3)&"#comm_"&cID&"。"
 end if
 emailcontent = "尊敬的｛"&quest(1)&"｝，您好，你在["&siteName&"]上发表的关于["&quest(2)&"]日志的评论，现已被["&memName&"]回复，回复内容为：["&replay&"]，"&CommUrl&"谢谢您的评论，欢迎再次光临！"
 call sendmail(quest(4),emailtitle,emailcontent)
end if

打开Plugins/GuestBook/guestbook.asp，找到：

复制内容到剪贴板

程序代码

在下面插入：

复制内容到剪贴板

程序代码

<%
if trim(GuestDB("email"))<>"" then
 response.write " <a href=mailto:"&trim(GuestDB("email"))&" target=_blank><img src=images/email1.gif border=0></a>"
else
 response.write " <img src=images/noemail1.gif>"
end if
if trim(GuestDB("siteurl"))<>"" and trim(GuestDB("siteurl"))<>"http://" then
 response.write " <a href="&trim(GuestDB("siteurl"))&" target=_blank><img src=images/url1.gif border=0></a>"
else
 response.write " <img src=images/nourl1.gif>"
end if
%>

找到：

复制内容到剪贴板

程序代码

<%if memName=empty then%><tr><td align="right" width="70">密　码:</td><td align="left" style="padding:3px;"><input name="password" type="password" size="18" class="userpass" maxlength="24"/></td></tr><%end if%>

在下面插入：

复制内容到剪贴板

程序代码

打开Plugins/GuestBook/bookaction.asp，找到：

复制内容到剪贴板

程序代码

post_Message=CheckStr(request.form("Message"))

在下面插入：

复制内容到剪贴板

程序代码

dim email,tsiteURL
email=trim(CheckStr(request.form("myblogemail")))
tsiteURL=trim(CheckStr(request.form("myblogsiteurl")))

找到：

复制内容到剪贴板

程序代码

if filterSpam(post_Message,"../../spam.xml") and stat_Admin=false then
 showmsg "留言发表错误信息","留言中包含被屏蔽的字符 <a href=""javascript:history.go(-1);"">返回</a>","WarningIcon","plugins"
 exit function
 end if

在上面插入：

复制内容到剪贴板

程序代码

if memName=empty and email<>"" and IsValidEmail(email)=false then
 showmsg "留言发表错误信息","邮箱格式错误 <a href=""javascript:history.go(-1);"">返回</a>","WarningIcon","plugins"
 exit function
 end if

 if memName=empty and tsiteURL<>"" and tsiteURL<>"http://" and IsRightUrl(tsiteURL)=false then
 showmsg "留言发表错误信息","网址格式错误 <a href=""javascript:history.go(-1);"">返回</a>","WarningIcon","plugins"
 exit function
 end if

找到：

复制内容到剪贴板

程序代码

Conn.ExeCute("Insert INTO blog_book(book_Messager,book_face,book_IP,book_Content,book_HiddenReply) VALUES ('"&username&"','"&face&"','"&getIP()&"','"&post_Message&"',"&hiddenreply&")")

替换为：

复制内容到剪贴板

程序代码

Conn.ExeCute("Insert INTO blog_book(book_Messager,book_face,book_IP,book_Content,book_HiddenReply,email,siteurl) VALUES ('"&username&"','"&face&"','"&getIP()&"','"&post_Message&"',"&hiddenreply&",'"&email&"','"&tsiteURL&"')")

找到：

复制内容到剪贴板

程序代码

Response.Cookies(CookieName)("bookLastPost")=DateToStr(now(),"Y-m-d H:I:S")

将下面‘评论留言通知’之间的代码，全部替换：

复制内容到剪贴板

程序代码

'留言邮件通知
 If blog_Isjmail Then
 Dim SQLcomm, log_commcomm
 SQLcomm="Select TOP 1 * FROM blog_book Where book_ID="&MsgID
 Set log_commcomm=conn.execute(SQLcomm)
 if trim(log_commcomm("email"))<>"" then
 dim emailcontent,emailtitle
 emailtitle = "您在"&siteName&"上发表的留言已被回复"
 emailcontent = "尊敬的｛"&log_commcomm("book_Messager")&"｝，您好，您在["&siteName&"]上发表的留言，现已被["&memName&"]回复，回复内容为：["&MsgReplyContent&"]，请点击查看"&siteURL&"LoadMod.asp?plugins=GuestBookForPJBlog#book_"&MsgID&"。谢谢您的留言，欢迎再次光临！"
 call sendmail(log_commcomm("email"),emailtitle,emailcontent)
 ' call sendmail(username,"",email_bookid,"",0,post_Message)
 end if
 log_commcomm.Close
 Set log_commcomm=Nothing
 End If
 '留言邮件通知结束

找到：

复制内容到剪贴板

程序代码

showmsg "回复信息","回复留言成功! <a href=""LoadMod.asp?plugins=GuestBookForPJBlog"">单击返回留言本</a>","MessageIcon","plugins"

在上面插入：

复制内容到剪贴板

程序代码

'留言邮件通知
 Dim SQLcomm, log_commcomm
 SQLcomm="Select TOP 1 * FROM blog_book Where book_ID="&MsgID
 Set log_commcomm=conn.execute(SQLcomm)
 if trim(log_commcomm("email"))<>"" then
 dim emailcontent,emailtitle
 emailtitle = "您在"&siteName&"上发表的留言已被回复"
 emailcontent = "尊敬的｛"&log_commcomm("book_Messager")&"｝，您好，您在["&siteName&"]上发表的留言，现已被["&memName&"]回复，回复内容为：["&MsgReplyContent&"]，请点击查看"&siteURL&"LoadMod.asp?plugins=GuestBookForPJBlog#book_"&MsgID&"。谢谢您的留言，欢迎再次光临！"
 call sendmail(log_commcomm("email"),emailtitle,emailcontent)
 ' call sendmail(username,"",email_bookid,"",0,post_Message)
 end if
 log_commcomm.Close
 Set log_commcomm=Nothing
 '留言邮件通知结束

打开common/function.asp，在最后一个

复制内容到剪贴板

程序代码

之前，插入如下代码：

复制内容到剪贴板

程序代码

Function IsRightUrl(UrlStrng)  '网址判断
  Dim regEx, retVal
  Set regEx = New RegExp
  regEx.Pattern = "^((https|http|ftp|rtsp|mms)?://)?(([0-9a-z_!~*'().&=+$%-]+: )?[0-9a-z_!~*'().&=+$%-]+@)?(([0-9]{1,3}\.){3}[0-9]{1,3}|([0-9a-z_!~*'()-]+\.)*([0-9a-z][0-9a-z-]{0,61})?[0-9a-z]\.[a-z]{2,6})(:[0-9]{1,4})?((/?)|(/[0-9a-z_!~*'().;?:@&=+$,%#-]+)+/?)$"
  regEx.IgnoreCase = False
  retVal = regEx.Test(UrlStrng)

  If retVal Then
    IsRightUrl = true
  Else
    IsRightUrl = false
  End If
End Function

找到：

复制内容到剪贴板

程序代码

Function sendmail(username,post_logID,email_commid,email_log_title,comm,post_Message) '邮件发送

到最近一个

复制内容到剪贴板

程序代码

End Function

之间的所有代码，包括这两句，全部替换（如果之前没有添加过，请直接添加）：

复制内容到剪贴板

程序代码

Function sendmail(blogemail,emailtitle,emailcontent)  '邮件发送
    on error resume next
    if trim(blog_jmail)="1" then
            Set msg = Server.CreateObject("JMail.Message")
            msg.silent = true
            msg.Logging = true
            msg.Charset = "gb2312"
            msg.MailServerUserName = blog_smtpuser
            msg.MailServerPassword = blog_smtppassword
            msg.From = blog_smtpmail
            msg.FromName = sitename
            msg.AddRecipient blogemail,sitename
            msg.Subject = emailtitle
            msg.Body = emailcontent
            msg.Send(blog_smtp)
            msg.close
            set msg = nothing
    Else
            Set objMail = Server.CreateObject("CDONTS.NewMail")
            objMail.To = blogemail
            objMail.From =blog_smtpmail
            objMail.Subject = emailtitle
            objMail.Body = emailcontent
            objMail.Send
            Set objMail = Nothing
    End If
End Function

如果之前没加过评论留言加网址和邮箱功能，请下载附件，升级数据库，否则请跳过。下载文件

点击下载附件

OK，全文结束。如果是全静态，修改完成后到后台重新生成。下载文件

我站的留言本

[本日志由小戒于 2008-12-08 10:17 PM 编辑]
收藏到QQ书签

文章来自: 本站原创

引用通告: 查看所有引用 | 我要引用此文章

Tags: 评论留言邮箱网址通知

评论: 27 | 引用: 0 | 查看次数: -

1 | 2 | 3 | ›

Rocklee

[2009-01-07 11:44 AM |

]

能用的~我现在170正在使用~~
感谢戒聊大哥

5jun

[2008-12-29 05:27 PM |

]

170的是不是不能共用这个方法了，我没改成功，能不能出个170能用的，嘿嘿！

小戒于 [2008-12-30 00:17 AM] 回复

暂时我还没有升级，不知道是否能用．

jump

[2008-12-24 05:38 PM |

]

感謝版主回覆
更改了系統時間並沒解決問題，於是我將blogcomm.asp 中的

If DateDiff("s", Request.Cookies(CookieName)("memLastPost"), Now())<blog_commTimerout Then
 'ReInfo(0) = "評論發表錯誤資訊"
 'ReInfo(1) = "發言太快,請 "&blog_commTimerout&" 秒後再發表評論 <a href=""javascript:history.go(-1);"">按一下返回</a>"
 'ReInfo(2) = "WarningIcon"
 'postcomm = ReInfo
 'Exit Function
 End If

遮蔽掉後一切都正常了 只是我這樣做會不會影響整個程式或造成不好的後果，如果方便可否幫我看上面的程式是否有問題 再一次感恩..

小戒于 [2008-12-25 06:38 PM] 回复

是修改服务器的时间格式噢。

jump

[2008-12-23 01:09 AM |

]

請問一下
我裝了這個功能，留言板的部份都正常但評論就出現以下訊息，不知是那裡出問題可否幫忙解決謝謝

錯誤類型：
Microsoft VBScript runtime (0x800A000D)
Type mismatch: '[string: "2008/11/26 下午 04:51:"]'
/test/blogcomm.asp, line 178

小戒于 [2008-12-23 11:24 AM] 回复

把服务器时间改为24小时的格式。

Candy

[2008-12-11 00:49 AM |

]

您好：
    按照你提供的方法全写上了、评论留言增加邮箱网址及博主回复通知评论留言人 For Pj3  157
留言评论邮件通知博主(增加后台开关)For pj3
上面两个我都加上、检查好几次代码没有错、可是Email没有收到任何邮件、我的回复也没有通知到网友的油箱、我用的是PJBlog3 v2.8.5.157  后台服务器信息： JMail.SMTPMail 组件: 支持
后台设置如下：
评论留言通知  (是)
邮件发送组件   支持JMail.SmtpMail
SMTP 服务器   smtp.qq.com
发件信箱       395215988@qq.com
SMTP 帐号   395215988
SMTP 密码   ***************
BLOG 地址   http://www.mxsf.net/blog/

QQ油箱的smtp我也启动了、可是没有收到哦、
期待博主指教。。。。。

小戒于 [2008-12-11 08:38 AM] 回复

换个邮箱吧。163的，免费的。试试。

麦田守望者

[2008-12-08 03:34 PM |

]

谢谢了！

hackwu

[2008-11-27 04:53 PM |

]

我觉得应该把注册会员时填的邮箱,网址用上,避免重复浪费!
注册会员添了邮箱,网址的可以自动展现
未注册只评论的可以自己输入
这样最好!

hackwu

[2008-11-27 04:52 PM |

]

注册会员时填的邮箱,网址可以直接使用吗?!

evio

[2008-11-26 06:32 PM |

]

小戒同学，你的标题长度该用cutstr(obj,num)了。哈哈。

随缘

[2008-11-17 05:06 PM |

]

改了两次还是出错,真晕

1 | 2 | 3 | ›

发表评论

昵　称:
密　码:	游客发言不需要密码.
邮　箱:	博主回复后，系统将发送通知邮件到您的邮箱，可不填.
网　址:
内　容:	正在加载编辑器...
验证码:
选　项:	禁止表情转换禁止自动转换链接禁止自动转换关键字

虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.

评论留言增加邮箱网址及博主回复通知评论留言人 For Pj3 157（11/2日修改网址判断）

作者:小戒 日期:2008-11-02

作者:小戒日期:2008-11-02