twinbbs.asp

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

        If UserLogined Then
            strSQL = strSQL & ",ONLINE='$(Online)'"
        End If
        strSQL = strSQL & " WHERE SEQID=$(SeqID)"
        strSQL = Replace(strSQL, "$(UserName)", SafeString(strUserName))
        strSQL = Replace(strSQL, "$(Online)", MyKernel.Memory("Online"))
        strSQL = Replace(strSQL, "$(SeqID)", rs("SeqID"))
    Else
        strSQL = "INSERT INTO $(Table) (USERNAME,ONLINE,FORUMID,STATE,IPADDR,STARTTIME) VALUES ('$(UserName)', $(Online), $(ForumID), '$(State)', '$(IPAddr)', $(Timeval))"
        If UserLogined Then
            strSQL = Replace(strSQL, "$(UserName)", SafeString(strUserName))
            strSQL = Replace(strSQL, "$(Online)", MyKernel.Memory("Online"))
        Else
            strSQL = Replace(strSQL, "$(UserName)", "")
            strSQL = Replace(strSQL, "$(Online)", 1)
        End If
        strSQL = Replace(strSQL, "$(IPAddr)", strIPAddr)
    End If
    rs.Close
    Set rs = Nothing
    strSQL = Replace(strSQL, "$(Table)", T_ONLINE)
    strSQL = Replace(strSQL, "$(ForumID)", lngForumID)
    strSQL = Replace(strSQL, "$(State)", SafeString(strState))
    strSQL = Replace(strSQL, "$(Timeval)", lngTime)
    MyKernel.DB.Exec strSQL
    Dim lngLastClear, lngInterval
    Dim strName
    strName = "TBBS.Online.Timestamp"
    lngLastClear = atol(GetCache(strName))
    lngInterval = atol(Env("online_interval"))
    If lngInterval < 1 Then lngInterval = 1200
    If lngLastClear < 1 Then
        SetCache strName, lngTime
    ElseIf lngTime - lngLastClear > lngInterval Then
        SetCache strName, lngTime
        strSQL = "DELETE FROM $(Table) WHERE LASTTIME<$(Timeval)"
        strSQL = Replace(strSQL, "$(Table)", T_ONLINE)
        strSQL = Replace(strSQL, "$(Timeval)", lngTime - lngInterval)
        MyKernel.DB.Exec strSQL
    End If
End Sub

Public Sub DelOnline()
    Dim strSQL
    If UserLogined Then
        strSQL = "DELETE FROM $(Table) WHERE USERNAME='$(UserName)'"
        strSQL = Replace(strSQL, "$(UserName)", SafeString(MyKernel.Memory("UserName")))
    Else
        strSQL = "DELETE FROM $(Table) WHERE IPADDR='$(IPAddr)' AND USERNAME IS NULL"
        strSQL = Replace(strSQL, "$(IPAddr)", MyIO.Env("REMOTE_ADDR"))
    End If
    strSQL = Replace(strSQL, "$(Table)", T_ONLINE)
    MyKernel.DB.Exec strSQL
End Sub

Public Property Get Forum(ByVal strKey)
    Dim xmlNode
    Dim arr
    arr = Split(strKey, ".")
    Set xmlNode = xmlRoot.selectSingleNode("forums/forum[@seqid = //vars/@forum_" & arr(0) & "_id]")
    If Not xmlNode Is Nothing Then
        Forum = atos(xmlNode.getAttribute(arr(1)))
    End If
    Set xmlNode = Nothing
End Property

Public Property Let Forum(ByVal strKey, vtValue)
    Dim xmlNode
    Dim arr
    arr = Split(strKey, ".")
    Set xmlNode = xmlRoot.selectSingleNode("forums/forum[@seqid = //vars/@forum_" & arr(0) & "_id]")
    If Not xmlNode Is Nothing Then
        xmlNode.setAttribute arr(1), vtValue
    End If
    Set xmlNode = Nothing
End Property

Public Property Get Topic(ByVal strKey)
    Topic = Attr("topic", strKey)
End Property

Public Property Let Topic(ByVal strKey, vtValue)
    Attr("topic", strKey) = vtValue
End Property

Public Property Get Quote(ByVal strKey)
    Quote = Attr("quote", strKey)
End Property

Public Property Let Quote(ByVal strKey, vtValue)
    Attr("quote", strKey) = vtValue
End Property

Public Property Get Page(ByVal strKey)
    Page = Variable("page", strKey)
End Property

Public Property Let Page(ByVal strKey, vtValue)
    Attr("page", strKey) = vtValue
    Variable("page", strKey) = vtValue
End Property

Public Sub SetPageXML(ByVal strParent, ByVal strChild, ByVal blnStandalone)
    Dim rs, strSQL
    Dim strWhere
    Dim strSort
    If Page("where") <> "" Then strWhere = " WHERE " & Page("where")
    If Page("sort") <> "" Then strSort = " ORDER BY " & Page("sort")
    If Page("datatype") = adAccess Then
        strSQL = "SELECT $(Column) FROM $(Table)$(Where)$(Sort)"
        strSQL = Replace(strSQL, "$(Table)", Page("table"))
        strSQL = Replace(strSQL, "$(Column)", Page("column"))
        strSQL = Replace(strSQL, "$(Where)", strWhere)
        strSQL = Replace(strSQL, "$(Sort)", strSort)
        Set rs = MyKernel.DB.Exec3(strSQL, adOpenKeyset, adLockReadOnly, adCmdText)
        If Not rs.EOF Then
            rs.Move Page("flag")
            AppendXML RecordToXML(rs, Page("size"), strParent, strChild), blnStandalone
        Else
            AppendXML RecordToXML(rs, -1, strParent, strChild), blnStandalone
        End If
        rs.Close
        Set rs = Nothing
    Else
        Select Case atoi(Page("datatype"))
        Case adSQLServer
            If Page("flag") > 0 Then
                strSQL = "SELECT TOP $(Move) $(Column) FROM $(Table)$(Where)$(WhereOrAnd)$(Index)$(Operator)(SELECT $(MinMax)($(Index)) FROM (SELECT TOP $(Flag) $(Index) FROM $(Table)$(Where)$(Sort)) X)$(Sort)"
                strSQL = Replace(strSQL, "$(WhereOrAnd)", IIf(strWhere = "", " WHERE ", " AND "))
                strSQL = Replace(strSQL, "$(Index)", Page("index"))
                strSQL = Replace(strSQL, "$(Operator)", IIf(Page("sorttype") = 0, ">", "<"))
                strSQL = Replace(strSQL, "$(MinMax)", IIf(Page("sorttype") = 0, "MAX", "MIN"))
            Else
                strSQL = "SELECT TOP $(Move) $(Column) FROM $(Table)$(Where)$(Sort)"
            End If
        Case adOracle
            strSQL = "SELECT $(Column),ROWNO FROM (SELECT $(Column),ROWNUM ROWNO FROM (SELECT $(Column) FROM $(Table)$(Where)$(Sort))) WHERE ROWNO BETWEEN $(Flag) AND $(Flag) + $(Move)"
        Case adMySQL
            strSQL = "SELECT $(Column) FROM $(Table)$(Where)$(Sort) LIMIT $(Flag),$(Move)"
        End Select
        strSQL = Replace(strSQL, "$(Table)", Page("table"))
        strSQL = Replace(strSQL, "$(Column)", Page("column"))
        strSQL = Replace(strSQL, "$(Where)", strWhere)
        strSQL = Replace(strSQL, "$(Sort)", strSort)
        strSQL = Replace(strSQL, "$(Move)", Page("move"))
        strSQL = Replace(strSQL, "$(Flag)", Page("flag"))
        AppendXML MyKernel.DB.SQLToXML(strSQL, strParent, strChild), blnStandalone
    End If
End Sub

Public Sub SetPagePrefix(ByVal strURL, vtName, vtValue)
    Dim arrName, arrValue, i
    Dim xmlPage, xmlField
    If IsArray(vtName) Then
        arrName = vtName
        arrValue = vtValue
    ElseIf vtName = "" Then
        arrName = Array()
        arrValue = Array()
    Else
        arrName = Array(vtName)
        arrValue = Array(vtValue)
    End If
    Set xmlPage = Element("page")
    xmlPage.setAttribute "action", strURL
    For i = 0 To UBound(arrName)
        Set xmlField = xmlPage.appendChild(Create("field"))
        xmlField.setAttribute "name", arrName(i)
        xmlField.setAttribute "value", arrValue(i)
        Set xmlField = Nothing
    Next
    strURL = GetURL(strURL, vtName, vtValue)
    xmlPage.setAttribute "url", strURL
    xmlPage.setAttribute "link", IIf(InStr(strURL, "?") > 0 , "&", "?")
    Set xmlPage = Nothing
End Sub

Public Function CheckForum(ByVal strName, ByVal strID)
    Dim xmlDoc, xmlNode
    Dim lngID
    lngID = atol(strID)
    Set xmlDoc = GetXMLCache("Forums")
    Set xmlNode = XMLQuery(xmlDoc.documentElement, "forum[@seqid=" & lngID & "]")
    CheckForum = CBool(Not xmlNode Is Nothing)
    If CheckForum Then
        Vars("forum_" & strName & "_id") = lngID
    End If
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
End Function

Public Function CheckTopic(ByVal strID)
    Dim xmlDoc, strSQL
    Dim lngID
    CheckTopic = False
    lngID = atol(strID)
    If lngID < 1 Then Exit Function
    strSQL = MyKernel.DB.GetLimitSQL(1, "*", T_TOPIC, "SEQID=$(SeqID)", "", "")
    strSQL = Replace(strSQL, "$(SeqID)", lngID)
    Set xmlDoc = MyKernel.DB.SQLToXML(strSQL, "topics", "topic")
    CheckTopic = xmlDoc.documentElement.hasChildNodes
    If CheckTopic Then
        AppendNode xmlDoc.documentElement.firstChild
    End If
    Set xmlDoc = Nothing
End Function

Public Function CheckQuote(ByVal strID)
    Dim lngID
    lngID = atol(strID)
    If lngID < 1 Then
        CheckQuote = True
        Exit Function
    End If
    Dim xmlDoc, strSQL
    strSQL = MyKernel.DB.GetLimitSQL(1, "*", T_TOPIC, "SEQID=$(SeqID)", "", "")
    strSQL = Replace(strSQL, "$(SeqID)", lngID)
    Set xmlDoc = MyKernel.DB.SQLToXML(strSQL, "topics", "quote")
    CheckQuote = CBool(xmlDoc.documentElement.childNodes.length = 1)
    If CheckQuote Then
        AppendNode xmlDoc.documentElement.firstChild
    End If
    Set xmlDoc = Nothing
End Function

Public Sub SetForumNav(ByVal blnURL)
    Dim arr, ptr
    Dim xmlDoc, xmlNodes, xmlNode
    arr = Split(Forum("crt.mark"), "_")
    Set xmlDoc = GetXMLCache("Forums")
    Set xmlNodes = XMLQueries(xmlDoc.documentElement, "forum[@seqid=" & Join(arr, " or @seqid=") & "]")
    For Each ptr In arr
        For Each xmlNode In xmlNodes
            If ptr = xmlNode.getAttribute("seqid") Then
                If Not blnURL And Forum("crt.seqid") = ptr Then
                    AddNav "", xmlNode.getAttribute("name")
                Else
                    AddNav "forum.asp?id=" & ptr, xmlNode.getAttribute("name")
                End If
                Exit For
            End If
        Next
    Next
    Page("name") = GetNav()
    AddOnline Forum("crt.seqid"), Page("name")
    Set xmlNodes = Nothing
    Set xmlDoc = Nothing
End Sub

Public Sub SetTopicNav(ByVal blnURL)
    Dim arr, ptr
    Dim xmlDoc, xmlNodes, xmlNode
    arr = Split(Forum("crt.mark"), "_")
    Set xmlDoc = GetXMLCache("Forums")
    Set xmlNodes = XMLQueries(xmlDoc.documentElement, "forum[@seqid=" & Join(arr, " or @seqid=") & "]")
    For Each ptr In arr
        For Each xmlNode In xmlNodes
            If ptr = xmlNode.getAttribute("seqid") Then
                AddNav "forum.asp?id=" & ptr, xmlNode.getAttribute("name")
                Exit For
            End If
        Next
    Next
    If blnURL Then
        AddNav "topic.asp?fid=" & Forum("crt.seqid") & "&id=" & Topic("seqid"), Topic("title")
    Else
        AddNav "", Topic("title")
    End If
    Page("name") = GetNav()
    AddOnline Forum("crt.seqid"), Page("name")
    Set xmlNodes = Nothing
    Set xmlDoc = Nothing
End Sub

Public Property Get Variable(ByVal strPrefix, ByVal strKey)
    Variable = Vars(strPrefix & "_" & strKey)
End Property

Public Property Let Variable(ByVal strPrefix, ByVal strKey, vtValue)
    Vars(strPrefix & "_" & strKey) = vtValue
End Property

Public Function CheckValidate(ByVal strName)
    Dim strVal
    If NetType <> "web" Then
        CheckValidate = True
    ElseIf Not Validate(strName) Then
        CheckValidate = True
    Else
        strVal = Trim(MyIO.Form("validate"))
        If strVal = "" Then
            CheckValidate = False
        Else
            CheckValidate =  CBool(strVal = Session("validate"))
        End If
    End If
End Function

Public Function FileType(ByVal strExt)
    Dim ret
    If InString(Env("allow_image"), strExt, False) Then
        ret = TBBS_IMAGE
    ElseIf InString(Env("allow_ring"), strExt, False) Then
        ret = TBBS_RING
    ElseIf InString(Env("allow_video"), strExt, False) Then
        ret = TBBS_VIDEO
    ElseIf InString(Env("allow_soft"), strExt, False) Then
        ret = TBBS_SOFT
    Else
        ret = 0
    End If
    FileType = ret
End Function

Public Function FileTypeName(ByVal intType)
    Dim ret
    Select Case intType
    Case TBBS_IMAGE
        ret = "image"
    Case TBBS_RING
        ret = "ring"
    Case TBBS_VIDEO
        ret = "video"
    Case TBBS_SOFT
        ret = "soft"
    Case Else
        ret = "unknown"
    End Select
    FileTypeName = ret
End Function

Public Sub SetMaster()
    If Not InString("1|2|3", MyKernel.Memory("groupid"), True) Then Exit Sub
    Dim strMark
    Dim arr, i, xmlNode
    Select Case MyKernel.Memory("groupid")
    Case "1"
        Attr("user", "master") = 1
    Case "2"
        Attr("user", "master") = 1
    Case "3"
        strMark = Forum("crt.mark")
        arr = Split(strMark, "_")
        If InString(Forum("crt.master"), MyKernel.Memory("username"), False) Then
            Attr("user", "master") = 1
        ElseIf UBound(arr) > 0 Then
            For i = 0 To UBound(arr) - 1
                Set xmlNode = xmlRoot.selectSingleNode("forums/forum[@seqid=" & arr(i) & "]/@master")
                If IsNull(xmlNode.text) Then
                ElseIf InString(xmlNode.text, MyKernel.Memory("username"), False) Then
                    Attr("user", "master") = 1
                    Exit For
                End If
                Set xmlNode = Nothing
            Next
        End If
    End Select
End Sub

Public Sub UpdateGroupCount(ByVal lngID, ByVal strOP, ByVal lngCount)
    Dim strSQL
    strSQL = "UPDATE $(Table) SET USERCOUNT=USERCOUNT$(OP)$(Count) WHERE SEQID=$(SeqID)"
    strSQL = Replace(strSQL, "$(Table)", T_GROUP)
    strSQL = Replace(strSQL, "$(OP)", strOP)
    strSQL = Replace(strSQL, "$(Count)", lngCount)
    strSQL = Replace(strSQL, "$(SeqID)", lngID)
    MyKernel.DB.Exec strSQL
End Sub
End Class
%>