#forum.mo

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

Option Explicit

TBBS.Vars("template") = "admin.forum"
TBBS.SetNodes "forums"

TBBS.Vars("forumid") = atol(Request.QueryString("forumid"))
TBBS.CheckForum "crt", TBBS.Vars("forumid")
Call main()

Private Sub doGet()
    TBBS.Vars("state") = 0
    If Request.QueryString("action") = "edit" Then
        TBBS.Vars("action_addr") = "admin.asp?handle=forum&action=edit&forumid=" & TBBS.Vars("forumid") & "&id=" & Request.QueryString("id")
        TBBS.Vars("action_name") = TBBS.Lang("edit_forum")
        If Not TBBS.CheckForum("edit", Request.QueryString("id")) Then
            TBBS.Vars("state") = 1
            TBBS.AddHint "missing_forum", Array()
        Else
            TBBS.Vars("name") = TBBS.Forum("edit.name")
            TBBS.Vars("intro") = TBBS.Forum("edit.intro")
            TBBS.Vars("master") = TBBS.Forum("edit.master")
        End If
    Else
        TBBS.Vars("action_addr") = "admin.asp?handle=forum&action=add&forumid=" & TBBS.Vars("forumid")
        TBBS.Vars("action_name") = TBBS.Lang("add_forum")
    End If
End Sub

Private Sub doPost()
    TBBS.Vars("action_addr") = "admin.asp?handle=forum&action=add&forumid=" & TBBS.Vars("forumid")
    TBBS.Vars("action_name") = TBBS.Lang("add_forum")
    Select Case Request.QueryString("action")
    Case "add"
        Call doPostAdd
    Case "edit"
        TBBS.Vars("action_addr") = "admin.asp?handle=forum&action=edit&forumid=" & TBBS.Vars("forumid") & "&id=" & Request.QueryString("id")
        TBBS.Vars("action_name") = TBBS.Lang("edit_forum")
        Call doPostEdit
    Case "delete"
        Call doPostDelete
    Case "order"
        Call doPostOrder
    Case Else
        TBBS.AddError "invalid_handle", Array()
    End Select
End Sub

Private Sub doPostAdd()
    Dim clsCmd
    TBBS.Vars("state") = 1
    TBBS.Vars("follow") = atol(MyIO.Form("follow"))
    TBBS.Vars("name") = Trim(MyIO.Form("name"))
    TBBS.Vars("intro") = MyIO.Form("intro")
    TBBS.Vars("master") = Trim(MyIO.Form("master"))
    If TBBS.Vars("name") = "" Then
        TBBS.AddHint "empty_forum_name", Array()
    ElseIf Len(TBBS.Vars("name")) > 255 Then
        TBBS.AddHint "forum_name_too_long", Array()
    ElseIf Not ValidMaster(TBBS.Vars("master")) Then
        TBBS.AddHint "missing_master", Array()
    ElseIf Not ValidFollow(TBBS.Vars("follow")) Then
        TBBS.AddHint "missing_forum", Array()
    Else
        Set clsCmd = MyKernel.Command(T_FORUM)
        clsCmd.CommandType = "INSERT"
        clsCmd.Add "name", TBBS.Vars("name")
        clsCmd.Add "intro", TBBS.Vars("intro")
        clsCmd.Add "master", TBBS.Vars("master")
        clsCmd.Add "follow", TBBS.Vars("follow")
        clsCmd.Add "intime", TBBS.Vars("time")
        clsCmd.Add "serial", 0
        clsCmd.Add "topics", 0
        clsCmd.Add "replies", 0
        clsCmd.Add "todayposts", 0
        If TBBS.Vars("follow") > 0 Then
            clsCmd.Add "mark", TBBS.Forum("follow.mark")
        Else
            clsCmd.Add "mark", 0
        End If
        clsCmd.Exec
        Set clsCmd = Nothing
        TBBS.Vars("identity") = MyKernel.DB.GetIdentity(T_FORUM)
        
        Set clsCmd = MyKernel.Command(T_FORUM)
        clsCmd.CommandType = "UPDATE"
        clsCmd.Where = "SEQID=" & TBBS.Vars("identity")
        If TBBS.Vars("follow") > 0 Then
            clsCmd.Add "mark", TBBS.Forum("follow.mark") & "_" & TBBS.Vars("identity")
        Else
            clsCmd.Add "mark", TBBS.Vars("identity")
        End If
        clsCmd.Exec
        Set clsCmd = Nothing
        
        Call SetMasters("", TBBS.Vars("master"))
        
        TBBS.SetXMLCache "Forums"
        TBBS.SetNodes "forums"
        TBBS.Vars("state") = 2
        TBBS.AddHint "add_forum_ok", Array()
    End If
End Sub

Private Function ValidFollow(ByVal lngID)
    If lngID = 0 Then
        ValidFollow = True
    Else
        ValidFollow = TBBS.CheckForum("follow", lngID)
    End If
End Function

Private Sub SetMasters(ByVal strOld, ByVal strNew)
    Dim strSQL, arr, arr2, arr3, i
    If strOld = strNew Then Exit Sub
    If strOld <> "" Then
        arr = Split(strOld, "|")
        strSQL = "SELECT SEQID,TOPICS FROM $(Table) WHERE USERNAME IN ($(UserName))"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
        strSQL = Replace(strSQL, "$(UserName)", SafeArray(arr))
        arr2 = MyKernel.DB.GetRows(strSQL)
        If IsArray(arr2) Then
            For i = 0 To UBound(arr2, 2)
                arr3 = GetGroupInfo2(arr2(1, i))
                strSQL = "UPDATE $(Table) SET GROUPID=$(GroupID),GROUPNAME='$(GroupName)',GROUPIMG='$(GroupImg)' WHERE SEQID=$(SeqID)"
                strSQL = Replace(strSQL, "$(Table)", T_USER)
                strSQL = Replace(strSQL, "$(GroupID)", arr3(0))
                strSQL = Replace(strSQL, "$(GroupName)", SafeString(arr3(1)))
                strSQL = Replace(strSQL, "$(GroupImg)", SafeString(arr3(2)))
                strSQL = Replace(strSQL, "$(SeqID)", arr2(0, i))
                MyKernel.DB.Exec strSQL
                TBBS.UpdateGroupCount arr3(0), "+", 1
            Next
            TBBS.UpdateGroupCount 3, "-", UBound(arr2, 2) + 1
        End If
    End If
    If strNew <> "" Then
        arr = Split(strNew, "|")
        arr3 = GetGroupInfo(3)
        strSQL = "SELECT GROUPID FROM $(Table) WHERE USERNAME IN ($(UserName))"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
        strSQL = Replace(strSQL, "$(UserName)", SafeArray(arr))
        arr2 = MyKernel.DB.GetRows(strSQL)
        If IsArray(arr2) Then
            For i = 0 To UBound(arr2, 2)
                TBBS.UpdateGroupCount arr2(0, i), "-", 1
            Next
            strSQL = "UPDATE $(Table) SET GROUPID=$(GroupID),GROUPNAME='$(GroupName)',GROUPIMG='$(GroupImg)' WHERE USERNAME IN ($(UserName))"
            strSQL = Replace(strSQL, "$(Table)", T_USER)
            strSQL = Replace(strSQL, "$(GroupID)", arr3(0))
            strSQL = Replace(strSQL, "$(GroupName)", SafeString(arr3(1)))
            strSQL = Replace(strSQL, "$(GroupImg)", SafeString(arr3(2)))
            strSQL = Replace(strSQL, "$(UserName)", SafeArray(arr))
            MyKernel.DB.Exec strSQL
            TBBS.UpdateGroupCount 3, "+", UBound(arr2, 2) + 1
        End If
    End If
    TBBS.SetXMLCache "Groups"
End Sub

Private Function GetGroupInfo(ByVal lngId)
    Dim xmlDoc, xmlNode
    Dim strSQL, ret(2)
    Set xmlDoc = TBBS.GetXMLCache("Groups")
    Set xmlNode = XMLQuery(xmlDoc.documentElement, "group[@seqid = " & lngId & "]")
    If Not xmlNode Is Nothing Then
        ret(0) = xmlNode.getAttribute("seqid")
        ret(1) = xmlNode.getAttribute("name")
        ret(2) = xmlNode.getAttribute("groupimg")
    Else
        Err.Raise vbObjectError + 1, "Forum.GetGroupInfo", "Missing GroupID"
    End If
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
    GetGroupInfo = ret
End Function

Private Function GetGroupInfo2(ByVal lngPosts)
    Dim xmlDoc, xmlNode
    Dim strSQL, ret(2)
    Set xmlDoc = TBBS.GetXMLCache("Groups")
    Set xmlNode = XMLQuery(xmlDoc.documentElement, "group[@flag = " & GROUP_MEMBER & " and @minposts > " & lngPosts & "]")
    If Not xmlNode Is Nothing Then
        ret(0) = xmlNode.getAttribute("seqid")
        ret(1) = xmlNode.getAttribute("name")
        ret(2) = xmlNode.getAttribute("groupimg")
    Else
        Err.Raise vbObjectError + 1, "Forum.GetGroupInfo2", "Missing GroupID"
    End If
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
    GetGroupInfo2 = ret
End Function

Private Sub doPostEdit()
    TBBS.Vars("state") = 1
    If Not TBBS.CheckForum("edit", Request.QueryString("id")) Then
        TBBS.Vars("state") = 1
        TBBS.AddHint "missing_forum", Array()
    End If
    Dim clsCmd
    TBBS.Vars("follow") = atol(MyIO.Form("follow"))
    TBBS.Vars("name") = Trim(MyIO.Form("name"))
    TBBS.Vars("intro") = MyIO.Form("intro")
    TBBS.Vars("master") = MyIO.Form("master")
    If TBBS.Vars("name") = "" Then
        TBBS.AddHint "empty_forum_name", Array()
    ElseIf Len(TBBS.Vars("name")) > 255 Then
        TBBS.AddHint "forum_name_too_long", Array()
    ElseIf Not ValidMaster(TBBS.Vars("master")) Then
        TBBS.AddHint "missing_master", Array()
    ElseIf Not ValidFollow(TBBS.Vars("follow")) Then
        TBBS.AddHint "invalid_follow", Array()
    ElseIf IsChild() Then
        TBBS.AddHint "cannot_move_child", Array()
    Else
        Set clsCmd = MyKernel.Command(T_FORUM)
        clsCmd.CommandType = "UPDATE"
        clsCmd.Where = "SEQID=" & TBBS.Forum("edit.seqid")
        clsCmd.Add "name", TBBS.Vars("name")
        clsCmd.Add "intro", TBBS.Vars("intro")
        clsCmd.Add "master", TBBS.Vars("master")
        If TBBS.Vars("follow") <> atol(TBBS.Forum("edit.follow")) Then
            clsCmd.Add "follow", TBBS.Vars("follow")
            If TBBS.Vars("follow") > 0 Then
                clsCmd.Add "mark", TBBS.Forum("follow.mark") & "_" & TBBS.Forum("edit.seqid")
            Else
                clsCmd.Add "mark", TBBS.Forum("edit.seqid")
            End If
        End If
        clsCmd.Exec
        Set clsCmd = Nothing
        Call SetMasters(TBBS.Forum("edit.master"), TBBS.Vars("master"))
        TBBS.SetXMLCache "Forums"
        TBBS.SetNodes "forums"
        TBBS.Vars("state") = 2
        TBBS.AddHint "edit_forum_ok", Array()
    End If
End Sub

Private Function ValidMaster(ByVal strName)
    If strName = "" Then
        ValidMaster = True
        Exit Function
    End If
    Dim arr
    Dim strSQL
    arr = Split(strName, "|")
    strSQL = "SELECT COUNT(SEQID) FROM $(Table) WHERE USERNAME IN ($(UserName))"
    strSQL = Replace(strSQL, "$(Table)", T_USER)
    strSQL = Replace(strSQL, "$(UserName)", SafeArray(arr))
    ValidMaster = CBool(atol(MyKernel.DB.GetRow(strSQL)) = UBound(arr) + 1)
End Function

Private Function IsChild()
    If TBBS.Vars("follow") = 0 Then
        IsChild = False
        Exit Function
    End If
    If TBBS.Forum("follow.seqid") = TBBS.Forum("edit.seqid") Then
        IsChild = True
        Exit Function
    End If
    IsChild = CBool(Left(TBBS.Forum("follow.mark"), Len(TBBS.Forum("edit.mark")) + 1) = TBBS.Forum("edit.mark") & "_")
End Function

Private Sub doPostDelete()
    Dim arr, ptr
    Dim strSQL
    TBBS.Vars("state") = 3
    arr = MyIO.FormArray("seqid")
    If Not IsArray(arr) Then
        TBBS.AddHint "choose_forum_empty", Array()
    ElseIf Not IsNumericArray(arr) Then
        TBBS.AddHint "invalid_handle", Array()
    Else
        TBBS.Vars("deletes") = 0
        For Each ptr In arr
            If TBBS.CheckForum("del", ptr) Then
                strSQL = "DELETE FROM $(Table) WHERE MARK='$(Mark)' OR LEFT(MARK, $(Length))='$(Mark)_'"
                strSQL = Replace(strSQL, "$(Mark)", TBBS.Forum("del.mark"))
                strSQL = Replace(strSQL, "$(Length)", Len(TBBS.Forum("del.mark")) + 1)
                MyKernel.DB.Exec Replace(strSQL, "$(Table)", T_TOPIC)
                TBBS.Vars("deletes") = TBBS.Vars("deletes") + atol(MyKernel.DB.Exec(Replace(strSQL, "$(Table)", T_FORUM)))
            End If
        Next
        If TBBS.Vars("deletes") > 0 Then
            TBBS.SetXMLCache "Forums"
            TBBS.SetNodes "forums"
        End If
        TBBS.Vars("state") = 4
        TBBS.AddHint "delete_forum_ok", Array(TBBS.Vars("deletes"))
    End If
End Sub

Private Sub doPostOrder()
    TBBS.Vars("state") = 3
    Dim arr, i
    Dim strSQL
    TBBS.Vars("state") = 3
    arr = MyIO.FormArray("seqid")
    If Not IsArray(arr) Then
        TBBS.AddHint "choose_forum_empty", Array()
    ElseIf Not IsNumericArray(arr) Then
        TBBS.AddHint "invalid_handle", Array()
    Else
        For i = 0 To UBound(arr)
            strSQL = "UPDATE $(Table) SET SERIAL=$(Serial) WHERE SEQID=$(SeqID)"
            strSQL = Replace(strSQL, "$(Table)", T_FORUM)
            strSQL = Replace(strSQL, "$(Serial)", i)
            strSQL = Replace(strSQL, "$(SeqID)", atol(arr(i)))
            MyKernel.DB.Exec strSQL
        Next
        TBBS.SetXMLCache "Forums"
        TBBS.SetNodes "forums"
        TBBS.Vars("state") = 4
        TBBS.AddHint "order_forum_ok", Array()
    End If
End Sub