测试一下

晓章

进入自由天空,进入精彩虚拟世界!

[此贴子已经被作者于2006-3-12 0:02:11编辑过]

晓章

以下内容需要花费现金200才可以浏览，您已经购买本帖

在线等级及活跃度forsp1.rar


最后更新：11月29日15：30
更新内容：解决今日到访问题！


' 活跃度插件V2.0 Beta1 For DVBBS 7.0~Dvbbs 7.1 sp1(11-14)
' 插件作者：若阑
' 网址：QQ电子宠物社区 http://www.qqpet.com/
' 升级修改：读窗
' 演示：http://www.521free.com/bbs
' 发布方式：免费
' 编写时间: 2005-03-20
' 改写时间: 2005-11-16
' 功能描述：插件用于添加两个论坛参数，活跃度和在线时间，参数有后台设置
' Copyright (C) 2005

升级内容
本次升级使插件进一步完善。
增加功能如下：
1、增加了在线升级短信提示
2、增加了在线升级奖励设置
3、增加了几个开关设置，使得自由选择需要的参数
4、在线等级计算公式的参数设置
5、提高了在线的计算精度，并让用户自己设置更新的频度
6、分离后台管理文件，使安装更加简便
7、增加了进入版面的在线限制和活跃度限制功能

文件清单：
四个图片文件在images文件夹里
一个后台管理文件admin/RL_admin_Active.asp
一个包含头文件inc/RL_ActiveComm.asp
一堆涉及修改的文件，都在BBS调用里面
一个在线排行列表文件
RLActiveList.asp

安装方法如下，请按顺序来安装
记得把所有要修改的文件先备份起来(包括const.asp，dispbbs.asp,savepost.asp,admin里面的user.asp,setting.asp,boardsetting.asp)

###############################################
#注意，针对原文件的修改                       #
#在调用里面都提供现成的(文件是4月6日下载的)   #
###############################################

一、把文件RL_ActiveSetup.asp上传到论坛根目录，并在浏览器打开你论坛上的该文件。按操作升级数据库。
请在确认数据库正确升级了再进行以下操作（以前安装过1.0的用户请跳过，执行第二步操作）
二、把inc里面文件RL_ActiveComm.asp上传到论坛所在目录的inc目录里面
三、把RL_admin_Active.asp上传到论坛所在目录
四、在后台摸版添加管理连接（如果不想在后台添加管理连接可以跳过）
    添加方法后台管理方法，进入[风格界面模板总管理]，选择[分页面模板(page_admin)]进入界面风格
    修改template.html(0)找到菜单管理，修改如下：
    菜单管理@@<a href=plus.asp target=main>论坛菜单管理</a>@@<a href=rl_admin_active.asp target=main>活跃度管理</a>||道具中心管理@@<

五、const.asp文件修改
<!--#Include File="Dv_ClsMain.asp"-->
<%
Set MyBoardOnline=new Cls_UserOnlne
Dvbbs.Checkcache()
Dvbbs.GetForum_Setting
Dvbbs.CheckUserLogin
%>
下面增加
<!--#Include File="RL_ActiveComm.asp"-->
<%
UpdateOnlineTime()
%>

六、发表文章的修改
savepost.asp
就是增加两个
UpdatePostCount() ' 更新活跃度  (修改部分)

1158行左右
Public Sub updatepostuser()
  '投票，发贴，更新积分
  'Dvbbs.MyUserInfo = Session(Dvbbs.CacheName & "UserID")
  '更新最后发贴时间
  Dvbbs.MyUserInfo(2) = Now
  Dim MagicSql
  If Action = 5 Or Action = 7 Then
   If FoundUseMagic Then
    If cCur(Dvbbs.MyUserInfo(37)) > tMagicMoney Then
     Dvbbs.MyUserInfo(37)=Dvbbs.MyUserInfo(37)-tMagicMoney
     Dvbbs.ToolsLog -88,1,tMagicMoney,0,1,"使用金币购买魔法表情",Dvbbs.MyUserInfo(37) & "|" & Dvbbs.MyUserInfo(38)
    Else
     MagicSql = ",UserTicket=UserTicket-"&tMagicTicket&""
     Dvbbs.MyUserInfo(38)=Dvbbs.MyUserInfo(38)-tMagicTicket
     Dvbbs.ToolsLog -88,1,0,tMagicTicket,1,"使用点券购买魔法表情",Dvbbs.MyUserInfo(37) & "|" & Dvbbs.MyUserInfo(38)
    End If
   End If
   Dvbbs.Execute("update [Dv_user] set UserLastIP='"&Dvbbs.usertrueip&"',UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Clng(Dvbbs.Forum_user(1))&",userEP=userEP+"&Clng(Dvbbs.Forum_user(6))&",userCP=userCP+"&Clng(Dvbbs.Forum_user(11))&",UserToday='"&Clng(Dvbbs.UserToday(0))+1&"|"&Clng(Dvbbs.UserToday(1))&"|"&Clng(Dvbbs.UserToday(2))&"|"&Clng(Dvbbs.UserToday(3))&"|"&Clng(Dvbbs.UserToday(4))&"',UserMoney="&Dvbbs.MyUserInfo(37)&" "&MagicSql&" Where UserID="&Dvbbs.userID)
   If Not Reuser Then
    UserPost=UserPost+1
    Dvbbs.MyUserInfo(21)=Dvbbs.MyUserInfo(21)+Clng(Dvbbs.Forum_user(1))
    Dvbbs.MyUserInfo(22)=Dvbbs.MyUserInfo(22)+Clng(Dvbbs.Forum_user(6))
    Dvbbs.MyUserInfo(23)=Dvbbs.MyUserInfo(23)+Clng(Dvbbs.Forum_user(11))
   End If
   UpdatePostCount() ' 更新活跃度  (修改部分)
  ElseIf Action = 6 Then '回贴更新积分。
   If Not Reuser Then
    Dvbbs.Execute("update [Dv_user] set UserLastIP='"&Dvbbs.usertrueip&"',UserPost=UserPost+1,userWealth=userWealth+"&Clng(Dvbbs.Forum_user(2))&",userEP=userEP+"&Clng(Dvbbs.Forum_user(7))&",userCP=userCP+"&Clng(Dvbbs.Forum_user(12))&",UserToday='"&Clng(Dvbbs.UserToday(0))+1&"|"&Clng(Dvbbs.UserToday(1))&"|"&Clng(Dvbbs.UserToday(2))&"|"&Clng(Dvbbs.UserToday(3))&"|"&Clng(Dvbbs.UserToday(4))&"',UserMoney="&Dvbbs.MyUserInfo(37)&" Where UserID="&Dvbbs.userID)
    UserPost=UserPost+1
    Dvbbs.MyUserInfo(21)=Dvbbs.MyUserInfo(21)+Clng(Dvbbs.Forum_user(2))
    Dvbbs.MyUserInfo(22)=Dvbbs.MyUserInfo(22)+Clng(Dvbbs.Forum_user(7))
    Dvbbs.MyUserInfo(23)=Dvbbs.MyUserInfo(23)+Clng(Dvbbs.Forum_user(12))
   Else
    Dvbbs.Execute("update [Dv_user] set UserLastIP='"&Dvbbs.usertrueip&"',UserPost=UserPost+1,userWealth=userWealth+"&Clng(Dvbbs.Forum_user(2))&",userEP=userEP+"&Clng(Dvbbs.Forum_user(7))&",userCP=userCP+"&Clng(Dvbbs.Forum_user(12))&",UserMoney="&Dvbbs.MyUserInfo(37)&" Where UserID="&Dvbbs.userID)
   End If
   UpdatePostCount() ' 更新活跃度  (修改部分)

  End If
  If Not Reuser Then
   Dvbbs.MyUserInfo(8)=UserPost+1
   Dvbbs.MyUserInfo(36)=Clng(Dvbbs.UserToday(0))+1 & "|" & Clng(Dvbbs.UserToday(1)) & "|" & Clng(Dvbbs.UserToday(2))&"|"&Clng(Dvbbs.UserToday(3))&"|"&Clng(Dvbbs.UserToday(4))
  End If
  '发贴数字能整除十则更新用户等级。(Updategrade())
  If UserPost mod 10 < 1  Then Updategrade()
  'Session(Dvbbs.CacheName & "UserID") = Dvbbs.MyUserInfo
End Sub

七、dispbbs.asp修改
(注意,如果原来安装过1.0的用户,请删除增加的那些声明,就是原来增加在166行左右的那些,为了简便安装,那些都写入了附件文件里面了)
296行左右
找到    '利用ubblist节点传送广告数据
    If Dvbbs.Forum_ads(7)="1" Then
     Node.selectSingleNode("@ubblist").text=Topic_Ads
    Else
     Node.selectSingleNode("@ubblist").text=""
    End If
    Node.selectSingleNode("@topic").text=Dvbbs.Replacehtml(Node.selectSingleNode("@topic").text)

修改如下(看清楚噢。是在Next上面)

   
   '========若阑修改活跃度插件开始
'如果在宠物调用之后用下面这行
   Dim RLActiveInfo
'如果没有宠物调用用这行
   Dim RLActiveInfo,CNode
   RLActiveInfo = GetActiveEachInfo(Node.selectSingleNode("@username").text)
   RLActiveInfo = Split(RLActiveInfo,"||")
   if Ubound(RLActiveInfo) >= 3 then
    Set CNode = XMLDOM.createNode(2,"RLActive","")
       Cnode.text=RLActiveInfo(0)
       node.attributes.setNamedItem(Cnode)
   
    Set CNode = XMLDOM.createNode(2,"RLActiveMax","")
       Cnode.text=RLActiveInfo(1)
       node.attributes.setNamedItem(Cnode)
   
    Set CNode = XMLDOM.createNode(2,"RLActiveWord","")
       Cnode.text=RLActiveInfo(2)
       node.attributes.setNamedItem(Cnode)
   
    Set CNode = XMLDOM.createNode(2,"RLActOnline","")
       Cnode.text=RLActiveInfo(3)
       node.attributes.setNamedItem(Cnode)
    Set CNode = XMLDOM.createNode(2,"RLActSetting","")
       Cnode.text=RLActiveInfo(4)
       node.attributes.setNamedItem(Cnode)
      end if
   '========若阑修改活跃度插件结束

后台模板修改
dispbbs分版面
template.html(0)
找到
function LoadMagicEmot(MagicID,topicid){
var cookiesstr=readCookie('mofaface_'+ topicid);
if (cookiesstr ==null){
createCookie('mofaface_'+ topicid,MagicID,365)
DispMagicEmot(MagicID,350,500)
}
}
</script>
下面增加
<script language="VBScript">
Function GetActivePic(RLActiveValue,RLActiveMax,RL_Setting)
Dim PicStr
RL_Setting = Split(RL_Setting,"$$")
PicStr = "<img src="""&RL_Setting(2)&""" width="""&CStr(50*RLActiveValue\RLActiveMax)&""" height=""10"" border=""0"" alt=""活跃度:"& RLActiveValue&"""><img src="""&RL_Setting(3)&""" width="""&CSTR(50*(RLActiveMax-RLActiveValue)\RLActiveMax)&""" height=""10"" border=""0"" alt=""活跃度:"&RLActiveValue&""">"
GetActivePic = PicStr
End Function

Function GetOnlineClassPic(RL_ActTimeT,RL_Setting)
Dim RL_UserClass,RL_NextClassNeed,RL_Str,TempStr,i

RL_UserClass = 0
RL_NextClassNeed = 0
RL_Setting = Split(RL_Setting,"$$")
For i=1 to 100
  if RL_ActTimeT \ 60 < CLng(RL_Setting(1))*i*i + CLng(RL_Setting(0))*i then
   RL_NextClassNeed = (CLng(RL_Setting(1))*i*i + CLng(RL_Setting(0))*i)*60 - RL_ActTimeT
   Exit For
  end if

  RL_UserClass = RL_UserClass + 1
  
Next


RL_Str = ""

TempStr = "在线:"&RL_ActTimeT \ 60&"小时"&RL_ActTimeT mod 60&"分钟.&#13&#10离升级差"&RL_NextClassNeed\60&"小时"&RL_NextClassNeed mod 60&"分钟.&#13&#10目前等级:"&RL_UserClass&""
   
if RL_UserClass = 0 then
  RL_Str = RL_Str & "<img src=""Images/noclass.gif"" alt="""&TempStr&""">"
end if


For i=1 to RL_UserClass \ 16
  RL_Str = RL_Str & "<img src=""Images/time_sun.gif"" alt="""&TempStr&""">"
Next
RL_UserClass = RL_UserClass mod 16

For i=1 to RL_UserClass \ 4
  RL_Str = RL_Str & "<img src=""Images/time_yueliang.gif"" alt="""&TempStr&""">"
Next
RL_UserClass = RL_UserClass mod 4

For i=1 to RL_UserClass
  RL_Str = RL_Str & "<img src=""Images/time_star.gif"" alt="""&TempStr&""">"
Next

GetOnlineClassPic = RL_Str
End Function


</script>

然后找到
<div>注册：<xsl:value-of select="/post/userlist/user[@userid=$userid]/@joindate"/></div>
下面增加

<xsl:if test="@RLActive!='-1' and @RLActiveMax!='-1'">

<div><xsl:text disable-output-escaping="yes" >&amp;nbsp;&amp;nbsp;</xsl:text><xsl:text disable-output-escaping="yes" >&amp;nbsp;&amp;nbsp;</xsl:text>活跃度：<script type="text/javascript" language="VBScript">document.write(GetActivePic(<xsl:value-of select="@RLActive"/>,<xsl:value-of select="@RLActiveMax"/>,'<xsl:value-of select="@RLActSetting" />'));</script></div>
<div><xsl:text disable-output-escaping="yes" >&amp;nbsp;&amp;nbsp;</xsl:text><xsl:text disable-output-escaping="yes" >&amp;nbsp;&amp;nbsp;</xsl:text>活跃等级：<xsl:value-of select="@RLActiveWord"/></div>
</xsl:if>
<xsl:if test="@RLActOnline!='-1'">
<div><xsl:text disable-output-escaping="yes" >&amp;nbsp;&amp;nbsp;</xsl:text><xsl:text disable-output-escaping="yes" >&amp;nbsp;&amp;nbsp;</xsl:text>在线等级：<script type="text/javascript" language="VBScript">document.write(GetOnlineClassPic(<xsl:value-of select="@RLActOnline" />,'<xsl:value-of select="@RLActSetting" />'));</script></div>
</xsl:if>

八：修改管理目录下的

上传三个图片文件到images里面Board.asp
找到
rs("Board_Setting")="0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,16240,3,0,gif|jpg|jpeg|bmp|png|rar|txt|zip|mid,0,0,1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1,0,1,100,20,10,9,normal,1,10,10,0,0,0,0,1,0,0,1,4,0,0,0,200,0,0,,$$,0,0,0,1,0|0|0|0|0|0|0|0|0,0|0|0|0|0|0|0|0|0,0,0,0,0,0,0,0,0,0,灌水|广告|奖励|惩罚|好文章|内容不符|重复发帖,0,1,0,24,0,0"
改为
rs("Board_Setting")="0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,16240,3,0,gif|jpg|jpeg|bmp|png|rar|txt|zip|mid,0,0,1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1,0,1,100,20,10,9,normal,1,10,10,0,0,0,0,1,0,0,1,4,0,0,0,200,0,0,,$$,0,0,0,1,0|0|0|0|0|0|0|0|0,0|0|0|0|0|0|0|0|0,0,0,0,0,0,0,0,0,0,灌水|广告|奖励|惩罚|好文章|内容不符|重复发帖,0,1,0,24,0,0,0*0"

全部安装完成，如果要其他辅助功能，请看辅助修改部分

由于设置文件已经分离了出来，所以原来安装过1.0的用户，请把admin_setting.asp恢复为原来的,或者看辅助修改部分的修改。

Well Done！！Good Luck!!

想要今日到访的朋友，请在高级修改，改index.asp时

把最后的%>前加入

function show_today()
dim duhome,sql,rs,i
sql="select UserName,LastLogin from [Dv_User] orders"
set rs=Dvbbs.Execute(sql)
If Not RS.Eof then
  SQL=Rs.GetRows(-1)
     rs.close:set rs=nothing
  for i=0 To Ubound(SQL,2)
   if FormatDateTime(sql(1,i),vbShortDate)=FormatDateTime(date,vbShortDate) then
   duhome=duhome&"<a href=dispuser.asp?name="&sql(0,i)&" target=""_blank"" title=查看"&sql(0,i)&"的个人资料>"
   duhome=duhome&""&sql(0,i)&"</a>"
   
   duhome=duhome&"&nbsp;&nbsp;"  
   end if
  next
else
  duhome=duhome&"今日没有会员到访"
    end if
show_today=duhome
end function

痴心茉莉

头晕了，完全懂不起哈
唉，只能怪自己当初学电脑时不用功，学了就丢

前村

头晕~~~~~~~~~~~`