core.asp

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

<%
Class ImplMocomWAPmoWAPCore
Public PageNo, PageId, CateId
Private rs
Private strSQL
Public Staple
Public Mapping
Public Content

Private Sub Class_Initialize()
    Set Staple = Nothing
    Set Mapping = Nothing
    Set Content = Nothing
    PageNo = atol(MyIO.QueryString("PageNo"))
    If PageNo < 1 Then PageNo = 1
    PageId = atol(MyIO.QueryString("PageId"))
    If PageId < 1 Then PageId = 1
    CateId = atol(MyIO.QueryString("CateId"))
End Sub

Private Sub Class_Terminate()
    Set Mapping = Nothing
    Set Content = Nothing
    Set Staple = Nothing
End Sub

Public Function ExportText(ByVal strIn)
    MyXML.Printf MyXML.CreateT(strIn)
    ExportText = True
End Function

Public Function ExportImage(ByVal strPath, ByVal strTitle, ByVal strURL)
    If strURL = "" Then
        MyXML.Printf MyXML.CreateImg(strPath, strTitle, -1, -1)
    Else
        MyXML.Printf MyXML.CreateA(strURL, MyXML.CreateImg(strPath, strTitle, -1, -1), "", "")
    End If
    ExportImage = True
End Function

Public Function ExportLink(ByVal strTitle, ByVal strLink)
    MyXML.Printf MyXML.CreateA(strLink, strTitle, "", "")
    ExportLink = True
End Function

Public Function ExportUserEntry _
( _
    ByVal loginBefore, _
    ByVal loginBehind, _
    ByVal strSpace _
)
    Dim strHead(1)
    Dim strFoot(1)
    Dim strLogin(1)
    Dim i, k
    Dim arr1, arr2
    strHead(0) = "BeforeLoginStart"
    strHead(1) = "BehindLoginStart"
    strFoot(0) = "BeforeLoginEnd"
    strFoot(1) = "BehindLoginEnd"
    strLogin(0) = loginBefore
    strLogin(1) = loginBehind
    For i = 0 To UBound(strLogin)
        If Err.Number Then Exit For
        MyXML.Printf MyXML.CreateC(strHead(i))
        arr1 = Split(strLogin(i), "||")
        For k = 0 To UBound(arr1)
            arr2 = Split(arr1(k), "&&", 2)
            If UBound(arr2) = 1 Then
                If i = 0 Then
                    MyXML.Printf MyXML.CreateA(GetURL(arr2(1), "Referer", MyIO.Env("REQUEST_URI")), arr2(0), "", "")
                Else
                    MyXML.Printf MyXML.CreateA(arr2(1), arr2(0), "", "")
                End If
            End If
            If k <> UBound(arr1) Then
                MyXML.Printf strSpace
            End If
        Next
        MyXML.Printf MyXML.CreateC(strFoot(i))
    Next
    ExportUserEntry = True
End Function

Private Sub ExportStyle(ByVal strIn, ByVal strColor, ByVal strText, ByVal blnCrLf)
    Dim fmt
    Dim arr
    arr = Split(strIn, "||")
    If strColor <> "#000000" Then fmt = "font"
    If UBound(arr) = 2 Then
        If arr(0) = "1" Then fmt = fmt & IIf(fmt = "", "b", "|b")
        If arr(1) = "1" Then fmt = fmt & IIf(fmt = "", "i", "|i")
        If arr(2) = "1" Then fmt = fmt & IIf(fmt = "", "u", "|u")
    End If
    If fmt = "" Then
        If blnCrLf Then
            MyXML.Println strText
        Else
            MyXML.Printf strText
        End If
    Else
        Dim xmlNode
        Set xmlNode = MyXML.CreateX(fmt, strText)
        If strColor <> "#000000" Then
            xmlNode.setAttribute "color", strColor
        End If
        If blnCrLf Then
            MyXML.Println xmlNode
        Else
            MyXML.Printf xmlNode
        End If
        Set xmlNode = Nothing
    End If
End Sub

Public Function ExportThemes _
( _
    ByVal strIconOrTitle, _
    ByVal strStyle, _
    ByVal strColor, _
    ByVal strPrefix, _
    ByVal strSuffix, _
    ByVal strCount, _
    ByVal strStapleSpace, _
    ByVal strThemeSpace _
)
    Dim xmlDoc, xmlNodes, xmlNode
    Set xmlDoc = WM_GetCache("staple")
    Set xmlNodes = XMLQueries(xmlDoc, "staples/staple[@hidden = 0 and @follow = 0]")
    ExportThemes = CBool(xmlNodes.length > 0)
    If ExportThemes Then
        Set xmlNode = xmlNodes.nextNode()
        Do While Not xmlNode Is Nothing
            ExportThemeX xmlNode, strIconOrTitle, strStyle, strColor, strPrefix, strSuffix, strCount, strStapleSpace
            Set xmlNode = xmlNodes.nextNode()
            If Not xmlNode Is Nothing Then
                If strThemeSpace <> "" Then MyXML.Println ""
                MyXML.Println strThemeSpace
            End If
        Loop
    End If
    Set xmlNodes = Nothing
    Set xmlDoc = Nothing
End Function

Public Function ExportTheme _
( _
    ByVal strSeqId, _
    ByVal strIconOrTitle, _
    ByVal strStyle, _
    ByVal strColor, _
    ByVal strPrefix, _
    ByVal strSuffix, _
    ByVal strCount, _
    ByVal strStapleSpace _
)
    Dim xmlDoc, xmlNode
    Set xmlDoc = WM_GetCache("staple")
    Set xmlNode = XMLQuery(xmlDoc, "staples/staple[@hidden = 0 and @follow = 0 and @seqid=" & atol(strSeqId) & "]")
    ExportTheme = CBool(Not xmlNode Is Nothing)
    If ExportTheme Then
        ExportThemeX xmlNode, strIconOrTitle, strStyle, strColor, strPrefix, strSuffix, strCount, strStapleSpace
    End If
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
End Function

Private Sub ExportThemeX _
( _
    xmlParent, _
    ByVal strIconOrTitle, _
    ByVal strStyle, _
    ByVal strColor, _
    ByVal strPrefix, _
    ByVal strSuffix, _
    ByVal strCount, _
    ByVal strStapleSpace _
)
    Dim xmlNodes, xmlNode
    Dim i
    Dim intCount
    i = 0
    intCount = atoi(strCount)
    If atoi(XMLAttr(xmlParent, "staplecount")) = 0 Then
        xmlParent.setAttribute "staplecount", 1
    End If
    If strIconOrTitle = "1" Then
        If XMLAttr(xmlParent, "icon") <> "" Then
            MyXML.Println MyXML.CreateImg("images/icon" & XMLAttr(xmlParent, "seqid") & "." & XMLAttr(xmlParent, "icon"), "加载中……", -1, -1)
        Else
            ExportStyle strStyle, strColor, strPrefix & XMLAttr(xmlParent, "title") & strSuffix, True
        End If
    End If
    Set xmlNodes = XMLQueries(xmlParent.ownerDocument, "staples/staple[@hidden = 0 and @follow = " & XMLAttr(xmlParent, "seqid") & "]")
    Set xmlNode = xmlNodes.nextNode()
    Do While Not xmlNode Is Nothing
        If MyKernel.Modlist(moMISC) = 1 Then
            If XMLAttr(xmlNode, "ismisc") = "1" Then
                If XMLAttr(xmlNode, "icon") <> "" Then
                    MyXML.Printf MyXML.CreateA(XMLAttr(xmlNode, "misc_visit") & "index.asp", MYXML.CreateImg("images/icon" & XMLAttr(xmlNode, "seqid") & "." & XMLAttr(xmlNode, "icon"), XMLAttr(xmlNode, "title"), -1, -1), "", "")
                ElseIf atoi(XMLAttr(xmlNode, "list")) > 0 Then
                    MyXML.Printf MyXMLCreateA(XMLAttr(xmlNode, "misc_visit") & "index.asp", XMLAttr(xmlNode, "title"), "images/list" & XMLAttr(xmlNode, "list") & ".gif", "")
                Else
                    MyXML.Printf MyXML.CreateA(XMLAttr(xmlNode, "misc_visit") & "index.asp", XMLAttr(xmlNode, "title"), "", "")
                End If
            Else
                If XMLAttr(xmlNode, "icon") <> "" Then
                    MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlNode, "seqid"), 1), MyXML.CreateImg("images/icon" & XMLAttr(xmlNode, "seqid") & "." & XMLAttr(xmlNode, "icon"), XMLAttr(xmlNode, "title"), -1, -1), "", "")
                ElseIf atoi(XMLAttr(xmlNode, "list")) > 0 Then
                    MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlNode, "seqid"), 1), XMLAttr(xmlNode, "title"), "images/list" & XMLAttr(xmlNode, "list") & ".gif", "")
                Else
                    MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlNode, "seqid"), 1), XMLAttr(xmlNode, "title"), "", "")
                End If
            End If
        Else
            If XMLAttr(xmlNode, "icon") <> "" Then
                MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlNode, "seqid"), 1), MyXML.CreateImg("images/icon" & XMLAttr(xmlNode, "seqid") & "." & XMLAttr(xmlNode, "icon"), XMLAttr(xmlNode, "title"), -1, -1), "", "")
            ElseIf atoi(XMLAttr(xmlNode, "list")) > 0 Then
                MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlNode, "seqid"), 1), XMLAttr(xmlNode, "title"), "images/list" & XMLAttr(xmlNode, "list") & ".gif", "")
            Else
                MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlNode, "seqid"), 1), XMLAttr(xmlNode, "title"), "", "")
            End If
        End If
        Set xmlNode = xmlNodes.nextNode()
        i = i + 1
        If i = intCount Then
            MyXML.Println ""
            MyXML.Printf MyXML.CreateA(GetStapleURL(XMLAttr(xmlParent, "seqid"), 1), "更多……", "", "")
            Exit Do
        ElseIf Not xmlNode Is Nothing Then
            If i Mod atoi(XMLAttr(xmlParent, "staplecount")) = 0 Then
                MyXML.Println ""
            Else
                MyXML.Printf strStapleSpace
            End If
        End If
    Loop
    Set xmlNodes = Nothing
End Sub

Public Function ExportContentx _
( _
    ByVal strType, _
    ByVal strCount, _
    ByVal strStaple, _
    ByVal strPrefixType, _
    ByVal strPrefix, _
    ByVal strSuffix, _
    ByVal strAttach, _
    ByVal strSpace, _
    ByVal strBytes _
)
    ExportContentx = ExportContentx1(strType, strCount, strStaple, strPrefixType, strPrefix, strSuffix, strAttach, "0", strSpace, strBytes)
End Function

Public Function ExportContentx1 _
( _
    ByVal strType, _
    ByVal strCount, _
    ByVal strStaple, _
    ByVal strPrefixType, _
    ByVal strPrefix, _
    ByVal strSuffix, _
    ByVal strAttach, _
    ByVal strAttachCount, _
    ByVal strSpace, _
    ByVal strBytes _
)
    Dim strWhere
    Dim strSort
    Dim intCount
    Dim intBytes
    Dim i, k
    Dim intAttachCount
    Dim strURL
    Dim strTitle
    Dim strImage
    Dim arr(7)
    Dim intMISC
    Dim xmlDoc, xmlNode, xmlDoc2, xmlNode2, strFrontImage
    Dim strMark
    intCount = atoi(strCount)
    If intCount <= 0 Then intCount = 1
    intBytes = atoi(strBytes)
    If intBytes < 0 Then intBytes = 0
    intAttachCount = atoi(strAttachCount)
    strWhere = "HIDDEN=0 AND EXAMINE=1"
    If strStaple = "x" Then
        'pass
    ElseIf strStaple = "y" Then
        If Not CheckStaple() Then Exit Function
        strMark = Staple("Mark")
        If WM_DataType = adOracle Then
            strWhere = strWhere & " AND (MARK='$(Mark)' OR SUBSTR(MARK,1,$(Length))='$(Mark)_')"
        Else
            strWhere = strWhere & " AND (MARK='$(Mark)' OR LEFT(MARK,$(Length))='$(Mark)_')"
        End If
        strWhere = Replace(strWhere, "$(Length)", Len(strMark) + 1)
        strWhere = Replace(strWhere, "$(Mark)", SafeString(strMark))
    ElseIf atol(strStaple) > 0 Then
        Set xmlDoc = WM_GetCache("staple")
        Set xmlNode = XMLQuery(xmlDoc.documentElement, "staple[@hidden = 0 and @category=" & wmStapleNormal & " and @seqid=" & atol(strStaple) & "]")
        If Not xmlNode Is Nothing Then
            strMark = XMLAttr(xmlNode, "mark")
        End If
        Set xmlNode = Nothing
        Set xmlDoc = Nothing
        If strMark = "" Then Exit Function
        If WM_DataType = adOracle Then
            strWhere = strWhere & " AND (Mark='$(Mark)' OR SUBSTR(Mark,1,$(Length))='$(Mark)_')"
        Else
            strWhere = strWhere & " AND (Mark='$(Mark)' OR LEFT(Mark,$(Length))='$(Mark)_')"
        End If
        strWhere = Replace(strWhere, "$(Length)", Len(strMark) + 1)
        strWhere = Replace(strWhere, "$(Mark)", SafeString(strMark))
    ElseIf IsNumericArray(Split(strStaple, "+")) Then
        strWhere = strWhere & " AND STAPLEID IN (" & Replace(strStaple, "+", ",") & ")"
    Else