"&template.Strings(29)&"&action=OtherErr"
End Function
'得到回复或引用帖子的判断和相关信息
Public Function Get_Re_TopicInfo()
Dim lockuser,postip
postip=""
Get_M_Request()
ReplyID = Request("replyid")
If ReplyID = "" Or Not IsNumeric(ReplyID) Then ReplyID = AnnounceID
Set Rs=Dvbbs.Execute("select PostTable,GetMoneyType From dv_topic where BoardID="&Dvbbs.BoardID&" And TopicID="&AnnounceID)
If Not (Rs.EOF And Rs.BOF) Then
TotalUseTable=rs(0)
GetMoneyType=rs(1)
Else
Dvbbs.AddErrCode(48)
End If
Set Rs=Nothing
Dvbbs.ShowErr()
If ReplyID = AnnounceID Then
Set Rs=Dvbbs.Execute("select top 1 AnnounceID from "&TotalUseTable&" where RootID="&AnnounceID&" order by AnnounceID")
If Not(Rs.BOF And Rs.EOF) Then
ReplyID=rs(0)
Else
Dvbbs.AddErrCode(48)
End If
Set Rs=Nothing
Dvbbs.ShowErr()
End If
If Request("guest") Then
Set Rs=Dvbbs.Execute("select body,topic,locktopic,username,dateandtime,isbest,UbbList,PostBuyUser,GetMoneyType,signflag,ip from "&TotalUseTable&" Where AnnounceID="&ReplyID&" and postuserid=0")
Else
Set Rs=Dvbbs.Execute("select b.body,b.topic,b.locktopic,b.username,b.dateandtime,b.isbest,u.lockuser,u.UserGroupID,b.UbbList,b.PostBuyUser,b.GetMoneyType,b.signflag,b.ip from "&TotalUseTable&" b inner join [dv_user] u on b.postuserid=u.userid Where b.AnnounceID="&ReplyID)
End If
If Rs.EOF And Rs.BOF Then
Dvbbs.AddErrCode(48)
Else
If Request("guest") Then
postip="("&Split(rs("ip"),".")(0)&"."&Split(rs("ip"),".")(1)&".*.*)"
Else
lockuser=rs("lockuser")
End If
If lockuser=1 Or lockuser=2 Then
Content=""
ElseIf Rs("locktopic")=2 Or Rs("locktopic")=3 Then
Content=""
ElseIf (rs("isbest")=1 and Dvbbs.GroupSetting(41)="0")Then
Content=""
Else
Content=rs("body")
End If
PostBuyUser = Rs("PostBuyUser")
If Rs("GetMoneyType")=3 and Instr(PostBuyUser,"|||$PayMoney|||") Then
If Instr(PostBuyUser,"|||"&Dvbbs.MemberName&"|||")=0 Then
Content=""
End If
End If
Topic=Rs("topic")
UserName=rs("username")
DateAndTime=rs("dateandtime")
UbbLists=Rs("UbbList")
If UserName = Dvbbs.membername Then
If Cint(Dvbbs.GroupSetting(4))=0 Then Dvbbs.AddErrCode(73)
Else
If Cint(Dvbbs.GroupSetting(2))=0 Then Dvbbs.AddErrCode(31)
End If
If Rs("signflag")=2 And Dvbbs.Board_Setting(68)="1" Then
UserName="匿名用户"
postip="("&Split(rs("ip"),".")(0)&Split(rs("ip"),".")(1)&")"
End If
UserName=UserName&postip
End If
Set Rs=Nothing
Dvbbs.ShowErr()
If Topic <> "" Then
Topic = Replace(template.Strings(31),"{$UserName}",UserName) & Topic
Else
Topic = Replace(template.Strings(31),"{$UserName}",UserName) & Content
End If
Topic=cutStr(Topic,50)
Topic=Replace(Replace(Replace(Replace(Topic,"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
If Request("reply")="true" and Content<>"" Then
Content = reubbcode(Content)
Content = Ubb2Html(Content)
If Dvbbs_Mode=2 Then
Content = "[quote][B]以下是引用[I]"&UserName&"[/I]在"&DateAndTime&"的发言：[/B][BR]"& Content & "[/QUOTE]"
Else
Content = "以下是引用"&UserName&"在"&DateAndTime&"的发言：
"& Content & "
"
End If
Content = Server.HtmlEncode(Content)
Else
Content = ""
End If
If GetMoneyType<>3 Then '购买金币贴不显示回复
'主题跟贴部分信息
Dim PostUserGroup,TempStr1,TempStr2,TempStr3
TempStr1 = Replace(template.html(7),"{$width}",Dvbbs.mainsetting(0)) '
Set Rs=Dvbbs.Execute("Select top 10 b.UserName,b.Topic,b.dateandtime,b.body,b.AnnounceID,b.isbest,u.lockuser,u.UserGroupID,b.postbuyuser,b.ubblist,b.IsAudit,b.locktopic,b.signflag,b.ip,b.postuserid from "&TotalUseTable&" b left outer join [dv_user] u on b.postuserid=u.userid where b.boardid="&Dvbbs.boardid&" and b.RootID="&AnnounceID&" order by b.AnnounceID desc")
Do While Not Rs.EOF
If Rs("postuserid")=0 Then
postip="("&Split(rs("ip"),".")(0)&"."&Split(rs("ip"),".")(1)&".*.*)"
lockuser=0
PostUserGroup=7
Else
postip=""
lockuser=rs("lockuser")
PostUserGroup=rs("UserGroupID")
End If
TempStr2 = TempStr1
If Rs("signflag")=2 Then
If Dvbbs.Boardmaster Then
UserName = Rs("UserName")&" (匿名)"
Else
UserName = "匿名用户"
End If
Else
UserName = Rs("UserName")
End If
postbuyuser=rs("postbuyuser")
UbbLists=Rs("UbbList")
If bgcolor="tablebody1" Then
bgcolor="tablebody2"
abgcolor="tablebody1"
Else
bgcolor="tablebody1"
abgcolor="tablebody2"
End If
UserName=UserName&postip
TempStr2 = Replace(TempStr2,"{$tablebody}",bgcolor)
TempStr2 = Replace(TempStr2,"{$username}",Dvbbs.HtmlEncode(UserName))
TempStr2 = Replace(TempStr2,"{$dateandtime}",Rs("DateAndTime"))
If lockuser=2 or Rs("locktopic")=2 Then
TempStr2 = Replace(TempStr2,"{$body}",template.Strings(10))
ElseIf lockuser=1 Then
TempStr2 = Replace(TempStr2,"{$body}",template.Strings(11))
ElseIf Rs("isbest")=1 and Dvbbs.GroupSetting(41)="0" Then
TempStr2 = Replace(TempStr2,"{$body}",template.Strings(12))
Else
If InStr(Ubblists,",39,") > 0 Then
TempStr2 = Replace(TempStr2,"{$body}",dv_ubb.Dv_UbbCode(Rs("body"),PostUserGroup,1,0))
Else
TempStr2 = Replace(TempStr2,"{$body}",dv_ubb.Dv_UbbCode(Rs("body"),PostUserGroup,1,1))
End If
End If
TempStr2 = Replace(TempStr2,"{$topic}",Dvbbs.HtmlEncode(Rs("Topic")))
TempStr3 = TempStr3 & TempStr2
Rs.MoveNext
Loop
Rs.close
Set Rs=Nothing
End If
Get_Re_TopicInfo = TempStr3
End Function
'取得编辑贴页面信息
Public Function Get_Edit_TopicInfo()
Get_M_Request()
ReplyID = Request("replyid")
If ReplyID = "" Or Not IsNumeric(ReplyID) Then Dvbbs.AddErrCode(30)
Dvbbs.ShowErr()
ReplyID = Clng(ReplyID)
Set Rs=Dvbbs.Execute("select PostTable,TopicMode,Expression from dv_topic where TopicID="&AnnounceID)
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(48)
Else
TotalUseTable = Rs(0)
MyTopicMode = Rs(1)
iMagicFace = Split(Rs(2),"|")
If Ubound(iMagicFace) = 1 Then FoundUseMagic = iMagicFace(0)
Rem 旧帖的主题模式值可能为空，则需要加入判断。2004-5-6 Dvbbs.YangZheng
If Isnull(MyTopicMode) Or MyTopicMode = "" Then MyTopicMode = 0
End If
Rs.close
If FoundUseMagic > 0 Then
Set Rs = Dvbbs.Plus_Execute("Select tMoney,tTicket From Dv_Plus_Tools_MagicFace Where MagicFace_s = " & FoundUseMagic)
If Rs.Eof And Rs.Bof Then
FoundUseMagic = 0
Else
tMagicMoney = Rs(0)
tMagicTicket = Rs(1)
End If
Rs.Close
End If
Get_Edit_PermissionInfo()
If Content<>"" then
Dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern=vbNewLine&"
(.|\n)*<\/font><\/div>"
Content=re.Replace(Content,"")
re.Pattern=vbNewLine&"\[align=right\]\[color=#000066\](.|\n)*\[\/color\]\[\/align\]"
Content=re.Replace(Content,"")
re.Pattern="(.|\n)*<\/font><\/div>"
Content=re.Replace(Content,"")
re.Pattern="\[align=right\]\[color=#000066\](.|\n)*\[\/color\]\[\/align\]"
Content=re.Replace(Content,"")
're.Pattern="\[i\](.*)\[\/i\]"
'Content=re.Replace(Content,"$1")
set re=Nothing
Content=Ubb2Html(Content)
Content=Server.htmlencode(Content)
End If
End Function
'判断用户是否有编辑权限且提取相关信息
Public Function Get_Edit_PermissionInfo()
Dim old_user
If Action = 4 Then
Set Rs=Dvbbs.Execute("select b.username,b.topic,b.body,b.dateandtime,u.UserGroupID,b.signflag,b.emailflag,b.UbbList,b.Expression,b.UseTools from "&TotalUseTable&" b left outer join [dv_user] u on b.postuserid=u.userid where b.RootID="&AnnounceID&" and b.AnnounceID="&ReplyID)
Else
Set Rs=Dvbbs.Execute("select b.username,b.topic,b.body,b.dateandtime,u.UserGroupID,b.signflag,b.emailflag,b.UbbList,b.Expression,b.UseTools from "&TotalUseTable&" b left outer join [dv_user] u on b.postuserid=u.userid where b.RootID="&RootID&" and b.AnnounceID="&AnnounceID)
End If
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(48)
Else
Notanony=InStr(Rs("UseTools"),"17")
Expression=Rs("Expression")
If Action = 4 Then
signflag=Rs("signflag")
mailflag=Rs("emailflag")
Topic=rs("topic")
If Topic<>"" Then Topic = Server.HtmlEncode(Topic)
topic=Replace(topic,"amp;","")
Content=rs("body")
old_user=rs("username")
UbbLists=rs("UbbList")
Else
If Clng(Dvbbs.forum_setting(50))>0 then
If Datediff("s",rs("dateandtime"),Now())>Clng(Dvbbs.forum_setting(50))*60 then
Content = Content+chr(13)+chr(10)+char_changed+chr(13)
Else
Content = Content
End If
Else
Content = Content+chr(13)+chr(10)+char_changed+chr(13)
End If
End If
If Clng(Dvbbs.forum_setting(51))>0 and not (Dvbbs.master or Dvbbs.boardmaster or Dvbbs.superboardmaster) Then
If DateDiff("s",rs("dateandtime"),Now())>Clng(Dvbbs.forum_setting(51))*60 then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes="&Replace(Replace(template.Strings(22),"{$posttime}",Datediff("s",rs("dateandtime"),Now())/60),"{$etlimited}",Dvbbs.forum_setting(51))&"&action=OtherErr"
End If
If Rs("username")=Dvbbs.membername Then
If Dvbbs.GroupSetting(10)="0" then
Dvbbs.AddErrCode(74)
CanEditPost=False
Else
CanEditPost=True
End If
Else
If (Dvbbs.master or Dvbbs.superboardmaster or Dvbbs.boardmaster) and Dvbbs.GroupSetting(23)="1" then
CanEditPost=True
Else
CanEditPost=False
End If
If Cint(Dvbbs.UserGroupID) > 3 And Dvbbs.GroupSetting(23)="1" Then CanEditPost=true
If Dvbbs.GroupSetting(23)="1" and Dvbbs.founduserPer Then
CanEditPost=True
ElseIf Dvbbs.GroupSetting(23)="0" And Dvbbs.founduserPer Then
CanEditPost=False
End If
If Cint(Dvbbs.UserGroupID) < 4 And Cint(Dvbbs.UserGroupID) = rs("UserGroupID") Then
Dvbbs.AddErrCode(75)
ElseIf Cint(Dvbbs.UserGroupID) < 4 and Cint(Dvbbs.UserGroupID) > rs("UserGroupID") Then
Dvbbs.AddErrCode(76)
End If
If Not CanEditPost Then Dvbbs.AddErrCode(77)
End If
End If
Set Rs=Nothing
Dvbbs.ShowErr()
If Action = 4 Then Dvbbs.MemberName=old_user
End Function
'返回判断和参数
Public Function Get_M_Request()
AnnounceID = Request("ID")
If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
Dvbbs.ShowErr()
AnnounceID = Clng(AnnounceID)
End Function
'只读，获得回复隐含Input模板
Public Property Get Re_HiddenInput()
Re_HiddenInput = template.html(4)
Re_HiddenInput = Replace(Re_HiddenInput,"{$announceid}",AnnounceID)
Re_HiddenInput = Replace(Re_HiddenInput,"{$replyid}",ReplyID)
End Property
'只读，获得编辑隐含Input模板
Public Property Get Edit_HiddenInput()
Edit_HiddenInput = template.html(5)
Edit_HiddenInput = Replace(Edit_HiddenInput,"{$announceid}",AnnounceID)
Edit_HiddenInput = Replace(Edit_HiddenInput,"{$replyid}",ReplyID)
End Property
'只读，获得上传表单模板
Public Property Get Temp_FileUpload()
Dim TempArray,TempStr1
Temp_FileUpload = template.html(2)
TempArray = Split(Dvbbs.Board_Setting(19),"|")
For i = 0 To Ubound(TempArray)
TempStr1 = TempStr1 & ""
Next
Temp_FileUpload = Replace(Temp_FileUpload,"{$uploadlist}",TempStr1)
End Property
'只读，获得UBB模板
Public Property Get Temp_UBB()
Dim TempArray
Temp_UBB = template.html(3)
TempArray = Split(template.html(9),"|")
For i = 1 To Ubound(TempArray)
Temp_UBB = Replace(Temp_UBB,"{$ubb"&i&"}",TempArray(0) & TempArray(i))
Next
End Property
'只读，获得UBB——HTML编辑器模板
Public Property Get Temp_UBBHTML()
Dim TempArray
Temp_UBBHTML = template.html(11)
Temp_UBBHTML=Replace(Temp_UBBHTML,"{$old_oldToolbars}",Temp_UBB)
End Property
End Class
'截取指定字符
Function cutStr(str,strlen)
'去掉所有HTML标记
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<(.[^>]*)>"
str=re.Replace(str,"")
set re=Nothing
Dim l,t,c,i
l=Len(str)
t=0
For i=1 to l
c=Abs(Asc(Mid(str,i,1)))
If c>255 Then
t=t+2
Else
t=t+1
End If
If t>=strlen Then
cutStr=left(str,i)&"..."
Exit For
Else
cutStr=str
End If
Next
cutStr=Replace(cutStr,chr(10),"")
cutStr=Replace(cutStr,chr(13),"")
End Function
'过滤不必要UBB
Function reUBBCode(strContent)
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="<\/div>"
strContent=re.Replace(strContent,Chr(2))
re.Pattern="以下是引用"
strContent=re.Replace(strContent,Chr(1))
re.Pattern="([^\x01\x02]*)\x02"
Do While re.Test(strContent)
strContent=re.Replace(strContent,"[quote]$1[/quote]")
Loop
re.Pattern="\x01[^\x02]*\x02"
strContent=re.Replace(strContent,"")
re.Pattern="\[quote\]((?:.|\n)*?)\[\/quote\]"
Do While re.Test(strContent)
strContent=re.Replace(strContent,"
$1
")
Loop
re.Pattern="\x02"
strContent=re.Replace(strContent,"
(?:.|\n)*?<\/font><\/div>"
strContent=re.Replace(strContent,"")
re.Pattern="\[align=right\]\[color=#000066\](?:.|\n)*?\[\/color\]\[\/align\]"
strContent=re.Replace(strContent,"")
' re.Pattern="(\[QUOTE\])(.|\n)*?(\[\/QUOTE\])"
' strContent=re.Replace(strContent,"$2")
re.Pattern="\[point=*([0-9]*)\](?:.|\n)*?\[\/point\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[post=*([0-9]*)\](?:.|\n)*?\[\/post\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[power=*([0-9]*)\](?:.|\n)*?\[\/power\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[usercp=*([0-9]*)\](?:.|\n)*?\[\/usercp\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[money=*([0-9]*)\](?:.|\n)*?\[\/money\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[replyview\](?:.|\n)*?\[\/replyview\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[usemoney=*([0-9]*)\](?:.|\n)*?\[\/usemoney\]"
strContent=re.Replace(strContent,"")
re.Pattern="\[UserName=(.[^\[]*)\](?:.|\n)*?\[\/UserName\]"
strContent=re.Replace(strContent,"")
re.Pattern=" "
strContent=re.Replace(strContent," ")
re.Pattern="<\/I>"
strContent=re.Replace(strContent,"")
set re=Nothing
reUBBCode=strContent
End Function
'编辑时用（对旧数据兼容）
Function Ubb2Html(str)
If Str<>"" And Not IsNull(Str) Then
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(>)("&vbNewLine&")(<)"
Str=re.Replace(Str,"$1$3")
re.Pattern="(>)("&vbNewLine&vbNewLine&")(<)"
Str=re.Replace(Str,"$1$3")
If Dvbbs_Mode=2 Then
re.Pattern=" "
Str=re.Replace(Str," ")
Else
re.Pattern=vbNewLine
Str=re.Replace(Str,"
")
re.Pattern=" "
Str=re.Replace(Str," ")
re.Pattern=" "
Str=re.Replace(Str," ")
End If
re.Pattern="<\/I>"
Str=re.Replace(Str,"")
re.Pattern="<(\w+)(?: )+([^>]*)>"
Str = re.Replace(Str,"<$1 $2>")
If Request("reply")="true" Then
re.Pattern="以下是引用(?:.|\n)*<\/div>"
Str=re.Replace(Str,"")
re.Pattern="以下是引用(?:.|\n)*<\/div>"
Str=re.Replace(Str,"")
re.Pattern="\[quote\]以下是引用(?:.|\n)*\[\/quote\]"
Str=re.Replace(Str,"")
re.Pattern="\[quote\]\[b\]以下是引用(?:.|\n)*\[\/quote\]"
Str=re.Replace(Str,"")
End If
Set Re=Nothing
Ubb2Html = Str
Else
Ubb2Html = ""
End If
End Function
Function GetFormID()
Dim i,sessionid
sessionid = Session.SessionID
For i=1 to Len(sessionid)
GetFormID=GetFormID&Chr(Mid(sessionid,i,1)+97)
Next
End Function
%>