dvbbs v8.2论坛程序带回复发帖接口- 获取代码 -ET采集官方网站-自在工坊 EditorTools全自动无人值守采集软件

dvbbs v8.2论坛程序带回复发帖接口

前往检查接口

前往发布接口

前往回复接口

前往发布规则

检查接口说明

4、发布配置-文章检查网址处，可以如下填写：
　　http://您的网址/etchk.asp?topic=<%title%>&boardid=
　　注：使用大小写敏感的服务器的用户请注意网址大小写和网站文件一致

5、接口文件无须任何改动即可使用，如果你希望增加校验或其他功能，请仔细修改；

下载GBK检查接口文件

下载UTF-8检查接口文件

检查接口代码

<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"--> 
<%

'EditorTools文章采集发布助手
'----------------------------------
'文件名
'etchk.asp
'dvbbs8.2文章检查文件，请复制在论坛根目录使用，为保密，请自行修改文件名

'主要参数
'topic  主题标题
'boardid 论坛版块ID，可留空，若填写则限制检查范围为该版块

'如果需要进行用户名、密码校验，请自行填加相关代码。

'----------------------------------


dim title,Rs,SQL,BoardID,substr
 
 title=Dvbbs.Checkstr(trim(request("topic")))
 if title="" then
  response.Write("[err]标题不能为空[/err]")
  set dvbbs=nothing
  response.End()
 else
  substr="where title='"&title&"' "
 end if
 BoardID=Dvbbs.Checkstr(trim(request("boardid")))
 if BoardID<>"" then
  substr=substr&" and BoardID="&BoardID
 end if
 Set Rs=Server.CreateObject("Adodb.RecordSet")
 SQL="Select top 1 * From DV_topic "&substr
 If Not IsObject(Conn) Then ConnectionDatabase
 Rs.Open SQL,Conn,1,3
 if rs.eof then
  response.Write("[no]")
 else
  response.Write("[yes]")
 end if
 rs.close
 set dvbbs=nothing
 set rs=nothing
 response.End()

%>

发布接口说明

注：以下参数名后“=”号为示范取值而用，参数名本身不含“=”号；
　　固定取值的参数，可以在发布规则-参数取值中设置；
　　采集取值的参数项，请在发布规则-发布项中添加；

3、主要参数
　　username　　　　　　　会员名参数名
　　passwd　　　　　　　　密码参数名
　　topic　　　　　　　　主题标题参数名
　　body　　　　　　　　　内容参数名

4、附加参数
　　boardid=　　　　　　　版块编号(取值为您要发布的版面FID号)

5、可选参数
　　topicmode=　　　　　　专题编号，如论坛未设必选专题，可以不用）
　　signflag=　　　　　　签名显示方式，0：不显示，1：显示，2：匿名
　　GetPostType=　　　　　帖子类型，0：悬赏金币帖，1：获赠金币帖
　　ToMoney=　　　　　　　金币数量

6、发布配置-文章检查网址处，可以如下填写：
　　http://您的网址/etpost.asp
　　注：使用大小写敏感的服务器的用户请注意网址大小写和网站文件一致

7、接口文件无须任何改动即可使用，如果你希望增加校验或其他功能，请仔细修改；

下载GBK发布接口文件

下载UTF-8发布接口文件

发布接口代码

<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<%
'!--#include file="inc/dv_clsother.asp"--

Rem 除首页外通用函数
'Dvbbs.Board_Setting(40)是否继承上级版主，顺带取出上级论坛版面信息
'最多只取向上的10级版面信息
'输出导航菜单字串
If Request("poststyle")="1" Then
    Dvbbs.ErrType=1
End If

Sub CheckBoardInfo()
    Dim parentstr,parentboard,XpathSQL,i,Maxdepth,Node,NavStr
    parentstr = Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@parentstr").text
    parentboard=Split(parentstr,",")
    If Dvbbs.UserID > 0 and Not Dvbbs.BoardMaster And CLng(Dvbbs.UserGroupID)=3 Then
        If Dvbbs.Board_Setting(40)="1" And Dvbbs.BoardParentID > 0 Then
            For i=0 to UBound(parentboard)
                If parentboard(i) <> "0" Then XpathSQL=XpathSQL &" or @boardid = " & parentboard(i)
            Next
        End If
        XpathSQL="boardmaster[@boardid = "& Dvbbs.Boardid & XpathSQL &"]/master[ . ='"& Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@username").text &"']"
        Dvbbs.BoardMaster=Not Application(Dvbbs.CacheName&"_boardmaster").documentElement.selectSingleNode(XpathSQL) Is Nothing
    End If
    If Dvbbs.BoardParentID > 0 Then
        Maxdepth=9
        If Ubound(parentboard) < Maxdepth+1 Then
            Maxdepth=Ubound(parentboard)
        End If
        For i=0 to Maxdepth
            If parentboard(i) <> "0"  Then
                Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& parentboard(i) &"']")
                If Node Is Nothing Then Exit For
                If i=0 Then
                        NavStr=" <a href=""index.asp?boardid="& parentboard(i) &""" onmouseover=""showmenu(event,BoardJumpList("&Node.selectSingleNode("@boardid").text&"),'',0);"">"& Node.selectSingleNode("@boardtype").text &"</a> "
                    Else
                        NavStr=NavStr& "→ <a href=""index.asp?boardid="& parentboard(i) &""">"& Node.selectSingleNode("@boardtype").text &"</a> "
                    End If
            End If
        Next
    End If
    Dvbbs.BoardInfoData=NavStr
    GetBoardPermission()
End Sub
Sub GetBoardPermission()
    Dim Rs,IsGroupSetting
    If Not Application(Dvbbs.CacheName &"_boarddata_" & Dvbbs.Boardid).documentElement.selectSingleNode("boarddata/@isgroupsetting") is nothing Then IsGroupSetting = Application(Dvbbs.CacheName &"_boarddata_" & Dvbbs.Boardid).documentElement.selectSingleNode("boarddata/@isgroupsetting").text
    If IsGroupSetting <> ""  Then
        IsGroupSetting = "," & IsGroupSetting & ","
        If InStr(IsGroupSetting,"," & Dvbbs.UserGroupID & ",")>0 Then
            Set Rs=Dvbbs.Execute("Select PSetting From Dv_BoardPermission Where Boardid="&Dvbbs.Boardid&" And GroupID="&Dvbbs.UserGroupID)
            If Not (Rs.Eof And Rs.Bof) Then
                Dvbbs.GroupSetting = Split(Rs(0),",")
            End If
            Set Rs=Nothing
        End If
        If Dvbbs.UserID>0 And InStr(IsGroupSetting,",0_"&Dvbbs.UserID&",")>0 Then
            Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid="&Dvbbs.BoardID&" And uc_UserID="&Dvbbs.Userid)
            If Not(Rs.Eof And Rs.Bof) Then
                Dvbbs.UserPermission=Split(Rs(0),",")
                Dvbbs.GroupSetting = Split(Rs(0),",")
                Dvbbs.FoundUserPer=True
            End If
            Set Rs=Nothing
        If Dvbbs.GroupSetting(70)="1"  Then
                Dvbbs.Master = True
            Else
                Dvbbs.Master = False
            End If
        End If
    End If
    If Not Dvbbs.BoardMaster Then Chkboardlogin()
End Sub
Rem 能否进入论坛的判断
Public Sub Chkboardlogin()
    If Dvbbs.Board_Setting(1)="1" And Dvbbs.GroupSetting(37)="0" Then Dvbbs.AddErrCode(26)
    If Dvbbs.GroupSetting(0)="0"  Then Dvbbs.AddErrCode(27)
    '访问论坛限制(包括文章、积分、金钱、魅力、威望、精华、被删数、注册时间)
    Dim BoardUserLimited
    BoardUserLimited = Split(Dvbbs.Board_Setting(54),"|")
    If Ubound(BoardUserLimited)=8 Then
        '文章
        If Trim(BoardUserLimited(0))<>"0" And IsNumeric(BoardUserLimited(0)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户发贴最少为 <B>"&BoardUserLimited(0)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)<Clng(BoardUserLimited(0)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户发贴最少为 <B>"&BoardUserLimited(0)&"</B> 才能进入&action=OtherErr"
        End If
        '积分
        If Trim(BoardUserLimited(1))<>"0" And IsNumeric(BoardUserLimited(1)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户积分最少为 <B>"&BoardUserLimited(1)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text)<Clng(BoardUserLimited(1)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户积分最少为 <B>"&BoardUserLimited(1)&"</B> 才能进入&action=OtherErr"
        End If
        '金钱
        If Trim(BoardUserLimited(2))<>"0" And IsNumeric(BoardUserLimited(2)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户金钱最少为 <B>"&BoardUserLimited(2)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text)<Clng(BoardUserLimited(2)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户金钱最少为 <B>"&BoardUserLimited(2)&"</B> 才能进入&action=OtherErr"
        End If
        '魅力
        If Trim(BoardUserLimited(3))<>"0" And IsNumeric(BoardUserLimited(3)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户魅力最少为 <B>"&BoardUserLimited(3)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text)<Clng(BoardUserLimited(3)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户魅力最少为 <B>"&BoardUserLimited(3)&"</B> 才能进入&action=OtherErr"
        End If
        '威望
        If Trim(BoardUserLimited(4))<>"0" And IsNumeric(BoardUserLimited(4)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户威望最少为 <B>"&BoardUserLimited(4)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text)<Clng(BoardUserLimited(4)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户威望最少为 <B>"&BoardUserLimited(4)&"</B> 才能进入&action=OtherErr"
        End If
        '精华
        If Trim(BoardUserLimited(5))<>"0" And IsNumeric(BoardUserLimited(5)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户精华最少为 <B>"&BoardUserLimited(5)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userisbest").text)<Clng(BoardUserLimited(5)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户精华最少为 <B>"&BoardUserLimited(5)&"</B> 才能进入&action=OtherErr"
        End If
        '删贴
        If Trim(BoardUserLimited(6))<>"0" And IsNumeric(BoardUserLimited(6)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户被删贴少于 <B>"&BoardUserLimited(6)&"</B> 才能进入&action=OtherErr"
            If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text)>Clng(BoardUserLimited(6)) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户被删贴少于 <B>"&BoardUserLimited(6)&"</B> 才能进入&action=OtherErr"
        End If
        '注册时间
        If Trim(BoardUserLimited(7))<>"0" And IsNumeric(BoardUserLimited(7)) Then
            If Dvbbs.UserID = 0 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户注册时间大于 <B>"&BoardUserLimited(7)&"</B> 分钟才能进入&action=OtherErr"
            If DateDiff("s",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now)<Clng(BoardUserLimited(7))*60 Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本版面设置了用户注册时间大于 <B>"&BoardUserLimited(7)&"</B> 分钟才能进入&action=OtherErr"
        End If
        
    End If
    '认证版块判断Board_Setting(2)
'    If Dvbbs.Board_Setting(2)="1" Then
'        Dim Get_BoardUser_Money,Canlogin,Boarduser,i,BoardUser_Money
'        Get_BoardUser_Money = False
'        If Clng(Dvbbs.Board_Setting(62))>0 Or Clng(Dvbbs.Board_Setting(63))>0 Then Get_BoardUser_Money = True
'            Canlogin = False
'        If Dvbbs.UserID=0 Then
'            Dvbbs.AddErrCode(24)
'            Dvbbs.showerr()
'        Else
'            If Not Application(Dvbbs.CacheName &"_boarddata_" & Dvbbs.Boardid).documentElement.selectSingleNode("boarddata/@boarduser") Is Nothing Then boarduser=Application(Dvbbs.CacheName &"_boarddata_" & Dvbbs.Boardid).documentElement.selectSingleNode("boarddata/@boarduser").text
'            If Boarduser=""  Then    
'                Canlogin = False
'            Else
'                Boarduser=Split(Boarduser,",")
'                For i = 0 To Ubound(Boarduser)
'                    If Get_BoardUser_Money Then
'                        BoardUser_Money = Split(Boarduser(i),"=")
'                        If Trim(Lcase(BoardUser_Money(0))) = Trim(Lcase(Dvbbs.MemberName)) Then
'                            '修改判断支付金币或点券进入版面的有效期 2004-8-29 Dv.Yz
'                            If Not DateDiff("d",BoardUser_Money(1),Now()) > Cint(Dvbbs.Board_Setting(64))*30 Then
'                                Canlogin = True
'                                Exit For
'                            End If
'                        End If
'                    Else
'                        If Trim(Lcase(Boarduser(i))) = Trim(Lcase(Dvbbs.MemberName)) Then
'                            Canlogin = True
'                            Exit For
'                        End If
'                    End If
'                Next
'            End If
'        End If
'        If Get_BoardUser_Money And Instr(Lcase(Dvbbs.ScriptName),"pay_boardlimited")=0 And (Not Canlogin) Then Response.Redirect "pay_boardlimited.asp?boardid=" & Dvbbs.BoardID
'        If Instr(Lcase(Dvbbs.ScriptName),"pay_boardlimited")=0 And (Not Canlogin) Then
'            Dvbbs.AddErrCode(25)    
'        End If
'    End If
'    Dvbbs.showerr()
End Sub
'得到论坛文字广告位部分内容,PageID=0为首页,=1为帖子列表页面,=2为帖子内容页面
Rem 论坛文字广告已经由 Sub 改为 Function 需要Response.Write 输出 2007-10-10 By Dv.唧唧
Function GetForumTextAd(PageID)
    If Dvbbs.Forum_ads(12) = "1" Then
         Select Case PageID
            Case 0
                
            Case 1
                If Not(Dvbbs.Forum_ads(15) = "0" Or Dvbbs.Forum_ads(15) = "2") Then Exit Function
            Case 2
             If Not((Dvbbs.Forum_ads(15) = "1" Or Dvbbs.Forum_ads(15) = "2")) Or (Dvbbs.Forum_ads(15) = "3") Then Exit Function
            Case Else
                Exit Function    
         End Select
         Dvbbs.Name = "Text_ad_"&Dvbbs.BoardID&"_"& Dvbbs.SkinID
        If Dvbbs.ObjIsEmpty() Then LoardTextAd()
        GetForumTextAd =  Dvbbs.Value
    End If    
End Function
Sub LoardTextAd()
    Dim XmlAds,Adstext,textvalue,XMLStyle,proc
        If IsObject(Application(Dvbbs.CacheName & "_TextAdservices")) Then
            Set XmlAds=Application(Dvbbs.CacheName & "_TextAdservices").cloneNode(True)
        Else
            Set XmlAds=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
            XmlAds.appendChild(XmlAds.createElement("xml"))
        End If
    Adstext=split(Dvbbs.Forum_ads(16),"#####")
    If Dvbbs.Forum_ads(17)="" Or Not IsNumeric(Dvbbs.Forum_ads(17)) Then  Dvbbs.Forum_ads(17)=4
    Dvbbs.Forum_ads(17)=Abs(Dvbbs.Forum_ads(17))
    If Dvbbs.Forum_ads(17)=0 Then Dvbbs.Forum_ads(17)=4
    XmlAds.documentElement.attributes.setNamedItem(XmlAds.createNode(2,"tdcount","")).text=Dvbbs.Forum_ads(17)
    For Each textvalue In adstext
        XmlAds.documentElement.appendChild(XmlAds.createNode(1,"text","")).text=textvalue
    Next
    If not IsObject(Application(Dvbbs.CacheName & "_showtextads_"& Dvbbs.SkinID)) Then
        Set Application(Dvbbs.CacheName & "_showtextads_"& Dvbbs.SkinID)=Dvbbs.iCreateObject("Msxml2.XSLTemplate" & MsxmlVersion)
        Set XMLStyle=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument"  & MsxmlVersion)
        XMLStyle.loadxml Dvbbs.mainhtml(22)
        Application(Dvbbs.CacheName & "_showtextads_"& Dvbbs.SkinID).stylesheet=XMLStyle
    End If
    Set proc = Application(Dvbbs.CacheName & "_showtextads_"& Dvbbs.SkinID).createProcessor()
    proc.input = XmlAds
  proc.transform()
  Dvbbs.Name = "Text_ad_"&Dvbbs.BoardID&"_"& Dvbbs.SkinID
  Dvbbs.Value=proc.output
  Set XmlAds=Nothing 
  Set proc=Nothing
End Sub
Sub LoadBoardNews_Paper()
    Dim Rs,node
    Set Rs=Dvbbs.Execute("select S_ID,S_BoardID,S_UserName,S_Title,S_Addtime From Dv_Smallpaper Order By S_ID DESC")
    If Not Rs.EOF Then
        Set Application(Dvbbs.CacheName & "_smallpaper")=Dvbbs.RecordsetToxml(rs,"smallpaper","xml")
        For Each Node in Application(Dvbbs.CacheName & "_smallpaper").documentElement.SelectNodes("smallpaper")
            Node.selectSingleNode("@s_username").text=Dvbbs.ChkBadWords(Node.selectSingleNode("@s_username").text)
            Node.selectSingleNode("@s_title").text=Server.HTMLEnCode(Dvbbs.ChkBadWords(Node.selectSingleNode("@s_title").text))
        Next
    Else
        Set Application(Dvbbs.CacheName & "_smallpaper")=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion)
        Application(Dvbbs.CacheName & "_smallpaper").appendChild(Application(Dvbbs.CacheName & "_smallpaper").createElement("xml"))
    End If
End Sub


%>
<!--#include file="inc/md5.asp"-->
<!--#include file="inc/ubblist.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<!--#include file="inc/dv_ubbcode.asp"-->
<!--#include file="inc/code_encrypt.asp"-->
<%
Dim parameter

'以下定义的变量在Dv_ubbcode.asp页面会用到
Dim replyid_a,AnnounceID,TotalUseTable,AnnounceID_a,RootID_a
Dim T_GetMoneyType,EmotPath
Dim UserName:UserName=Dvbbs.Membername
Dim IsThisBoardMaster '确定当前用户是否本版版主，防止下面的操作影响到 Dvbbs.BoardMaster导致出错
IsThisBoardMaster = Dvbbs.BoardMaster
Dim PostStyle,ajaxPost
PostStyle = Request.Form("poststyle")
'ajaxPost = CInt(Request.Form("ajaxPost"))
'
'If ajaxPost=1 Then
'    ajaxPost = True
'Else
    ajaxPost = False
'End If

If Dvbbs.BoardID < 1 Then
    Response.Write "[err]BoardID参数错误[/err]"    'zzcity add
    'Response.Write "参数错误"
    Dvbbs.PageEnd()
    Response.End
End If

Dim MyPost
Dim postbuyuser,bgcolor,abgcolor,FormID
Dvbbs.Loadtemplates("post")
Set MyPost = New Dvbbs_Post
Dvbbs.Stats = MyPost.ActionName
'EmotPath=Split(Dvbbs.Forum_emot,"|||")(0)        'em心情路径
'If Not ajaxPost Then
'    If PostStyle = "1" Then
'        Dvbbs.Head()
'        Dvbbs.ErrType=1
'    Else
'        Dvbbs.Nav()
'        Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"",""
'    End If
'End if
MyPost.Save_CheckData
Set MyPost = Nothing
'If Not ajaxPost Then Dvbbs.Footer
Dvbbs.PageEnd()
Class Dvbbs_Post
    Public Action,ActionName,Star,Page,IsAudit,ToAction,TopicMode,Reuser
    Private ReplyID,ParentID,RootID,Topic,Content,char_changed,signflag,mailflag,iLayer,iOrders
    Private TopTopic,IsTop,LastPost,LastPost_1,UpLoadPic_n,ihaveupfile,smsuserlist,upfileinfo
    Private UserName,UserPassWord,UserPost,GroupID,UserClass,DateAndTime,DateTimeStr,Expression,MyLastPostTime,LastPostTimes
    Private LockTopic,MyLockTopic,MyIsTop,MyIsTopAll,MyTopicMode,Child
    Private CanLockTopic,CanTopTopic,CanTopTopic_a,CanEditPost,Rs,SQL,i,IsAuditcheck
    Private vote,votetype,votenum,votetimeout,voteid,isvote,ErrCodes
    Private GetPostType,ToMoney,UseTools,ToolsBuyUser,GetMoneyType,Tools_UseTools,Tools_LastPostTime,ToolsInfo,ToolsSetting
    Private tMagicFace,iMagicFace,tMagicMoney,tMagicTicket,FoundUseMagic,isAlipayTopic
    Private Sub Class_Initialize()

        ErrCodes = ""
        Dvbbs.ErrCodes=""
        '管理员及该版版主允许在锁定论坛发帖
'        If Dvbbs.Board_Setting(0)="1" And Not (Dvbbs.Master or Dvbbs.Boardmaster) Then
'            If ajaxpost Then
'                Call showAjaxMsg(0,"锁定论坛，只对管理员及该版版主开放！","","")
'            Else
'                parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&action=lock&boardid="&dvbbs.boardID&""
'                Response.redirect parameter
'            End If
'        End If
'        If Dvbbs.IsReadonly()  And Not Dvbbs.Master Then
'            If ajaxpost Then
'                Call showAjaxMsg(0,"论坛只读，只对管理员开放！","","")
'            Else
'                parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&action=readonly&boardid="&dvbbs.boardID&""
'                Response.redirect parameter
'            End If
'        End If
'        Action = Request("Action")
        Action = "snew"    'zzcity add
        TotalUseTable = Dvbbs.NowUseBBS
'        Select Case Action
'        Case "snew"
            Action = 5
            ActionName = template.Strings(1)
'            If Dvbbs.GroupSetting(3)="0" Then Dvbbs.AddErrCode(70)
'        Case "sre"
'            Action = 6
'            ActionName = template.Strings(3)
'            'If Dvbbs.GroupSetting(5)="0" then Dvbbs.AddErrCode(71)
'        Case "svote"
'            Action = 7
'            ActionName = template.Strings(5)
'            If Dvbbs.GroupSetting(8)="0" then Dvbbs.AddErrCode(56)
'        Case "sedit"
'            Action = 8
'            ActionName = template.Strings(7)
'        Case Else
'            Action = 1
'            ActionName = template.Strings(0)
'        End Select
        Star = Request("star")
        If Star = "" Or Not IsNumeric(Star) Then Star = 1
        Star = Clng(Star)
        Page = Request("page")
        If Page = "" Or Not IsNumeric(Page) Then Page = 1
        Page = Clng(Page)
        'IsAudit = Cint(Dvbbs.Board_Setting(3))
        IsAudit=0
        Reuser = False    '此变量标识是否更名发贴
        FoundUseMagic = False
    End Sub

    Public Function CheckFormID(id)
        CheckFormID=false
        Dim i,Str
        For i=1 to Len(id)
            Str=Str & Asc(Mid(id,i,1))-97
        Next
        If Session.SessionID=Str Then
            CheckFormID=True
        End If
    End Function

    Rem 改写ShowErr过程 ajax模式下 不跳转 By Dv.唧唧  于 火星
'    Sub ShowErr("")
    Sub ShowErr(ErrCodes)

'        If ajaxpost And Dvbbs.ErrCodes<>"" Then
'            Call showAjaxMsg(0,getErrCodeMsg(),"","")
'        Else
'            Dvbbs.ShowErr()
'        End If
        if ErrCodes<>"" then'zzcity add    
            Response.Write "[err]"&ErrCodes&"[/err]"    
            Dvbbs.PageEnd()
            response.End()
        elseif Dvbbs.ErrCodes<>"" then
            Response.Write "[err]"&Dvbbs.ErrCodes&"[/err]"    
            Dvbbs.PageEnd()
            response.End()
        end if
    End Sub

    '通用判断
    Public Function Chk_Post()
        'FormID=Request("Dvbbs")
        'If FormID="" Then FormID=Request.Cookies("Dvbbs"):Response.Cookies("Dvbbs")=""
        'If Not CheckFormID(FormID) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=您提交的参数错误&action=OtherErr"
'        If Dvbbs.Board_Setting(43)="1" Then Dvbbs.AddErrCode(72)
'        If Dvbbs.Board_Setting(1)="1" and Dvbbs.GroupSetting(37)="0" Then Dvbbs.AddErrCode(26)
'        If Dvbbs.UserID>0 Then
'            If Clng(Dvbbs.GroupSetting(52))>0 And DateDiff("s",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now)<Clng(Dvbbs.GroupSetting(52))*60 Then
'                If ajaxPost Then
'                    Call showAjaxMsg(0,Replace(template.Strings(21),"{$timelimited}",Dvbbs.GroupSetting(52)),"","")
'                Else
'                    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(21),"{$timelimited}",Dvbbs.GroupSetting(52))&"&action=OtherErr"
'                    Response.redirect parameter
'                End if
'
'            End If
'            If Dvbbs.GroupSetting(62)<>"0" And Not Action = 8 Then
'                If Clng(Dvbbs.GroupSetting(62))<=Clng(Dvbbs.UserToday(0)) Then
'                    If ajaxPost Then
'                        Call showAjaxMsg(0,Replace(template.Strings(27),"{$topiclimited}",Dvbbs.GroupSetting(62)),"","")
'                    Else
'                        parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(27),"{$topiclimited}",Dvbbs.GroupSetting(62))&"&action=OtherErr"
'                        Response.redirect parameter
'                    End if
'                End If
'            End If
'        End If
'        If Dvbbs.GroupSetting(3)="0" And (Action = 5 Or Action = 7) Then
'            If ajaxPost Then
'                Call showAjaxMsg(0,template.Strings(28),"","")
'            Else
'                Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&template.Strings(28)&"&action=OtherErr"
'            End if
'        End if
        'If Dvbbs.GroupSetting(5)="0" And (Action = 6) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&template.Strings(29)&"&action=OtherErr"
    End Function

    '返回判断和参数
    Public Function Get_M_Request()
        AnnounceID = Request("ID")
        If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
        if Dvbbs.ErrCodes<>"" then ShowErr("非法的帖子参数")
        AnnounceID = cCur(AnnounceID)
    End Function

    '检查提交来源
    Public Sub CheckfromScript()
'        If Not Dvbbs.ChkPost() Then Dvbbs.AddErrCode(16):ShowErr("")
'         'If CStr(Request.Cookies("Dvbbs"))=CStr(Dvbbs.Boardid) Then Dvbbs.AddErrCode(30):ShowErr("") '非法的贴子参数。
'         If (Not ChkUserLogin) And (Action = 5 Or Action = 6 Or Action = 7) And Dvbbs.UserID>0 Then Dvbbs.AddErrCode(12):ShowErr("")
    End Sub

    '判断发贴时间间隔
    Private Sub CheckpostTime()
        If Dvbbs.Board_Setting(30)="1"  Then
'            If IsDate(Session(Dvbbs.CacheName & "posttime"))  Then
'                If DateDiff("s",Session(Dvbbs.CacheName & "posttime"),Now())<CLng(Dvbbs.Board_Setting(31)) Then
'                    If ajaxPost Then
'                        Call showAjaxMsg(0,Replace(template.Strings(33),"{$PostTimes}",Dvbbs.Board_Setting(31)),"","")
'                    Else
'                        parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<Br>"+"<li>"&Replace(template.Strings(33),"{$PostTimes}",Dvbbs.Board_Setting(31))&"&action=OtherErr"
'                        Response.redirect parameter
'                    End if
'                End If
'            End If
            Session(Dvbbs.CacheName & "posttime")=Now()
        End If
    End Sub
    '检查用户身份
    Public Function ChkUserLogin()
         ChkUserLogin=False
         '取得发贴用户名和密码
'        If Dvbbs.UserID=0 Then
'            UserName="客人"
'        Else
'            If ajaxPost Then
'                UserName=Dvbbs.Checkstr(unescape(Request.Form("username")))
'            Else
                UserName=Dvbbs.Checkstr(Request.Form("username"))
'            End If
'        End If
        '校验用户名和密码是否合法
        If UserName="" Or Dvbbs.strLength(userName)>Cint(Dvbbs.Forum_setting(41)) Or Dvbbs.strLength(userName) < Cint(Dvbbs.Forum_setting(40)) Then Dvbbs.AddErrCode(17)
        if Dvbbs.ErrCodes<>"" then ShowErr("请输入您的用户名，请确认您输入的用户名长度是否符合论坛标准")    'zzcity add
        If Not IstrueName(UserName) Then Dvbbs.AddErrCode(18)
        if Dvbbs.ErrCodes<>"" then ShowErr("无效的用户名")    'zzcity add
'        If Action = 8 Then
'            '编辑贴子，检查用户身份
'            UserPassWord=Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("password")))
'            SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,TruePassWord From [Dv_User] Where UserID="&Dvbbs.UserID
'        Else
            '检查用户是否当前用户
'            If UserName<>Dvbbs.MemberName Then
                Reuser=True
                UserPassWord=Dvbbs.Checkstr(Trim(Request.Form("passwd")))
                UserPassWord=md5(UserPassWord,16)
                SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,userpassword,UserToday From [Dv_User] Where UserName='"&UserName&"' "
'            Else
'                UserPassWord=Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("password")))
'                SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,TruePassWord From [Dv_User] Where UserID="&Dvbbs.UserID
'            End If
'        End If
'        If Len(UserPassWord)<>16 AND Len(UserPassWord)<>32 Then Dvbbs.AddErrCode(18)
         Set Rs=Dvbbs.Execute(SQL)
         If Not Rs.EOF Then
'            If Not (UserPassWord<>rs(6) Or rs(5)=1 or rs(3)=5) Then
                '不允许使用马甲
'                If Dvbbs.UserID<>Rs(1) Then
'                    ChkUserLogin = False
'                Else
                    Dvbbs.UserID=Rs(1)
                    Dvbbs.UserToday=Split(Rs(7),"|")
                     UserPost=Rs(2)
                     GroupID=Rs(3)
                     userclass=Rs(4)
                     ChkUserLogin=True
'                End If
                Response.cookies("upNum")=0
'             Else
'                  Dvbbs.LetGuestSession()
'            End If
         End If
         Set Rs = Nothing
     End Function

    '判断发表类型及权限 GetPostType 0=赠送金币贴(求回复答案),1=获赠金币贴,2=金币购买贴
    Private Sub Chk_PostType()
        Dim ToolsID
        ToolsID = Trim(Request.Form("ToolsID"))
        GetPostType = Trim(Request.Form("GetPostType"))
        ToMoney = Trim(Request.Form("ToMoney"))
        If ToMoney="" or Not Isnumeric(ToMoney) Then ToMoney = 0
        If ToolsID="" or Not Isnumeric(ToolsID) Then
            ToolsID = ""
        Else
            ToolsID = Cint(ToolsID)
        End If
        ToMoney = cCur(ToMoney)
        UseTools = ""
        ToolsBuyUser = ""
        GetMoneyType = 0
        If Dvbbs.GroupSetting(59)<>1 Then Exit Sub
        If GetPostType<>"" and (Action = 5 or Action = 7) Then
            Select Case GetPostType
            Case "0"
                If ToMoney = 0 or ToMoney > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text)  Or ToMoney < 0 Then
'                    If ajaxpost Then
'                        Call showAjaxMsg(0,"您设置的金币值为空或者多于您拥有的金币数量。","","")
'                    Else
'                        Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
'                    End If
                    ShowErr("您设置的金币值为空或者多于您拥有的金币数量。")
                End if
                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  = CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text) -ToMoney
                'UseTools = "-1111"
                ToolsBuyUser = "0|||$SendMoney"
                GetMoneyType = 1
            Case "1"
                ToolsBuyUser = "0|||$GetMoney"
                GetMoneyType = 2
                'UseTools = ToolsInfo(4)
            Case "2"
                If ToMoney = 0 Or ToMoney < 0 Then
'                    If ajaxpost Then
'                        Call showAjaxMsg(0,"请正确填写购买帖的金币数量。","","")
'                    Else
'                        Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>请正确填写购买帖的金币数量。&action=OtherErr"
'                    End If
                    ShowErr("请正确填写购买帖的金币数量。")
                End if
                Dim Buy_Orders,Buy_VIPType,Buy_UserList
                Buy_Orders = Request.FORM("Buy_Orders")
                Buy_VIPType = Request.FORM("Buy_VIPType")
                Buy_UserList = Request.FORM("Buy_UserList")
                If Buy_Orders<>"" and IsNumeric(Buy_Orders) Then
                    Buy_Orders = cCur(Buy_Orders)
                Else
                    Buy_Orders = -1
                End If
                If Not IsNumeric(Buy_VIPType) Then Buy_VIPType = 0
                If Buy_UserList<>"" Then Buy_UserList = Replace(Replace(Replace(Buy_UserList,"|||",""),"@@@",""),"$PayMoney","")
                ToolsBuyUser = "0@@@"&Buy_Orders&"@@@"&Buy_VIPType&"@@@"&Buy_UserList&"|||$PayMoney|||"
                GetMoneyType = 3
                'UseTools = ToolsInfo(4)
            End Select
        End If
        '回复获赠金币帖判断
        If Action = 6 and GetPostType = "1" Then
            If ToMoney = 0 or ToMoney > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text)  Or ToMoney < 0 Then
'                If ajaxpost Then
'                    Call showAjaxMsg(0,"您设置的金币值为空或者多于您拥有的金币数量。","","")
'                Else
'                    Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
'                End If
                ShowErr("您设置的金币值为空或者多于您拥有的金币数量。")
            End If
        End If
    End Sub


    Rem ------------------------
    Rem 保存部分函数开始
    Rem ------------------------
    '检查数据,提取数据，获得贴子数据表名等。

    Public Sub Save_CheckData()
        'Chk_Post()
        'CheckfromScript()

        '把提交的数据保存到session
        'Content = CheckAlipay()
        call ChkUserLogin()
    
        isAlipayTopic = 2
        If Content = "" Then
            Content = Dvbbs.Checkstr(unescape(Request.Form("body")))
            isAlipayTopic = 0
        End If
        '不再把内容保存到session
        'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"postdata","")).text= Request.Form("body")

        '验证码校验
'        If Dvbbs.Board_Setting(4) <> "0" Then
'            If Not Dvbbs.CodeIsTrue() Then
'                If ajaxpost Then
'                    Call showAjaxMsg(0,"验证码校验失败,请点击验证码进行刷新！","","")
'                Else
'                    Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>验证码校验失败，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'                End If
'            End If
'        End If

        If InStr(Content,"[/payto]") > 0 And InStr(Content,"[payto]") > 0 And InStr(Content,"(/seller)") > 0 And InStr(Content,"(seller)") > 0 Then isAlipayTopic = 2
        Chk_PostType()

        '魔法表情检查部分
'        tMagicFace = Request("tMagicFace")
'        If tMagicFace = "" Or Not IsNumeric(tMagicFace) Then tMagicFace = 0
'        tMagicFace = Cint(tMagicFace)
'        iMagicFace = Request("iMagicFace")
'        If iMagicFace = "" Or Not IsNumeric(iMagicFace) Then iMagicFace = 0
'        iMagicFace = Clng(iMagicFace)
        Expression = Dvbbs.Checkstr(Request.Form("Expression"))
        If Expression = "" Then
            Expression = "face1.gif"
        Else
            Expression = Replace(Expression,"|","")
        End If
'        If tMagicFace = 1 And iMagicFace > 0 And Dvbbs.Forum_Setting(98)="1" Then
'            Set Rs = Dvbbs.Plus_Execute("Select tMoney,tTicket,MagicSetting From Dv_Plus_Tools_MagicFace Where MagicFace_s = " & iMagicFace)
'            If Rs.Eof And Rs.Bof Then
'                Expression = "0|" & Expression
'                tMagicMoney = 0
'                tMagicTicket = 0
'            Else
'                If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) < Rs(1) And cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) < Rs(0) Then
'                    If ajaxpost Then
'                        Call showAjaxMsg(0,"您没有足够的金币或点券使用魔法表情！","","")
'                    Else
'                        Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您没有足够的金币或点券使用魔法表情，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'                    End If
'                End if
'                Dim iMagicSetting, iMagicStr
'                iMagicStr = ""
'                iMagicSetting = Split(Rs(2),"|")
'                If cCur(iMagicSetting(0)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text ) Then iMagicStr ="您的帖子数"
'                If cCur(iMagicSetting(1)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) Then iMagicStr ="您的金钱数"
'                If cCur(iMagicSetting(2)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) Then iMagicStr ="您的经验数"
'                If cCur(iMagicSetting(3)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text ) Then iMagicStr ="您的魅力数"
'                If cCur(iMagicSetting(4)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text) Then iMagicStr ="您的威望数"
'
'                If iMagicStr<>"" Then
'                    If ajaxpost Then
'                        Call showAjaxMsg(0,iMagicStr&"没有达到使用魔法表情的标准，","","")
'                    Else
'                        Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&iMagicStr&"没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'                    End If
'                End If
'
'                Expression = iMagicFace & "|" & Expression
'                tMagicMoney = Rs(0)
'                tMagicTicket = Rs(1)
'                FoundUseMagic = True
'            End If
'            Rs.Close
'            Set Rs=Nothing
'        Else
            Expression = "0|" & Expression
'        End If
        Expression = Split(Expression,"|")
        Topic = Dvbbs.Checkstr(Trim(unescape(Request.Form("topic"))))
        signflag = Dvbbs.Checkstr(Trim(Request.Form("signflag")))
        mailflag = Dvbbs.Checkstr(Trim(Request.Form("emailflag")))
        MyTopicMode = Dvbbs.Checkstr(Trim(Request.Form("topicximoo")))
        MyLockTopic = Dvbbs.Checkstr(Trim(Request.Form("locktopic")))
        Myistop = Dvbbs.Checkstr(Trim(Request.Form("istop")))
        Myistopall = Dvbbs.Checkstr(Trim(Request.Form("istopall")))
        TopicMode = Request.Form("topicmode")

        If Dvbbs.strLength(topic)> CLng(Dvbbs.Board_Setting(45)) Then
'            If ajaxPost Then
'                Call showAjaxMsg(0,Replace(template.Strings(23),"{$topiclimited}",Dvbbs.Board_Setting(45)),"","")
'            Else
'                parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(23),"{$topiclimited}",Dvbbs.Board_Setting(45))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'                Response.redirect parameter
'            End If
            ShowErr("标题长度不能大于"&Dvbbs.Board_Setting(45)&"。")
        End If
        Rem 限制提交数据不能大于64K
        If Len(Content) > 64*1024*1024 Then
'            If ajaxPost Then
'                Call showAjaxMsg(0,"您提交的数据过大，提交数据不能大于64K.","","")
'            Else
'                parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您提交的数据过大，提交数据不能大于64K&action=OtherErr&autoreload=1"
'                Response.redirect parameter
'            End if
            ShowErr("您提交的数据过大，提交数据不能大于64K。")
        End If

        Rem 老迷增加xhtml格式限制
        Dim XMLPOST,XHTML
        XHTML=False
'        If XHTML Then
'            Set XMLPOST=Dvbbs.CreateXmlDoc("msxml2.DOMDocument"& MsxmlVersion)
'            If XMLPOST.loadxml("<xhtml>" & replace(Content,"&","&amp;") &"</xhtml>") Then
'                Content=replace(Mid(XMLPOST.documentElement.xml,8,Len(XMLPOST.documentElement.xml)-15),"&amp;","&")
'            Else
'                If ajaxPost Then
'                    Call showAjaxMsg(0,"您提交的数据不合法(必须提交XHTML格式).","","")
'                Else
'                    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您提交的数据不合法(必须提交XHTML格式)&action=OtherErr&autoreload=1"
'                    Response.redirect parameter
'                End if
'
'            End If
'            Set XMLPOST=Nothing
'        End If
        If Dvbbs.strLength(Content) > CLng(Dvbbs.Board_Setting(16)) Then
'            If ajaxPost Then
'                Call showAjaxMsg(0,Replace(template.Strings(24),"{$bodylimited}",Dvbbs.Board_Setting(16)),"","")
'            Else
'                Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(24),"{$bodylimited}",Dvbbs.Board_Setting(16))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'            End If
            ShowErr("帖子内容长度不能大于"&Dvbbs.Board_Setting(16)&"。")
        End If
        REM 2004-4-23添加限制帖子内容最小字节数,下次在模板中添加。Dvbbs.YangZheng
        If Dvbbs.strLength(Content) < CLng(Dvbbs.Board_Setting(52)) And Not CLng(Dvbbs.Board_Setting(52)) = 0 Then
'            If ajaxPost Then
'                Call showAjaxMsg(0,Replace(template.Strings(24),"大于{$bodylimited}","小于"&Dvbbs.Board_Setting(52)),"","")
'            Else
'                parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(24),"大于{$bodylimited}","小于"&Dvbbs.Board_Setting(52))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'                Response.redirect parameter
'            End if
            ShowErr("帖子内容长度不能小于"&Dvbbs.Board_Setting(52)&"。")
        End If
        Dim testContent
        '如果使用了非HTML编辑器，则替换换行标志以实现换行 by 雨·漫步
        If Dvbbs.GroupSetting(67) = 0 Then
            Content = Replace(Content,vbCrLf,"<br />")
        End If
        testContent=Content
        testContent=Replace(testContent,vbNewLine,"")
        testContent=Replace(testContent," ","")
        testContent=Replace(testContent,"&nbsp;","")
        'testContent=Trim(Dvbbs.Replacehtml(testContent))
        If testContent="" and InStr(Content,"<img")=0 and InStr(Content,"<input")=0 and InStr(Content,"<object")=0  and InStr(Content,"<embed")=0 Then
'            If ajaxpost Then
'                Call showAjaxMsg(0,"您没有填写内容,请填写帖子内容","","")
'            Else
'                Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您没有填写内容.2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'            End If
            ShowErr("您没有填写内容,请填写帖子内容。")
        End If
        If Dvbbs.UserID=0 Then
            mailflag=0:signflag=0
        Else
            If Not IsNumeric(mailflag) Or mailflag="" Then mailflag=0
            mailflag=CInt(mailflag)
            If Not IsNumeric(signflag) Or signflag="" Then signflag=1
            signflag=CInt(signflag)
        End If
        If TopicMode<>"" and IsNumeric(TopicMode) Then TopicMode=Cint(TopicMode) Else TopicMode=0
        If Request.form("upfilerename")<>"" Then
            ihaveupfile=1
            upfileinfo=Replace(Request.form("upfilerename"),"'","")
            upfileinfo=Replace(upfileinfo,";","")
            upfileinfo=Replace(upfileinfo,"--","")
            upfileinfo=Replace(upfileinfo,")","")
            Dim fixid,upfilelen
            fixid=Replace(upfileinfo," ","")
            fixid=Replace(fixid,",","")
            If Not IsNumeric(fixid) Then ihaveupfile=0
            upfilelen=len(upfileinfo)
            upfileinfo=left(upfileinfo,upfilelen-1)
        Else
            ihaveupfile=0
        End If
        voteid=0
        isvote=0
        Dim VoteTemp,VoteTemp1,VoteTemp2
'        If Action = 7 Then
'            votetype=Dvbbs.Checkstr(request.Form("votetype"))
'            If IsNumeric(votetype)=0 or votetype="" Then votetype=0
'            vote=Dvbbs.Checkstr(trim(Replace(request.Form("vote"),"|","")))
'            Dim j,k,vote_1,votelen,votenumlen
'            If vote="" Then
'                Dvbbs.AddErrCode(81)
'            Else
'                vote=split(vote,chr(13)&chr(10))
'                j=0
'                For i = 0 To ubound(vote)
'                    VoteTemp1 = ""
'                    VoteTemp2 = ""
'                    If Not (vote(i)="" Or vote(i)=" ") Then
'                        VoteTemp = Split(vote(i),"@@")
'                        If Ubound(VoteTemp) = 3 Then '判断是否调查
'                            If VoteTemp(1)="0" or VoteTemp(1)="1" Then
'                                VoteTemp1 = Split(VoteTemp(2),"$$")
'                                For k=0 to Ubound(VoteTemp1)-1
'                                    VoteTemp2 = VoteTemp2 & "0$$"
'                                Next
'                            Else
'                                VoteTemp2 = 0
'                            End If
'                            votenum= votenum & VoteTemp2&"|"
'                        Else
'                            votenum=votenum&"0|"
'                        End If
'                        vote_1=""&vote_1&""&vote(i)&"|"
'                        j=j+1
'                    End If
'                    If i>cint(Dvbbs.Board_Setting(32))-2 Then Exit For
'                Next
'                'For k = 1 to j
'                '    votenum=""&votenum&"0|"
'                'Next
'                votelen=len(vote_1)
'                votenumlen=len(votenum)
'                votenum=left(votenum,votenumlen-1)
'                vote=left(vote_1,votelen-1)
'                'Response.Write votenum
'                'Response.End
'            End If
'            If Not IsNumeric(request("votetimeout")) Then
'                Dvbbs.AddErrCode(82)
'            Else
'                If request("votetimeout")="0" Then
'                    votetimeout=dateadd("d",9999,Now())
'                Else
'                    votetimeout=dateadd("d",CCur(request("votetimeout")),Now())
'                End If
'                votetimeout=Replace(Replace(CSTR(votetimeout+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
'            End If
'        End If
        If Action = 5 Or Action = 7 Then
            CanLockTopic=False
            CanTopTopic=False
            CanTopTopic_a=False
            If Topic="" OR Replace(Topic&"","","")="" Then
'                If ajaxpost Then
'                    Call showAjaxMsg(0,"您是否忘记填写标题了？","","")
'                Else
'                    Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您忘记填写标题<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'                End If
                ShowErr("您忘记填写标题")
            End if
            '减少判断，如果不为固顶，锁定等等的操作的话，不检查权限。
'            If MyLockTopic="yes" Or Myistopall="yes" Or Myistop="yes" Then
'                '判断用户是否有固顶/解除固顶帖子权限
'                'If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) Then
'                If Dvbbs.GroupSetting(20)="1" Then CanLockTopic=True
'                'End If
'                If Dvbbs.GroupSetting(21)="1" Then CanTopTopic=True
'
'                'If Dvbbs.FoundUserPer and Dvbbs.GroupSetting(21)="1" Then
'                '    CanTopTopic=True
'                'ElseIf Dvbbs.FoundUserPer and Dvbbs.GroupSetting(21)="0" Then
'                '    CanTopTopic=False
'                'End If
'                '判断用户是否有总固顶帖子权限
'                If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Dvbbs.GroupSetting(38)="1" Then CanTopTopic_a=True
'                If Dvbbs.GroupSetting(38)="1" and Cint(Dvbbs.UserGroupID)>3 Then CanTopTopic_a=True
'                If Dvbbs.FoundUserPer and Dvbbs.GroupSetting(38)="1" Then
'                    CanTopTopic_a=True
'                ElseIf Dvbbs.FoundUserPer and Dvbbs.GroupSetting(38)="0" Then
'                    CanTopTopic_a=False
'                End If
'            End If
            If MyLockTopic="yes" Then
                MyLockTopic=1
            Else
                MyLockTopic=0
            End If
            If Myistopall="yes" Then
                Myistopall=1
            Else
                Myistopall=0
            End If
            If Not CanTopTopic_a Then Myistopall=0
            If Myistop="yes" and Myistopall=0 Then
                Myistop=1
                If Not CanTopTopic Then Myistop=0
            ElseIf Myistopall=1 Then
                Myistop=3
            Else
                Myistop=0
            End If
            If Not IsNumeric(MyTopicMode) or Dvbbs.GroupSetting(51)="0" Then MyTopicMode=0
            If Not CanLockTopic Then MyLockTopic=0
            TotalUseTable=Dvbbs.NowUseBbs
'        ElseIf Action = 6 Then
'            AnnounceID = Request("followup")
'            RootID = Request("RootID")
'            If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
'            If RootID = "" Or Not IsNumeric(RootID) Then Dvbbs.AddErrCode(30)
'            TotalUseTable=Request.Form("TotalUseTable")
'            TotalUseTable=checktable(TotalUseTable)
'            ShowErr("")
'            AnnounceID = cCur(AnnounceID)
'            ParentID = AnnounceID
'            RootID = cCur(RootID)
'            MyLockTopic=0
'        ElseIf Action = 8 Then
'            If Not IsNumeric(MyTopicMode) or Dvbbs.GroupSetting(51)="0" Then MyTopicMode=0
'            AnnounceID = Request("replyID")
'            RootID = Request("ID")
'            If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
'            If RootID = "" Or Not IsNumeric(RootID) Then Dvbbs.AddErrCode(30)
'            TotalUseTable = Checktable(Request.Form("TotalUseTable"))
'            ShowErr("")
'            AnnounceID = cCur(AnnounceID)
'            RootID = cCur(RootID)
'            MyLockTopic=0
'            Set Rs=Dvbbs.Execute("select AnnounceID from "&TotalUseTable&" where ParentID=0 and rootid="&RootID)
'            If Not Rs.eof Then
'                If AnnounceID=Rs(0) Then
'                    If Topic="" OR Replace(Topic&"","","")="" Then Dvbbs.AddErrCode(79)
'                End If
'            Else
'                Dvbbs.AddErrCode(30)
'            End If
        End If
        
'        ShowErr("")

        SaveData()
    End Sub
    '保存数据
    Private Sub SaveData()
        If Not (Dvbbs.Master or Action = 8) Then CheckpostTime()
        Dim Forumupload
        'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@postdata").text =""
'         If Dvbbs.GroupSetting(64)="1" Then
             IsAudit=0
'         Else
'             If Dvbbs.Board_Setting(57)="1" Then
'                 IsAudit=NeedIsAudit()                
                 IsAuditcheck=IsAudit
'             End If
'         End If
        If Dvbbs.UserID=0 Then IsAudit=1:IsAuditcheck=2
'         If IsAudit=0 Then
'             If AccessPost =1 Then
'                     IsAudit=1
'                     IsAuditcheck=2
'             End If
'         End If
         locktopic=0
        If MyLockTopic=1 Then locktopic=1
        If IsAudit=1 And Action <> 8 Then
            LockTopic=Dvbbs.BoardID
            Dvbbs.BoardID=777
            Response.Cookies("Dvbbs")=LockTopic
        Else
            Response.Cookies("Dvbbs")=Dvbbs.Boardid
        End If
        Forumupload=split(Dvbbs.Board_Setting(19),"|")
        For i=0 to ubound(Forumupload)
            If Instr(Content,"[upload="&Forumupload(i)&"]") or Instr(Content,"."&Forumupload(i)&"") or Instr(Content,"["&Forumupload(i)&"]") then
                uploadpic_n=Forumupload(i)
                Exit For
            End If
        Next
        
        If InStr(Content,"viewfile.asp?ID=") Then uploadpic_n="down"
'        If Not Action = 8 Then
            savepost()
        
            If Dvbbs.UserID>0 Then updatepostuser()
            
'        Else
'            Update_Edit_Announce()
'        End If

        If Dvbbs.GroupSetting(59)=1 Then
            If (Action = 5 Or Action = 7) and (GetPostType="1" or GetPostType="2") Then
                'Dim LogMsg
                'LogMsg = "<a href=""dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&""" target=_blank>主题：《<B>"&topic&"</B>》</a> 使用<B>"&ToolsInfo(5)&"</B>道具成功，并插入道具日志记录。"
                'Call Dvbbs.ToolsLog(ToolsInfo(4),1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
                'Call UpdateUserTools(Dvbbs.UserID,ToolsInfo(4),1)
            ElseIf Action = 6 and GetPostType="1" and GetMoneyType=4 Then
                Call GetMoney_SaveRe
            End If
        End If
        If Action <>8 Then
            'If IsSqlDataBase = 1 Then
            '    Dvbbs.Execute("Delete From [Dv_lastpost] Where Datediff(Mi, DateAndtime, " & SqlNowString & ") > 20")
            'Else
            '    Dvbbs.Execute("Delete From [Dv_lastpost] Where Datediff('s', DateAndtime, " & SqlNowString & ") > 20*60")
            'End If
            'Dvbbs.Execute("Insert Into Dv_lastpost (PostTitle,PostUserID,DateAndtime) values ('"&Dvbbs.Checkstr(Left(Trim(Request.Form("topic")&"")& Request.Form("body"),150))&"',"&Dvbbs.UserID&",'"&Now()&"')")
        End If
        
        succeed()
    End Sub
    '保存发贴，投票和回贴
    Public Sub Savepost()
        If Action = 5 Or Action = 7 Then
            ilayer=1:iOrders=0:ParentID=0
            MyLastPostTime=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
            DateTimeStr=MyLastPostTime'Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
            If Action = 7 Then Insert_To_Vote()
            
            Insert_To_Topic()
            
            '更新总固顶和固顶的数据以及缓存数据
            If MyIsTop=3 Then
                '将总固顶ID插入总设置表
                Dim iForum_AllTopNum
                Set Rs=Dvbbs.Execute("Select Forum_AllTopNum From Dv_Setup")
                If Trim(Rs(0))="" Or IsNull(Rs(0)) Then
                    iForum_AllTopNum = RootID
                Else
                    iForum_AllTopNum = Rs(0) & "," & RootID
                End If
                Dvbbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&iForum_AllTopNum&"'")
                Dvbbs.ReloadSetupCache iForum_AllTopNum,28
                Set Rs=Nothing
            ElseIf MyIsTop=1 Then
                Dim BoardTopStr
                Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID="&Clng(Dvbbs.BoardID))
                If Not (Rs.Eof And Rs.Bof) Then
                    If Rs(1)="" Or IsNull(Rs(1)) Then
                        BoardTopStr = RootID
                    Else
                        If InStr(","&Rs(1)&",","," & RootID & ",")>0 Then
                            BoardTopStr = Rs(1)
                        Else
                            BoardTopStr = Rs(1) & "," & RootID
                        End If
                    End If
                    Dvbbs.Execute("Update Dv_Board Set BoardTopStr='"&BoardTopStr&"' Where BoardID="&Rs(0))
                    Dvbbs.LoadBoardinformation Rs(0)
                End If
                Set Rs=Nothing
            End If
'        ElseIf Action = 6 Then
'            Get_SaveRe_TopicInfo()
'            Get_ForumTreeCode()
'            DateTimeStr=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
        End If
        
    
        Insert_To_Announce()
        If Action = 6 Then
'            topic=Replace(Replace(cutStr(reubbcode(topic),14),chr(10),""),"'","")
'            If topic="" Then
'                topic=Content
'                topic=Replace(cutStr(reubbcode(topic),14),chr(10),"")
'            Else
'                topic=Replace(cutStr(reubbcode(topic),14),chr(10),"")
'            End If
'            If ihaveupfile=1 Then Dvbbs.Execute("update dv_upfile set F_AnnounceID='"&RootID&"|"&AnnounceID&"',F_Readme='"&Replace(toptopic,"'","")&"',F_flag=0 where F_ID in ("&upfileinfo&")")
        Else
            If ihaveupfile=1 Then Dvbbs.Execute("update dv_upfile set F_AnnounceID='"&RootID&"|"&AnnounceID&"',F_Readme='"&Topic&"',F_flag=0  where F_ID in ("&upfileinfo&")")
        End If
        If signflag=2 Then
            LastPost=Replace("匿名用户","$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & Replace(topic,"$","&#36;") & "$" & uploadpic_n & "$" & " " & "$" & RootID & "$" & Dvbbs.BoardID
        Else
            LastPost=Replace(username,"$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & Replace(topic,"$","&#36;") & "$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
        End If
        LastPost=Replace(LastPost,"'","")
        LastPost=Dvbbs.ChkBadWords(LastPost)
        If IsAudit<>1 Then
            Dim IsUpDateLastPostTime
            IsUpDateLastPostTime = False
            If  InStr("," & Tools_UseTools & ",",",13,")>0 Or InStr("," & Tools_UseTools & ",",",14,")>0 Then IsUpDateLastPostTime = True
            If Action = 6 Then
                If IsUpDateLastPostTime Then
                    If DateDiff("h",Now(),Tools_LastPostTime)<=0 Then
                        SQL="update Dv_topic set child=child+1,LastPostTime="&SqlNowString&",LastPost='"&LastPost&"' where TopicID="&RootID
                    Else
                        SQL="update Dv_topic set child=child+1,LastPost='"&LastPost&"' where TopicID="&RootID
                    End If
                Else
                    SQL="update Dv_topic set child=child+1,LastPostTime="&SqlNowString&",LastPost='"&LastPost&"' where TopicID="&RootID
                End If
                Dvbbs.Execute(SQL)
                Child=Child+2
                If Child mod Dvbbs.Board_Setting(27)=0 Then
                    star=Child\Dvbbs.Board_Setting(27)
                Else
                    star=(Child\Dvbbs.Board_Setting(27))+1
                End If
            Else
                 Dvbbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicid="&RootID)
            End If
        Else
            Rem 待审核取消回复更新最后发贴。
            If Action = 5 Or Action = 7 Then  Dvbbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicid="&RootID)
        End If
        If Action = 5 Or Action = 7 Then
            toptopic=Replace(cutStr(topic,20),"$","&#36;")
        Else
            toptopic=Replace(cutStr(toptopic,20),"$","&#36;")
        End If
        
        'toptopic =主标题,Content=内容
        '判断是否是加密的论坛，如果是，则不显示最后发贴内容。
        If Dvbbs.Board_Setting(2)="1" Then
            LastPost_1="保密$" & AnnounceID & "$" & DateTimeStr & "$请认证用户进入查看$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
        ElseIf signflag=2 Then
            LastPost_1=Replace("匿名用户","$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & toptopic & "$" & uploadpic_n & "$" & " " & "$" & RootID & "$" & Dvbbs.BoardID
        Else
            LastPost_1=Replace(username,"$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & toptopic & "$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
        End If
        LastPost_1=reubbcode(Replace(LastPost_1,"'",""))
        LastPost_1=Dvbbs.ChkBadWords(LastPost_1)
        If IsAudit=0 Then
            UpDate_BoardInfoAndCache()
            UpDate_ForumInfoAndCache()
        End If
        Response.Cookies("Dvbbs")=Dvbbs.BoardID
        
    End Sub
    '判断用户是否有编辑权限且提取相关信息
    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 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 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
'            If Action = 4 Then
'                signflag=Rs("signflag")
'                mailflag=Rs("emailflag")
'                Topic=rs("topic")
'                If Topic<>"" Then Topic = Server.HtmlEncode(Topic)
'                Content=rs("body")
'                old_user=rs("username")
'            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)
'                    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
'                    If ajaxPost Then
'                        Call showAjaxMsg(0,Replace(Replace(template.Strings(22),"{$posttime}",Datediff("s",rs("dateandtime"),Now())/60),"{$etlimited}",Dvbbs.forum_setting(51)),"","")
'                    Else
'                        parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(Replace(template.Strings(22),"{$posttime}",Datediff("s",rs("dateandtime"),Now())/60),"{$etlimited}",Dvbbs.forum_setting(51))&"&action=OtherErr"
'                        Response.redirect parameter
'                    End If
'                End If
'            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
'                signflag=Rs("signflag")
'                mailflag=Rs("emailflag")
'                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
'        ShowErr("")
'        If Action = 4 Then Dvbbs.MemberName=old_user
    End Function

    Public Sub Get_SaveRe_TopicInfo()
'        SQL="select locktopic,LastPost,title,smsuserlist,IsSmsTopic,istop,Child,UseTools,LastPostTime,GetMoneyType,PostUserID, DateAndTime from Dv_topic where BoardID="&Dvbbs.BoardID&" And topicid="&cstr(RootID)
'        Set Rs=dvbbs.Execute(sql)
'        If Not (Rs.EOF And Rs.BOF) Then
'            toptopic = Rs(2)
'            istop = Rs(5)
'            Child = Rs(6)
'            Tools_UseTools = "," & Rs(7) & ","
'            Tools_LastPostTime = Rs(8)
'            If Rs("IsSmsTopic")=1 Then smsuserlist=Rs("smsuserlist")
'            If Rs("LockTopic")=1 And Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then Dvbbs.AddErrCode(78)
'            '锁定多少天前的帖子判断 2004-9-16 Dv.Yz
'            If Ubound(Dvbbs.Board_Setting) > 70 And Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then
'                If Not Clng(Dvbbs.Board_Setting(71)) = 0 And Datediff("d", Rs(11), Now()) > Clng(Dvbbs.Board_Setting(71)) Then Dvbbs.AddErrCode(78)
'            End If
'            If Not IsNull(Rs(1)) Then
'                LastPost=split(Rs(1),"$")
'                If ubound(LastPost)=7 Then
'                    UpLoadPic_n=LastPost(4)
'                Else
'                    UpLoadPic_n=""
'                End If
'            End If
'            If Cint(Rs(9)) = 5 Then
'                If ajaxpost Then
'                    Call showAjaxMsg(0,template.Strings(32),"","")
'                Else
'                    Response.redirect"showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<br>"+"<li>"&template.Strings(32)&"&action=OtherErr"
'                End If
'            End If
'            If Clng(Rs(10)) <> Dvbbs.UserID and Cint(Rs(9)) = 2 and GetPostType = "1" Then
'                GetMoneyType = 4
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text -ToMoney
'            Else
'                GetMoneyType = 0
'                ToMoney=0
'            End If
'        End If
'        Set Rs = Nothing
'        ShowErr("")
    End Sub
    Public Sub Insert_To_Vote()
        '插入投票记录 GroupSetting(68)投票项目中是否可以使用HTML
        Dim UArticle,UWealth,UEP,UCP,UPower
        Dim LockVote
        UArticle = Request.Form("UArticle")
        UWealth = Request.Form("UWealth")
        UEP = Request.Form("UEP")
        UCP = Request.Form("UCP")
        UPower = Request.Form("UPower")
        LockVote = Request.Form("lockvote")
        If Not IsNumeric(UArticle) Then UArticle = 0
        If Not IsNumeric(UWealth) Then UWealth = 0
        If Not IsNumeric(UEP) Then UEP = 0
        If Not IsNumeric(UCP) Then UArticle = 0
        If Not IsNumeric(UPower) Then UPower = 0
        If Not IsNumeric(LockVote) Then LockVote = 0
        If Dvbbs.GroupSetting(68)<>"1" Then vote = server.htmlencode(vote)
        Dvbbs.execute("insert into dv_vote (vote,votenum,votetype,timeout,UArticle,UWealth,UEP,UCP,UPower,LockVote) values ('"&vote&"','"&votenum&"',"&votetype&",'"&votetimeout&"',"&UArticle&","&UWealth&","&UEP&","&UCP&","&UPower&","&LockVote&")")
        set rs=dvbbs.execute("select Max(voteid) from dv_vote")
        voteid=Rs(0)
        isvote=1
        Set Rs=Nothing
    End Sub
    Public Sub Insert_To_Topic()
        '插入主题表
        Dim hidename
        If signflag=2 Then
            hidename=1
        Else
            hidename=0
        End If
        
        SQL="insert into Dv_topic (Title,Boardid,PostUsername,PostUserid,DateAndTime,Expression,LastPost,LastPostTime,PostTable,locktopic,istop,TopicMode,isvote,PollID,Mode,GetMoney,UseTools,GetMoneyType,isSmsTopic,HideName) values ('"&topic&"',"&Dvbbs.boardid&",'"&username&"',"&Dvbbs.userid&",'"&DateTimeStr&"','"&Expression(0)&"|"&Expression(1)&"','$$"&DateTimeStr&"$$$$','"&MyLastPostTime&"','"&TotalUseTable&"',"&locktopic&","&Myistop&","&MyTopicMode&","&isvote&","&voteid&","&TopicMode&","&ToMoney&",'"&UseTools&"',"&GetMoneyType&","&isAlipayTopic&","&hidename&")"

        Dvbbs.Execute(sql)
        
        Set Rs=Dvbbs.Execute("select Max(topicid) From Dv_topic Where PostUserid="&Dvbbs.UserID)
        RootID=Rs(0)
    End Sub
    Public Sub Insert_To_Announce()
        '插入回复表
        DIM UbblistBody
        UbblistBody = Content
        UbblistBody = Ubblist(Content)
        Dim FlashId
        If Dvbbs.qcomic_plus Then
            FlashId = Dvbbs.Checkstr(Request.Form("phid"))
        Else
            FlashId = "0"
        End If

        SQL="insert into "&TotalUseTable&"(Boardid,ParentID,username,topic,body,DateAndTime,length,RootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,PostUserID,isupload,IsAudit,Ubblist,GetMoney,UseTools,PostBuyUser,GetMoneyType,FlashId) values ("&Dvbbs.boardid&","&ParentID&",'"&username&"','"&topic&"','"&Content&"','"&DateTimeStr&"','"&Dvbbs.strlength(Content)&"',"&RootID&","&ilayer&","&iorders&",'"&Dvbbs.UserTrueIP&"','"&Expression(1)&"',"&locktopic&","&signflag&","&mailflag&",0,"&Dvbbs.userid&","&ihaveupfile&","&IsAudit&",'"&UbblistBody&"',"&ToMoney&",'"&UseTools&"','"&dvbbs.checkstr(ToolsBuyUser)&"',"&GetMoneyType&",'"&FlashId&"')"
        Dvbbs.Execute(sql)
        Set Rs=Dvbbs.Execute("select Max(AnnounceID) From "&TotalUseTable&" Where PostUserID="&Dvbbs.UserID)
        AnnounceID=Rs(0)

        If Dvbbs.qcomic_plus And Len(FlashId)>5 Then
            On Error Resume Next
                DIM Qcomic_setting,qcomic_url,qcomic_code,qcomic_http,qcomic_tid,qcomic_rs,qcomic_topic
                If topic="" Then
                    qcomic_tid = RootID
                    Set qcomic_rs = Dvbbs.iCreateObject("ADODB.Recordset")
                    SQL="SELECT Title FROM Dv_Topic where TopicID="&RootID
                    qcomic_rs.Open SQL,conn,1,3
                    If Not qcomic_rs.Eof Then
                        qcomic_topic = qcomic_rs(0)
                    End If
                Else
                    qcomic_topic = topic
                End If

                Qcomic_setting = Split(Dvbbs.qcomic_plus_setting(), "||||")
                qcomic_code = "spassword=" & Qcomic_setting(2)
                qcomic_code = qcomic_code & "&phid=" & FlashId
                qcomic_code = qcomic_code & "&tid=" & RootID
                qcomic_code = qcomic_code & "&pid=" & AnnounceID
                qcomic_code = qcomic_code & "&fid=" & Dvbbs.boardid
                qcomic_code = qcomic_code & "&uid=" & Dvbbs.userid
                qcomic_code = qcomic_code & "&ctime=" & Now()
                qcomic_code = qcomic_code & "&mtime=" & Now()
                qcomic_url = "http://comic.qihoo.com/dvbbs/update.php?sid=" & Qcomic_setting(1)
                qcomic_url = qcomic_url & "&code=" & Server.UrlEncode(AuthCode(qcomic_code, "ENCODE", Qcomic_setting(3)))
                qcomic_url = qcomic_url & "&title=" & Server.UrlEncode(qcomic_topic)
                qcomic_url = qcomic_url & "&content=" & Server.UrlEncode(Left(Dvbbs.Replacehtml(Dvbbs.ReplaceUbb(Content)),1000))

                Set qcomic_http = Server.CreateObject("Microsoft.XMLHTTP")
                qcomic_http.Open "GET",qcomic_url,false
                qcomic_http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                qcomic_http.send()
            If Err Then err.Clear
        End If

    End Sub
    '检查贴中是否含过滤字
    Public Function NeedIsAudit()
        NeedIsAudit=0
        Dim i,ChecKData
        If Dvbbs.Board_Setting(58)<>"0" Then
            ChecKData=split(Dvbbs.Board_Setting(58),"|")
            For i=0 to UBound(ChecKData)
                If Trim(ChecKData(i))<>"" Then
                    If InStr(Content,ChecKData(i))>0 Or InStr(Topic,ChecKData(i))>0 Then
                        NeedIsAudit=1
                        Exit Function
                    End If
                End If
            Next
        End If
    End Function
    Public Sub Get_ForumTreeCode()
'        Dim mailbody
'        Set Rs=Dvbbs.Execute("select b.layer,b.orders,b.EmailFlag,b.username,u.userEmail from "&TotalUseTable&" b inner join [Dv_user] u on b.postuserid=u.userid where b.AnnounceID="&ParentID)
'        If Not(rs.EOF And rs.BOF) Then
'            If IsNull(Rs(0)) Then
'                iLayer=1
'            Else
'                iLayer=Rs(0)
'            End If
'            If IsNull(Rs(1)) Then
'                iOrders=0
'            Else
'                iOrders=Rs(1)
'            End If
'            If Rs(3)=Dvbbs.membername Then
'                If Cint(Dvbbs.GroupSetting(4))=0 Then Dvbbs.AddErrCode(73)
'            Else
'                If Dvbbs.GroupSetting(5)="0" Then
'                    If ajaxpost Then
'                        Call showAjaxMsg(0,template.Strings(29),"","")
'                    Else
'                        Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&template.Strings(29)&"&action=OtherErr"
'                    End If
'                End if
'                If Rs(2)>0 Then
'                    Dim sUrl,Email,TempArray,etopic
'                    TempArray = Split(template.html(10),"||")
'                    sUrl=Dvbbs.Get_ScriptNameUrl
'                    If Rs(2)=1 Or Rs(2)=3 Then
'                        etopic=Replace(template.Strings(25),"{$forumname}",Dvbbs.Forum_info(0))
'                        email=Rs(4)
'                        mailbody = TempArray(0)
'                        mailbody = Replace(mailbody,"{$username}",Rs(3))
'                        mailbody = Replace(mailbody,"{$boardid}",Dvbbs.BoardID)
'                        mailbody = Replace(mailbody,"{$forumname}",Dvbbs.Forum_info(0))
'                        mailbody = Replace(mailbody,"{$topicid}",RootID)
'                        mailbody = Replace(mailbody,"{$star}",Star)
'                        mailbody = Replace(mailbody,"{$surl}",sUrl)
'                        mailbody = Replace(mailbody,"{$parentid}",ParentID)
'                        Dim DvEmail
'                        Set DvEmail = New Dv_SendMail
'                        DvEmail.SendObject = Cint(Dvbbs.Forum_Setting(2))    '设置选取组件 1=Jmail,2=Cdonts,3=Aspemail
'                        DvEmail.ServerLoginName = Dvbbs.Forum_info(12)    '您的邮件服务器登录名
'                        DvEmail.ServerLoginPass = Dvbbs.Forum_info(13)    '登录密码
'                        DvEmail.SendSMTP = Dvbbs.Forum_info(4)            'SMTP地址
'                        DvEmail.SendFromEmail = Dvbbs.Forum_info(5)        '发送来源地址
'                        DvEmail.SendFromName = Dvbbs.Forum_info(0)        '发送人信息
'                        If DvEmail.ErrCode = 0 Then
'                            DvEmail.SendMail email,etopic,mailbody    '执行发送邮件
'                        End If
'                        Set DvEmail = Nothing
'                    End If
'                    If Rs(2)=2 Or Rs(2)=3 Then
'                        mailbody = TempArray(1)
'                        mailbody = Replace(mailbody,"{$boardid}",Dvbbs.BoardID)
'                        mailbody = Replace(mailbody,"{$topicid}",RootID)
'                        mailbody = Replace(mailbody,"{$star}",Star)
'                        mailbody = Replace(mailbody,"{$surl}",sUrl)
'                        mailbody = Replace(mailbody,"{$parentid}",ParentID)
'                        Dvbbs.Execute("insert into dv_message(incept,sender,title,content,sendtime,flag,issend) values('"&Rs(3)&"','"&Dvbbs.Forum_info(0)&"','"&template.Strings(26)&"','"&mailbody&"',"&SqlNowString&",0,1)")
'                        update_user_msg(Rs(3))
'                    End If
'                End If
'            End If
'        Else
'            iLayer=1
'            iOrders=0
'        End If
'        Set Rs=Nothing
'        If RootID<>0 Then
'            iLayer=ilayer+1
'            Dvbbs.Execute "update "&TotalUseTable&" set orders=orders+1 where RootID="&cstr(RootID)&" and orders>"&cstr(iOrders)
'            iOrders=iOrders+1
'        End If
    End Sub
    Public Sub Update_Edit_Announce()
        Dim re,LastBoard,LastTopic
        Set re=new RegExp
        re.IgnoreCase =True
        re.Global=True
        re.Pattern="<br>"
        Content = re.Replace(Content,"[br]")
        re.Pattern="\[align=right\]\[color=#000066\](.*)\[\/color\]\[\/align\]"
        Content = re.Replace(Content,"")
        re.Pattern="<div align=right><font color=#000066>(.*)<\/font><\/div>"
        Content = re.Replace(Content,"")
        re.Pattern="\[br\]"
        Content = re.Replace(Content,"<br>")
        Set re=Nothing
        If Dvbbs.membername<>UserName Then
            If Dvbbs.forum_setting(49)="1" Then char_changed = "[align=right][color=#000066][此贴子已经被"&Dvbbs.membername&"于"&Now()&"编辑过][/color][/align]"
        Else
            If Dvbbs.forum_setting(48)="1" Then char_changed = "[align=right][color=#000066][此贴子已经被作者于"&Now()&"编辑过][/color][/align]"
        End If
        Get_Edit_PermissionInfo
        Dim Contentdata,LastPost_l
        Contentdata=Content
        ShowErr("")
        '取出当前版面最后回复id,如果本帖为最后回复则更新相应数据
        Set Rs = Dvbbs.Execute("select LastPost from dv_board where boardid="&Dvbbs.BoardID)
        If not (Rs.EOF And Rs.BOF) Then
            If Not IsNull(rs(0)) And rs(0)<>"" then
                LastBoard=split(rs(0),"$")
                If ubound(LastBoard)=7 Then
                    If cCur(LastBoard(1))=cCur(AnnounceID) Then
                        If signflag=2 Then LastBoard(0)="匿名用户":LastBoard(5)=""
                        LastPost=LastBoard(0) & "$" & LastBoard(1) & "$" & Now() & "$" & LastBoard(3) & "$" & LastBoard(4) & "$" & LastBoard(5) & "$" & LastBoard(6) & "$" & Dvbbs.BoardID
                        dvbbs.execute("update dv_board set LastPost='"&Replace(Replace(LastPost,"'",""),"<","&lt;")&"' where boardid="&Dvbbs.BoardID)
                        UpDate_BoardInfoAndCache()
                    End If
                End If
            End If
        End If

        '取得当前主题最后回复id,如果本帖为最后回复则更新相应数据
        Dim iFoundUseMagic,MyMagicFace
        Set Rs=Dvbbs.Execute("select LastPost,istop,Expression from dv_topic where topicid="&rootid)
        If Not (Rs.Eof And Rs.Bof) Then
            istop=rs(1)
            MyMagicFace = Split(Rs(2),"|")
            If Ubound(MyMagicFace) = 1 Then iFoundUseMagic = MyMagicFace(0)
            If Not Isnull(Rs(0)) And Rs(0)<>"" Then
                LastTopic=split(rs(0),"$")
                If Ubound(LastTopic)=7 Then
                    If cCur(LastTopic(1))=cCur(Announceid) Then
                        If signflag=2 Then LastTopic(0)="匿名用户":LastTopic(5)=""
                        If Trim(uploadpic_n)<>"" Then LastTopic(4)=uploadpic_n
                        LastPost=LastTopic(0) & "$" & LastTopic(1) & "$" & Now() & "$" & Replace(cutStr(reubbcode(Contentdata),20),"$","&#36;") & "$" & LastTopic(4) & "$" & LastTopic(5) & "$" & LastTopic(6) & "$" & Dvbbs.BoardID
                        dvbbs.execute("update dv_topic set LastPost='"&Replace(LastPost,"'","")&"' where topicid="&rootid)
                    End If
                End If
            End If
        End If

        Set Rs = Dvbbs.iCreateObject("ADODB.Recordset")
        SQL="SELECT * FROM "&TotalUseTable&" where AnnounceID="&Announceid&" And username='"&username&"'"
        rs.Open SQL,conn,1,3
        If Rs.EOF And Rs.BOF Then
            If Not CanEditPost Then showerr("您没有足够的权限编辑本帖子，请和管理员联系")    'Dvbbs.AddErrCode(77)
        ElseIf Not Dvbbs.master And rs("locktopic")=1 then
            showerr("本主题已经锁定，不能发表回复")    'Dvbbs.AddErrCode(78)
        Else
            If Rs("parentid")=0 then
                Dim iExpression
                iExpression = ",Expression='"&Expression(0)&"|"&Expression(1)&"'"
                If signflag=2 Then
                    Dvbbs.Execute("update dv_topic set title='"&topic&"',TopicMode="&MyTopicMode&",isSmsTopic="&isAlipayTopic&" "&iExpression&",HideName=1 where topicid="&rootid)
                Else
                    Dvbbs.Execute("update dv_topic set title='"&topic&"',TopicMode="&MyTopicMode&",isSmsTopic="&isAlipayTopic&" "&iExpression&",HideName=0 where topicid="&rootid)
                End If
            End If
            If IsAudit = 1 Then
                Rs("locktopic")=3
            ElseIf Rs("locktopic")=3 And IsAudit = 0 Then
                Rs("locktopic")=0
            End If
            Rs("Topic") =Replace(Topic,"''","'")
            rs("Body") =Replace(Content,"''","'")
            rs("length")=Dvbbs.strlength(Content)
            rs("ip")=Dvbbs.UserTrueIP
            rs("Expression")=Expression(1)
            rs("signflag")=signflag
            rs("emailflag")=mailflag
            If Rs("isupload")=0 And ihaveupfile=1 Then Rs("isupload")=1
            Dim UbblistBody
            UbblistBody = Ubblist(Content)
            Rs("Ubblist")=UbblistBody

            If Dvbbs.qcomic_plus Then
                Dim FlashId
                FlashId = Dvbbs.Checkstr(Request.Form("phid"))
                Rs("FlashId") = FlashId
            End If
            rs.Update
            If Dvbbs.qcomic_plus Then
                On Error Resume Next
                    DIM Qcomic_setting,qcomic_url,qcomic_code,qcomic_http,qcomic_rs,qcomic_topic,qcomic_tid
                    If Rs("Topic")="" Then
                        qcomic_tid = Rs("RootID")
                        Set qcomic_rs = Dvbbs.iCreateObject("ADODB.Recordset")
                        SQL="SELECT Title FROM Dv_Topic where TopicID="&qcomic_tid
                        qcomic_rs.Open SQL,conn,1,3
                        If Not qcomic_rs.Eof Then
                            qcomic_topic = qcomic_rs(0)
                        End If
                    Else
                        qcomic_topic = Rs("Topic")
                    End If
                    Qcomic_setting = Split(Dvbbs.qcomic_plus_setting(), "||||")
                    qcomic_code = "spassword=" & Qcomic_setting(2)
                    qcomic_code = qcomic_code & "&phid=" & FlashId
                    qcomic_code = qcomic_code & "&tid=" & rs("RootID")
                    qcomic_code = qcomic_code & "&pid=" & rs("AnnounceID")
                    qcomic_code = qcomic_code & "&fid=" & rs("BoardID")
                    qcomic_code = qcomic_code & "&uid=" & rs("postuserid")
                    qcomic_code = qcomic_code & "&mtime=" & Now()
                    qcomic_url = "http://comic.qihoo.com/dvbbs/update.php?sid=" & Qcomic_setting(1)
                    qcomic_url = qcomic_url & "&code=" & Server.UrlEncode(AuthCode(qcomic_code, "ENCODE", Qcomic_setting(3)))
                    qcomic_url = qcomic_url & "&title=" & Server.UrlEncode(qcomic_topic)
                    qcomic_url = qcomic_url & "&content=" & Server.UrlEncode(Left(Dvbbs.Replacehtml(Dvbbs.ReplaceUbb(Rs("Body"))),1000))

                    Set qcomic_http = Server.CreateObject("Microsoft.XMLHTTP")
                    qcomic_http.Open "GET",qcomic_url,false
                    qcomic_http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                    qcomic_http.send()
                If Err Then err.Clear
            End If

            If ihaveupfile=1 Then dvbbs.execute("update dv_upfile set F_AnnounceID='"&rootid&"|"&AnnounceID&"',F_Readme='"&Replace(Rs("Topic"),"'","''")&"',F_flag=0 where F_ID in ("&upfileinfo&")")
            If FoundUseMagic Then
                If iMagicFace <> Clng(iFoundUseMagic) Then
                    If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) > tMagicMoney Then
                        Dvbbs.Execute("Update Dv_User Set UserMoney=UserMoney-"&tMagicMoney&" Where UserID="&Dvbbs.UserID)
                        Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text -tMagicMoney
                        Dvbbs.ToolsLog -88,1,tMagicMoney,0,1,"使用金币购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
                    Else
                        Dvbbs.Execute("Update Dv_User Set UserTicket=UserTicket-"&tMagicTicket&" Where UserID="&Dvbbs.UserID)
                        Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text-tMagicTicket
                        Dvbbs.ToolsLog -88,1,0,tMagicTicket,1,"使用点券购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
                    End If
                End If
            End If
        End If
        Rs.Close
        Set Rs=Nothing
        ShowErr("")
    End Sub

    '更新用户及系统道具数量(用户ID，道具ID，减少数量)
    Private Sub UpdateUserTools(U_UserID,U_ToolsID,n)
        Dim Sql,Rs
        If Clng(n)<0 Then
            n = "+" & n
        Else
            n = "-" & n
        End If
        Set Rs = Dvbbs.Plus_Execute("Select ID From [Dv_Plus_Tools_Buss] Where UserID="& U_UserID &" and ToolsID="& U_ToolsID)
        If Rs.Eof And Rs.Bof Then
            Dim Trs
            Set Trs = Dvbbs.Plus_Execute("Select ToolsName From Dv_Plus_Tools_Info Where ID=" & U_ToolsID)
            If Not (Trs.Eof And Trs.Bof) Then
                Sql = "Insert Into [Dv_Plus_Tools_Buss] (UserID,UserName,ToolsID,ToolsName,ToolsCount) Values ("&U_UserID&",'"&Dv_Tools.ToUserInfo(1)&"',"&U_ToolsID&",'"&Trs(0)&"',"&Clng(Replace(Replace(n,"+",""),"-",""))&")"
                Dvbbs.Plus_Execute(Sql)
            End If
            Trs.Close
            Set Trs=Nothing
        Else
            Sql = "Update [Dv_Plus_Tools_Buss] Set ToolsCount = ToolsCount"&n&" Where UserID="& U_UserID &" and ToolsID="& U_ToolsID
            Dvbbs.Plus_Execute(Sql)
        End If
        Rs.Close
        Set Rs=Nothing
        Sql = "Update [Dv_Plus_Tools_Info] Set UserStock =  UserStock"&n&" Where ID="& U_ToolsID
        Dvbbs.Plus_Execute(Sql)
    End Sub
    '回复获赠金币帖时更新
    Public Sub GetMoney_SaveRe()
        Dim ToUserID,ToUserName,UpPostBuyUser,UpGetMoney,Tempstr
        SQL="Select PostUserID,GetMoney,PostBuyUser,Username From "&TotalUseTable&" Where RootID="&RootID&" and ParentID=0 and GetMoneyType=2"
        Set Rs = Dvbbs.iCreateObject("ADODB.Recordset")
        Rs.Open SQL,conn,1,3
            If Not Rs.Eof Then
                ToUserID = Clng(Rs(0))
                UpGetMoney = Rs(1) + ToMoney
                UpPostBuyUser = Rs(2)
                ToUserName = Rs(3)
                Tempstr = Split(UpPostBuyUser,"|||",2)
                Tempstr(0) = UpGetMoney
                Tempstr(1) = Tempstr(1) & "|||" & UserName &","& ToMoney
                UpPostBuyUser = Tempstr(0) & "|||" & Tempstr(1)
                UpPostBuyUser = Trim(UpPostBuyUser)
                Rs(1) = UpGetMoney
                Rs(2) = UpPostBuyUser
            Rs.update
            End If
        Rs.Close : Set Rs=Nothing

        '更新主题MONEY值
        Sql = "Update [Dv_Topic] Set GetMoney="&UpGetMoney&" where TopicID="&RootID
        Dvbbs.Execute(sql)
        '主题作者获取金币
        Sql = "Update [Dv_User] Set UserMoney=UserMoney + "&ToMoney&" where UserID="&ToUserID
        Dvbbs.Execute(sql)
        '插入道具日志
        'Dim LogMsg
        'LogMsg = "<a href=""dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&star="&Star&"#"&Announceid&""" target=_blank>回复主题：《<B>"&topic&"</B>》</a> 赠道给作者:<b>"&ToUserName&"</b><font color="&Dvbbs.mainsetting(1)&">"&ToMoney&"</font>个金币成功，并插入道具日志记录。"
        'Call Dvbbs.ToolsLog(0,0,ToMoney,0,0,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
    End Sub


'更新版面数据和缓存
    Public Sub UpDate_BoardInfoAndCache()
        Dim UpdateBoardID,parentstr
        parentstr =Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@parentstr").text
        If parentstr <> "0" Then
            UpdateBoardID= parentstr & "," & Dvbbs.BoardID
        Else
            UpdateBoardID=Dvbbs.BoardID
        End If
        Dim updateboard,i
        LastPost_1=replace(LastPost_1,"<","&lt;")
        If Action = 6 Then
            SQL="update Dv_board set PostNum=PostNum+1,todaynum=todaynum+1,LastPost='"&LastPost_1&"' where boardid in ("&UpdateBoardID&")"
        ElseIf Action = 5 Or Action = 7 Then
            SQL="update Dv_board set PostNum=PostNum+1,TopicNum=TopicNum+1,todaynum=todaynum+1,LastPost='"&LastPost_1&"' where boardid in ("&UpdateBoardID&")"
        ElseIf Action = 8 Then
            LastPost_1=replace(LastPost,"<","&lt;")
        End If
        Dvbbs.Execute(sql)
        UpdateBoardID=Split(UpdateBoardID,",")
        LastPost_1=Split(LastPost_1,"$")
        For Each updateboard in UpdateBoardID
            If IsObject(Application(Dvbbs.CacheName &"_information_" & updateboard)) Then
                If Not Action = 8 Then
                    Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@postnum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@postnum").text)+1
                    Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@todaynum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@todaynum").text)+1
                End If
                If Action = 5 Or Action = 7 Then
                    Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@topicnum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@topicnum").text)+1
                End If
                For i=0 to UBound(LastPost_1)
                    Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@lastpost_"& i &"").text=LastPost_1(i)
                Next
            End If
        Next
    End Sub
    Public Sub UpDate_ForumInfoAndCache()
        Dim updateinfo,LastPostTime
        Dim Forum_LastPost,Forum_TodayNum,Forum_MaxPostNum
        Forum_LastPost=Dvbbs.CacheData(15,0)
        Forum_TodayNum=Dvbbs.CacheData(9,0)
        Forum_MaxPostNum=Dvbbs.CacheData(12,0)
        LastPostTimes=split(Forum_LastPost,"$")
        LastPostTime=LastPostTimes(2)
        If Not IsDate(LastPostTime) Then LastPostTime=Now()
        If datediff("d",LastPostTime,Now())=0 Then
            If CLng(Forum_TodayNum)+1 > CLng(Forum_MaxPostNum) Then
                updateinfo=",Forum_MaxPostNum=Forum_TodayNum+1,Forum_MaxPostDate="&SqlNowString&""
                Dvbbs.ReloadSetupCache Now(),13
                Dvbbs.ReloadSetupCache CLng(Forum_TodayNum)+1,12
            End If
            Dvbbs.ReloadSetupCache CLng(Forum_TodayNum)+1,9
            If Action = 6 Then
                SQL="update Dv_setup set Forum_PostNum=Forum_PostNum+1,Forum_TodayNum=Forum_TodayNum+1,Forum_LastPost='"&LastPost&"' "&updateinfo&" "
            Else
                SQL="update Dv_setup set Forum_TopicNum=Forum_TopicNum+1,Forum_PostNum=Forum_PostNum+1,Forum_TodayNum=Forum_TodayNum+1,Forum_LastPost='"&LastPost&"' "&updateinfo&" "
            End If
        Else
            If Action = 6 Then
                SQL="update Dv_setup set Forum_PostNum=Forum_PostNum+1,forum_YesTerdayNum="&CLng(Forum_TodayNum)&",Forum_TodayNum=1,Forum_LastPost='"&LastPost&"' "
            Else
                SQL="update Dv_setup set Forum_TopicNum=Forum_TopicNum+1,Forum_PostNum=Forum_PostNum+1,forum_YesTerdayNum="&CLng(Forum_TodayNum)&",Forum_TodayNum=1,Forum_LastPost='"&LastPost&"' "
            End If
            Dvbbs.ReloadSetupCache 1,9
        End If
        '更新总固顶部分数据和缓存
        If Not Action = 6 Then
            If Myistop=2 Then
                Dim tmpstr
                If Dvbbs.CacheData(28,0)="" Then
                    tmpstr=", Forum_alltopnum='"&RootID&"'"
                    Dvbbs.ReloadSetupCache RootID,28
                Else
                    tmpstr=", Forum_alltopnum='"&Dvbbs.CacheData(28,0)&","&RootID&"'"
                    Dvbbs.ReloadSetupCache Dvbbs.CacheData(28,0)&","&RootID,28
                End If
                SQL=SQl&tmpstr
            End If
            Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))+1,7'主题数
        End If
        Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))+1,8'文章数
        Dvbbs.ReloadSetupCache LastPost,15
        Dvbbs.Execute(SQL)
    End Sub
    Public Sub succeed()
        response.Write("[reply]rootid="&RootID&";announceid="&AnnounceID&";totalusetable="&TotalUseTable&"[/reply]")    'zzcity add
        
'        Dim Uid,bid
'        Uid = Dvbbs.userid
'        Bid = Dvbbs.boardid
'        If PostStyle = "ajax" And Action =6 And Dvbbs.UserID>0 And ajaxPost Then
'            'Response.redirect "ajaxPostTpl.asp??boardid="&Dvbbs.boardid&"&Id="&RootID&"&AnnounceID="&AnnounceID&"&TotalUseTable="&TotalUseTable
'            Call ajaxReturn()
'            Exit Sub
'        End If

'        Dim TempStr,PostRetrunName,tourl,returnurl
'        If IsAudit=1 And Action <> 8 Then Dvbbs.BoardID=LockTopic
'        Dvbbs.Stats = Dvbbs.Stats & template.Strings(20)
'        'Call Dvbbs.BoardMasterPoint()    '动网官方版主插件，斑竹评定
'        TempStr = template.html(8)
'        Select case Dvbbs.Board_Setting(17)
'        case "1"
'            tourl = "index.asp"
'            PostRetrunName=template.Strings(13)
'        case "2"
'            tourl="index.asp?boardid="&Dvbbs.boardid
'            PostRetrunName=template.Strings(14)
'        case "3","4"
'            If IsAudit=1  Then
'                tourl="index.asp?boardid="&Dvbbs.boardid
'                If IsAuditcheck=1 Then
'                    PostRetrunName="由于您发表的贴子含敏感内容，您的贴子需要管理员审核过才可以见到。"
'                ElseIf IsAuditcheck=2 Then
'                    PostRetrunName="由于您尚未达到豁免审核的条件，您的贴子需要管理员审核过才可以见到。"
'                Else
'                    PostRetrunName=template.Strings(19)
'                End If
'            Else
'                Select Case Action
'                    Case 5
'                        tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'                        PostRetrunName=template.Strings(15)
'                    Case 6
'                        tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'                        PostRetrunName=template.Strings(16)
'                    Case 7
'                        tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'                        PostRetrunName=template.Strings(17)
'                    Case 8
'                        tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'                        PostRetrunName=template.Strings(18)
'                End Select
'                If Dvbbs.Board_Setting(17) = "4" And Not ajaxPost Then
'                    tourl = Dvbbs.ArchiveHtml(tourl)
'                    Dvbbs.Footer
'                    Response.redirect tourl
'                    Response.end
'                End If
'            End If
'        End Select

'        Dim UrlFlag
'        If IsAudit=1 Then
'            If Dvbbs.Board_Setting(17)>2 Then
'                UrlFlag=2
'            Else
'                UrlFlag=Dvbbs.Board_Setting(17)
'            End If
'        Else
'            UrlFlag=Dvbbs.Board_Setting(17)
'        End If
'        Select Case UrlFlag
'            case 1 returnurl = "index.asp"
'            case 2 returnurl = "index.asp?boardid="&Dvbbs.boardid
'            case 3 returnurl = "dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'            case 4 returnurl = "dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page="&page&"&star="&Star
'            Case Else returnurl= "dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'        End Select
'        returnurl = Mid(Dvbbs.ArchiveHtml("<a "&returnurl), 4)
'
'        TempStr = Replace(TempStr,"{$tourl}",Mid(Dvbbs.ArchiveHtml("<a "&tourl), 4))
'        TempStr = Replace(TempStr,"{$returnurl}",returnurl)
'        TempStr = Replace(TempStr,"{$stats}",Dvbbs.Stats)
'        TempStr = Replace(TempStr,"{$boardname}",Dvbbs.BoardType)
'        TempStr = Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
'        TempStr = Replace(TempStr,"{$page}",page)
'        TempStr = Replace(TempStr,"{$PostRetrunName}",PostRetrunName)
'        If ajaxPost Then
'            Call showAjaxMsg(1,Dvbbs.Stats,"返回："&PostRetrunName,UrlFlag&"|"&Dvbbs.boardid&"|"&RootID&"|"&Star&"|"&page&"|"&returnurl)
'        Else
'            Response.Write TempStr
'        End If
    End Sub
    Private Function checktable(Table)
        Table=Right(Trim(Table),2)
        If Not IsNumeric(table) Then Table=Right(Trim(Table),1)
        If Not IsNumeric(table) Then showerr("非法的帖子参数。")    'Dvbbs.AddErrCode(30)
        checktable="Dv_bbs"&table
    End Function

     '更新用户积分，所需外部变量,UserPost,userid,（外加发贴回贴的积分设置数据）
    Public Sub updatepostuser()
        '投票，发贴，更新积分
        '更新最后发贴时间
        Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@activetime").text = Now()
        If IsAudit> 0 Then Exit Sub
        Dim MagicSql
        
        If Action = 5 Or Action = 7 Then
'            If FoundUseMagic Then
'                If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) > tMagicMoney Then
'                    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text -tMagicMoney
'                    Dvbbs.ToolsLog -88,1,tMagicMoney,0,1,"使用金币购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
'                Else
'                    MagicSql = ",UserTicket=UserTicket-"&tMagicTicket&""
'                    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text-tMagicTicket
'                    Dvbbs.ToolsLog -88,1,0,tMagicTicket,1,"使用点券购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
'                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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" "&MagicSql&" Where UserID="&Dvbbs.userID)
            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))&"' "&MagicSql&" Where UserID="&Dvbbs.userID)    'zzcity add
'            If Not Reuser Then
'                UserPost=UserPost+1
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertopic").text =CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertopic").text)+1
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text+Clng(Dvbbs.Forum_user(1))
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text+Clng(Dvbbs.Forum_user(6))
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text +Clng(Dvbbs.Forum_user(11))
'            End If
'        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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" Where UserID="&Dvbbs.userID)
'                UserPost=UserPost+1
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text+Clng(Dvbbs.Forum_user(2))
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text+Clng(Dvbbs.Forum_user(7))
'                Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text +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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" Where UserID="&Dvbbs.userID)
'            End If
        End If
'        If Not Reuser Then
'            Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text =CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)+1
'            Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text=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()
    End Sub
    '更新用户等级，所需外部变量,UserPost,GroupID,userid
    Public Sub Updategrade()
        Dim FoundGrade,TitlePic
        REM 判断用户组(等级)资料，当用户级别为跟随文章数增长则自动更新用户组(等级)
        REM 自动更新用户数据
        REM 如果属于系统或特殊或多属性组
        Set Rs=Dvbbs.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Dv_UserGroups Where UserGroupID="&GroupID)
        If Not (Rs.Eof And Rs.Bof) Then
            If Rs(2)<>3 Then
                '用户等级不按照文章升级，用户为系统或特殊或多属性组
                UserClass=Rs(3)
                TitlePic=Rs(4)
                FoundGrade=True
            End If
        End If
        If Not FoundGrade Then
            '如果不属于系统或特殊或多属性组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
            Set Rs=Dvbbs.Execute("Select Top 1 usertitle,GroupPic,UserGroupID From Dv_UserGroups Where ParentGID=3 And Minarticle<="&UserPost&" Order By MinArticle Desc,UserGroupID")
            If Not (Rs.Eof And Rs.Bof) Then
                UserClass=Rs(0)
                TitlePic=Rs(1)
                GroupID=Rs(2)
                FoundGrade=True
            End If
        End If
        Set Rs=Nothing
        If Not FoundGrade Then
'            If ajaxpost Then
'                Call showAjaxMsg(0,"系统没有找到您的注册用户组资料，请联系管理员进行修正。","","")
'            Else
'                Response.Redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>系统没有找到您的注册用户组资料，请联系管理员进行修正。&action=OtherErr"
'            End If
            showerr("系统没有找到您的注册用户组资料，请联系管理员进行修正。")
        End If
        Dvbbs.Execute("Update [Dv_User] Set UserClass='"&UserClass&"',TitlePic='"&TitlePic&"',UserGroupID="&GroupID&" Where UserID="&Dvbbs.UserID)
        'If Not Reuser Then
            Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userclass").text = UserClass
            Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text = GroupID
        'End If
    End Sub
    Function AccessPost()
        Dim Dom,node,ischeckcontent
        If Cint(Dvbbs.Board_Setting(3))=0 Then
            AccessPost=0
            Exit Function
        End If
        ischeckcontent=0
        Set Dom=Application(Dvbbs.CacheName & "_accesstopic")
        '检查审核是否有打开设置
        Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]")
        If Node is Nothing Then
            AccessPost=0
            Exit Function
        End If
        '检查是否属于需要审核的用户组
        Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]/checkuser[@use=1 and @usergroupid="&dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text&"]")
        Dim CheckUserGroup
        If Node is Nothing Then
            Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]/checkuser[@use=1 and @usergroupid=4]")
            If Not (Node Is Nothing) Then
                Response.Charset = "GB2312"
                Dim ParentGID
                If Not TypeName(Application(Dvbbs.CacheName &"_groupsetting"))="DOMDocument" Then LoadGroupSetting()
                ParentGID=Application(Dvbbs.CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text &"']/@parentgid").text
                If Not ParentGID=3 Then AccessPost=0:Exit Function
                CheckUserGroup=4
            Else
                AccessPost=0
                Exit Function
            End If
        Else
            CheckUserGroup=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text
        End If

        '用户被豁免审核判断
        Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]/nocheck/username[.='"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@username").text&"']")
        If Not Node is Nothing Then
            AccessPost=0
            Exit Function
        End If
        Rem action=5 主题 actiom=6 回复 action=7 投票 action=8 编辑
        Dim tmpstr,laction,regdate,delPercent
         Select Case action
             Case "5"
                 tmpstr="setting[@use=1]/check[@new=1]"
                 laction="new"
             Case "6"
                     tmpstr="setting[@use=1]/check[@re=1]"
                     laction="re"
             Case "7"
                 tmpstr="setting[@use=1]/check[@new=1]"
                 laction="new"
             Case "8"
                 tmpstr="setting[@use=1]/check[@edit=1]"
                 laction="edit"
         End Select
        If Dom.documentElement.selectSingleNode(tmpstr) Is Nothing Then
            AccessPost=0
            Exit Function
        End If
        regdate=Datediff("d",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now())
        If CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) > 0 Or CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text) < 0 Then
            delPercent=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)-CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text)
            delPercent=(0-CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text))/delPercent
        Else
            delPercent=0
        End If
        delPercent=FormatPercent(delPercent)
        For Each node in Dom.documentElement.selectNodes("setting[@use=1 and check/@"&laction&"=1]/checkuser[@use=1 and @usergroupid="&CheckUserGroup&"]")
            '主题数判断
            If Node.selectSingleNode("usertopic/@use").text="1" Then
                If CCur(Node.selectSingleNode("usertopic/@value").text) > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertopic").text) Then
                    AccessPost=1
                    Exit For
                End If
            End If
            '回贴数
            If Node.selectSingleNode("userpost/@use").text="1" Then
                If CCur(Node.selectSingleNode("userpost/@value").text) > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) Then
                    AccessPost=1
                    Exit For
                End If
            End If
            '注册天数的比较
            If Node.selectSingleNode("regdate/@use").text="1" Then
                If CCur(Node.selectSingleNode("regdate/@value").text) > regdate Then
                    AccessPost=1
                    Exit For
                End If
            End If
            '删贴百分比比较
            If Node.selectSingleNode("userdel/@use").text="1" Then
                If FormatNumber(Node.selectSingleNode("userdel/@value").text) <  FormatNumber(delPercent) Then
                    AccessPost=1
                    Exit For
                End If
            End If
            '对被屏蔽用户是否审核的判断
            If Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@lockuser").text="2" And Node.selectSingleNode("lockuser/@use").text="1" Then
                AccessPost=1
                Exit For
            End If
            If Node.selectSingleNode("checkcontent/@use").text="1" Then
                Ischeckcontent=1
            End If
        Next
        If AccessPost=1 Then
            Exit Function
        End If
        If ischeckcontent=0 Then
            AccessPost=0
        Else
            Set Node=Dom.documentElement.selectNodes("setting[@use=1]/checkcontent")
            AccessPost=checkcontent(node)
        End If
    End Function
    Function checkcontent(node1)
        Dim re,s,node,tmpnode
        checkcontent=0
        s=unescape(Request("topic"))&unescape(Request("Body"))
        Set re=new RegExp
        re.IgnoreCase =True
        re.Global=True
        For Each Node in node1
            '含图片检查
            If Node.selectSingleNode("checkpic/@use").text="1" Then
                re.Pattern="(\[IMG\]|<img)"
                If re.Test(s) Then
                    checkcontent=1
                    Exit For
                End If
            End If
            '含链接检查
            If Node.selectSingleNode("checklink/@use").text="1" Then
                re.Pattern="(\[url\]|<a |http://|https://)"
                If re.Test(s) Then
                    checkcontent=1
                    Exit For
                End If
            End If
            '含flash检查
            If Node.selectSingleNode("checkflash/@use").text="1" Then
                re.Pattern="(\[flash|<object )"
                If re.Test(s) Then
                    checkcontent=1
                    Exit For
                End If
            End If
            '含媒体播放检查
            If Node.selectSingleNode("checkmp/@use").text="1" Then
                re.Pattern="(\[mp)"
                If re.Test(s) Then
                    checkcontent=1
                    Exit For
                End If
            End If
            '含媒rm检查
            If Node.selectSingleNode("checkrm/@use").text="1" Then
                re.Pattern="(\[rm)"
                If re.Test(s) Then
                    checkcontent=1
                    Exit For
                End If
            End If
            For Each tmpnode in Node.selectNodes("checkword")
                re.Pattern=tmpnode.selectSingleNode("@content").text
                If re.Test(s) Then
                    checkcontent=1
                    Exit For
                End If
            Next
        Next
        set re=Nothing
    End Function

    Rem Add ajax回复帖子返回html过程 By Dv.唧唧 2007-10-18
    Private Sub ajaxReturn()
        If IsAudit=1  Then
            If IsAuditcheck=1 Then
                Response.write "{IsAuditInfo:'由于您发表的贴子含敏感内容，您的贴子需要管理员审核过才可以见到。'}"
            ElseIf IsAuditcheck=2 Then
                Response.write "{IsAuditInfo:'由于您尚未达到豁免审核的条件，您的贴子需要管理员审核过才可以见到。'}"
            Else
                Response.write "{IsAuditInfo:'"&template.Strings(19)&"'}"
            End If
'            Response.Write "parent.close_postform();alert('"&PostRetrunName&"');"'parent.close_postform();"
            Response.end
        end if
        Dvbbs.LoadTemplates("dispbbs")

        Dim dv_ubb
        Set dv_ubb=new Dvbbs_UbbCode
        UserFlashGet=0'禁止使用 FlashGet避免缺少函数出错，原本可以包含FlashGet函数文件的，但这文件实在太垃圾了，一包含就有数据输出。 by老迷
        dv_ubb.PostType=1

        Dim outputHtml
        outputHtml = template.html(5)

        Dim Rs,Rs2,Rs3,Body
        TotalUseTable=checktable(TotalUseTable)
        Set Rs=Dvbbs.Execute("select * From "&TotalUseTable&" Where PostUserID="&Dvbbs.UserID&" And AnnounceID="& CLng(AnnounceID))
        Set Rs2=Dvbbs.Execute("select Child,GetMoneyType From Dv_Topic Where TopicID="&CLng(RootID))
        Set Rs3=Dvbbs.Execute("select UserEmail,UserPost,UserSex,UserFace,UserWidth,UserHeight,UserIM,JoinDate,UserClass,userEP,UserPower,UserIsBest,UserTitle,UserGroupID,TitlePic  From Dv_User Where UserID="&Dvbbs.UserId)

        Dim UserIM,nameglow(7),sexPic,namestyle,getnameglow
        UserIM = Split(Rs3("UserIM"),"|||")
        nameglow(0)=Dvbbs.mainsetting(9)
        nameglow(1)=Dvbbs.mainsetting(7)
        nameglow(2)=Dvbbs.mainsetting(7)
        nameglow(3)=Dvbbs.mainsetting(5)
        nameglow(6)="gray"
        nameglow(7)=Dvbbs.mainsetting(11)

        'FOR UBB
        replyid_a = AnnounceID
        AnnounceID_a = AnnounceID
        RootID_a = RootID
        T_GetMoneyType = Rs2(1)


        Dim floor
        floor = Cint(Rs2(0)+1)
        If floor >10 And Star=1 Then floor = 1

        If floor Mod 2 = 0 Then
            outputHtml = Replace(outputHtml,"{$divStyle}","postlary2")
        Else
            outputHtml = Replace(outputHtml,"{$divStyle}","postlary1")
        End If

        If Rs3("UserSex")=0 Then
            sexPic="FeMale.gif"
        Else
            sexPic="Male.gif"
        End If

        If Dvbbs.forum_setting(6)=1 And Rs3("UserTitle")<>"" Then
            outputHtml = Replace(outputHtml,"{$UserTitle}",Rs3("UserTitle"))
        Else
            outputHtml = Replace(outputHtml,"{$UserTitle}","")
        End If

        'If CLng(Rs3("UserPower")) > 0 Then
            'outputHtml = Replace(outputHtml,"{$UserPower}","<div><font color=""red""><b>威望："&Rs3("UserPower")&"</b></font></div>")
        'Else
            outputHtml = Replace(outputHtml,"{$UserPower}",Rs3("UserPower"))
        'End If
        outputHtml = Replace(outputHtml,"{$UserBest}",Rs3("UserIsBest"))


        If CInt(Rs3("UserGroupID")) < 9 Then
            getnameglow = nameglow(Rs3("UserGroupID")-1)
        Else
            getnameglow = Dvbbs.mainsetting(5)
        End If

        namestyle = Split(Application(Dvbbs.CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& CInt(Rs3("UserGroupID")) &"']/@groupsetting").text,",")(58)
        namestyle = Split(namestyle,"§")

        If Dvbbs.Forum_setting(99) = 1 Then
            outputHtml = Replace(outputHtml,"{$Boke}"," | <a href=""boke.asp?UserID="&Dvbbs.UserId&""" title=""访问"&Dvbbs.membername&"的个人博客"" target=""_blank"">博客</a>")
        Else
            outputHtml = Replace(outputHtml,"{$Boke}","")
        End If

        If Trim(UserIM(0))<>"" Then
            outputHtml = Replace(outputHtml,"{$homepage}"," | <a href="""&UserIM(0)&""" target=""_blank"" title=""访问"&Dvbbs.membername&"的主页"">主页</a>")
        Else
            outputHtml = Replace(outputHtml,"{$homepage}","")
        End If

        If Trim(UserIM(1))<>"" Then
            outputHtml = Replace(outputHtml,"{$QQ}"," | <a href=""tencent://message/?uin="&UserIM(1)&""" title=""点击发送QQ消息给"&UserIM(1)&""" >QQ</a>")
        Else
            outputHtml = Replace(outputHtml,"{$QQ}","")
        End If

        If Trim(Rs3("UserEmail"))<>"" Then
            outputHtml = Replace(outputHtml,"{$UserEmail}"," | <a href=""mailto:"&Rs3("UserEmail")&""" title=""点击这里发送电子邮件给"&Dvbbs.membername&""">邮箱</a>")
        Else
            outputHtml = Replace(outputHtml,"{$UserEmail}","")
        End If
        Ubblists= Rs("Ubblist")
        If InStr(Ubblists,",39,") > 0  Then
            Body = dv_ubb.Dv_UbbCode(Dvbbs.ChkBadWords(Rs("Body")),Rs3("UserGroupID"),1,0)
        Else
            Body = dv_ubb.Dv_UbbCode(Dvbbs.ChkBadWords(Rs("Body")),Rs3("UserGroupID"),1,1)
        End If

        outputHtml = Replace(outputHtml,"{$boardID}",Dvbbs.boardid)                                             '版面ID
        outputHtml = Replace(outputHtml,"{$replyID}",Rs("AnnounceID"))                                         '帖子编号
        outputHtml = Replace(outputHtml,"{$topicId}",RootID)                                                 '主题编号
        outputHtml = Replace(outputHtml,"{$Expression}",Rs("Expression"))                                     '发帖心情
        outputHtml = Replace(outputHtml,"{$topic}",Rs("Topic"))                                                 '标题
        outputHtml = Replace(outputHtml,"{$floor}",Rs2(0)+1)                                                 '楼层
        outputHtml = Replace(outputHtml,"{$Content}",Body)                                                     '内容
        outputHtml = Replace(outputHtml,"{$postUserName}",Dvbbs.membername)                                     '用户名
        outputHtml = Replace(outputHtml,"{$postUserId}",Dvbbs.UserId)                                         '用户ID
        outputHtml = Replace(outputHtml,"{$sexPic}",sexPic)                                                     '性别图片
        outputHtml = Replace(outputHtml,"{$UserFace}",Mid(Rs3("UserFace"),InStr(Rs3("UserFace"),"|")+1))     '头像
        outputHtml = Replace(outputHtml,"{$UserFaceW}",Rs3("UserWidth"))                                     '头像高度
        outputHtml = Replace(outputHtml,"{$UserFaceH}",Rs3("UserHeight"))                                     '头像宽度
        outputHtml = Replace(outputHtml,"{$nameglow}",getnameglow)                                             '用户名光晕颜色
        outputHtml = Replace(outputHtml,"{$postUserGroup}",Rs3("UserClass"))                                 '用户组名称
        outputHtml = Replace(outputHtml,"{$TitlePic}",Rs3("TitlePic"))                                         '等级图片
        outputHtml = Replace(outputHtml,"{$postUserPost}",Rs3("UserPost"))                                     '用户帖子数
        outputHtml = Replace(outputHtml,"{$postUserScore}",Rs3("userEP"))                                     '用户积分
        'outputHtml = Replace(outputHtml,"{$postUserReg}",FormatDateTime(Rs3("JoinDate"),1))                     '注册日期
        outputHtml = Replace(outputHtml,"{$postUserReg}",Rs3("JoinDate"))
        outputHtml = Replace(outputHtml,"{$postTime}",Rs("DateAndTime"))                                     '回复时间
        outputHtml = Replace(outputHtml,"{$namestyleA}",namestyle(0))                                         '用户名标记 1
        outputHtml = Replace(outputHtml,"{$namestyleB}",namestyle(1))                                         '用户名标记 2
        outputHtml = Replace(outputHtml,"{$star}",Star)                                                         '分页标记标记

        Dvbbs.Stats = Dvbbs.Stats & "成功"
        'Call Dvbbs.BoardMasterPoint()    '动网官方版主插件，斑竹评定

        Response.Clear
        Response.Write outputHtml Rem &"----"& Dv_FilterJS(Rs3("UserFace"))
        'Response.Cookies("Dvbbs")=GetFormID()

        Rs.Close
        Rs2.Close
        Rs3.Close
        Set Rs = Nothing
        Set Rs2 = Nothing
        Set Rs3 = Nothing
        Set dv_ubb=Nothing
        Response.End
    End Sub

    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

    Sub showAjaxMsg(t,msg1,msg2,str)
        Response.Clear
        Rem 返回值：提交状态 0失败 1成功，显示信息，一些参数 如版块ID | 帖子id | 第几页 | 跳转URL
        Response.Write Dvbbs.Replacehtml("{Suc:"&t&",message:["""&msg1&""","""&msg2&"""],id:"""&str&"""};")
        Response.End
    End Sub

    Rem Add 返回showerr错误信息
    Function getErrCodeMsg()
        Dim i,ErrCodes,ErrString
        ErrCodes=Dvbbs.ErrCodes
        If ErrCodes<>"" Then
            ErrCodes=Split(ErrCodes,",")
            For i=0 to UBound(ErrCodes)
                If IsNumeric(ErrCodes(i)) Then
                    If i=0 Then
                        ErrString= Dvbbs.ReadTextFile(Template.Folder &"\"& Template.ChildFolder &"\showerr_Strings"&ErrCodes(i)&".htm")
                    Else
                        ErrString=ErrString&"<br />"&Dvbbs.ReadTextFile(Template.Folder &"\"& Template.ChildFolder &"\showerr_Strings"&ErrCodes(i)&".htm")
                    End If
                End If
            Next
        End If
        getErrCodeMsg = ErrString
    End Function
End Class



'截取指定字符
Function cutStr(str,strlen)
    '去掉所有HTML标记
    'Dim re
    'Set re=new RegExp
    're.IgnoreCase =True
    're.Global=True
    're.Pattern="<([^<>]*?)>"
    'Do while re.Test(str)
    '    str=re.Replace(str,"")
    'Loop
    'set re=Nothing
    Str=Dvbbs.Replacehtml(Str)
    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,和HTML
Function reUBBCode(strContent)
    Dim re
    Set re=new RegExp
    re.IgnoreCase =True
    re.Global=True
    strContent=Replace(strContent,"&nbsp;"," ")
    re.Pattern="(\[QUOTE\])(.|\n)*(\[\/QUOTE\])"
    strContent=re.Replace(strContent,"")
    re.Pattern="(\[point=*([0-9]*)\])(.|\n)*(\[\/point\])"
    strContent=re.Replace(strContent,"&nbsp;")
    re.Pattern="(\[post=*([0-9]*)\])(.|\n)*(\[\/post\])"
    strContent=re.Replace(strContent,"&nbsp;")
    re.Pattern="(\[power=*([0-9]*)\])(.|\n)*(\[\/power\])"
    strContent=re.Replace(strContent,"&nbsp;")
    re.Pattern="(\[usercp=*([0-9]*)\])(.|\n)*(\[\/usercp\])"
    strContent=re.Replace(strContent,"&nbsp;")
    re.Pattern="(\[money=*([0-9]*)\])(.|\n)*(\[\/money\])"
    strContent=re.Replace(strContent,"&nbsp;")
    re.Pattern="(\[replyview\])(.|\n)*(\[\/replyview\])"
    strContent=re.Replace(strContent,"&nbsp;")
    re.Pattern="(\[usemoney=*([0-9]*)\])(.|\n)*(\[\/usemoney\])"
    strContent=re.Replace(strContent,"&nbsp;")
    strContent=Replace(strContent,"<I></I>","")
    Set re=Nothing
    strContent=Replace(strContent,Chr(10),"")
    strContent=Replace(strContent,Chr(13),"")
    strContent=Replace(strContent, CHR(32), " ")
    strContent=Replace(strContent, CHR(9), " ")
    strContent=Dvbbs.Replacehtml(strContent)
    reUBBCode=replace(strContent,"<","&lt;")
End Function

'通用函数
Function IstrueName(uName)
    IstrueName=False
    If InStr(uName,"=")>0 Then Exit Function
    If InStr(uName,"%")>0 Then Exit Function
    If InStr(uName,Chr(32))>0 Then Exit Function
    If InStr(uName,"?")>0 Then Exit Function
    If InStr(uName,"&")>0 Then Exit Function
    If InStr(uName,";")>0 Then Exit Function
    If InStr(uName,",")>0 Then Exit Function
    If InStr(uName,"'")>0 Then Exit Function
    If InStr(uName,Chr(34))>0 Then Exit Function
    If InStr(uName,chr(9))>0 Then Exit Function
    If InStr(uName,"　")>0 Then Exit Function
    If InStr(uName,"$")>0 Then Exit Function
    IstrueName=True
End Function
'发贴时用，为了减少入库量
'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
Sub UPDATE_User_Msg(username)
    Dim msginfo,i,UP_UserInfo,newmsg
    newmsg=newincept(username)
    If newmsg>0 Then
        msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
    Else
        msginfo="0||0||null"
    End If
    Dvbbs.execute("UPDATE [Dv_User] Set UserMsg='"&Dvbbs.CheckStr(msginfo)&"' WHERE username='"&Dvbbs.CheckStr(username)&"'")
    If username=Dvbbs.MemberName Then
        Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text=msginfo
    Else
        Call Dvbbs.NeedUpdateList(username,1)
    End If
End Sub

'统计留言
Function newincept(iusername)
Dim Rs
Rs=Dvbbs.execute("SELECT Count(id) FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& Dvbbs.CheckStr(iusername) &"'")
    newincept=Rs(0)
    Set Rs=nothing
    If isnull(newincept) Then newincept=0
End Function

Function inceptid(stype,iusername)
    Dim Rs
    Set Rs=Dvbbs.execute("SELECT top 1 id,sender FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& Dvbbs.CheckStr(iusername) &"'")
    If not rs.eof Then
        If stype=1 Then
            inceptid=Rs(0)
        Else
            inceptid=Rs(1)
        End If
    Else
        If stype=1 Then
            inceptid=0
        Else
            inceptid="null"
        End If
    End If
    Set Rs=nothing
End Function
%>

回复接口说明

6、接口文件无须任何改动即可使用，如果你希望增加校验或其他功能，请仔细修改；

下载GBK回复接口文件

下载UTF-8回复接口文件

回复接口代码

<!--#include file="conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/md5.asp"-->
<!--#include file="inc/ubblist.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<!--#include file="inc/dv_ubbcode.asp"-->
<!--#include file="inc/code_encrypt.asp"-->
<%
Dim parameter

'以下定义的变量在Dv_ubbcode.asp页面会用到
Dim replyid_a,AnnounceID,TotalUseTable,AnnounceID_a,RootID_a
Dim T_GetMoneyType,EmotPath
Dim UserName:UserName=Dvbbs.Membername
Dim IsThisBoardMaster '确定当前用户是否本版版主，防止下面的操作影响到 Dvbbs.BoardMaster导致出错
IsThisBoardMaster = Dvbbs.BoardMaster
Dim PostStyle,ajaxPost
PostStyle = Request.Form("poststyle")
'ajaxPost = CInt(Request.Form("ajaxPost"))
'
'If ajaxPost=1 Then
' ajaxPost = True
'Else
 ajaxPost = False
'End If

If Dvbbs.BoardID < 1 Then
 Response.Write "[err]BoardID参数错误[/err]" 'zzcity add
 'Response.Write "参数错误"
 Dvbbs.PageEnd()
 Response.End
End If
Dim MyPost
Dim postbuyuser,bgcolor,abgcolor,FormID
Dvbbs.Loadtemplates("post")
Set MyPost = New Dvbbs_Post
Dvbbs.Stats = MyPost.ActionName
'EmotPath=Split(Dvbbs.Forum_emot,"|||")(0)  'em心情路径
'If Not ajaxPost Then
' If PostStyle = "1" Then
'  Dvbbs.Head()
'  Dvbbs.ErrType=1
' Else
'  Dvbbs.Nav()
'  Dvbbs.Head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"",""
' End If
'End if

MyPost.Save_CheckData
Set MyPost = Nothing
'If Not ajaxPost Then Dvbbs.Footer
Dvbbs.PageEnd()
Class Dvbbs_Post
 Public Action,ActionName,Star,Page,IsAudit,ToAction,TopicMode,Reuser
 Private ReplyID,ParentID,RootID,Topic,Content,char_changed,signflag,mailflag,iLayer,iOrders
 Private TopTopic,IsTop,LastPost,LastPost_1,UpLoadPic_n,ihaveupfile,smsuserlist,upfileinfo
 Private UserName,UserPassWord,UserPost,GroupID,UserClass,DateAndTime,DateTimeStr,Expression,MyLastPostTime,LastPostTimes
 Private LockTopic,MyLockTopic,MyIsTop,MyIsTopAll,MyTopicMode,Child
 Private CanLockTopic,CanTopTopic,CanTopTopic_a,CanEditPost,Rs,SQL,i,IsAuditcheck
 Private vote,votetype,votenum,votetimeout,voteid,isvote,ErrCodes
 Private GetPostType,ToMoney,UseTools,ToolsBuyUser,GetMoneyType,Tools_UseTools,Tools_LastPostTime,ToolsInfo,ToolsSetting
 Private tMagicFace,iMagicFace,tMagicMoney,tMagicTicket,FoundUseMagic,isAlipayTopic
 Private Sub Class_Initialize()

  ErrCodes = ""
  Dvbbs.ErrCodes=""
  '管理员及该版版主允许在锁定论坛发帖
'  If Dvbbs.Board_Setting(0)="1" And Not (Dvbbs.Master or Dvbbs.Boardmaster) Then
'   If ajaxpost Then
'    Call showAjaxMsg(0,"锁定论坛，只对管理员及该版版主开放！","","")
'   Else
'    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&action=lock&boardid="&dvbbs.boardID&""
'    Response.redirect parameter
'   End If
'  End If
'  If Dvbbs.IsReadonly()  And Not Dvbbs.Master Then
'   If ajaxpost Then
'    Call showAjaxMsg(0,"论坛只读，只对管理员开放！","","")
'   Else
'    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&action=readonly&boardid="&dvbbs.boardID&""
'    Response.redirect parameter
'   End If
'  End If
'  Action = Request("Action")
  Action = "sre" 'zzcity add
  TotalUseTable = Dvbbs.NowUseBBS
'  Select Case Action
'  Case "snew"
'   Action = 5
'   ActionName = template.Strings(1)
'   If Dvbbs.GroupSetting(3)="0" Then Dvbbs.AddErrCode(70)
'  Case "sre"
   Action = 6
   ActionName = template.Strings(3)
'   'If Dvbbs.GroupSetting(5)="0" then Dvbbs.AddErrCode(71)
'  Case "svote"
'   Action = 7
'   ActionName = template.Strings(5)
'   If Dvbbs.GroupSetting(8)="0" then Dvbbs.AddErrCode(56)
'  Case "sedit"
'   Action = 8
'   ActionName = template.Strings(7)
'  Case Else
'   Action = 1
'   ActionName = template.Strings(0)
'  End Select
  Star = Request("star")
  If Star = "" Or Not IsNumeric(Star) Then Star = 1
  Star = Clng(Star)
  Page = Request("page")
  If Page = "" Or Not IsNumeric(Page) Then Page = 1
  Page = Clng(Page)
  'IsAudit = Cint(Dvbbs.Board_Setting(3))
  IsAudit=0
  Reuser = False '此变量标识是否更名发贴
  FoundUseMagic = False
 End Sub

 Public Function CheckFormID(id)
  CheckFormID=false
  Dim i,Str
  For i=1 to Len(id)
   Str=Str & Asc(Mid(id,i,1))-97
  Next
  If Session.SessionID=Str Then
   CheckFormID=True
  End If
 End Function

 Rem 改写ShowErr过程 ajax模式下 不跳转 By Dv.唧唧  于 火星
' Sub ShowErr("")
 Sub ShowErr(ErrCodes)

'  If ajaxpost And Dvbbs.ErrCodes<>"" Then
'   Call showAjaxMsg(0,getErrCodeMsg(),"","")
'  Else
'   Dvbbs.ShowErr()
'  End If
  if ErrCodes<>"" then'zzcity add 
   Response.Write "[err]"&ErrCodes&"[/err]" 
   Dvbbs.PageEnd()
   response.End()
  elseif Dvbbs.ErrCodes<>"" then
   Response.Write "[err]"&Dvbbs.ErrCodes&"[/err]" 
   Dvbbs.PageEnd()
   response.End()
  end if
 End Sub

 '通用判断
 Public Function Chk_Post()
  'FormID=Request("Dvbbs")
  'If FormID="" Then FormID=Request.Cookies("Dvbbs"):Response.Cookies("Dvbbs")=""
  'If Not CheckFormID(FormID) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=您提交的参数错误&action=OtherErr"
'  If Dvbbs.Board_Setting(43)="1" Then Dvbbs.AddErrCode(72)
'  If Dvbbs.Board_Setting(1)="1" and Dvbbs.GroupSetting(37)="0" Then Dvbbs.AddErrCode(26)
'  If Dvbbs.UserID>0 Then
'   If Clng(Dvbbs.GroupSetting(52))>0 And DateDiff("s",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now)<Clng(Dvbbs.GroupSetting(52))*60 Then
'    If ajaxPost Then
'     Call showAjaxMsg(0,Replace(template.Strings(21),"{$timelimited}",Dvbbs.GroupSetting(52)),"","")
'    Else
'     parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(21),"{$timelimited}",Dvbbs.GroupSetting(52))&"&action=OtherErr"
'     Response.redirect parameter
'    End if
'
'   End If
'   If Dvbbs.GroupSetting(62)<>"0" And Not Action = 8 Then
'    If Clng(Dvbbs.GroupSetting(62))<=Clng(Dvbbs.UserToday(0)) Then
'     If ajaxPost Then
'      Call showAjaxMsg(0,Replace(template.Strings(27),"{$topiclimited}",Dvbbs.GroupSetting(62)),"","")
'     Else
'      parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(27),"{$topiclimited}",Dvbbs.GroupSetting(62))&"&action=OtherErr"
'      Response.redirect parameter
'     End if
'    End If
'   End If
'  End If
'  If Dvbbs.GroupSetting(3)="0" And (Action = 5 Or Action = 7) Then
'   If ajaxPost Then
'    Call showAjaxMsg(0,template.Strings(28),"","")
'   Else
'    Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&template.Strings(28)&"&action=OtherErr"
'   End if
'  End if
  'If Dvbbs.GroupSetting(5)="0" And (Action = 6) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&template.Strings(29)&"&action=OtherErr"
 End Function

 '返回判断和参数
 Public Function Get_M_Request()
  AnnounceID = Request("ID")
  If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
  if Dvbbs.ErrCodes<>"" then ShowErr("非法的帖子参数")
  AnnounceID = cCur(AnnounceID)
 End Function

 '检查提交来源
 Public Sub CheckfromScript()
'  If Not Dvbbs.ChkPost() Then Dvbbs.AddErrCode(16):ShowErr("")
'   'If CStr(Request.Cookies("Dvbbs"))=CStr(Dvbbs.Boardid) Then Dvbbs.AddErrCode(30):ShowErr("") '非法的贴子参数。
'   If (Not ChkUserLogin) And (Action = 5 Or Action = 6 Or Action = 7) And Dvbbs.UserID>0 Then Dvbbs.AddErrCode(12):ShowErr("")
 End Sub

 '判断发贴时间间隔
 Private Sub CheckpostTime()
  If Dvbbs.Board_Setting(30)="1"  Then
'   If IsDate(Session(Dvbbs.CacheName & "posttime"))  Then
'    If DateDiff("s",Session(Dvbbs.CacheName & "posttime"),Now())<CLng(Dvbbs.Board_Setting(31)) Then
'     If ajaxPost Then
'      Call showAjaxMsg(0,Replace(template.Strings(33),"{$PostTimes}",Dvbbs.Board_Setting(31)),"","")
'     Else
'      parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<Br>"+"<li>"&Replace(template.Strings(33),"{$PostTimes}",Dvbbs.Board_Setting(31))&"&action=OtherErr"
'      Response.redirect parameter
'     End if
'    End If
'   End If
   Session(Dvbbs.CacheName & "posttime")=Now()
    
  End If
 End Sub
 '检查用户身份
 Public Function ChkUserLogin()
   ChkUserLogin=False
   '取得发贴用户名和密码
'  If Dvbbs.UserID=0 Then
'   UserName="客人"
'  Else
'   If ajaxPost Then
'    UserName=Dvbbs.Checkstr(unescape(Request.Form("username")))
'   Else
    UserName=Dvbbs.Checkstr(Request.Form("username"))
'   End If
'  End If
  '校验用户名和密码是否合法
  If UserName="" Or Dvbbs.strLength(userName)>Cint(Dvbbs.Forum_setting(41)) Or Dvbbs.strLength(userName) < Cint(Dvbbs.Forum_setting(40)) Then ShowErr("请输入您的用户名，请确认您输入的用户名长度是否符合论坛标准") 'Dvbbs.AddErrCode(17) 'zzcity add
  If Not IstrueName(UserName) Then ShowErr("无效的用户名") 'Dvbbs.AddErrCode(18) 'zzcity add
'  If Action = 8 Then
'   '编辑贴子，检查用户身份
'   UserPassWord=Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("password")))
'   SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,TruePassWord From [Dv_User] Where UserID="&Dvbbs.UserID
'  Else
   '检查用户是否当前用户
'   If UserName<>Dvbbs.MemberName Then
    Reuser=True
    UserPassWord=Dvbbs.Checkstr(Trim(Request.Form("passwd")))
    UserPassWord=md5(UserPassWord,16)
    SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,userpassword,UserToday From [Dv_User] Where UserName='"&UserName&"' "
'   Else
'    UserPassWord=Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("password")))
'    SQL = "Select JoinDate,UserID,UserPost,UserGroupID,userclass,lockuser,TruePassWord From [Dv_User] Where UserID="&Dvbbs.UserID
'   End If
'  End If
'  If Len(UserPassWord)<>16 AND Len(UserPassWord)<>32 Then Dvbbs.AddErrCode(18)
   Set Rs=Dvbbs.Execute(SQL)
   If Not Rs.EOF Then
'   If Not (UserPassWord<>rs(6) Or rs(5)=1 or rs(3)=5) Then
    '不允许使用马甲
'    If Dvbbs.UserID<>Rs(1) Then
'     ChkUserLogin = False
'    Else
     Dvbbs.UserID=Rs(1)
     Dvbbs.UserToday=Split(Rs(7),"|")
      UserPost=Rs(2)
      GroupID=Rs(3)
      userclass=Rs(4)
      ChkUserLogin=True
'    End If
    Response.cookies("upNum")=0
'    Else
'      Dvbbs.LetGuestSession()
'   End If
   End If
   Set Rs = Nothing
  End Function

 '判断发表类型及权限 GetPostType 0=赠送金币贴(求回复答案),1=获赠金币贴,2=金币购买贴
 Private Sub Chk_PostType()
  Dim ToolsID
  ToolsID = Trim(Request.Form("ToolsID"))
  GetPostType = Trim(Request.Form("GetPostType"))
  ToMoney = Trim(Request.Form("ToMoney"))
  If ToMoney="" or Not Isnumeric(ToMoney) Then ToMoney = 0
  If ToolsID="" or Not Isnumeric(ToolsID) Then
   ToolsID = ""
  Else
   ToolsID = Cint(ToolsID)
  End If
  ToMoney = cCur(ToMoney)
  UseTools = ""
  ToolsBuyUser = ""
  GetMoneyType = 0
  If Dvbbs.GroupSetting(59)<>1 Then Exit Sub
'  If GetPostType<>"" and (Action = 5 or Action = 7) Then
'   Select Case GetPostType
'   Case "0"
'    If ToMoney = 0 or ToMoney > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text)  Or ToMoney < 0 Then
'     If ajaxpost Then
'      Call showAjaxMsg(0,"您设置的金币值为空或者多于您拥有的金币数量。","","")
'     Else
'      Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
'     End If
'     ShowErr("您设置的金币值为空或者多于您拥有的金币数量。")
'    End if
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  = CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text) -ToMoney
'    'UseTools = "-1111"
'    ToolsBuyUser = "0|||$SendMoney"
'    GetMoneyType = 1
'   Case "1"
'    ToolsBuyUser = "0|||$GetMoney"
'    GetMoneyType = 2
'    'UseTools = ToolsInfo(4)
'   Case "2"
'    If ToMoney = 0 Or ToMoney < 0 Then
''     If ajaxpost Then
''      Call showAjaxMsg(0,"请正确填写购买帖的金币数量。","","")
''     Else
''      Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>请正确填写购买帖的金币数量。&action=OtherErr"
''     End If
'     ShowErr("请正确填写购买帖的金币数量。")
'    End if
'    Dim Buy_Orders,Buy_VIPType,Buy_UserList
'    Buy_Orders = Request.FORM("Buy_Orders")
'    Buy_VIPType = Request.FORM("Buy_VIPType")
'    Buy_UserList = Request.FORM("Buy_UserList")
'    If Buy_Orders<>"" and IsNumeric(Buy_Orders) Then
'     Buy_Orders = cCur(Buy_Orders)
'    Else
'     Buy_Orders = -1
'    End If
'    If Not IsNumeric(Buy_VIPType) Then Buy_VIPType = 0
'    If Buy_UserList<>"" Then Buy_UserList = Replace(Replace(Replace(Buy_UserList,"|||",""),"@@@",""),"$PayMoney","")
'    ToolsBuyUser = "0@@@"&Buy_Orders&"@@@"&Buy_VIPType&"@@@"&Buy_UserList&"|||$PayMoney|||"
'    GetMoneyType = 3
'    'UseTools = ToolsInfo(4)
'   End Select
'  End If
  '回复获赠金币帖判断
  If Action = 6 and GetPostType = "1" Then
   If ToMoney = 0 or ToMoney > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text)  Or ToMoney < 0 Then
'    If ajaxpost Then
'     Call showAjaxMsg(0,"您设置的金币值为空或者多于您拥有的金币数量。","","")
'    Else
'     Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您设置的金币值为空或者多于您拥有的金币数量。&action=OtherErr"
'    End If
    ShowErr("您设置的金币值为空或者多于您拥有的金币数量。")
   End If
  End If
 End Sub


 Rem ------------------------
 Rem 保存部分函数开始
 Rem ------------------------
 '检查数据,提取数据，获得贴子数据表名等。

 Public Sub Save_CheckData()
  'Chk_Post()
  'CheckfromScript()
  
  '把提交的数据保存到session
  'Content = CheckAlipay()
  call ChkUserLogin() 'zzcity add
  
  isAlipayTopic = 2
  If Content = "" Then
   Content = Dvbbs.Checkstr(unescape(Request.Form("body")))
   isAlipayTopic = 0
  End If
  '不再把内容保存到session
  'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"postdata","")).text= Request.Form("body")

  '验证码校验
'  If Dvbbs.Board_Setting(4) <> "0" Then
'   If Not Dvbbs.CodeIsTrue() Then
'    If ajaxpost Then
'     Call showAjaxMsg(0,"验证码校验失败,请点击验证码进行刷新！","","")
'    Else
'     Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>验证码校验失败，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'    End If
'   End If
'  End If

  If InStr(Content,"[/payto]") > 0 And InStr(Content,"[payto]") > 0 And InStr(Content,"(/seller)") > 0 And InStr(Content,"(seller)") > 0 Then isAlipayTopic = 2
  Chk_PostType()

  '魔法表情检查部分
'  tMagicFace = Request("tMagicFace")
'  If tMagicFace = "" Or Not IsNumeric(tMagicFace) Then tMagicFace = 0
'  tMagicFace = Cint(tMagicFace)
'  iMagicFace = Request("iMagicFace")
'  If iMagicFace = "" Or Not IsNumeric(iMagicFace) Then iMagicFace = 0
'  iMagicFace = Clng(iMagicFace)
  Expression = Dvbbs.Checkstr(Request.Form("Expression"))
  If Expression = "" Then
   Expression = "face1.gif"
  Else
   Expression = Replace(Expression,"|","")
  End If
'  If tMagicFace = 1 And iMagicFace > 0 And Dvbbs.Forum_Setting(98)="1" Then
'   Set Rs = Dvbbs.Plus_Execute("Select tMoney,tTicket,MagicSetting From Dv_Plus_Tools_MagicFace Where MagicFace_s = " & iMagicFace)
'   If Rs.Eof And Rs.Bof Then
'    Expression = "0|" & Expression
'    tMagicMoney = 0
'    tMagicTicket = 0
'   Else
'    If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text) < Rs(1) And cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) < Rs(0) Then
'     If ajaxpost Then
'      Call showAjaxMsg(0,"您没有足够的金币或点券使用魔法表情！","","")
'     Else
'      Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您没有足够的金币或点券使用魔法表情，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'     End If
'    End if
'    Dim iMagicSetting, iMagicStr
'    iMagicStr = ""
'    iMagicSetting = Split(Rs(2),"|")
'    If cCur(iMagicSetting(0)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text ) Then iMagicStr ="您的帖子数"
'    If cCur(iMagicSetting(1)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) Then iMagicStr ="您的金钱数"
'    If cCur(iMagicSetting(2)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) Then iMagicStr ="您的经验数"
'    If cCur(iMagicSetting(3)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text ) Then iMagicStr ="您的魅力数"
'    If cCur(iMagicSetting(4)) > cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text) Then iMagicStr ="您的威望数"
'
'    If iMagicStr<>"" Then
'     If ajaxpost Then
'      Call showAjaxMsg(0,iMagicStr&"没有达到使用魔法表情的标准，","","")
'     Else
'      Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&iMagicStr&"没有达到使用魔法表情的标准，2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'     End If
'    End If
'
'    Expression = iMagicFace & "|" & Expression
'    tMagicMoney = Rs(0)
'    tMagicTicket = Rs(1)
'    FoundUseMagic = True
'   End If
'   Rs.Close
'   Set Rs=Nothing
'  Else
   Expression = "0|" & Expression
'  End If
  Expression = Split(Expression,"|")
  Topic = Dvbbs.Checkstr(Trim(unescape(Request.Form("topic"))))
  signflag = Dvbbs.Checkstr(Trim(Request.Form("signflag")))
  mailflag = Dvbbs.Checkstr(Trim(Request.Form("emailflag")))
  MyTopicMode = Dvbbs.Checkstr(Trim(Request.Form("topicximoo")))
  MyLockTopic = Dvbbs.Checkstr(Trim(Request.Form("locktopic")))
  Myistop = Dvbbs.Checkstr(Trim(Request.Form("istop")))
  Myistopall = Dvbbs.Checkstr(Trim(Request.Form("istopall")))
  TopicMode = Request.Form("topicmode")

  If Dvbbs.strLength(topic)> CLng(Dvbbs.Board_Setting(45)) Then
'   If ajaxPost Then
'    Call showAjaxMsg(0,Replace(template.Strings(23),"{$topiclimited}",Dvbbs.Board_Setting(45)),"","")
'   Else
'    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(23),"{$topiclimited}",Dvbbs.Board_Setting(45))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'    Response.redirect parameter
'   End If
   ShowErr("标题长度不能大于"&Dvbbs.Board_Setting(45)&"。")
  End If
  Rem 限制提交数据不能大于64K
  If Len(Content) > 64*1024*1024 Then
'   If ajaxPost Then
'    Call showAjaxMsg(0,"您提交的数据过大，提交数据不能大于64K.","","")
'   Else
'    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您提交的数据过大，提交数据不能大于64K&action=OtherErr&autoreload=1"
'    Response.redirect parameter
'   End if
   ShowErr("您提交的数据过大，提交数据不能大于64K。")
  End If

  Rem 老迷增加xhtml格式限制
  Dim XMLPOST,XHTML
  XHTML=False
'  If XHTML Then
'   Set XMLPOST=Dvbbs.CreateXmlDoc("msxml2.DOMDocument"& MsxmlVersion)
'   If XMLPOST.loadxml("<xhtml>" & replace(Content,"&","&amp;") &"</xhtml>") Then
'    Content=replace(Mid(XMLPOST.documentElement.xml,8,Len(XMLPOST.documentElement.xml)-15),"&amp;","&")
'   Else
'    If ajaxPost Then
'     Call showAjaxMsg(0,"您提交的数据不合法(必须提交XHTML格式).","","")
'    Else
'     parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您提交的数据不合法(必须提交XHTML格式)&action=OtherErr&autoreload=1"
'     Response.redirect parameter
'    End if
'
'   End If
'   Set XMLPOST=Nothing
'  End If
  If Dvbbs.strLength(Content) > CLng(Dvbbs.Board_Setting(16)) Then
'   If ajaxPost Then
'    Call showAjaxMsg(0,Replace(template.Strings(24),"{$bodylimited}",Dvbbs.Board_Setting(16)),"","")
'   Else
'    Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(24),"{$bodylimited}",Dvbbs.Board_Setting(16))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'   End If
   ShowErr("帖子内容长度不能大于"&Dvbbs.Board_Setting(16)&"。")
  End If
  REM 2004-4-23添加限制帖子内容最小字节数,下次在模板中添加。Dvbbs.YangZheng
  If Dvbbs.strLength(Content) < CLng(Dvbbs.Board_Setting(52)) And Not CLng(Dvbbs.Board_Setting(52)) = 0 Then
'   If ajaxPost Then
'    Call showAjaxMsg(0,Replace(template.Strings(24),"大于{$bodylimited}","小于"&Dvbbs.Board_Setting(52)),"","")
'   Else
'    parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(template.Strings(24),"大于{$bodylimited}","小于"&Dvbbs.Board_Setting(52))&"<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'    Response.redirect parameter
'   End if
   ShowErr("帖子内容长度不能小于"&Dvbbs.Board_Setting(52)&"。")
  End If
  Dim testContent
        '如果使用了非HTML编辑器，则替换换行标志以实现换行 by 雨·漫步
        If Dvbbs.GroupSetting(67) = 0 Then
            Content = Replace(Content,vbCrLf,"<br />")
        End If
  testContent=Content
  testContent=Replace(testContent,vbNewLine,"")
  testContent=Replace(testContent," ","")
  testContent=Replace(testContent,"&nbsp;","")
  'testContent=Trim(Dvbbs.Replacehtml(testContent))
  If testContent="" and InStr(Content,"<img")=0 and InStr(Content,"<input")=0 and InStr(Content,"<object")=0  and InStr(Content,"<embed")=0 Then
'   If ajaxpost Then
'    Call showAjaxMsg(0,"您没有填写内容,请填写帖子内容","","")
'   Else
'    Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您没有填写内容.2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'   End If
   ShowErr("您没有填写内容,请填写帖子内容。")
  End If
  If Dvbbs.UserID=0 Then
   mailflag=0:signflag=0
  Else
   If Not IsNumeric(mailflag) Or mailflag="" Then mailflag=0
   mailflag=CInt(mailflag)
   If Not IsNumeric(signflag) Or signflag="" Then signflag=1
   signflag=CInt(signflag)
  End If
  If TopicMode<>"" and IsNumeric(TopicMode) Then TopicMode=Cint(TopicMode) Else TopicMode=0
  If Request.form("upfilerename")<>"" Then
   ihaveupfile=1
   upfileinfo=Replace(Request.form("upfilerename"),"'","")
   upfileinfo=Replace(upfileinfo,";","")
   upfileinfo=Replace(upfileinfo,"--","")
   upfileinfo=Replace(upfileinfo,")","")
   Dim fixid,upfilelen
   fixid=Replace(upfileinfo," ","")
   fixid=Replace(fixid,",","")
   If Not IsNumeric(fixid) Then ihaveupfile=0
   upfilelen=len(upfileinfo)
   upfileinfo=left(upfileinfo,upfilelen-1)
  Else
   ihaveupfile=0
  End If
  voteid=0
  isvote=0
  Dim VoteTemp,VoteTemp1,VoteTemp2
'  If Action = 7 Then
'   votetype=Dvbbs.Checkstr(request.Form("votetype"))
'   If IsNumeric(votetype)=0 or votetype="" Then votetype=0
'   vote=Dvbbs.Checkstr(trim(Replace(request.Form("vote"),"|","")))
'   Dim j,k,vote_1,votelen,votenumlen
'   If vote="" Then
'    Dvbbs.AddErrCode(81)
'   Else
'    vote=split(vote,chr(13)&chr(10))
'    j=0
'    For i = 0 To ubound(vote)
'     VoteTemp1 = ""
'     VoteTemp2 = ""
'     If Not (vote(i)="" Or vote(i)=" ") Then
'      VoteTemp = Split(vote(i),"@@")
'      If Ubound(VoteTemp) = 3 Then '判断是否调查
'       If VoteTemp(1)="0" or VoteTemp(1)="1" Then
'        VoteTemp1 = Split(VoteTemp(2),"$$")
'        For k=0 to Ubound(VoteTemp1)-1
'         VoteTemp2 = VoteTemp2 & "0$$"
'        Next
'       Else
'        VoteTemp2 = 0
'       End If
'       votenum= votenum & VoteTemp2&"|"
'      Else
'       votenum=votenum&"0|"
'      End If
'      vote_1=""&vote_1&""&vote(i)&"|"
'      j=j+1
'     End If
'     If i>cint(Dvbbs.Board_Setting(32))-2 Then Exit For
'    Next
'    'For k = 1 to j
'    ' votenum=""&votenum&"0|"
'    'Next
'    votelen=len(vote_1)
'    votenumlen=len(votenum)
'    votenum=left(votenum,votenumlen-1)
'    vote=left(vote_1,votelen-1)
'    'Response.Write votenum
'    'Response.End
'   End If
'   If Not IsNumeric(request("votetimeout")) Then
'    Dvbbs.AddErrCode(82)
'   Else
'    If request("votetimeout")="0" Then
'     votetimeout=dateadd("d",9999,Now())
'    Else
'     votetimeout=dateadd("d",CCur(request("votetimeout")),Now())
'    End If
'    votetimeout=Replace(Replace(CSTR(votetimeout+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
'   End If
'  End If
'  If Action = 5 Or Action = 7 Then
'   CanLockTopic=False
'   CanTopTopic=False
'   CanTopTopic_a=False
'   If Topic="" OR Replace(Topic&"","","")="" Then
'    If ajaxpost Then
'     Call showAjaxMsg(0,"您是否忘记填写标题了？","","")
'    Else
'     Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您忘记填写标题<BR>2秒后自动返回上一页面。&action=OtherErr&autoreload=1"
'    End If
'    ShowErr("您忘记填写标题")
'   End if
   '减少判断，如果不为固顶，锁定等等的操作的话，不检查权限。
'   If MyLockTopic="yes" Or Myistopall="yes" Or Myistop="yes" Then
'    '判断用户是否有固顶/解除固顶帖子权限
'    'If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) Then
'    If Dvbbs.GroupSetting(20)="1" Then CanLockTopic=True
'    'End If
'    If Dvbbs.GroupSetting(21)="1" Then CanTopTopic=True
'
'    'If Dvbbs.FoundUserPer and Dvbbs.GroupSetting(21)="1" Then
'    ' CanTopTopic=True
'    'ElseIf Dvbbs.FoundUserPer and Dvbbs.GroupSetting(21)="0" Then
'    ' CanTopTopic=False
'    'End If
'    '判断用户是否有总固顶帖子权限
'    If (dvbbs.master or dvbbs.superboardmaster or dvbbs.boardmaster) and Dvbbs.GroupSetting(38)="1" Then CanTopTopic_a=True
'    If Dvbbs.GroupSetting(38)="1" and Cint(Dvbbs.UserGroupID)>3 Then CanTopTopic_a=True
'    If Dvbbs.FoundUserPer and Dvbbs.GroupSetting(38)="1" Then
'     CanTopTopic_a=True
'    ElseIf Dvbbs.FoundUserPer and Dvbbs.GroupSetting(38)="0" Then
'     CanTopTopic_a=False
'    End If
'   End If
'   If MyLockTopic="yes" Then
'    MyLockTopic=1
'   Else
'    MyLockTopic=0
'   End If
'   If Myistopall="yes" Then
'    Myistopall=1
'   Else
'    Myistopall=0
'   End If
'   If Not CanTopTopic_a Then Myistopall=0
'   If Myistop="yes" and Myistopall=0 Then
'    Myistop=1
'    If Not CanTopTopic Then Myistop=0
'   ElseIf Myistopall=1 Then
'    Myistop=3
'   Else
'    Myistop=0
'   End If
'   If Not IsNumeric(MyTopicMode) or Dvbbs.GroupSetting(51)="0" Then MyTopicMode=0
'   If Not CanLockTopic Then MyLockTopic=0
'   TotalUseTable=Dvbbs.NowUseBbs
'  ElseIf Action = 6 Then
   'AnnounceID = Request("followup")
   AnnounceID = Request("announceid") 'zzcity add
   RootID = Request("rootid")
   If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then showerr("AnnounceID参数缺失") 'Dvbbs.AddErrCode(30)
   If RootID = "" Or Not IsNumeric(RootID) Then showerr("RootID参数缺失") 'Dvbbs.AddErrCode(30)
   TotalUseTable=Request.Form("totalusetable")
   TotalUseTable=checktable(TotalUseTable)
   'ShowErr("")
   AnnounceID = cCur(AnnounceID)
   ParentID = AnnounceID
   RootID = cCur(RootID)
   MyLockTopic=0
'  ElseIf Action = 8 Then
'   If Not IsNumeric(MyTopicMode) or Dvbbs.GroupSetting(51)="0" Then MyTopicMode=0
'   AnnounceID = Request("replyID")
'   RootID = Request("ID")
'   If AnnounceID = "" Or Not IsNumeric(AnnounceID) Then Dvbbs.AddErrCode(30)
'   If RootID = "" Or Not IsNumeric(RootID) Then Dvbbs.AddErrCode(30)
'   TotalUseTable = Checktable(Request.Form("TotalUseTable"))
'   ShowErr("")
'   AnnounceID = cCur(AnnounceID)
'   RootID = cCur(RootID)
'   MyLockTopic=0
'   Set Rs=Dvbbs.Execute("select AnnounceID from "&TotalUseTable&" where ParentID=0 and rootid="&RootID)
'   If Not Rs.eof Then
'    If AnnounceID=Rs(0) Then
'     If Topic="" OR Replace(Topic&"","","")="" Then Dvbbs.AddErrCode(79)
'    End If
'   Else
'    Dvbbs.AddErrCode(30)
'   End If
'  End If
  
'  ShowErr("")
  
  SaveData()
 End Sub
 '保存数据
 Private Sub SaveData()
  If Not (Dvbbs.Master or Action = 8) Then CheckpostTime()
  Dim Forumupload
  'Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@postdata").text =""
'   If Dvbbs.GroupSetting(64)="1" Then
    IsAudit=0
'   Else
'    If Dvbbs.Board_Setting(57)="1" Then
'     IsAudit=NeedIsAudit()    
     IsAuditcheck=IsAudit
'    End If
'   End If
  If Dvbbs.UserID=0 Then IsAudit=1:IsAuditcheck=2
'   If IsAudit=0 Then
'    If AccessPost =1 Then
'      IsAudit=1
'      IsAuditcheck=2
'    End If
'   End If
   locktopic=0
  If MyLockTopic=1 Then locktopic=1
  If IsAudit=1 And Action <> 8 Then
   LockTopic=Dvbbs.BoardID
   Dvbbs.BoardID=777
   Response.Cookies("Dvbbs")=LockTopic
  Else
   Response.Cookies("Dvbbs")=Dvbbs.Boardid
  End If
  Forumupload=split(Dvbbs.Board_Setting(19),"|")
  For i=0 to ubound(Forumupload)
   If Instr(Content,"[upload="&Forumupload(i)&"]") or Instr(Content,"."&Forumupload(i)&"") or Instr(Content,"["&Forumupload(i)&"]") then
    uploadpic_n=Forumupload(i)
    Exit For
   End If
  Next
  
  If InStr(Content,"viewfile.asp?ID=") Then uploadpic_n="down"
'  If Not Action = 8 Then
   savepost()
  
   If Dvbbs.UserID>0 Then updatepostuser()
   
'  Else
'   Update_Edit_Announce()
'  End If

  If Dvbbs.GroupSetting(59)=1 Then
   If (Action = 5 Or Action = 7) and (GetPostType="1" or GetPostType="2") Then
    'Dim LogMsg
    'LogMsg = "<a href=""dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&""" target=_blank>主题：《<B>"&topic&"</B>》</a> 使用<B>"&ToolsInfo(5)&"</B>道具成功，并插入道具日志记录。"
    'Call Dvbbs.ToolsLog(ToolsInfo(4),1,0,0,1,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
    'Call UpdateUserTools(Dvbbs.UserID,ToolsInfo(4),1)
   ElseIf Action = 6 and GetPostType="1" and GetMoneyType=4 Then
    Call GetMoney_SaveRe
   End If
  End If
  If Action <>8 Then
   'If IsSqlDataBase = 1 Then
   ' Dvbbs.Execute("Delete From [Dv_lastpost] Where Datediff(Mi, DateAndtime, " & SqlNowString & ") > 20")
   'Else
   ' Dvbbs.Execute("Delete From [Dv_lastpost] Where Datediff('s', DateAndtime, " & SqlNowString & ") > 20*60")
   'End If
   'Dvbbs.Execute("Insert Into Dv_lastpost (PostTitle,PostUserID,DateAndtime) values ('"&Dvbbs.Checkstr(Left(Trim(Request.Form("topic")&"")& Request.Form("body"),150))&"',"&Dvbbs.UserID&",'"&Now()&"')")
  End If
  
  succeed()
 End Sub
 '保存发贴，投票和回贴
 Public Sub Savepost()
'  If Action = 5 Or Action = 7 Then
'   ilayer=1:iOrders=0:ParentID=0
'   MyLastPostTime=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
'   DateTimeStr=MyLastPostTime'Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
'   If Action = 7 Then Insert_To_Vote()
'   
'   Insert_To_Topic()
'   
'   '更新总固顶和固顶的数据以及缓存数据
'   If MyIsTop=3 Then
'    '将总固顶ID插入总设置表
'    Dim iForum_AllTopNum
'    Set Rs=Dvbbs.Execute("Select Forum_AllTopNum From Dv_Setup")
'    If Trim(Rs(0))="" Or IsNull(Rs(0)) Then
'     iForum_AllTopNum = RootID
'    Else
'     iForum_AllTopNum = Rs(0) & "," & RootID
'    End If
'    Dvbbs.Execute("Update Dv_Setup Set Forum_AllTopNum='"&iForum_AllTopNum&"'")
'    Dvbbs.ReloadSetupCache iForum_AllTopNum,28
'    Set Rs=Nothing
'   ElseIf MyIsTop=1 Then
'    Dim BoardTopStr
'    Set Rs=Dvbbs.Execute("Select BoardID,BoardTopStr From Dv_Board Where BoardID="&Clng(Dvbbs.BoardID))
'    If Not (Rs.Eof And Rs.Bof) Then
'     If Rs(1)="" Or IsNull(Rs(1)) Then
'      BoardTopStr = RootID
'     Else
'      If InStr(","&Rs(1)&",","," & RootID & ",")>0 Then
'       BoardTopStr = Rs(1)
'      Else
'       BoardTopStr = Rs(1) & "," & RootID
'      End If
'     End If
'     Dvbbs.Execute("Update Dv_Board Set BoardTopStr='"&BoardTopStr&"' Where BoardID="&Rs(0))
'     Dvbbs.LoadBoardinformation Rs(0)
'    End If
'    Set Rs=Nothing
'   End If
'  ElseIf Action = 6 Then
  If Action = 6 Then
   Get_SaveRe_TopicInfo()
   Get_ForumTreeCode()
   
   dim  replyno,mrnd 'zzcity add
   Randomize
   mrnd = Int((9 * Rnd) + 1)
   replyno = Request.Form("replyno") 'zzcity add
   If replyno = "" Or Not IsNumeric(replyno) Then  replyno=mrnd

'   DateTimeStr=Replace(Replace(CSTR(NOW()+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
   DateTimeStr=Replace(Replace(CSTR(DateAdd("n",replyno*10+mrnd,Now())+Dvbbs.Forum_Setting(0)/24),"上午",""),"下午","")
  End If
  
 
  Insert_To_Announce()
  If Action = 6 Then
   topic=Replace(Replace(cutStr(reubbcode(topic),14),chr(10),""),"'","")
   If topic="" Then
    topic=Content
    topic=Replace(cutStr(reubbcode(topic),14),chr(10),"")
   Else
    topic=Replace(cutStr(reubbcode(topic),14),chr(10),"")
   End If
   If ihaveupfile=1 Then Dvbbs.Execute("update dv_upfile set F_AnnounceID='"&RootID&"|"&AnnounceID&"',F_Readme='"&Replace(toptopic,"'","")&"',F_flag=0 where F_ID in ("&upfileinfo&")")
  Else
'   If ihaveupfile=1 Then Dvbbs.Execute("update dv_upfile set F_AnnounceID='"&RootID&"|"&AnnounceID&"',F_Readme='"&Topic&"',F_flag=0  where F_ID in ("&upfileinfo&")")
  End If
  If signflag=2 Then
   LastPost=Replace("匿名用户","$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & Replace(topic,"$","&#36;") & "$" & uploadpic_n & "$" & " " & "$" & RootID & "$" & Dvbbs.BoardID
  Else
   LastPost=Replace(username,"$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & Replace(topic,"$","&#36;") & "$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
  End If
  LastPost=Replace(LastPost,"'","")
  LastPost=Dvbbs.ChkBadWords(LastPost)
  If IsAudit<>1 Then
   Dim IsUpDateLastPostTime
   IsUpDateLastPostTime = False
   If  InStr("," & Tools_UseTools & ",",",13,")>0 Or InStr("," & Tools_UseTools & ",",",14,")>0 Then IsUpDateLastPostTime = True
   If Action = 6 Then
    If IsUpDateLastPostTime Then
     If DateDiff("h",Now(),Tools_LastPostTime)<=0 Then
      SQL="update Dv_topic set child=child+1,LastPostTime="&SqlNowString&",LastPost='"&LastPost&"' where TopicID="&RootID
     Else
      SQL="update Dv_topic set child=child+1,LastPost='"&LastPost&"' where TopicID="&RootID
     End If
    Else
     SQL="update Dv_topic set child=child+1,LastPostTime="&SqlNowString&",LastPost='"&LastPost&"' where TopicID="&RootID
    End If
    Dvbbs.Execute(SQL)
    Child=Child+2
    If Child mod Dvbbs.Board_Setting(27)=0 Then
     star=Child\Dvbbs.Board_Setting(27)
    Else
     star=(Child\Dvbbs.Board_Setting(27))+1
    End If
   Else
     Dvbbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicid="&RootID)
   End If
  Else
   Rem 待审核取消回复更新最后发贴。
'   If Action = 5 Or Action = 7 Then  Dvbbs.Execute("update Dv_topic set LastPost='"&LastPost&"' where topicid="&RootID)
  End If
  If Action = 5 Or Action = 7 Then
   toptopic=Replace(cutStr(topic,20),"$","&#36;")
  Else
   toptopic=Replace(cutStr(toptopic,20),"$","&#36;")
  End If
  
  'toptopic =主标题,Content=内容
  '判断是否是加密的论坛，如果是，则不显示最后发贴内容。
  If Dvbbs.Board_Setting(2)="1" Then
   LastPost_1="保密$" & AnnounceID & "$" & DateTimeStr & "$请认证用户进入查看$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
  ElseIf signflag=2 Then
   LastPost_1=Replace("匿名用户","$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & toptopic & "$" & uploadpic_n & "$" & " " & "$" & RootID & "$" & Dvbbs.BoardID
  Else
   LastPost_1=Replace(username,"$","") & "$" & AnnounceID & "$" & DateTimeStr & "$" & toptopic & "$" & uploadpic_n & "$" & Dvbbs.UserID & "$" & RootID & "$" & Dvbbs.BoardID
  End If
  LastPost_1=reubbcode(Replace(LastPost_1,"'",""))
  LastPost_1=Dvbbs.ChkBadWords(LastPost_1)
  If IsAudit=0 Then
   UpDate_BoardInfoAndCache()
   UpDate_ForumInfoAndCache()
  End If
  Response.Cookies("Dvbbs")=Dvbbs.BoardID
  
 End Sub
 '判断用户是否有编辑权限且提取相关信息
 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 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 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
'   If Action = 4 Then
'    signflag=Rs("signflag")
'    mailflag=Rs("emailflag")
'    Topic=rs("topic")
'    If Topic<>"" Then Topic = Server.HtmlEncode(Topic)
'    Content=rs("body")
'    old_user=rs("username")
'   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)
'     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
'     If ajaxPost Then
'      Call showAjaxMsg(0,Replace(Replace(template.Strings(22),"{$posttime}",Datediff("s",rs("dateandtime"),Now())/60),"{$etlimited}",Dvbbs.forum_setting(51)),"","")
'     Else
'      parameter="showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&Replace(Replace(template.Strings(22),"{$posttime}",Datediff("s",rs("dateandtime"),Now())/60),"{$etlimited}",Dvbbs.forum_setting(51))&"&action=OtherErr"
'      Response.redirect parameter
'     End If
'    End If
'   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
'    signflag=Rs("signflag")
'    mailflag=Rs("emailflag")
'    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
'  ShowErr("")
'  If Action = 4 Then Dvbbs.MemberName=old_user
 End Function

 Public Sub Get_SaveRe_TopicInfo()
  SQL="select locktopic,LastPost,title,smsuserlist,IsSmsTopic,istop,Child,UseTools,LastPostTime,GetMoneyType,PostUserID, DateAndTime from Dv_topic where BoardID="&Dvbbs.BoardID&" And topicid="&cstr(RootID)
  Set Rs=dvbbs.Execute(sql)
  If Not (Rs.EOF And Rs.BOF) Then
   toptopic = Rs(2)
   istop = Rs(5)
   Child = Rs(6)
   Tools_UseTools = "," & Rs(7) & ","
   Tools_LastPostTime = Rs(8)
   If Rs("IsSmsTopic")=1 Then smsuserlist=Rs("smsuserlist")
'   If Rs("LockTopic")=1 And Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then Dvbbs.AddErrCode(78)
   '锁定多少天前的帖子判断 2004-9-16 Dv.Yz
'   If Ubound(Dvbbs.Board_Setting) > 70 And Not (Dvbbs.Master Or Dvbbs.BoardMaster Or Dvbbs.SuperBoardMaster) Then
'    If Not Clng(Dvbbs.Board_Setting(71)) = 0 And Datediff("d", Rs(11), Now()) > Clng(Dvbbs.Board_Setting(71)) Then Dvbbs.AddErrCode(78)
'   End If
   If Not IsNull(Rs(1)) Then
    LastPost=split(Rs(1),"$")
    If ubound(LastPost)=7 Then
     UpLoadPic_n=LastPost(4)
    Else
     UpLoadPic_n=""
    End If
   End If
'   If Cint(Rs(9)) = 5 Then
'    If ajaxpost Then
'     Call showAjaxMsg(0,template.Strings(32),"","")
'    Else
'     Response.redirect"showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<br>"+"<li>"&template.Strings(32)&"&action=OtherErr"
'    End If
'   End If
   If Clng(Rs(10)) <> Dvbbs.UserID and Cint(Rs(9)) = 2 and GetPostType = "1" Then
    GetMoneyType = 4
    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text -ToMoney
   Else
    GetMoneyType = 0
    ToMoney=0
   End If
  End If
  Set Rs = Nothing
'  ShowErr("")
 End Sub
 Public Sub Insert_To_Vote()
  '插入投票记录 GroupSetting(68)投票项目中是否可以使用HTML
  Dim UArticle,UWealth,UEP,UCP,UPower
  Dim LockVote
  UArticle = Request.Form("UArticle")
  UWealth = Request.Form("UWealth")
  UEP = Request.Form("UEP")
  UCP = Request.Form("UCP")
  UPower = Request.Form("UPower")
  LockVote = Request.Form("lockvote")
  If Not IsNumeric(UArticle) Then UArticle = 0
  If Not IsNumeric(UWealth) Then UWealth = 0
  If Not IsNumeric(UEP) Then UEP = 0
  If Not IsNumeric(UCP) Then UArticle = 0
  If Not IsNumeric(UPower) Then UPower = 0
  If Not IsNumeric(LockVote) Then LockVote = 0
  If Dvbbs.GroupSetting(68)<>"1" Then vote = server.htmlencode(vote)
  Dvbbs.execute("insert into dv_vote (vote,votenum,votetype,timeout,UArticle,UWealth,UEP,UCP,UPower,LockVote) values ('"&vote&"','"&votenum&"',"&votetype&",'"&votetimeout&"',"&UArticle&","&UWealth&","&UEP&","&UCP&","&UPower&","&LockVote&")")
  set rs=dvbbs.execute("select Max(voteid) from dv_vote")
  voteid=Rs(0)
  isvote=1
  Set Rs=Nothing
 End Sub
 Public Sub Insert_To_Topic()
  '插入主题表
  Dim hidename
  If signflag=2 Then
   hidename=1
  Else
   hidename=0
  End If
  
  SQL="insert into Dv_topic (Title,Boardid,PostUsername,PostUserid,DateAndTime,Expression,LastPost,LastPostTime,PostTable,locktopic,istop,TopicMode,isvote,PollID,Mode,GetMoney,UseTools,GetMoneyType,isSmsTopic,HideName) values ('"&topic&"',"&Dvbbs.boardid&",'"&username&"',"&Dvbbs.userid&",'"&DateTimeStr&"','"&Expression(0)&"|"&Expression(1)&"','$$"&DateTimeStr&"$$$$','"&MyLastPostTime&"','"&TotalUseTable&"',"&locktopic&","&Myistop&","&MyTopicMode&","&isvote&","&voteid&","&TopicMode&","&ToMoney&",'"&UseTools&"',"&GetMoneyType&","&isAlipayTopic&","&hidename&")"

  Dvbbs.Execute(sql)
  
  Set Rs=Dvbbs.Execute("select Max(topicid) From Dv_topic Where PostUserid="&Dvbbs.UserID)
  RootID=Rs(0)
 End Sub
 Public Sub Insert_To_Announce()
  '插入回复表
  DIM UbblistBody
  UbblistBody = Content
  UbblistBody = Ubblist(Content)
  Dim FlashId
  If Dvbbs.qcomic_plus Then
   FlashId = Dvbbs.Checkstr(Request.Form("phid"))
  Else
   FlashId = "0"
  End If

  SQL="insert into "&TotalUseTable&"(Boardid,ParentID,username,topic,body,DateAndTime,length,RootID,layer,orders,ip,Expression,locktopic,signflag,emailflag,isbest,PostUserID,isupload,IsAudit,Ubblist,GetMoney,UseTools,PostBuyUser,GetMoneyType,FlashId) values ("&Dvbbs.boardid&","&ParentID&",'"&username&"','"&topic&"','"&Content&"','"&DateTimeStr&"','"&Dvbbs.strlength(Content)&"',"&RootID&","&ilayer&","&iorders&",'"&Dvbbs.UserTrueIP&"','"&Expression(1)&"',"&locktopic&","&signflag&","&mailflag&",0,"&Dvbbs.userid&","&ihaveupfile&","&IsAudit&",'"&UbblistBody&"',"&ToMoney&",'"&UseTools&"','"&dvbbs.checkstr(ToolsBuyUser)&"',"&GetMoneyType&",'"&FlashId&"')"
  Dvbbs.Execute(sql)
  Set Rs=Dvbbs.Execute("select Max(AnnounceID) From "&TotalUseTable&" Where PostUserID="&Dvbbs.UserID)
  AnnounceID=Rs(0)

  If Dvbbs.qcomic_plus And Len(FlashId)>5 Then
   On Error Resume Next
    DIM Qcomic_setting,qcomic_url,qcomic_code,qcomic_http,qcomic_tid,qcomic_rs,qcomic_topic
    If topic="" Then
     qcomic_tid = RootID
     Set qcomic_rs = Dvbbs.iCreateObject("ADODB.Recordset")
     SQL="SELECT Title FROM Dv_Topic where TopicID="&RootID
     qcomic_rs.Open SQL,conn,1,3
     If Not qcomic_rs.Eof Then
      qcomic_topic = qcomic_rs(0)
     End If
    Else
     qcomic_topic = topic
    End If

    Qcomic_setting = Split(Dvbbs.qcomic_plus_setting(), "||||")
    qcomic_code = "spassword=" & Qcomic_setting(2)
    qcomic_code = qcomic_code & "&phid=" & FlashId
    qcomic_code = qcomic_code & "&tid=" & RootID
    qcomic_code = qcomic_code & "&pid=" & AnnounceID
    qcomic_code = qcomic_code & "&fid=" & Dvbbs.boardid
    qcomic_code = qcomic_code & "&uid=" & Dvbbs.userid
    qcomic_code = qcomic_code & "&ctime=" & Now()
    qcomic_code = qcomic_code & "&mtime=" & Now()
    qcomic_url = "http://comic.qihoo.com/dvbbs/update.php?sid=" & Qcomic_setting(1)
    qcomic_url = qcomic_url & "&code=" & Server.UrlEncode(AuthCode(qcomic_code, "ENCODE", Qcomic_setting(3)))
    qcomic_url = qcomic_url & "&title=" & Server.UrlEncode(qcomic_topic)
    qcomic_url = qcomic_url & "&content=" & Server.UrlEncode(Left(Dvbbs.Replacehtml(Dvbbs.ReplaceUbb(Content)),1000))

    Set qcomic_http = Server.CreateObject("Microsoft.XMLHTTP")
    qcomic_http.Open "GET",qcomic_url,false
    qcomic_http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    qcomic_http.send()
   If Err Then err.Clear
  End If

 End Sub
 '检查贴中是否含过滤字
 Public Function NeedIsAudit()
  NeedIsAudit=0
  Dim i,ChecKData
  If Dvbbs.Board_Setting(58)<>"0" Then
   ChecKData=split(Dvbbs.Board_Setting(58),"|")
   For i=0 to UBound(ChecKData)
    If Trim(ChecKData(i))<>"" Then
     If InStr(Content,ChecKData(i))>0 Or InStr(Topic,ChecKData(i))>0 Then
      NeedIsAudit=1
      Exit Function
     End If
    End If
   Next
  End If
 End Function
 Public Sub Get_ForumTreeCode()
  Dim mailbody
  Set Rs=Dvbbs.Execute("select b.layer,b.orders,b.EmailFlag,b.username,u.userEmail from "&TotalUseTable&" b inner join [Dv_user] u on b.postuserid=u.userid where b.AnnounceID="&ParentID)
  If Not(rs.EOF And rs.BOF) Then
   If IsNull(Rs(0)) Then
    iLayer=1
   Else
    iLayer=Rs(0)
   End If
   If IsNull(Rs(1)) Then
    iOrders=0
   Else
    iOrders=Rs(1)
   End If
'   If Rs(3)=Dvbbs.membername Then
'    If Cint(Dvbbs.GroupSetting(4))=0 Then Dvbbs.AddErrCode(73)
'   Else
    If Dvbbs.GroupSetting(5)="0" Then
'     If ajaxpost Then
'      Call showAjaxMsg(0,template.Strings(29),"","")
'     Else
'      Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>"&template.Strings(29)&"&action=OtherErr"
'     End If
     showerr("错误的版面参数！")
    End if
'    If Rs(2)>0 Then
'     Dim sUrl,Email,TempArray,etopic
'     TempArray = Split(template.html(10),"||")
'     sUrl=Dvbbs.Get_ScriptNameUrl
'     If Rs(2)=1 Or Rs(2)=3 Then
'      etopic=Replace(template.Strings(25),"{$forumname}",Dvbbs.Forum_info(0))
'      email=Rs(4)
'      mailbody = TempArray(0)
'      mailbody = Replace(mailbody,"{$username}",Rs(3))
'      mailbody = Replace(mailbody,"{$boardid}",Dvbbs.BoardID)
'      mailbody = Replace(mailbody,"{$forumname}",Dvbbs.Forum_info(0))
'      mailbody = Replace(mailbody,"{$topicid}",RootID)
'      mailbody = Replace(mailbody,"{$star}",Star)
'      mailbody = Replace(mailbody,"{$surl}",sUrl)
'      mailbody = Replace(mailbody,"{$parentid}",ParentID)
'      Dim DvEmail
'      Set DvEmail = New Dv_SendMail
'      DvEmail.SendObject = Cint(Dvbbs.Forum_Setting(2)) '设置选取组件 1=Jmail,2=Cdonts,3=Aspemail
'      DvEmail.ServerLoginName = Dvbbs.Forum_info(12) '您的邮件服务器登录名
'      DvEmail.ServerLoginPass = Dvbbs.Forum_info(13) '登录密码
'      DvEmail.SendSMTP = Dvbbs.Forum_info(4)   'SMTP地址
'      DvEmail.SendFromEmail = Dvbbs.Forum_info(5)  '发送来源地址
'      DvEmail.SendFromName = Dvbbs.Forum_info(0)  '发送人信息
'      If DvEmail.ErrCode = 0 Then
'       DvEmail.SendMail email,etopic,mailbody '执行发送邮件
'      End If
'      Set DvEmail = Nothing
'     End If
'     If Rs(2)=2 Or Rs(2)=3 Then
'      mailbody = TempArray(1)
'      mailbody = Replace(mailbody,"{$boardid}",Dvbbs.BoardID)
'      mailbody = Replace(mailbody,"{$topicid}",RootID)
'      mailbody = Replace(mailbody,"{$star}",Star)
'      mailbody = Replace(mailbody,"{$surl}",sUrl)
'      mailbody = Replace(mailbody,"{$parentid}",ParentID)
'      Dvbbs.Execute("insert into dv_message(incept,sender,title,content,sendtime,flag,issend) values('"&Rs(3)&"','"&Dvbbs.Forum_info(0)&"','"&template.Strings(26)&"','"&mailbody&"',"&SqlNowString&",0,1)")
'      update_user_msg(Rs(3))
'     End If
'    End If
'   End If
  Else
   iLayer=1
   iOrders=0
  End If
  Set Rs=Nothing
  If RootID<>0 Then
   iLayer=ilayer+1
   Dvbbs.Execute "update "&TotalUseTable&" set orders=orders+1 where RootID="&cstr(RootID)&" and orders>"&cstr(iOrders)
   iOrders=iOrders+1
  End If
 End Sub
 Public Sub Update_Edit_Announce()
  Dim re,LastBoard,LastTopic
  Set re=new RegExp
  re.IgnoreCase =True
  re.Global=True
  re.Pattern="<br>"
  Content = re.Replace(Content,"[br]")
  re.Pattern="\[align=right\]\[color=#000066\](.*)\[\/color\]\[\/align\]"
  Content = re.Replace(Content,"")
  re.Pattern="<div align=right><font color=#000066>(.*)<\/font><\/div>"
  Content = re.Replace(Content,"")
  re.Pattern="\[br\]"
  Content = re.Replace(Content,"<br>")
  Set re=Nothing
  If Dvbbs.membername<>UserName Then
   If Dvbbs.forum_setting(49)="1" Then char_changed = "[align=right][color=#000066][此贴子已经被"&Dvbbs.membername&"于"&Now()&"编辑过][/color][/align]"
  Else
   If Dvbbs.forum_setting(48)="1" Then char_changed = "[align=right][color=#000066][此贴子已经被作者于"&Now()&"编辑过][/color][/align]"
  End If
  Get_Edit_PermissionInfo
  Dim Contentdata,LastPost_l
  Contentdata=Content
  ShowErr("")
  '取出当前版面最后回复id,如果本帖为最后回复则更新相应数据
  Set Rs = Dvbbs.Execute("select LastPost from dv_board where boardid="&Dvbbs.BoardID)
  If not (Rs.EOF And Rs.BOF) Then
   If Not IsNull(rs(0)) And rs(0)<>"" then
    LastBoard=split(rs(0),"$")
    If ubound(LastBoard)=7 Then
     If cCur(LastBoard(1))=cCur(AnnounceID) Then
      If signflag=2 Then LastBoard(0)="匿名用户":LastBoard(5)=""
      LastPost=LastBoard(0) & "$" & LastBoard(1) & "$" & Now() & "$" & LastBoard(3) & "$" & LastBoard(4) & "$" & LastBoard(5) & "$" & LastBoard(6) & "$" & Dvbbs.BoardID
      dvbbs.execute("update dv_board set LastPost='"&Replace(Replace(LastPost,"'",""),"<","&lt;")&"' where boardid="&Dvbbs.BoardID)
      UpDate_BoardInfoAndCache()
     End If
    End If
   End If
  End If

  '取得当前主题最后回复id,如果本帖为最后回复则更新相应数据
  Dim iFoundUseMagic,MyMagicFace
  Set Rs=Dvbbs.Execute("select LastPost,istop,Expression from dv_topic where topicid="&rootid)
  If Not (Rs.Eof And Rs.Bof) Then
   istop=rs(1)
   MyMagicFace = Split(Rs(2),"|")
   If Ubound(MyMagicFace) = 1 Then iFoundUseMagic = MyMagicFace(0)
   If Not Isnull(Rs(0)) And Rs(0)<>"" Then
    LastTopic=split(rs(0),"$")
    If Ubound(LastTopic)=7 Then
     If cCur(LastTopic(1))=cCur(Announceid) Then
      If signflag=2 Then LastTopic(0)="匿名用户":LastTopic(5)=""
      If Trim(uploadpic_n)<>"" Then LastTopic(4)=uploadpic_n
      LastPost=LastTopic(0) & "$" & LastTopic(1) & "$" & Now() & "$" & Replace(cutStr(reubbcode(Contentdata),20),"$","&#36;") & "$" & LastTopic(4) & "$" & LastTopic(5) & "$" & LastTopic(6) & "$" & Dvbbs.BoardID
      dvbbs.execute("update dv_topic set LastPost='"&Replace(LastPost,"'","")&"' where topicid="&rootid)
     End If
    End If
   End If
  End If

  Set Rs = Dvbbs.iCreateObject("ADODB.Recordset")
  SQL="SELECT * FROM "&TotalUseTable&" where AnnounceID="&Announceid&" And username='"&username&"'"
  rs.Open SQL,conn,1,3
  If Rs.EOF And Rs.BOF Then
   If Not CanEditPost Then showerr("您没有足够的权限编辑本帖子，请和管理员联系") 'Dvbbs.AddErrCode(77)
  ElseIf Not Dvbbs.master And rs("locktopic")=1 then
   showerr("本主题已经锁定，不能发表回复") 'Dvbbs.AddErrCode(78)
  Else
   If Rs("parentid")=0 then
    Dim iExpression
    iExpression = ",Expression='"&Expression(0)&"|"&Expression(1)&"'"
    If signflag=2 Then
     Dvbbs.Execute("update dv_topic set title='"&topic&"',TopicMode="&MyTopicMode&",isSmsTopic="&isAlipayTopic&" "&iExpression&",HideName=1 where topicid="&rootid)
    Else
     Dvbbs.Execute("update dv_topic set title='"&topic&"',TopicMode="&MyTopicMode&",isSmsTopic="&isAlipayTopic&" "&iExpression&",HideName=0 where topicid="&rootid)
    End If
   End If
   If IsAudit = 1 Then
    Rs("locktopic")=3
   ElseIf Rs("locktopic")=3 And IsAudit = 0 Then
    Rs("locktopic")=0
   End If
   Rs("Topic") =Replace(Topic,"''","'")
   rs("Body") =Replace(Content,"''","'")
   rs("length")=Dvbbs.strlength(Content)
   rs("ip")=Dvbbs.UserTrueIP
   rs("Expression")=Expression(1)
   rs("signflag")=signflag
   rs("emailflag")=mailflag
   If Rs("isupload")=0 And ihaveupfile=1 Then Rs("isupload")=1
   Dim UbblistBody
   UbblistBody = Ubblist(Content)
   Rs("Ubblist")=UbblistBody

   If Dvbbs.qcomic_plus Then
    Dim FlashId
    FlashId = Dvbbs.Checkstr(Request.Form("phid"))
    Rs("FlashId") = FlashId
   End If
   rs.Update
   If Dvbbs.qcomic_plus Then
    On Error Resume Next
     DIM Qcomic_setting,qcomic_url,qcomic_code,qcomic_http,qcomic_rs,qcomic_topic,qcomic_tid
     If Rs("Topic")="" Then
      qcomic_tid = Rs("RootID")
      Set qcomic_rs = Dvbbs.iCreateObject("ADODB.Recordset")
      SQL="SELECT Title FROM Dv_Topic where TopicID="&qcomic_tid
      qcomic_rs.Open SQL,conn,1,3
      If Not qcomic_rs.Eof Then
       qcomic_topic = qcomic_rs(0)
      End If
     Else
      qcomic_topic = Rs("Topic")
     End If
     Qcomic_setting = Split(Dvbbs.qcomic_plus_setting(), "||||")
     qcomic_code = "spassword=" & Qcomic_setting(2)
     qcomic_code = qcomic_code & "&phid=" & FlashId
     qcomic_code = qcomic_code & "&tid=" & rs("RootID")
     qcomic_code = qcomic_code & "&pid=" & rs("AnnounceID")
     qcomic_code = qcomic_code & "&fid=" & rs("BoardID")
     qcomic_code = qcomic_code & "&uid=" & rs("postuserid")
     qcomic_code = qcomic_code & "&mtime=" & Now()
     qcomic_url = "http://comic.qihoo.com/dvbbs/update.php?sid=" & Qcomic_setting(1)
     qcomic_url = qcomic_url & "&code=" & Server.UrlEncode(AuthCode(qcomic_code, "ENCODE", Qcomic_setting(3)))
     qcomic_url = qcomic_url & "&title=" & Server.UrlEncode(qcomic_topic)
     qcomic_url = qcomic_url & "&content=" & Server.UrlEncode(Left(Dvbbs.Replacehtml(Dvbbs.ReplaceUbb(Rs("Body"))),1000))

     Set qcomic_http = Server.CreateObject("Microsoft.XMLHTTP")
     qcomic_http.Open "GET",qcomic_url,false
     qcomic_http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
     qcomic_http.send()
    If Err Then err.Clear
   End If

   If ihaveupfile=1 Then dvbbs.execute("update dv_upfile set F_AnnounceID='"&rootid&"|"&AnnounceID&"',F_Readme='"&Replace(Rs("Topic"),"'","''")&"',F_flag=0 where F_ID in ("&upfileinfo&")")
   If FoundUseMagic Then
    If iMagicFace <> Clng(iFoundUseMagic) Then
     If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) > tMagicMoney Then
      Dvbbs.Execute("Update Dv_User Set UserMoney=UserMoney-"&tMagicMoney&" Where UserID="&Dvbbs.UserID)
      Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text -tMagicMoney
      Dvbbs.ToolsLog -88,1,tMagicMoney,0,1,"使用金币购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
     Else
      Dvbbs.Execute("Update Dv_User Set UserTicket=UserTicket-"&tMagicTicket&" Where UserID="&Dvbbs.UserID)
      Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text-tMagicTicket
      Dvbbs.ToolsLog -88,1,0,tMagicTicket,1,"使用点券购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
     End If
    End If
   End If
  End If
  Rs.Close
  Set Rs=Nothing
  ShowErr("")
 End Sub

 '更新用户及系统道具数量(用户ID，道具ID，减少数量)
 Private Sub UpdateUserTools(U_UserID,U_ToolsID,n)
  Dim Sql,Rs
  If Clng(n)<0 Then
   n = "+" & n
  Else
   n = "-" & n
  End If
  Set Rs = Dvbbs.Plus_Execute("Select ID From [Dv_Plus_Tools_Buss] Where UserID="& U_UserID &" and ToolsID="& U_ToolsID)
  If Rs.Eof And Rs.Bof Then
   Dim Trs
   Set Trs = Dvbbs.Plus_Execute("Select ToolsName From Dv_Plus_Tools_Info Where ID=" & U_ToolsID)
   If Not (Trs.Eof And Trs.Bof) Then
    Sql = "Insert Into [Dv_Plus_Tools_Buss] (UserID,UserName,ToolsID,ToolsName,ToolsCount) Values ("&U_UserID&",'"&Dv_Tools.ToUserInfo(1)&"',"&U_ToolsID&",'"&Trs(0)&"',"&Clng(Replace(Replace(n,"+",""),"-",""))&")"
    Dvbbs.Plus_Execute(Sql)
   End If
   Trs.Close
   Set Trs=Nothing
  Else
   Sql = "Update [Dv_Plus_Tools_Buss] Set ToolsCount = ToolsCount"&n&" Where UserID="& U_UserID &" and ToolsID="& U_ToolsID
   Dvbbs.Plus_Execute(Sql)
  End If
  Rs.Close
  Set Rs=Nothing
  Sql = "Update [Dv_Plus_Tools_Info] Set UserStock =  UserStock"&n&" Where ID="& U_ToolsID
  Dvbbs.Plus_Execute(Sql)
 End Sub
 '回复获赠金币帖时更新
 Public Sub GetMoney_SaveRe()
  Dim ToUserID,ToUserName,UpPostBuyUser,UpGetMoney,Tempstr
  SQL="Select PostUserID,GetMoney,PostBuyUser,Username From "&TotalUseTable&" Where RootID="&RootID&" and ParentID=0 and GetMoneyType=2"
  Set Rs = Dvbbs.iCreateObject("ADODB.Recordset")
  Rs.Open SQL,conn,1,3
   If Not Rs.Eof Then
    ToUserID = Clng(Rs(0))
    UpGetMoney = Rs(1) + ToMoney
    UpPostBuyUser = Rs(2)
    ToUserName = Rs(3)
    Tempstr = Split(UpPostBuyUser,"|||",2)
    Tempstr(0) = UpGetMoney
    Tempstr(1) = Tempstr(1) & "|||" & UserName &","& ToMoney
    UpPostBuyUser = Tempstr(0) & "|||" & Tempstr(1)
    UpPostBuyUser = Trim(UpPostBuyUser)
    Rs(1) = UpGetMoney
    Rs(2) = UpPostBuyUser
   Rs.update
   End If
  Rs.Close : Set Rs=Nothing

  '更新主题MONEY值
  Sql = "Update [Dv_Topic] Set GetMoney="&UpGetMoney&" where TopicID="&RootID
  Dvbbs.Execute(sql)
  '主题作者获取金币
  Sql = "Update [Dv_User] Set UserMoney=UserMoney + "&ToMoney&" where UserID="&ToUserID
  Dvbbs.Execute(sql)
  '插入道具日志
  'Dim LogMsg
  'LogMsg = "<a href=""dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&star="&Star&"#"&Announceid&""" target=_blank>回复主题：《<B>"&topic&"</B>》</a> 赠道给作者:<b>"&ToUserName&"</b><font color="&Dvbbs.mainsetting(1)&">"&ToMoney&"</font>个金币成功，并插入道具日志记录。"
  'Call Dvbbs.ToolsLog(0,0,ToMoney,0,0,LogMsg,Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &"|"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text)
 End Sub


'更新版面数据和缓存
 Public Sub UpDate_BoardInfoAndCache()
  Dim UpdateBoardID,parentstr
  parentstr =Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@parentstr").text
  If parentstr <> "0" Then
   UpdateBoardID= parentstr & "," & Dvbbs.BoardID
  Else
   UpdateBoardID=Dvbbs.BoardID
  End If
  Dim updateboard,i
  LastPost_1=replace(LastPost_1,"<","&lt;")
  If Action = 6 Then
   SQL="update Dv_board set PostNum=PostNum+1,todaynum=todaynum+1,LastPost='"&LastPost_1&"' where boardid in ("&UpdateBoardID&")"
  ElseIf Action = 5 Or Action = 7 Then
   SQL="update Dv_board set PostNum=PostNum+1,TopicNum=TopicNum+1,todaynum=todaynum+1,LastPost='"&LastPost_1&"' where boardid in ("&UpdateBoardID&")"
  ElseIf Action = 8 Then
   LastPost_1=replace(LastPost,"<","&lt;")
  End If
  Dvbbs.Execute(sql)
  UpdateBoardID=Split(UpdateBoardID,",")
  LastPost_1=Split(LastPost_1,"$")
  For Each updateboard in UpdateBoardID
   If IsObject(Application(Dvbbs.CacheName &"_information_" & updateboard)) Then
    If Not Action = 8 Then
     Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@postnum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@postnum").text)+1
     Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@todaynum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@todaynum").text)+1
    End If
    If Action = 5 Or Action = 7 Then
     Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@topicnum").text=CLng(Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@topicnum").text)+1
    End If
    For i=0 to UBound(LastPost_1)
     Application(Dvbbs.CacheName &"_information_" & updateboard).documentElement.selectSingleNode("information/@lastpost_"& i &"").text=LastPost_1(i)
    Next
   End If
  Next
 End Sub
 Public Sub UpDate_ForumInfoAndCache()
  Dim updateinfo,LastPostTime
  Dim Forum_LastPost,Forum_TodayNum,Forum_MaxPostNum
  Forum_LastPost=Dvbbs.CacheData(15,0)
  Forum_TodayNum=Dvbbs.CacheData(9,0)
  Forum_MaxPostNum=Dvbbs.CacheData(12,0)
  LastPostTimes=split(Forum_LastPost,"$")
  LastPostTime=LastPostTimes(2)
  If Not IsDate(LastPostTime) Then LastPostTime=Now()
  If datediff("d",LastPostTime,Now())=0 Then
   If CLng(Forum_TodayNum)+1 > CLng(Forum_MaxPostNum) Then
    updateinfo=",Forum_MaxPostNum=Forum_TodayNum+1,Forum_MaxPostDate="&SqlNowString&""
    Dvbbs.ReloadSetupCache Now(),13
    Dvbbs.ReloadSetupCache CLng(Forum_TodayNum)+1,12
   End If
   Dvbbs.ReloadSetupCache CLng(Forum_TodayNum)+1,9
   If Action = 6 Then
    SQL="update Dv_setup set Forum_PostNum=Forum_PostNum+1,Forum_TodayNum=Forum_TodayNum+1,Forum_LastPost='"&LastPost&"' "&updateinfo&" "
   Else
    SQL="update Dv_setup set Forum_TopicNum=Forum_TopicNum+1,Forum_PostNum=Forum_PostNum+1,Forum_TodayNum=Forum_TodayNum+1,Forum_LastPost='"&LastPost&"' "&updateinfo&" "
   End If
  Else
   If Action = 6 Then
    SQL="update Dv_setup set Forum_PostNum=Forum_PostNum+1,forum_YesTerdayNum="&CLng(Forum_TodayNum)&",Forum_TodayNum=1,Forum_LastPost='"&LastPost&"' "
   Else
    SQL="update Dv_setup set Forum_TopicNum=Forum_TopicNum+1,Forum_PostNum=Forum_PostNum+1,forum_YesTerdayNum="&CLng(Forum_TodayNum)&",Forum_TodayNum=1,Forum_LastPost='"&LastPost&"' "
   End If
   Dvbbs.ReloadSetupCache 1,9
  End If
  '更新总固顶部分数据和缓存
  If Not Action = 6 Then
   If Myistop=2 Then
    Dim tmpstr
    If Dvbbs.CacheData(28,0)="" Then
     tmpstr=", Forum_alltopnum='"&RootID&"'"
     Dvbbs.ReloadSetupCache RootID,28
    Else
     tmpstr=", Forum_alltopnum='"&Dvbbs.CacheData(28,0)&","&RootID&"'"
     Dvbbs.ReloadSetupCache Dvbbs.CacheData(28,0)&","&RootID,28
    End If
    SQL=SQl&tmpstr
   End If
   Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(7,0))+1,7'主题数
  End If
  Dvbbs.ReloadSetupCache CLng(Dvbbs.CacheData(8,0))+1,8'文章数
  Dvbbs.ReloadSetupCache LastPost,15
  Dvbbs.Execute(SQL)
 End Sub
 Public Sub succeed()
  response.Write("[ok]回复帖ID="&AnnounceID) 'zzcity add
  
'  Dim Uid,bid
'  Uid = Dvbbs.userid
'  Bid = Dvbbs.boardid
'  If PostStyle = "ajax" And Action =6 And Dvbbs.UserID>0 And ajaxPost Then
'   'Response.redirect "ajaxPostTpl.asp??boardid="&Dvbbs.boardid&"&Id="&RootID&"&AnnounceID="&AnnounceID&"&TotalUseTable="&TotalUseTable
'   Call ajaxReturn()
'   Exit Sub
'  End If

'  Dim TempStr,PostRetrunName,tourl,returnurl
'  If IsAudit=1 And Action <> 8 Then Dvbbs.BoardID=LockTopic
'  Dvbbs.Stats = Dvbbs.Stats & template.Strings(20)
'  'Call Dvbbs.BoardMasterPoint() '动网官方版主插件，斑竹评定
'  TempStr = template.html(8)
'  Select case Dvbbs.Board_Setting(17)
'  case "1"
'   tourl = "index.asp"
'   PostRetrunName=template.Strings(13)
'  case "2"
'   tourl="index.asp?boardid="&Dvbbs.boardid
'   PostRetrunName=template.Strings(14)
'  case "3","4"
'   If IsAudit=1  Then
'    tourl="index.asp?boardid="&Dvbbs.boardid
'    If IsAuditcheck=1 Then
'     PostRetrunName="由于您发表的贴子含敏感内容，您的贴子需要管理员审核过才可以见到。"
'    ElseIf IsAuditcheck=2 Then
'     PostRetrunName="由于您尚未达到豁免审核的条件，您的贴子需要管理员审核过才可以见到。"
'    Else
'     PostRetrunName=template.Strings(19)
'    End If
'   Else
'    Select Case Action
'     Case 5
'      tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'      PostRetrunName=template.Strings(15)
'     Case 6
'      tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'      PostRetrunName=template.Strings(16)
'     Case 7
'      tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'      PostRetrunName=template.Strings(17)
'     Case 8
'      tourl="dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'      PostRetrunName=template.Strings(18)
'    End Select
'    If Dvbbs.Board_Setting(17) = "4" And Not ajaxPost Then
'     tourl = Dvbbs.ArchiveHtml(tourl)
'     Dvbbs.Footer
'     Response.redirect tourl
'     Response.end
'    End If
'   End If
'  End Select

'  Dim UrlFlag
'  If IsAudit=1 Then
'   If Dvbbs.Board_Setting(17)>2 Then
'    UrlFlag=2
'   Else
'    UrlFlag=Dvbbs.Board_Setting(17)
'   End If
'  Else
'   UrlFlag=Dvbbs.Board_Setting(17)
'  End If
'  Select Case UrlFlag
'   case 1 returnurl = "index.asp"
'   case 2 returnurl = "index.asp?boardid="&Dvbbs.boardid
'   case 3 returnurl = "dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'   case 4 returnurl = "dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page="&page&"&star="&Star
'   Case Else returnurl= "dispbbs.asp?boardid="&Dvbbs.boardid&"&id="&RootID&"&page=1&star="&Star
'  End Select
'  returnurl = Mid(Dvbbs.ArchiveHtml("<a "&returnurl), 4)
'
'  TempStr = Replace(TempStr,"{$tourl}",Mid(Dvbbs.ArchiveHtml("<a "&tourl), 4))
'  TempStr = Replace(TempStr,"{$returnurl}",returnurl)
'  TempStr = Replace(TempStr,"{$stats}",Dvbbs.Stats)
'  TempStr = Replace(TempStr,"{$boardname}",Dvbbs.BoardType)
'  TempStr = Replace(TempStr,"{$boardid}",Dvbbs.BoardID)
'  TempStr = Replace(TempStr,"{$page}",page)
'  TempStr = Replace(TempStr,"{$PostRetrunName}",PostRetrunName)
'  If ajaxPost Then
'   Call showAjaxMsg(1,Dvbbs.Stats,"返回："&PostRetrunName,UrlFlag&"|"&Dvbbs.boardid&"|"&RootID&"|"&Star&"|"&page&"|"&returnurl)
'  Else
'   Response.Write TempStr
'  End If
 End Sub
 Private Function checktable(Table)
  Table=Right(Trim(Table),2)
  If Not IsNumeric(table) Then Table=Right(Trim(Table),1)
  If Not IsNumeric(table) Then showerr("totalusetable参数缺失") 'Dvbbs.AddErrCode(30)
  checktable="Dv_bbs"&table
 End Function

  '更新用户积分，所需外部变量,UserPost,userid,（外加发贴回贴的积分设置数据）
 Public Sub updatepostuser()
  '投票，发贴，更新积分
  '更新最后发贴时间
  Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@activetime").text = Now()
  If IsAudit> 0 Then Exit Sub
  Dim MagicSql
  
'  If Action = 5 Or Action = 7 Then
'   If FoundUseMagic Then
'    If cCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text ) > tMagicMoney Then
'     Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text -tMagicMoney
'     Dvbbs.ToolsLog -88,1,tMagicMoney,0,1,"使用金币购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
'    Else
'     MagicSql = ",UserTicket=UserTicket-"&tMagicTicket&""
'     Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text-tMagicTicket
'     Dvbbs.ToolsLog -88,1,0,tMagicTicket,1,"使用点券购买魔法表情",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text  & "|" & Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userticket").text
'    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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" "&MagicSql&" Where UserID="&Dvbbs.userID)
'   If Not Reuser Then
'    UserPost=UserPost+1
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertopic").text =CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertopic").text)+1
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text+Clng(Dvbbs.Forum_user(1))
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text+Clng(Dvbbs.Forum_user(6))
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text +Clng(Dvbbs.Forum_user(11))
'   End If
'  ElseIf Action = 6 Then '回贴更新积分。
  If 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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" Where UserID="&Dvbbs.userID)
'    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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" Where UserID="&Dvbbs.userID)
'    UserPost=UserPost+1
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text+Clng(Dvbbs.Forum_user(2))
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text+Clng(Dvbbs.Forum_user(7))
'    Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text =Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text +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.UserSession.documentElement.selectSingleNode("userinfo/@usermoney").text &" Where UserID="&Dvbbs.userID)
    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))&" Where UserID="&Dvbbs.userID) 'zzcity add
'   End If
  End If
'  If Not Reuser Then
'   Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text =CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)+1
'   Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text=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()
 End Sub
 '更新用户等级，所需外部变量,UserPost,GroupID,userid
 Public Sub Updategrade()
  Dim FoundGrade,TitlePic
  REM 判断用户组(等级)资料，当用户级别为跟随文章数增长则自动更新用户组(等级)
  REM 自动更新用户数据
  REM 如果属于系统或特殊或多属性组
  Set Rs=Dvbbs.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Dv_UserGroups Where UserGroupID="&GroupID)
  If Not (Rs.Eof And Rs.Bof) Then
   If Rs(2)<>3 Then
    '用户等级不按照文章升级，用户为系统或特殊或多属性组
    UserClass=Rs(3)
    TitlePic=Rs(4)
    FoundGrade=True
   End If
  End If
  If Not FoundGrade Then
   '如果不属于系统或特殊或多属性组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
   Set Rs=Dvbbs.Execute("Select Top 1 usertitle,GroupPic,UserGroupID From Dv_UserGroups Where ParentGID=3 And Minarticle<="&UserPost&" Order By MinArticle Desc,UserGroupID")
   If Not (Rs.Eof And Rs.Bof) Then
    UserClass=Rs(0)
    TitlePic=Rs(1)
    GroupID=Rs(2)
    FoundGrade=True
   End If
  End If
  Set Rs=Nothing
  If Not FoundGrade Then
'   If ajaxpost Then
'    Call showAjaxMsg(0,"系统没有找到您的注册用户组资料，请联系管理员进行修正。","","")
'   Else
'    Response.Redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>系统没有找到您的注册用户组资料，请联系管理员进行修正。&action=OtherErr"
'   End If
   showerr("系统没有找到您的注册用户组资料，请联系管理员进行修正。")
  End If
  Dvbbs.Execute("Update [Dv_User] Set UserClass='"&UserClass&"',TitlePic='"&TitlePic&"',UserGroupID="&GroupID&" Where UserID="&Dvbbs.UserID)
  'If Not Reuser Then
   Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userclass").text = UserClass
   Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text = GroupID
  'End If
 End Sub
 Function AccessPost()
  Dim Dom,node,ischeckcontent
  If Cint(Dvbbs.Board_Setting(3))=0 Then
   AccessPost=0
   Exit Function
  End If
  ischeckcontent=0
  Set Dom=Application(Dvbbs.CacheName & "_accesstopic")
  '检查审核是否有打开设置
  Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]")
  If Node is Nothing Then
   AccessPost=0
   Exit Function
  End If
  '检查是否属于需要审核的用户组
  Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]/checkuser[@use=1 and @usergroupid="&dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text&"]")
  Dim CheckUserGroup
  If Node is Nothing Then
   Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]/checkuser[@use=1 and @usergroupid=4]")
   If Not (Node Is Nothing) Then
    Response.Charset = "GB2312"
    Dim ParentGID
    If Not TypeName(Application(Dvbbs.CacheName &"_groupsetting"))="DOMDocument" Then LoadGroupSetting()
    ParentGID=Application(Dvbbs.CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text &"']/@parentgid").text
    If Not ParentGID=3 Then AccessPost=0:Exit Function
    CheckUserGroup=4
   Else
    AccessPost=0
    Exit Function
   End If
  Else
   CheckUserGroup=Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usergroupid").text
  End If

  '用户被豁免审核判断
  Set Node=Dom.documentElement.selectSingleNode("setting[@use=1]/nocheck/username[.='"&Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@username").text&"']")
  If Not Node is Nothing Then
   AccessPost=0
   Exit Function
  End If
  Rem action=5 主题 actiom=6 回复 action=7 投票 action=8 编辑
  Dim tmpstr,laction,regdate,delPercent
   Select Case action
    Case "5"
     tmpstr="setting[@use=1]/check[@new=1]"
     laction="new"
    Case "6"
      tmpstr="setting[@use=1]/check[@re=1]"
      laction="re"
    Case "7"
     tmpstr="setting[@use=1]/check[@new=1]"
     laction="new"
    Case "8"
     tmpstr="setting[@use=1]/check[@edit=1]"
     laction="edit"
   End Select
  If Dom.documentElement.selectSingleNode(tmpstr) Is Nothing Then
   AccessPost=0
   Exit Function
  End If
  regdate=Datediff("d",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now())
  If CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) > 0 Or CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text) < 0 Then
   delPercent=CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)-CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text)
   delPercent=(0-CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text))/delPercent
  Else
   delPercent=0
  End If
  delPercent=FormatPercent(delPercent)
  For Each node in Dom.documentElement.selectNodes("setting[@use=1 and check/@"&laction&"=1]/checkuser[@use=1 and @usergroupid="&CheckUserGroup&"]")
   '主题数判断
   If Node.selectSingleNode("usertopic/@use").text="1" Then
    If CCur(Node.selectSingleNode("usertopic/@value").text) > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertopic").text) Then
     AccessPost=1
     Exit For
    End If
   End If
   '回贴数
   If Node.selectSingleNode("userpost/@use").text="1" Then
    If CCur(Node.selectSingleNode("userpost/@value").text) > CCur(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) Then
     AccessPost=1
     Exit For
    End If
   End If
   '注册天数的比较
   If Node.selectSingleNode("regdate/@use").text="1" Then
    If CCur(Node.selectSingleNode("regdate/@value").text) > regdate Then
     AccessPost=1
     Exit For
    End If
   End If
   '删贴百分比比较
   If Node.selectSingleNode("userdel/@use").text="1" Then
    If FormatNumber(Node.selectSingleNode("userdel/@value").text) <  FormatNumber(delPercent) Then
     AccessPost=1
     Exit For
    End If
   End If
   '对被屏蔽用户是否审核的判断
   If Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@lockuser").text="2" And Node.selectSingleNode("lockuser/@use").text="1" Then
    AccessPost=1
    Exit For
   End If
   If Node.selectSingleNode("checkcontent/@use").text="1" Then
    Ischeckcontent=1
   End If
  Next
  If AccessPost=1 Then
   Exit Function
  End If
  If ischeckcontent=0 Then
   AccessPost=0
  Else
   Set Node=Dom.documentElement.selectNodes("setting[@use=1]/checkcontent")
   AccessPost=checkcontent(node)
  End If
 End Function
 Function checkcontent(node1)
  Dim re,s,node,tmpnode
  checkcontent=0
  s=unescape(Request("topic"))&unescape(Request("Body"))
  Set re=new RegExp
  re.IgnoreCase =True
  re.Global=True
  For Each Node in node1
   '含图片检查
   If Node.selectSingleNode("checkpic/@use").text="1" Then
    re.Pattern="(\[IMG\]|<img)"
    If re.Test(s) Then
     checkcontent=1
     Exit For
    End If
   End If
   '含链接检查
   If Node.selectSingleNode("checklink/@use").text="1" Then
    re.Pattern="(\[url\]|<a |http://|https://)"
    If re.Test(s) Then
     checkcontent=1
     Exit For
    End If
   End If
   '含flash检查
   If Node.selectSingleNode("checkflash/@use").text="1" Then
    re.Pattern="(\[flash|<object )"
    If re.Test(s) Then
     checkcontent=1
     Exit For
    End If
   End If
   '含媒体播放检查
   If Node.selectSingleNode("checkmp/@use").text="1" Then
    re.Pattern="(\[mp)"
    If re.Test(s) Then
     checkcontent=1
     Exit For
    End If
   End If
   '含媒rm检查
   If Node.selectSingleNode("checkrm/@use").text="1" Then
    re.Pattern="(\[rm)"
    If re.Test(s) Then
     checkcontent=1
     Exit For
    End If
   End If
   For Each tmpnode in Node.selectNodes("checkword")
    re.Pattern=tmpnode.selectSingleNode("@content").text
    If re.Test(s) Then
     checkcontent=1
     Exit For
    End If
   Next
  Next
  set re=Nothing
 End Function

 Rem Add ajax回复帖子返回html过程 By Dv.唧唧 2007-10-18
 Private Sub ajaxReturn()
  If IsAudit=1  Then
   If IsAuditcheck=1 Then
    Response.write "{IsAuditInfo:'由于您发表的贴子含敏感内容，您的贴子需要管理员审核过才可以见到。'}"
   ElseIf IsAuditcheck=2 Then
    Response.write "{IsAuditInfo:'由于您尚未达到豁免审核的条件，您的贴子需要管理员审核过才可以见到。'}"
   Else
    Response.write "{IsAuditInfo:'"&template.Strings(19)&"'}"
   End If
'   Response.Write "parent.close_postform();alert('"&PostRetrunName&"');"'parent.close_postform();"
   Response.end
  end if
  Dvbbs.LoadTemplates("dispbbs")

  Dim dv_ubb
  Set dv_ubb=new Dvbbs_UbbCode
  UserFlashGet=0'禁止使用 FlashGet避免缺少函数出错，原本可以包含FlashGet函数文件的，但这文件实在太垃圾了，一包含就有数据输出。 by老迷
  dv_ubb.PostType=1

  Dim outputHtml
  outputHtml = template.html(5)

  Dim Rs,Rs2,Rs3,Body
  TotalUseTable=checktable(TotalUseTable)
  Set Rs=Dvbbs.Execute("select * From "&TotalUseTable&" Where PostUserID="&Dvbbs.UserID&" And AnnounceID="& CLng(AnnounceID))
  Set Rs2=Dvbbs.Execute("select Child,GetMoneyType From Dv_Topic Where TopicID="&CLng(RootID))
  Set Rs3=Dvbbs.Execute("select UserEmail,UserPost,UserSex,UserFace,UserWidth,UserHeight,UserIM,JoinDate,UserClass,userEP,UserPower,UserIsBest,UserTitle,UserGroupID,TitlePic  From Dv_User Where UserID="&Dvbbs.UserId)

  Dim UserIM,nameglow(7),sexPic,namestyle,getnameglow
  UserIM = Split(Rs3("UserIM"),"|||")
  nameglow(0)=Dvbbs.mainsetting(9)
  nameglow(1)=Dvbbs.mainsetting(7)
  nameglow(2)=Dvbbs.mainsetting(7)
  nameglow(3)=Dvbbs.mainsetting(5)
  nameglow(6)="gray"
  nameglow(7)=Dvbbs.mainsetting(11)

  'FOR UBB
  replyid_a = AnnounceID
  AnnounceID_a = AnnounceID
  RootID_a = RootID
  T_GetMoneyType = Rs2(1)


  Dim floor
  floor = Cint(Rs2(0)+1)
  If floor >10 And Star=1 Then floor = 1

  If floor Mod 2 = 0 Then
   outputHtml = Replace(outputHtml,"{$divStyle}","postlary2")
  Else
   outputHtml = Replace(outputHtml,"{$divStyle}","postlary1")
  End If

  If Rs3("UserSex")=0 Then
   sexPic="FeMale.gif"
  Else
   sexPic="Male.gif"
  End If

  If Dvbbs.forum_setting(6)=1 And Rs3("UserTitle")<>"" Then
   outputHtml = Replace(outputHtml,"{$UserTitle}",Rs3("UserTitle"))
  Else
   outputHtml = Replace(outputHtml,"{$UserTitle}","")
  End If

  'If CLng(Rs3("UserPower")) > 0 Then
   'outputHtml = Replace(outputHtml,"{$UserPower}","<div><font color=""red""><b>威望："&Rs3("UserPower")&"</b></font></div>")
  'Else
   outputHtml = Replace(outputHtml,"{$UserPower}",Rs3("UserPower"))
  'End If
  outputHtml = Replace(outputHtml,"{$UserBest}",Rs3("UserIsBest"))


  If CInt(Rs3("UserGroupID")) < 9 Then
   getnameglow = nameglow(Rs3("UserGroupID")-1)
  Else
   getnameglow = Dvbbs.mainsetting(5)
  End If

  namestyle = Split(Application(Dvbbs.CacheName &"_groupsetting").documentElement.selectSingleNode("usergroup[@usergroupid='"& CInt(Rs3("UserGroupID")) &"']/@groupsetting").text,",")(58)
  namestyle = Split(namestyle,"§")

  If Dvbbs.Forum_setting(99) = 1 Then
   outputHtml = Replace(outputHtml,"{$Boke}"," | <a href=""boke.asp?UserID="&Dvbbs.UserId&""" title=""访问"&Dvbbs.membername&"的个人博客"" target=""_blank"">博客</a>")
  Else
   outputHtml = Replace(outputHtml,"{$Boke}","")
  End If

  If Trim(UserIM(0))<>"" Then
   outputHtml = Replace(outputHtml,"{$homepage}"," | <a href="""&UserIM(0)&""" target=""_blank"" title=""访问"&Dvbbs.membername&"的主页"">主页</a>")
  Else
   outputHtml = Replace(outputHtml,"{$homepage}","")
  End If

  If Trim(UserIM(1))<>"" Then
   outputHtml = Replace(outputHtml,"{$QQ}"," | <a href=""tencent://message/?uin="&UserIM(1)&""" title=""点击发送QQ消息给"&UserIM(1)&""" >QQ</a>")
  Else
   outputHtml = Replace(outputHtml,"{$QQ}","")
  End If

  If Trim(Rs3("UserEmail"))<>"" Then
   outputHtml = Replace(outputHtml,"{$UserEmail}"," | <a href=""mailto:"&Rs3("UserEmail")&""" title=""点击这里发送电子邮件给"&Dvbbs.membername&""">邮箱</a>")
  Else
   outputHtml = Replace(outputHtml,"{$UserEmail}","")
  End If
  Ubblists= Rs("Ubblist")
  If InStr(Ubblists,",39,") > 0  Then
   Body = dv_ubb.Dv_UbbCode(Dvbbs.ChkBadWords(Rs("Body")),Rs3("UserGroupID"),1,0)
  Else
   Body = dv_ubb.Dv_UbbCode(Dvbbs.ChkBadWords(Rs("Body")),Rs3("UserGroupID"),1,1)
  End If

  outputHtml = Replace(outputHtml,"{$boardID}",Dvbbs.boardid)            '版面ID
  outputHtml = Replace(outputHtml,"{$replyID}",Rs("AnnounceID"))           '帖子编号
  outputHtml = Replace(outputHtml,"{$topicId}",RootID)             '主题编号
  outputHtml = Replace(outputHtml,"{$Expression}",Rs("Expression"))          '发帖心情
  outputHtml = Replace(outputHtml,"{$topic}",Rs("Topic"))             '标题
  outputHtml = Replace(outputHtml,"{$floor}",Rs2(0)+1)             '楼层
  outputHtml = Replace(outputHtml,"{$Content}",Body)              '内容
  outputHtml = Replace(outputHtml,"{$postUserName}",Dvbbs.membername)          '用户名
  outputHtml = Replace(outputHtml,"{$postUserId}",Dvbbs.UserId)           '用户ID
  outputHtml = Replace(outputHtml,"{$sexPic}",sexPic)              '性别图片
  outputHtml = Replace(outputHtml,"{$UserFace}",Mid(Rs3("UserFace"),InStr(Rs3("UserFace"),"|")+1))  '头像
  outputHtml = Replace(outputHtml,"{$UserFaceW}",Rs3("UserWidth"))          '头像高度
  outputHtml = Replace(outputHtml,"{$UserFaceH}",Rs3("UserHeight"))          '头像宽度
  outputHtml = Replace(outputHtml,"{$nameglow}",getnameglow)            '用户名光晕颜色
  outputHtml = Replace(outputHtml,"{$postUserGroup}",Rs3("UserClass"))         '用户组名称
  outputHtml = Replace(outputHtml,"{$TitlePic}",Rs3("TitlePic"))           '等级图片
  outputHtml = Replace(outputHtml,"{$postUserPost}",Rs3("UserPost"))          '用户帖子数
  outputHtml = Replace(outputHtml,"{$postUserScore}",Rs3("userEP"))          '用户积分
  'outputHtml = Replace(outputHtml,"{$postUserReg}",FormatDateTime(Rs3("JoinDate"),1))      '注册日期
  outputHtml = Replace(outputHtml,"{$postUserReg}",Rs3("JoinDate"))
  outputHtml = Replace(outputHtml,"{$postTime}",Rs("DateAndTime"))          '回复时间
  outputHtml = Replace(outputHtml,"{$namestyleA}",namestyle(0))           '用户名标记 1
  outputHtml = Replace(outputHtml,"{$namestyleB}",namestyle(1))           '用户名标记 2
  outputHtml = Replace(outputHtml,"{$star}",Star)               '分页标记标记

  Dvbbs.Stats = Dvbbs.Stats & "成功"
  'Call Dvbbs.BoardMasterPoint() '动网官方版主插件，斑竹评定

  Response.Clear
  Response.Write outputHtml Rem &"----"& Dv_FilterJS(Rs3("UserFace"))
  'Response.Cookies("Dvbbs")=GetFormID()

  Rs.Close
  Rs2.Close
  Rs3.Close
  Set Rs = Nothing
  Set Rs2 = Nothing
  Set Rs3 = Nothing
  Set dv_ubb=Nothing
  Response.End
 End Sub

 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

 Sub showAjaxMsg(t,msg1,msg2,str)
  Response.Clear
  Rem 返回值：提交状态 0失败 1成功，显示信息，一些参数 如版块ID | 帖子id | 第几页 | 跳转URL
  Response.Write Dvbbs.Replacehtml("{Suc:"&t&",message:["""&msg1&""","""&msg2&"""],id:"""&str&"""};")
  Response.End
 End Sub

 Rem Add 返回showerr错误信息
 Function getErrCodeMsg()
  Dim i,ErrCodes,ErrString
  ErrCodes=Dvbbs.ErrCodes
  If ErrCodes<>"" Then
   ErrCodes=Split(ErrCodes,",")
   For i=0 to UBound(ErrCodes)
    If IsNumeric(ErrCodes(i)) Then
     If i=0 Then
      ErrString= Dvbbs.ReadTextFile(Template.Folder &"\"& Template.ChildFolder &"\showerr_Strings"&ErrCodes(i)&".htm")
     Else
      ErrString=ErrString&"<br />"&Dvbbs.ReadTextFile(Template.Folder &"\"& Template.ChildFolder &"\showerr_Strings"&ErrCodes(i)&".htm")
     End If
    End If
   Next
  End If
  getErrCodeMsg = ErrString
 End Function
End Class



'截取指定字符
Function cutStr(str,strlen)
 '去掉所有HTML标记
 'Dim re
 'Set re=new RegExp
 're.IgnoreCase =True
 're.Global=True
 're.Pattern="<([^<>]*?)>"
 'Do while re.Test(str)
 ' str=re.Replace(str,"")
 'Loop
 'set re=Nothing
 Str=Dvbbs.Replacehtml(Str)
 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,和HTML
Function reUBBCode(strContent)
 Dim re
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 strContent=Replace(strContent,"&nbsp;"," ")
 re.Pattern="(\[QUOTE\])(.|\n)*(\[\/QUOTE\])"
 strContent=re.Replace(strContent,"")
 re.Pattern="(\[point=*([0-9]*)\])(.|\n)*(\[\/point\])"
 strContent=re.Replace(strContent,"&nbsp;")
 re.Pattern="(\[post=*([0-9]*)\])(.|\n)*(\[\/post\])"
 strContent=re.Replace(strContent,"&nbsp;")
 re.Pattern="(\[power=*([0-9]*)\])(.|\n)*(\[\/power\])"
 strContent=re.Replace(strContent,"&nbsp;")
 re.Pattern="(\[usercp=*([0-9]*)\])(.|\n)*(\[\/usercp\])"
 strContent=re.Replace(strContent,"&nbsp;")
 re.Pattern="(\[money=*([0-9]*)\])(.|\n)*(\[\/money\])"
 strContent=re.Replace(strContent,"&nbsp;")
 re.Pattern="(\[replyview\])(.|\n)*(\[\/replyview\])"
 strContent=re.Replace(strContent,"&nbsp;")
 re.Pattern="(\[usemoney=*([0-9]*)\])(.|\n)*(\[\/usemoney\])"
 strContent=re.Replace(strContent,"&nbsp;")
 strContent=Replace(strContent,"<I></I>","")
 Set re=Nothing
 strContent=Replace(strContent,Chr(10),"")
 strContent=Replace(strContent,Chr(13),"")
 strContent=Replace(strContent, CHR(32), " ")
 strContent=Replace(strContent, CHR(9), " ")
 strContent=Dvbbs.Replacehtml(strContent)
 reUBBCode=replace(strContent,"<","&lt;")
End Function

'通用函数
Function IstrueName(uName)
 IstrueName=False
 If InStr(uName,"=")>0 Then Exit Function
 If InStr(uName,"%")>0 Then Exit Function
 If InStr(uName,Chr(32))>0 Then Exit Function
 If InStr(uName,"?")>0 Then Exit Function
 If InStr(uName,"&")>0 Then Exit Function
 If InStr(uName,";")>0 Then Exit Function
 If InStr(uName,",")>0 Then Exit Function
 If InStr(uName,"'")>0 Then Exit Function
 If InStr(uName,Chr(34))>0 Then Exit Function
 If InStr(uName,chr(9))>0 Then Exit Function
 If InStr(uName,"　")>0 Then Exit Function
 If InStr(uName,"$")>0 Then Exit Function
 IstrueName=True
End Function
'发贴时用，为了减少入库量
'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
Sub UPDATE_User_Msg(username)
 Dim msginfo,i,UP_UserInfo,newmsg
 newmsg=newincept(username)
 If newmsg>0 Then
  msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
 Else
  msginfo="0||0||null"
 End If
 Dvbbs.execute("UPDATE [Dv_User] Set UserMsg='"&Dvbbs.CheckStr(msginfo)&"' WHERE username='"&Dvbbs.CheckStr(username)&"'")
 If username=Dvbbs.MemberName Then
  Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text=msginfo
 Else
  Call Dvbbs.NeedUpdateList(username,1)
 End If
End Sub

'统计留言
Function newincept(iusername)
Dim Rs
Rs=Dvbbs.execute("SELECT Count(id) FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& Dvbbs.CheckStr(iusername) &"'")
    newincept=Rs(0)
 Set Rs=nothing
 If isnull(newincept) Then newincept=0
End Function

Function inceptid(stype,iusername)
 Dim Rs
 Set Rs=Dvbbs.execute("SELECT top 1 id,sender FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& Dvbbs.CheckStr(iusername) &"'")
 If not rs.eof Then
  If stype=1 Then
   inceptid=Rs(0)
  Else
   inceptid=Rs(1)
  End If
 Else
  If stype=1 Then
   inceptid=0
  Else
   inceptid="null"
  End If
 End If
 Set Rs=nothing
End Function
%>

发布规则使用说明

在ET采集软件发布配置的规则列表使用鼠标右键菜单导入本发布规则代码。

ET采集2发布规则范例

# ET发布规则文本
# 发布规则名称：Dvbbs 8.2
# 版本号：2.0.2
# 生成时间：2009-11-01 13:41:45
#
[name]
RHZiYnMgOC4y
[/name]
[urlchk]
aHR0cDovL8T6tcTN+Na3L2V0Y2hrLmFzcD90b3BpYz08JXRpdGxlJT4mYm9hcmRpZD0=
[/urlchk]
[urlpost]
aHR0cDovL8T6tcTN+Na3L2V0cG9zdC5hc3A=
[/urlpost]
[urlreply]
aHR0cDovL8T6tcTN+Na3L2V0cmVwbHkuYXNw
[/urlreply]
[isreply]
VHJ1ZQ==
[/isreply]
[len_t_s]
NQ==
[/len_t_s]
[len_t_l]
ODA=
[/len_t_l]
[len_c_s]
NTA=
[/len_c_s]
[len_c_l]
MTAwMDA=
[/len_c_l]
[ptitle]
dG9waWM=
[/ptitle]
[pcontent]
Ym9keQ==
[/pcontent]
[puser]
dXNlcm5hbWU=
[/puser]
[ppsw]
cGFzc3dk
[/ppsw]
[para1]
Ym9hcmRpZD3E+rXEwtvMs7Dmv+mx4LrFDQp0b3BpY21vZGU9DQpzaWduZmxhZz0NCkdldFBvc3RU
eXBlPQ0KVG9Nb25leT0=
[/para1]
[userlist]
1cu6xTE9w9zC6zENCtXLusUyPcPcwusy
[/userlist]
[paralist]

[/paralist]
[ftp]
RmFsc2U=
[/ftp]
[ftpserver]

[/ftpserver]
[ftpport]
MjE=
[/ftpport]
[ftpuser]

[/ftpuser]
[ftppsw]

[/ftppsw]
[ftppasv]
RmFsc2U=
[/ftppasv]
[ymupdir]
RmFsc2U=
[/ymupdir]
[codepage]
MA==
[/codepage]
[translang]
MA==
[/translang]
[transparas]
dG9waWMNCmJvZHk=
[/transparas]
[pathfile]

[/pathfile]
[urlfile]
L1VwbG9hZEZpbGU=
[/urlfile]
[pfiles]
ZmlsZXM=
[/pfiles]
[psurl]
c3VybA==
[/psurl]
[isloginpost]
RmFsc2U=
[/isloginpost]
[postcookies]

[/postcookies]
[postokcode]

[/postokcode]
[postaddurl]

[/postaddurl]
[isubb]
RmFsc2U=
[/isubb]
[iscrlf]
RmFsc2U=
[/iscrlf]
[sn]
OTk5OQ==
[/sn]
[g_id]
Mw==
[/g_id]

（请使用 CTRL+A 和 CTRL+C 从上栏复制规则）

免责声明：自在工坊网站所展示的作品信息由用户自行提供，其真实性、准确性和合法性由信息发布人负责。自在工坊不提供任何保证，并不承担任何法律责任。