config.asp

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

        If MyPower("ConfigDownload") = 1 Then
            arr = Array("AllowImage", "AllowRing", "AllowVideo", "AllowSoft", "KeepWidth", "KeepHeight", "DownType", "DownWidth", "DownHeight", "DownConfig", "PrevWidth", "PrevHeight", "FrontWidth", "FrontHeight", "DownOrig", "ImageFront", "StapleList", "CheckImage", "ImagePrefix", "DownloadType", "disable_link", "impress", "impress_text", "impress_size", "impress_color", "impress_font", "impress_image", "impress_place", "impress_x", "impress_y")
            For Each ptr In arr
                MyKernel.Config(ptr) = MyIO.Form(ptr)
            Next
            MyKernel.Config("AllowAttach") = MyKernel.Config("AllowImage") & "|" & MyKernel.Config("AllowRing") & "|" & MyKernel.Config("AllowVideo") & "|" & MyKernel.Config("AllowSoft")
            MySaveMIME wmTypeImage, "image"
            MySaveMIME wmTypeRing, "ring"
            MySaveMIME wmTypeVideo, "video"
            MySaveMIME wmTypeSoft, "soft"
            blnError = False
            strError = "上传下载配置保存成功"
        Else
            strError = "您没有修改上传下载配置的权限"
        End If
    Case 4
        If MyPower("ConfigIPRule") = 1 Then
            MyKernel.Config("IPRule") = MyIO.Form("IPRule")
            MyKernel.Config("IPRule0") = Replace(MyIO.Form("IPRule0"), ", ", "|")
            MyKernel.Config("IPRule1") = Replace(MyIO.Form("IPRule1"), ", ", "|")
            blnError = False
            strError = "IP访问规则保存成功"
        Else
            strError = "您没有修改IP访问规则的权限"
        End If
    Case 5
        If MyPower("ConfigUARule") = 1 Then
            MyKernel.Config("UARule") = Replace(MyIO.Form("UARule"), ", ", "|")
            blnError = False
            strError = "用户终端规则保存成功"
        Else
            strError = "您没有修改用户终端规则的权限"
        End If
    Case Else
    End Select
    ExportHead "保存配置"
    MyIO.Echo "<script language=""javascript"">"
    MyIO.Echo "function myload()"
    MyIO.Echo "{"
    MyIO.Echo "MessageBox.show(" & IIf(blnError = False, "MSG_HINT", "MSG_WARNING") & ", """ & strError & """);"
    MyIO.Echo "MessageBox.doAccept(function()"
    MyIO.Echo "{"
    MyIO.Echo "location.replace(""admin_base.asp?Option=" & atoi(MyIO.QueryString("Option")) & """);"
    MyIO.Echo "}, true);"
    MyIO.Echo "}"
    MyIO.Echo "</script>"
    ExportFoot
End Sub

Private Sub MySaveFile(ByVal strKey)
    Dim objItem
    Set objItem = MyIO.File(strKey, 0)
    If objItem Is Nothing Then Exit Sub
    If objItem.State = 0 Then
        Select Case strKey
        Case "SiteLogo"
            If InString(MyKernel.Config("AllowImage"), objItem.FileExt, False) Then
                ClearImage "logo"
                objItem.SaveToFile GetMapPath("images/logo." & objItem.FileExt)
                MyKernel.Config(strKey) = objItem.FileExt
            End If
        Case "BackImage"
            If InString(MyKernel.Config("AllowImage"), objItem.FileExt, False) Then
                ClearImage "backimage"
                objItem.SaveToFile GetMapPath("images/backimage." & objItem.FileExt)
                MyKernel.Config(strKey) = objItem.FileExt
            End If
        Case "BackSound"
            If InString(MyKernel.Config("AllowRing"), objItem.FileExt, False) Then
                ClearFile "backsound", "AllowRing"
                objItem.SaveToFile GetMapPath("images/backsound." & objItem.FileExt)
                MyKernel.Config(strKey) = objItem.FileExt
            End If
        End Select
    End If
    Set objItem = Nothing
End Sub

Private Function GetContentType(ByVal strExt)
    Dim xmlNode
    Set xmlNode = XMLQuery(xmlMIMEDoc.documentElement, "mime[@name='" & XPathString(strExt) & "']")
    If Not xmlNode Is Nothing Then
        GetContentType = XMLAttr(xmlNode, "type")
    End If
    Set xmlNode = Nothing
End Function

Private Function SetContentType(ByVal strExt, ByVal strType)
    Dim xmlNode
    Set xmlNode = XMLQuery(xmlMIMEDoc.documentElement, "mime[@name='" & XPathString(strExt) & "']")
    If xmlNode Is Nothing Then
        Set xmlNode = xmlMIMEDoc.documentElement.appendChild(xmlMimeDoc.createElement(strExt))
        xmlNode.setAttribute "ext", strExt
    End If
    xmlNode.setAttribute "type", strType
    Set xmlNode = Nothing
    blnModify = True
End Function

Private Sub GetMIMEList(ByVal strName, ByVal strList)
    MyIO.Echo "<table width=""400"" border=""border=""1"" cellpadding=""2"" cellspacing=""0"" style=""border-collapse:collapse;margin-top:5px"" bordercolor=""#000000"">"
    MyIO.Echo "  <tr>"
    MyIO.Echo "  <td width=""100"" class=""winT3"">扩展名</td>"
    MyIO.Echo "  <td width=""300"" class=""winT3"">MIME类型</td>"
    MyIO.Echo "  </tr>"
    Dim arrList
    Dim ptr
    arrList = Split(strList, "|")
    For Each ptr In arrList
        MyIO.Echo "  <tr class=""winT1"">"
        MyIO.Echo "  <td>" & ptr & "<input type=""hidden"" name=""" & strName & "_name"" value=""" & ptr & """ /></td>"
        MyIO.Echo "  <td><input type=""text"" name=""" & strName & "_mime"" value=""" & GetContentType(ptr) & """ size=""40"" class=""txt"" /></td>"
        MyIO.Echo "  </tr>"
    Next
    MyIO.Echo "</table>"
End Sub

Private Sub MySaveMIME(ByVal x, ByVal strKey)
    Dim arr1
    Dim arr2
    Dim i
    arr1 = MyIO.FormArray(strKey & "_name")
    arr2 = MyIO.FormArray(strKey & "_mime")
    For i = 0 To UBound(arr1)
        MyKernel.DB.Exec "UPDATE " & T_MATTER & " SET Category=" & x & " WHERE Ext='" & SafeString(arr1(i)) & "'"
        SetContentType arr1(i), arr2(i)
    Next
End Sub

Private Sub getIPRule(ByVal x)
    Dim arrList
    Dim ptr
    arrList = Split(MyKernel.Config("IPRule" & x), "|")
    MyIO.Echo "<div id=""IP_DIV" & x & """ style=""position:relative;" & IIf(atoi(MyKernel.Config("IPRule")) = x + 1, "", "display:none") & """>"
    MyIO.Echo IIf(x = 0, "<font color=""#0000FF"">允许</font>", "<font color=""#FF0000"">禁止</font>") & "任何IP访问，以下IP除外，支持模糊IP，可以模糊匹配到最后两位，例如：192.168.*.*<br/>"
    MyIO.Echo "<select name=""IPRule" & x & """ class=""sel"" style=""width:300;height:100"" multiple=""true"" onChange=""ChkSelect(this, this.form.IP_delbtn" & x & ")"">"
    For Each ptr In arrList
        MyIO.Echo "<option value=""" & ptr & """>" & ptr & "</option>"
    Next
    MyIO.Echo "</select><br/>"
    MyIO.Echo "IP地址：<input type=""text"" name=""IP" & x & """ class=""txt"" style=""width:135"" />"
    MyIO.Echo " <input type=""button"" value=""添  加"" class=""btn"" onclick=""AddIPRule(this.form.IPRule" & x & ", this.form.IP" & x & ")"" />"
    MyIO.Echo " <input type=""button"" value=""删  除"" class=""btn"" onclick=""DelIPRule(this.form.IPRule" & x & ", this)"" disabled=""true"" id=""IP_delbtn" & x & """ />"
    MyIO.Echo "</div>"
End Sub

Private Sub getUARule()
    Dim arrList
    Dim ptr
    arrList = Split(MyKernel.Config("UARule"), "|")
    MyIO.Echo "  <select name=""UARule"" class=""sel"" style=""width:300;height:100"" multiple=""true"" onchange=""ChkSelect(this, this.form.UA_delbtn)"">"
    For Each ptr In arrList
        MyIO.Echo "  <option value=""" & MyIO.HTMLEncode(ptr) & """>" & MyIO.HTMLEncode(ptr) & "</option>"
    Next
    MyIO.Echo "  </select><br/>"
    MyIO.Echo "  终端标识：<input type=""text"" name=""UA"" class=""txt"" style=""width:135"" />"
    MyIO.Echo "  <input type=""button"" value=""添  加"" class=""btn"" onclick=""AddUARule(this.form.UARule, this.form.UA)"" />"
    MyIO.Echo "  <input type=""button"" value=""删  除"" class=""btn"" onclick=""DelUARule(this.form.UARule, this)"" disabled=""true"" id=""UA_delbtn"" />"
End Sub

Private Sub AsyncRooms()
    Dim xdb
    Dim arr, ptr
    Set xdb = WM_XMLDB("Chats")
    If xdb.RecordCount <> -1 Then
        Do While Not xdb.EOF
            If Not InString(MyKernel.Config("ChatRoom"), xdb("Name"), False) Then
                xdb.Drop "Room" & xdb("SeqId")
                xdb.Delete False
            Else
                xdb.MoveNext
            End If
        Loop
    End If
    arr = Split(MyKernel.Config("ChatRoom"), "|")
    For Each ptr In arr
        xdb.Filter = "@Name='" & XPathString(ptr) & "'"
        If xdb.EOF Then
            xdb.AddNew
            xdb("Name") = ptr
            xdb("Total") = 0
            xdb("Intime") = GetTime(Now())
            xdb("Outime") = 0
            xdb.Update
        End If
    Next
    Set xdb = Nothing
End Sub

Public Function newInstance()
    Set newInstance = New ImplMocomWAPmoManagerConfig
End Function
End Class
%>