post

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

Private xmlForumDoc, xmlForum
Private objCmd
Private lngForumId
Private lngArtId
Private intPageNo
Private blnError
Private strError

Private Sub Class_Initialize()
    Set MyXML = MyKernel.XMLParser
    Set xmlForumDoc = WM_GetCache("forum")
    blnError = True
End Sub

Private Sub Class_Terminate()
    Set xmlForumDoc = Nothing
End Sub

Public Sub main()
    MyXML.Align = "center"
    MyXML.Println MyKernel.Config("BBSTitle")
    MyXML.Align = "left"
    lngForumId = atol(MyIO.QueryString("ForumId"))
    intPageNo = atoi(MyIO.QueryString("PageNo"))
    lngArtId = atol(MyIO.QueryString("ArticleId"))
    If MyKernel.Config("IsBBS") <> "1" Then
        MyXML.Println "该功能已被站长关闭"
    ElseIf IsGuest() Then
        Call RegisterHint("只有注册用户才能发帖")
    Else
        Set xmlForum = XMLQuery(xmlForumDoc.documentElement, "forum[@seqid=" & lngForumId & "]")
        If xmlForum Is Nothing Then
            MyRedirect "bbs/index.asp"
        Else
            Set objCmd = MyKernel.Command(T_ARTICLE)
            If lngArtId > 0 Then
                objCmd.CommandType = "SELECT"
                objCmd.Where = "SeqId=" & lngArtId
                objCmd.Exec
            End If
            MyXML.Println "[" & XMLAttr(xmlForum, "title") & "]"
            If lngArtId <> objCmd("SeqId") Then
                MyXML.Println "找不到你要回帖的原贴"
            Else
                If MyIO.Env("REQUEST_METHOD") = "POST" Then
                    Call doPost
                Else
                    Call doGet
                End If
                If objCmd("SeqId") > 0 Then
                    MyXML.Println MyXML.CreateA("bbs/article.asp?ForumId=" & XMLAttr(xmlForum, "seqid") & "&PageNo=" & intPageNo & "&ArticleId=" & objCmd("SeqId"), "返回" & objCmd("Title"), GetImagePrefix("images/back.gif"), "")
                End If
            End If
            Set objCmd = Nothing
            MyXML.Println MyXML.CreateA("bbs/forum.asp?ForumId=" & XMLAttr(xmlForum, "seqid") & "&PageNo=" & intPageNo, "返回" & XMLAttr(xmlForum, "title"), GetImagePrefix("images/back.gif"), "")
        End If
        Set xmlForum = Nothing
    End If
    MyXML.Println MyXML.CreateA("bbs/index.asp", "返回" & MyKernel.Config("BBSTitle"), GetImagePrefix("images/back.gif"), "")
    Call BackHomeX(BBS_SEQID)
    Call SetLog("bbs", 0)
    Call MyKernel.OutputXML(Empty)
End Sub

Private Sub doGet()
    If objCmd("SeqId") > 0 Then
        MyXML.Println "回复帖子[" & objCmd("Title") & "]"
        MyXML.SetF "bbs/post.asp?ForumId=" & XMLAttr(xmlForum, "seqid") & "&PageNo=" & intPageNo & "&ArticleId=" & objCmd("SeqId"), "post", "", True
    Else
        MyXML.Println "发表新帖"
        MyXML.setF "bbs/post.asp?ForumId=" & XMLAttr(xmlForum, "seqid") & "&PageNo=" & intPageNo, "post", "", True
        MyXML.SetN "Title", "text", "", "帖子标题：", "", True, 0, 0, ""
    End If
    MyXML.SetN "Content", "text", "", "帖子内容：", "", True, 0, 0, ""
    MyXML.SetN "", "submit", "确定", "", "", True, 0, 0, ""
End Sub

Private Sub doPost()
    MyIO.PostBytes = MBYTE
    Dim strTitle, strContent
    Dim strSQL, lngTime
    strTitle = Trim(MyIO.Form("Title"))
    strContent = Trim(MyIO.Form("Content"))
    If objCmd("SeqId") = 0 And strTitle = "" Then
        strError = "请输入帖子标题"
    ElseIf strContent = "" Then
        strError = "请输入帖子内容"
    ElseIf GetTime(Now()) - atol(MyKernel.Memory("LastArt")) < atoi(MyKernel.Config("ArtInterval")) Then
        strError = "感谢您的参与，请不要频繁发帖或回帖"
    ElseIf atoi(MyKernel.Memory("ArtTotal")) > atoi(MyKernel.Config("ArtTotal")) Then
        blnError = True
        strError = "感谢你的参与，一天最多能发表" & MyKernel.Config("ArtTotal") & "个留言"
    Else
        blnError = False
        strError = IIf(objCmd("SeqId") = 0, "发帖", "回帖") & "成功"
        objCmd.CommandType = "INSERT"
        lngTime = GetTime(Now())
        objCmd.Add "UserId", MyKernel.Memory("UserId")
        objCmd.Add "UserName", MyKernel.Memory("Nick")
        objCmd.Add "ForumId", XMLAttr(xmlForum, "seqid")
        objCmd.Add "ForumName", XMLAttr(xmlForum, "title")
        objCmd.Add "Title", strTitle
        objCmd.Add "Content", strContent
        objCmd.Add "Reply", 0
        objCmd.Add "Hit", 0
        objCmd.Add "Follow", objCmd("SeqId")
        objCmd.Add "Intime", lngTime
        objCmd.Add "Outime", lngTime
        objCmd.Exec
        If objCmd("SeqId") = 0 Then
            xmlForum.setAttribute "arttotal", atol(XMLAttr(xmlForum, "arttotal")) + 1
            SetCache WM_CacheName("forum"), xmlForumDoc
            strSQL = "UPDATE $(Table) SET ARTTOTAL=$(ArtTotal) WHERE SEQID=$(SeqId)"
            strSQL = Replace(strSQL, "$(Table)", T_FORUM)
            strSQL = Replace(strSQL, "$(ArtTotal)", XMLAttr(xmlForum, "arttotal"))
            strSQL = Replace(strSQL, "$(SeqId)", XMLAttr(xmlForum, "seqid"))
            MyKernel.DB.Exec strSQL
        Else
            strSQL = "UPDATE $(Table) SET REPLY=REPLY+1,Outime=$(Timeval) WHERE SEQID=$(SeqId)"
            strSQL = Replace(strSQL, "$(Table)", T_ARTICLE)
            strSQL = Replace(strSQL, "$(Timeval)", lngTime)
            strSQL = Replace(strSQL, "$(SeqId)", objCmd("SeqId"))
            MyKernel.DB.Exec strSQL
        End If
        strSQL = "UPDATE $(Table) SET ARTTOTAL=$(ArtTotal),LASTART=$(Timeval) WHERE SEQID=$(SeqId)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
        If atol(MyKernel.Memory("LastRemark")) >= GetTime(Date()) Then
            MyKernel.Memory("ArtTotal") = atoi(MyKernel.Memory("ArtTotal")) + 1
        Else
            MyKernel.Memory("ArtTotal") = 1
        End If
        strSQL = Replace(strSQL, "$(ArtTotal)", MyKernel.Memory("ArtTotal"))
        strSQL = Replace(StrSQL, "$(Timeval)", GetTime(Now()))
        strSQL = Replace(strSQL, "$(SeqId)", MyKernel.Memory("SeqId"))
        MyKernel.DB.Exec strSQL
    End If
    MyXML.Println strError
    If blnError Then
        Call doGet
    End IF
End Sub