core

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

Public Function ExportAds(ByVal strId)
    Dim lngID
    Dim xmlDoc, xmlNode
    Dim arr1, arr2
    lngID = atol(strId)
    If lngID = 0 Then
        MyXML.Printf MyXML.CreateC("AdsStart")
        MyXML.Printf MyXML.CreateC("AdsEnd")
    Else
        Set xmlDoc = WM_GetCache("ad")
        Set xmlNode = XMLQuery(xmlDoc.documentElement, "ad[@seqid=" & lngID & "]")
        If Not xmlNode Is Nothing Then
            Select Case atoi(XMLAttr(xmlNode, "category"))
            Case 0
                MyXML.Printf MyXML.CreateA(GetAdsURL(XMLAttr(xmlNode, "seqid"), XMLAttr(xmlNode, "content")), XMLAttr(xmlNode, "title"), "", "")
            Case 1
                CurrentAdsID = XMLAttr(xmlNode, "seqid")
                MyXML.Printf MyXML.CreateT(preg_replace2("<a\s+[^<>]*href=""([^""]+)"".*>(.+?)</a>", "gi", "FormatAds", XMLAttr(xmlNode, "content")))
            Case 2
                If XMLAttr(xmlNode, "content") <> "" Then
                    MyXML.Printf MyXML.CreateA(GetAdsURL(XMLAttr(xmlNode, "seqid"), XMLAttr(xmlNode, "content")), "", XMLAttr(xmlNode, "title"), "")
                Else
                    MyXML.Printf MyXML.CreateImg(XMLAttr(xmlNode, "title"), "加载中……", -1, -1)
                End If
            End Select
            arr1 = Array("Handle", "Id", "Referer")
            arr2 = Array("ads", XMLAttr(xmlNode, "seqid"), MyIO.Env("REQUEST_URI"))
            MyXML.Printf MyXML.CreateImg(GetURL("log.asp", arr1, arr2), "", 0, 0)
        End If
        Set xmlNode = Nothing
        Set xmlDoc = Nothing
    End If
    ExportAds = True
End Function

Public Function ExportSMSHint(ByVal strHint)
    MyXML.Printf MyXML.CreateC("SMSCountStart")
    MyXML.Printf MyXML.CreateA("msgbox.asp?Handle=View&Category=0", strHint, "", "")
    MyXML.Printf MyXML.CreateC("SMSCountEnd")
    ExportSMSHint = True
End Function

Public Function ExportContentRemark(ByVal strCount, ByVal strIsForm)
    ExportContentRemark = False
    If Staple Is Nothing Then Exit Function
    If Content Is Nothing Then Exit Function
    Dim intCount
    intCount = atoi(strCount)
    If intCount <= 0 Then Exit Function
    If Staple("Remark") = 1 Then
        MyXML.Println Replace("共有评论：$(RemarkTotal)条", "$(RemarkTotal)", Content("RemarkTotal"))
        If Content("Category") = wmContentNormal Then
            Dim rs, strSQL
            Dim i
            Dim tmp
            i = 1
            strSQL = MyKernel.DB.GetLimitSQL(intCount, "Content,UserID,UserName,Intime", T_REMARK, "ContentId=" & Content("SeqId"), "", "Intime DESC")
            Set rs = MyKernel.DB.Exec2(strSQL)
            Do While rs.EOF = False
                tmp = "评论$(Serial)：$(Content)("
                tmp = Replace(tmp, "$(Serial)", i)
                tmp = Replace(tmp, "$(Content)", rs("Content"))
                MyXML.Printf tmp
                If rs("UserID") = 0 Then
                    MyXML.Printf rs("UserName") & "[游客]"
                Else
                    MyXML.Printf MyXML.CreateA(GetMsgSendURL(rs("UserID")), rs("UserName"), "", "")
                End If
                MyXML.Println FormatTime(rs("Intime"), "/m-d H:i)")
                rs.MoveNext
                i = i + 1
            Loop
            rs.Close
            Set rs = Nothing
        End If
        Dim arr1, arr2
        arr1 = Array("StapleId", "PageNo", "ContentId", "Intime", "PageId")
        arr2 = Array(Staple("SeqId"), PageNo, Content("SeqId"), Content("Intime"), PageId)
        MyXML.Println MyXML.CreateA(GetURL("remark.asp", arr1, arr2), "所有评论", "", "")
        If strIsForm = "1" Then
            MyXML.Printf MyXML.CreateC("RemarkFormStart")
            MyXML.Printf MyXML.CreateC("RemarkType_" & Staple("RemarkType"))
            MyXML.SetF GetURL("remark.asp", arr1, arr2), "post", "", True
            MyXML.Form.appendChild MyXML.CreateC("UserNameStart")
            MyXML.SetN "UserName", "text", "", "您的昵称：", "", True, 0, 0, ""
            MyXML.Form.appendChild MyXML.CreateC("UserNameEnd")
            MyXML.SetN "Content", "text", "", "发表评论：", "", True, 0, 0, ""
            MyXML.SetN "", "submit", "确定发表", "", "", True, 0, 0, ""
            MyXML.Printf MyXML.CreateC("RemarkFormEnd")
        End If
        ExportContentRemark = True
    End If
End Function

Public Function ExportPath(ByVal strSpace)
    Select Case LCase(MyIO.Env("SCRIPT_NAME"))
    Case GetPathName("index.asp")
        MyXML.Printf "首页"
    Case GetPathName("register.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)会员注册", "$(Space)", strSpace)
    Case GetPathName("login.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)会员登录", "$(Space)", strSpace)
    Case GetPathName("forget.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)取回密码", "$(Space)", strSpace)
    Case GetPathName("console.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)我的控制台", "$(Space)", strSpace)
    Case GetPathName("marker.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)我的书签", "$(Space)", strSpace)
    Case GetPathName("msgbox.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)我的短信", "$(Space)", strSpace)
    Case GetPathName("out.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)退出登录", "$(Space)", strSpace)
    Case GetPathName("query.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)站内搜索", "$(Space)", strSpace)
    Case GetPathName("trade.asp")
        MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
        MyXML.Printf Replace("$(Space)订购产品", "$(Space)", strSpace)
    Case GetPathName("staple.asp")
        If Not Staple Is Nothing Then
            MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
            ParsePath Staple("Mark"), strSpace, False
        End If
    Case GetPathName("category.asp")
        If Not Staple Is Nothing Then
            MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
            ParsePath Staple("Mark"), strSpace, True
        End If
    Case GetPathName("content.asp")
        If Not Staple Is Nothing Then
            MyXML.Printf MyXML.CreateA("index.asp", "首页", "", "")
            ParsePath Staple("Mark"), strSpace, True
            If Not Content Is Nothing Then
                MyXML.Printf strSpace
                MyXML.Printf Content("Title")
            End If
        End If
    End Select
    ExportPath = True
End Function

Public Sub ParsePath(ByVal strMark, ByVal strSpace, ByVal blnParse)
    Dim strSQL
    Dim arr1, arr2
    Dim i, k
    arr1 = Split(strMark, "_")
    strSQL = "SELECT SEQID,TITLE FROM $(Table) WHERE SEQID IN ($(List))"
    strSQL = Replace(strSQL, "$(Table)", T_STAPLE)
    strSQL = Replace(strSQL, "$(List)", Join(arr1, ","))
    arr2 = MyKernel.DB.GetRows(strSQL)
    If Not IsArray(arr2) Then Exit Sub
    For i = 0 To UBound(arr1)
        For k = 0 To UBound(arr2, 2)
            If arr2(0, k) = atol(arr1(i)) Then
                MyXML.Printf strSpace
                If i = UBound(arr1) Then
                    If blnParse Then
                        MyXML.Printf MyXML.CreateA(GetStapleURL(arr2(0, k), 1), arr2(1, k), "", "")
                    Else
                        MyXML.Printf arr2(1, k)
                    End If
                Else
                    MyXML.Printf MyXML.CreateA(GetStapleURL(arr2(0, k), 1), arr2(1, k), "", "")
                End If
                Exit For
            End If
        Next
    Next
End Sub

Public Function ExportOnline(ByVal strCount, ByVal strSpace)
    MyXML.Printf "当前在线用户："
    MyXML.Printf MyXML.CreateC("[Online_" & strCount & "_" & strSpace & "]")
    ExportOnline = True
End Function

Public Function ExportForm(ByVal strAction, ByVal strMethod, ByVal strEnctype, ByVal strElements)
    If strMethod = "get" Then
        MyXML.SetF strAction, strMethod, strEnctype, False
        If Left(LCase(strAction), 7) <> "http://" Then
            MyXML.SetN "M", "hidden", "$(MemId)", "", "", False, 0, 0, ""
            MyXML.SetN "CoopId", "hidden", "$(CoopId)", "", "", False, 0, 0, ""
        End If
    Else
        MyXML.SetF strAction, strMethod, strEnctype, False
    End If
    Dim arr1, arr2
    Dim i
    arr1 = Split(strElements, "||")
    For i = 0 To UBound(arr1)
        arr2 = Split(arr1(i), "&&")
        If UBound(arr2) >= 8 Then
            MyXML.SetN arr2(0), arr2(1), arr2(2), arr2(3), arr2(4), CBool(arr2(5) = "1"), atoi(arr2(6)), atoi(arr2(7)), arr2(8)
        End If
    Next
    ExportForm = True
End Function

Public Function ExportStapleForm()
    ExportStapleForm = False
    If Staple Is Nothing Then Exit Function
    MyXML.SetF "query.asp", "get", "", True
    Call SetQuery
    MyXML.SetN "Staple", "hidden", Staple("SeqId"), "", "", False, 0, 0, ""
    MyXML.SetN "Keyword", "text", "", "搜索单词：", " 最少两个字符", True, 0, 0, ""
    MyXML.SetS "Category", 0, "搜索选项：", "", True, 0, 0, ""
    MyXML.SetO "0", "标题"
    MyXML.SetO "50", "内容"
    MyXML.SetO "100", "标题和内容"
    MyXML.SetN "", "submit", "搜索", "", "", True, 0, 0, ""
    ExportStapleForm = True
End Function

Public Function ExportCategory()
    ExportCategory = False
    If Staple Is Nothing Then Exit Function
    If Staple("Cate") <> 1 Then Exit Function
    Dim xmlDoc, xmlNodes, xmlNode
    Set xmlDoc = WM_GetCache("category")
    Set xmlNodes = XMLQueries(xmlDoc.documentElement, "category[@follow = 0]")
    ExportCategory = CBool(xmlNodes.length > 0)
    For Each xmlNode In xmlNodes
        MyXML.Println "[" & XMLAttr(xmlNode, "title") & "]"
        If ExportCategoryChild(xmlDoc, XMLAttr(xmlNode, "seqid"), atoi(XMLAttr(xmlNode, "count")), XMLAttr(xmlNode, "space")) Then
            MyXML.Println ""
        End If
    Next
    Set xmlNodes = Nothing
    Set xmlDoc = Nothing
End Function

Private Function ExportCategoryChild(xmlDoc, ByVal lngID, ByVal intCount, ByVal strSpace)
    Dim xmlNodes, xmlNode
    Dim i
    Set xmlNodes = XMLQueries(xmlDoc.documentElement, "category[@follow = " & lngID & "]")
    Set xmlNode = xmlNodes.nextNode()
    ExportCategoryChild = CBool(xmlNodes.length > 0)
    i = 0
    Do While Not xmlNode Is Nothing
        MyXML.Printf MyXML.CreateA("category.asp?StapleId=" & Staple("SeqId") & "&PageNo=" & PageNo & "&CateId=" & XMLAttr(xmlNode, "seqid"), XMLAttr(xmlNode, "title"), "", "")
        Set xmlNode = xmlNodes.nextNode()
        i = i + 1
        If xmlNode Is Nothing Then
            'pass
        ElseIf i Mod intCount = 0 Then
            MyXML.Println ""
        Else
            MyXML.Printf strSpace
        End If
    Loop
    Set xmlNodes = Nothing
End Function

Public Function ExportBackCategory(ByVal strPrefix, ByVal strTitle)
    ExportBackCategory = False
    If Staple Is Nothing Then Exit Function
    If Staple("Cate") <> 1 Then Exit Function
    Dim strTemp, lngCate
    lngCate = atol(MyIO.QueryString("CateId"))
    If lngCate < 1 Then Exit Function
    If InStr(strTitle, "$(CateName)") > 0 Then
        strTemp = Replace(strTitle, "$(CateName)", GetCategory(lngCate))
    Else
        strTemp = strTitle
    End If
    If strPrefix = "1" Then
        MyXML.Printf MyXML.CreateA("category.asp?StapleId=" & Staple("SeqId") & "&CateId=" & lngCate, strTemp, "images/cate.gif", "")
    Else
        MyXML.Printf MyXML.CreateA("category.asp?StapleId=" & Staple("SeqId") & "&CateId=" & lngCate, strTemp, "", "")
    End If
    ExportBackCategory = True
End Function

'No Standard API
Public Function CheckStaple()
    Dim lngID
    CheckStaple = False
    lngID = atol(MyIO.QueryString("StapleId"))
    If lngID < 1 Then Exit Function
    If Staple Is Nothing Then
        Set Staple = MyKernel.Command(T_STAPLE)
        Staple.CommandType = "SELECT"
        Staple.Where = "HIDDEN=0 AND SEQID=" & lngID
        If Not Staple.Exec Then Exit Function
        If Staple("Category") = wmStapleMapping Then
            Set Mapping = MyKernel.Command(T_STAPLE)
            Mapping.CommandType = "SELECT"
            Mapping=Where = "HIDDEN=0 AND SEQID=" & Staple("Mapping")
            If Not Mapping.Exec Then Exit Function
        Else
            Set Mapping = Staple
        End If
    End If
    If Staple("SeqId") = 0 Then Exit Function
    If Staple("Hidden") = 1 Then Exit Function
    If Mapping Is Nothing Then Exit Function
    If Mapping("SeqId") = 0 Then Exit Function
    If Mapping("Hidden") = 1 Then Exit Function
    CheckStaple = True
End Function

Public Function CheckContent()
    Dim lngID
    CheckContent = False
    If Not CheckStaple() Then Exit Function
    lngID = atol(MyIO.QueryString("ContentId"))
    If lngID < 1 Then Exit Function
    If Content Is Nothing Then
        Set Content = MyKernel.Command(T_CONTENT)
        Content.CommandType = "SELECT"
        Content.Where = "HIDDEN=0 AND EXAMINE=1 AND SEQID=" & lngID