给zblog博客加个朋友圈(读者墙)

这次分享的是给zblog加一个“朋友圈”的功能,这个方法是从我博客主题的制作者“石头”那借鉴过来,效果大家可以点击导航上的朋友圈观看。目的是可以更方便您的回访一些朋友,还可让其他朋友结识更多的朋友。相信也是很多zblog粉期待的。

效果图:

朋友圈

下面说说具体方法。

1,首先要新建一个页面,zblog自定义页面的添加方法我以前已经介绍过了,,不会的可以去看看学习下先。

2,安装 “评论之星”插件。安装完成后,去修改PLUGIN\CmtStar目录中的include.asp。把内容你换成:

<%
‘///////////////////////////////////////////////////////////////////////////////
‘// 插件应用:    1.8 Devo 其它版本的Z-blog未知
‘// 插件制作:    haphic(http://haphic.com/)
‘// 备    注:    CmtStar – 挂口页
‘// 最后修改:   2009-12-2
‘// 最后版本:    0.1
‘///////////////////////////////////////////////////////////////////////////////
Const CmtStar_DayNum = 365
Const CmtStar_Num = 500
Const CmtStar_Level = 1
Const CmtStar_AlwaysShowLinks = True
Const CmtStar_DefaultLink = “”
Const CmtStar_ThisMonthOnly = False
Const CmtStar_BlockedName = “”
‘注册插件
Call RegisterPlugin(“CmtStar”,”ActivePlugin_CmtStar”)
Function ActivePlugin_CmtStar()
‘挂上接口
‘Call Add_Action_Plugin(“Action_Plugin_MakeBlogReBuild_Begin”,”Call CmtStar_BuildCache”)
Call Add_Action_Plugin(“Action_Plugin_MakeBlogReBuild_Core_Begin”,”Call CmtStar_BuildCache:Call ClearGlobeCache():Call LoadGlobeCache()”)
‘Call Add_Action_Plugin(“Action_Plugin_CommentPost_Succeed”,”Call CmtStar_BuildCache:Call ClearGlobeCache():Call LoadGlobeCache()”)
End Function

Function CmtStar_BuildCache()
On Error Resume Next
Dim aryCmtName()
Dim aryCmtNum()
Dim aryCmtUrl()
Dim aryCmtEmail()

Dim tmpCmtName
Dim tmpCmtNum
Dim tmpCmtUrl
Dim tmpCmtEmail
Dim i : i=0
Dim j : j=0
Dim k : k=0
Dim bolNameFound
ReDim Preserve  aryCmtName(i)
ReDim Preserve  aryCmtNum(i)
ReDim Preserve  aryCmtUrl(i)
ReDim Preserve  aryCmtEmail(i)

‘从数据库中取得数据
Dim objRS
If CmtStar_ThisMonthOnly Then
Set objRS=objConn.Execute(“SELECT [comm_Author],[comm_HomePage],[comm_Email] FROM [blog_Comment] WHERE ([log_ID]>=0) AND (Year([comm_PostTime])=”&Year(Now())&”) AND (Month([comm_PostTime])=”&Month(Now())&”) ORDER BY [comm_ID] DESC”)
Else
Set objRS=objConn.Execute(“SELECT [comm_Author],[comm_HomePage],[comm_Email] FROM [blog_Comment] WHERE ([log_ID]>=0) AND ([comm_PostTime]>Now()-“& CmtStar_DayNum &”) ORDER BY [comm_ID] DESC”)
End If
If (Not objRS.bof) And (Not objRS.eof) Then
Do While Not objRS.eof
If CmtStar_NameIllegal(objRS(“comm_Author”))=False Then
bolNameFound = False
For j=0 To UBound(aryCmtName) Step 1
If LCase(aryCmtName(j)) = LCase(objRS(“comm_Author”)) Then
aryCmtNum(j) = aryCmtNum(j)+1
If Len(aryCmtUrl(j)) < 5 Then
aryCmtUrl(j) = objRS(“comm_HomePage”)
Else
If Not Len(objRS(“comm_HomePage”))<5 Then
aryCmtUrl(j) = aryCmtUrl(j) & “|” & objRS(“comm_HomePage”) ‘取得所有的URL, 字符串 URL|URL|URL 形式.
End If
End If
bolNameFound = True
Exit For
End If
Next
If bolNameFound = False Then
ReDim Preserve  aryCmtName(i)
ReDim Preserve  aryCmtNum(i)
ReDim Preserve  aryCmtUrl(i)
ReDim Preserve  aryCmtEmail(i)
aryCmtName(i) = objRS(“comm_Author”)
aryCmtNum(i) = 1
aryCmtUrl(i) = objRS(“comm_HomePage”)
aryCmtEmail(i) = objRS(“comm_Email”)

i=i+1
End If
End If
objRS.MoveNext
Loop
End If
objRS.Close
Set objRS=Nothing

‘滤去评论数小于指定值的评论者
tmpCmtName = aryCmtName
tmpCmtNum = aryCmtNum
tmpCmtUrl = aryCmtUrl
tmpCmtEmail = aryCmtEmail
Erase aryCmtName
Erase aryCmtNum
Erase aryCmtUrl
Erase aryCmtEmail
j=0
For i=0 To UBound(tmpCmtName) Step 1
If Not tmpCmtNum(i)<CmtStar_Level Then
ReDim Preserve  aryCmtName(j)
ReDim Preserve  aryCmtNum(j)
ReDim Preserve  aryCmtUrl(j)
ReDim Preserve  aryCmtEmail(j)
aryCmtName(j) = tmpCmtName(i)
aryCmtNum(j) = tmpCmtNum(i)
aryCmtUrl(j) = tmpCmtUrl(i)
aryCmtEmail(j) = tmpCmtEmail(i)
j=j+1
End If
Next
Erase tmpCmtName
Erase tmpCmtNum
Erase tmpCmtUrl
Erase tmpCmtEmail

‘最多原则确定链接, 防冒名
Dim objRegExp, Matches
Set objRegExp=new RegExp
objRegExp.IgnoreCase =True
objRegExp.Global=True
Dim m,n,s,t
For k=0 To UBound(aryCmtName) Step 1
m = aryCmtUrl(k)
t = 0
If InStr(m,”|”)>0 Then
n=Split(m,”|”)
For Each s In n
If Right(s,1)=”/” Then s=Left(s,Len(s)-1)
objRegExp.Pattern=”(“& s &”)”
Set Matches = objRegExp.Execute(m)
If t<Matches.Count Then
t=Matches.Count
aryCmtUrl(k) = s
End If
Set Matches = Nothing
Next
End If<
br /> Next
Set objRegExp=Nothing

‘排序
k=Ubound(aryCmtName)
For i=k To 0 Step -1
For j=0 To i-1
If aryCmtNum(j)<aryCmtNum(j+1) Then
tmpCmtName = aryCmtName(j)
tmpCmtNum = aryCmtNum(j)
tmpCmtUrl = aryCmtUrl(j)
tmpCmtEmail = aryCmtEmail(j)
aryCmtName(j) = aryCmtName(j+1)
aryCmtNum(j) = aryCmtNum(j+1)
aryCmtUrl(j) = aryCmtUrl(j+1)
aryCmtEmail(j) = aryCmtEmail(j+1)
aryCmtName(j+1) = tmpCmtName
aryCmtNum(j+1) = tmpCmtNum
aryCmtUrl(j+1) = tmpCmtUrl
aryCmtEmail(j+1) = tmpCmtEmail
End If
Next
Next

‘导出评论之星
Dim strCmtLink : strCmtLink=CmtStar_DefaultLink : If Len(strCmtLink)<5 Then strCmtLink=ZC_BLOG_HOST
Dim strCmtStar : strCmtStar=””
For k=0 To Ubound(aryCmtName) Step 1
If (aryCmtName(k) <> “”) Then
If k>CmtStar_Num-1 Then Exit For
If CmtStar_AlwaysShowLinks Then
If Len(aryCmtURL(k))<5 Then aryCmtURL(k)=strCmtLink
End If
If Len(aryCmtURL(k))<5 Then
strCmtStar = strCmtStar & “<img src=””http://www.gravatar.com/avatar/”&md5(aryCmtEmail(k))&”?d=identicon&s=36&r=g“” height=36 widht=36 alt=”””& aryCmtName(k) &””” />” & vbCrlf
Else
strCmtStar = strCmtStar & “<a href=”””& URLEncodeForAntiSpam(aryCmtUrl(k)) &””” target=””_blank””>” & “<img src=””http://www.gravatar.com/avatar/”&md5(aryCmtEmail(k))&”?d=identicon&s=36&r=g“” height=36 widht=36 alt=”””& aryCmtName(k) &””” /></a>” & vbCrlf
End If
End If
Next
Erase aryCmtName
Erase aryCmtNum
Erase aryCmtUrl
strCmtStar=TransferHTML(strCmtStar,”[no-asp]”)
Call SaveToFile(BlogPath & “/include/CmtStar.asp”,strCmtStar,”utf-8″,True)
Err.Clear
End Function
Function CmtStar_NameIllegal(ByVal strName)
If Len(CmtStar_BlockedName)=<1 Then Exit Function
Dim strList,aryList,sList,bolIllegal
bolIllegal=False
strName=LCase(strName)
strList=LCase(CmtStar_BlockedName)
‘strList=Replace(strList,” “,”,”)
‘strList=Replace(strList,” ”,”,”)
strList=Replace(strList,”;”,”,”)
strList=Replace(strList,”;”,”,”)
strList=Replace(strList,”,”,”,”)
strList=Replace(strList,”,”,”|”)
aryList=Split(strList,”|”)
For Each sList In aryList
If sList<>”” Then
If sList=strName Then
bolIllegal=True
Exit For
End If
End If
Next
CmtStar_NameIllegal=bolIllegal
End Function
‘安装插件
Function InstallPlugin_CmtStar()
Call CmtStar_BuildCache()
End Function
‘卸载插件
Function UnInstallPlugin_CmtStar()
On Error Resume Next
Dim fso
Set fso = Server.CreateObject(“Scripting.FileSystemObject”)
fso.DeleteFile(BlogPath & “INCLUDE/CmtStar.asp”)
Set fso = Nothing
Err.Clear
End Function
%>

3,在自定义页面中调用<#CACHE_INCLUDE_CMTSTAR#>标签。

4,配置评论之星插件,你可以选择显示的数量跟一些条件,最后重建文件就好了。

“给zblog博客加个朋友圈(读者墙)”上的32条回复

  1. 在侧边栏做了个小的,不打算单独做页面了,而且我用的是Wordpress,嘻嘻,你这教程完全不适用。

    gtsow 于 2011-3-7 10:08:18 回复

    这个教程就是根据小的改的。

评论已关闭。