只允许客人看到帖子中的部份内容

蓝雨

未登陆用户或者未注册用户只可以看到帖子的部份内容，并且代码帖(如UBB语法，HTML语法)只可以看到部分代码而已，不会显示效果。

此主题相关图片如下：

Dvbbs7.0.0_ac修改方法

修改dispbbs.asp文件，找到

QUOTE:

If InStr(Ubblists,\",39,\") > 0Then
TopicBody = dv_ubb.Dv_UbbCode(SQL(5,i),SQL(34,i),1,0)
Else
TopicBody = dv_ubb.Dv_UbbCode(SQL(5,i),SQL(34,i),1,1)
End If

改为

QUOTE:

If InStr(Ubblists,\",39,\") > 0Then
If Dvbbs.userid=0 then
TopicBody = left(Server.HtmlEnCode(SQL(5,i)),50)&\"......

您还没有登陆，欲知全文内容，请选择注册或者登陆。\"
Else
TopicBody = dv_ubb.Dv_UbbCode(SQL(5,i),SQL(34,i),1,0)
End If
Else
If Dvbbs.userid=0 then
TopicBody = left(Server.HtmlEnCode(SQL(5,i)),50)&\"......

您还没有登陆，欲知全文内容，请选择注册或者登陆。\"
Else
TopicBody = dv_ubb.Dv_UbbCode(SQL(5,i),SQL(34,i),1,1)
End If
End If

其中，里面的50为提取的字节数，按自己的需要可以更改。

此时效果已经不错了，但是点帖子右上角的仍可以看到帖子内容，为了更完美，再修改此文件printpage.asp，找到

QUOTE:

Templist=Replace(Templist,\"{$body}\",SimJsReplace(dv_ubb.Dv_UbbCode(SQL(3,i),SQL(4,i),1,1)))

改为

QUOTE:

If Dvbbs.userid=0 then
Dvbbs.AddErrCode(6)
Dvbbs.Showerr()
Else
Templist=Replace(Templist,\"{$body}\",SimJsReplace(dv_ubb.Dv_UbbCode(SQL(3,i),SQL(4,i),1,1)))
End If

Dvbbs7.1.0_ac修改方法

打开dispbbs.asp文件，找到

QUOTE:

If InStr(Ubblists,\",39,\") > 0Then
TopicBody = dv_ubb.Dv_UbbCode(node.attributes.getNamedItem(\"body\").text,node.attributes.getNamedItem(\"UserGroupID\").text,1,0)
Else
TopicBody = dv_ubb.Dv_UbbCode(node.attributes.getNamedItem(\"body\").text,node.attributes.getNamedItem(\"UserGroupID\").text,1,1)
End If

改为

QUOTE:

If InStr(Ubblists,\",39,\") > 0Then
If Dvbbs.userid=0 Then
TopicBody = left(Server.HtmlEnCode(node.attributes.getNamedItem(\"body\").text,50)&\"......

您还没有登陆，欲知全文内容，请选择注册或者登陆。\"
Else
TopicBody = dv_ubb.Dv_UbbCode(node.attributes.getNamedItem(\"body\").text,node.attributes.getNamedItem(\"UserGroupID\").text,1,0)
End If
Else
If Dvbbs.userid=0 Then
TopicBody = left(Server.HtmlEnCode(node.attributes.getNamedItem(\"body\").text),50)&\"......

您还没有登陆，欲知全文内容，请选择注册或者登陆。\"
Else
TopicBody = dv_ubb.Dv_UbbCode(node.attributes.getNamedItem(\"body\").text,node.attributes.getNamedItem(\"UserGroupID\").text,1,1)
End If
End If

这里的50是什么意思就不用多说了。

同样，为防止客人按“打印”看到帖子内容，再改TopicOther.asp文件

找到

Templist=Replace(Templist,\"{$body}\",SimJsReplace(dv_ubb.Dv_UbbCode(SQL(3,i),SQL(4,i),1,1)))

改为

QUOTE:

If Dvbbs.userid=0 then
Response.redirect \"showerr.asp?ErrCodes=

嘿嘿，本论坛不许客人查看帖子全部内容，麻烦您注册或者登陆吧。&action=OtherErr\"
Else
Templist=Replace(Templist,\"{$body}\",SimJsReplace(dv_ubb.Dv_UbbCode(SQL(3,i),SQL(4,i),1,1)))
End If

Templist=Replace(Templist,\"{$body}\",SimJsReplace(dv_ubb.Dv_UbbCode(SQL(3,i),SQL(4,i),1,1)))
End If

修改完毕。
注：红色为添加部份

------------------------------------------------------------------

Dvbbs 7.1.0 SP1(20060716版)修改方法

dispbbs.asp文件中，找到

QUOTE:

\'Ubb转换
If InStr(Ubblists,\",39,\") > 0 Then
Node.selectSingleNode(\"@body\").text = dv_ubb.Dv_UbbCode(postbody,UserGroupID,1,0)
Else
Node.selectSingleNode(\"@body\").text = dv_ubb.Dv_UbbCode(postbody,UserGroupID,1,1)
End If

替换为

QUOTE:

\'Ubb转换
If InStr(Ubblists,\",39,\") > 0 Then
If Dvbbs.UserID = 0 Then
Node.selectSingleNode(\"@body\").text = Left(Server.HtmlEnCode(postbody),50) & \"……

您还没有登录，欲知全文内容，请选择〖注册〗或者〖登录〗。\"
Else
Node.selectSingleNode(\"@body\").text = dv_ubb.Dv_UbbCode(postbody,UserGroupID,1,0)
End If
Else
If Dvbbs.UserID = 0 Then
Node.selectSingleNode(\"@body\").text = Left(Server.HtmlEnCode(postbody),50) & \"……

您还没有登录，欲知全文内容，请选择〖注册〗或者〖登录〗。\"
Else
Node.selectSingleNode(\"@body\").text = dv_ubb.Dv_UbbCode(postbody,UserGroupID,1,1)
End If
End If

老规矩，红字为添加部份，蓝色背景的数字表示截取可供预览的长度，默认是50，可以自行修改。

蓝雨

DISPBBS.ASP

找到332行左右的.

QUOTE:

If Not CanRead Then
TopicBody = TopicInfo
Else
If Not (node.attributes.getNamedItem("LockUser").text="2" Or (node.attributes.getNamedItem("isbest").text="1" And Dvbbs.GroupSetting(41)="0") Or node.attributes.getNamedItem("LockUser").text="1") Then
If InStr(Ubblists,",39,") > 0 Then
TopicBody = dv_ubb.Dv_UbbCode(node.attributes.getNamedItem("body").text,node.attributes.getNamedItem("UserGroupID").text,1,0)
Else
TopicBody = dv_ubb.Dv_UbbCode(node.attributes.getNamedItem("body").text,node.attributes.getNamedItem("UserGroupID").text,1,1)
End If
End If
End If

后面添加

QUOTE:

If Rs(10)=1 Then
Dim RLSql, RLRs, RLPingYu, RLRE, lFlag
RLSql = "select l_username,l_content from [Dv_Log] where l_AnnounceID =" & AnnounceID
Set RLRs = Dvbbs.Execute(RLSql)
If Not RLRs.Eof Then
lFlag = 0
Do While Not RLRs.Eof And lFlag=0
If InStr(RLRs(1), "精华帖子")>0 Then
Set RLRE=new RegExp
RLRE.IgnoreCase =True
RLRE.Global=True
RLPingYu = RLRs(1)
RLRE.Pattern="精华帖子.*用户操作(.*)"
RLPingYu = RLRE.Replace(RLPingYu, "精华帖子,奖励$1")
RLRE.Pattern="精华帖子.*没有对用户进行分值操作"
RLPingYu = RLRE.Replace(RLPingYu, "精华帖子,没有对用户进行分值操作")
TopicBody = "

你的图片地址>本贴被【 " & RLRs(0) & " 】评为" & RLPingYu & "你的图片地址>
" & TopicBody
lFlag = 1
Set RLRE=Nothing
End If
RLRs.MoveNext
Loop
End If
RLRs.CLose
Set RLRs = Nothing

End If

蓝雨

把你的dispbbs打包给我传上来 我看看

蓝雨

给你编辑了一下 你在试试看, 编辑到你给我的压缩包里面了, 你直接下载吧

蓝雨

看看这个 最好你要先备份一下

[此贴子已经被作者于2007-6-15 11:40:52编辑过]

蓝雨

[em01][em01]

蓝雨

[em01][em01]