func.asp

来自「WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品」· ASP 代码 · 共 593 行 · 第 1/2 页

        Set objImg = Nothing
    Case "2"
        Set objImg = Server.CreateObject("ImageMagickObject.MagickImage")
        objImg.Convert "-gravity", MyKernel.Config("impress_place"), "-draw", "image over " & MyKernel.Config("impress_x") & "," & MyKernel.Config("impress_y") & " 0,0 '" & GetMapPath(MyKernel.Config("impress_image")) & "'", strPath, strPath
        Set objImg = Nothing
    Case Else
    End Select
    If Err.Number Then
        MyDebug "ImageImpress(" & strPath & ") Error: " & Err.Description
        Err.Clear
    End If
End Sub

Public Sub CheckMatterSize(objMatter)
    If objMatter("Width") > 0 Or objMatter("Height") > 0 Then
        'pass
    ElseIf objMatter("Category") = wmTypeImage Then
        Dim size, strPath
        strPath = GetMatterPath(objMatter("Category"), objMatter("Intime"), objMatter("Mark"), objMatter("Ext"), "")
        size = ImageResize2(strPath, strPath, atoi(MyKernel.Config("KeepWidth")), atoi(MyKernel.Config("KeepHeight")))
        If size(0) > 0 Or size(1) > 0 Then
            objMatter("Width") = size(0)
            objMatter("Height") = size(1)
            Dim strSQL
            strSQL = "UPDATE $(Table) SET Width=$(Width),Height=$(Height) WHERE SeqId=$(SeqId)"
            strSQL = Replace(strSQL, "$(Table)", T_MATTER)
            strSQL = Replace(strSQL, "$(Width)", objMatter("Width"))
            strSQL = Replace(strSQL, "$(Height)", objMatter("Height"))
            strSQL = Replace(strSQL, "$(SeqId)", objMatter("SeqId"))
            MyKernel.DB.Exec strSQL
        End If
    End If
End Sub

Public Function GetUserStatus(ByVal intStatus)
    Select Case atol(intStatus)
    Case wmUserAll
        GetUserStatus = "所有用户"
    Case wmUserForbid
        GetUserStatus = "屏蔽用户"
    Case wmUserDelete
        GetUserStatus = "删除用户"
    Case wmUserGuest
        GetUserStatus = "访问用户"
    Case wmUserRegister
        GetUserStatus = "注册用户"
    Case wmUserVIP
        GetUserStatus = "VIP 用户"
    End Select
End Function

Public Sub RemoveCache(ByVal strName, ByVal lngID, ByVal lngIntime, ByVal lngFollow)
    Dim fd, fc, f, strPath, key
    Select Case strName
    Case "index"
        strPath = GetMapPath("cache")
        If fso.FolderExists(strPath) Then
            Set fd = fso.GetFolder(strPath)
            For Each fc In fd.Files
                If Left(fc.Name, 6) = "index." Then
                    fso.DeleteFile fc.Path
                End If
            Next
            Set fd = Nothing
        End If
    Case "staple"
        If lngID < 1 Then
            strPath = GetMapPath("cache")
            If fso.FolderExists(strPath) Then
                Set fd = fso.GetFolder(strPath)
                For Each fc In fd.SubFolders
                    fso.DeleteFolder fc.Path
                Next
                Set fd = Nothing
            End If
        Else
            strPath = GetMapPath("cache/staple" & lngID)
            If fso.FolderExists(strPath) Then
                Set fd = fso.GetFolder(strPath)
                For Each fc In fd.Files
                    fso.DeleteFile fc.Path
                Next
                Set fd = Nothing
            End If
        End If
    Case "content"
        If lngID < 1 Then
            If lngFollow > 0 Then
                strPath = GetMapPath("cache/staple" & lngFollow)
            Else
                strPath = GetMapPath("cache")
            End If
            If fso.FolderExists(strPath) Then
                Set fd = fso.GetFolder(strPath)
                For Each fc In fd.SubFolders
                    For Each f In fc.SubFolders
                        fso.DeleteFolder f.Path
                    Next
                Next
                Set fd = Nothing
            End If
        Else
            strPath = GetMapPath("cache/staple" & lngFollow & "/" & FormatTime(lngIntime, "Ymd"))
            If fso.FolderExists(strPath) Then
                key = "index_" & lngID & "_"
                Set fd = fso.GetFolder(strPath)
                For Each fc In fd.Files
                    If Left(fc.Name, Len(key)) = key Then
                        fso.DeleteFile fc.Path
                    End If
                Next
            End If
        End If
    Case Else
    End Select
End Sub

Public Function WM_XMLDB(ByVal strName)
    Dim xdb, rs, strSQL, arr, ptr
    Set xdb = vbsre.mocom.util.XMLDB.newInstance()
    If Not xdb.Execute(strName) Then
        Select Case strName
        Case "Spy"
            xdb.Append "SeqId", adInteger, 4
            xdb.Append "Name", adVarChar, 255
            xdb.Append "List", adVarChar, 255
            xdb.Append "Type", adInteger, 4
            xdb.Append "Repeat", adChar, 1
            xdb.Append "Charset", adVarChar, 10
            xdb.Append "ListRule", adVarChar, 255
            xdb.Append "ContentRule", adVarChar, 255
            xdb.Append "PageRule", adVarChar, 255
            xdb.Append "StapleId", adInteger, 4
            xdb.Append "StapleTitle", adVarChar, 50
            xdb.Append "Mark", adVarChar, 255
            xdb.Append "Check", adChar, 1
            xdb.Append "Total", adInteger, 4
            xdb.Append "Success", adInteger, 4
            xdb.Append "Failed", adInteger, 4
            xdb.Append "Time", adInteger, 4
            xdb.Properties("Sequence") = "SeqId"
            xdb.Config("Sequence") = 1
        Case "Chats"
            xdb.Append "SeqId", adInteger, 4
            xdb.Append "Name", adVarChar, 50
            xdb.Append "Total", adInteger, 4
            xdb.Append "Intime", adInteger, 4
            xdb.Append "Outime", adInteger, 4
            xdb.Properties("Sequence") = "SeqId"
            xdb.Config("Sequence") = 1
            xdb.Config("Total") = 0
            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
        Case "Stat"
            xdb.Append "SeqId", adInteger, 4
            xdb.Append "Name", adVarChar, 255
            xdb.Append "Total", adInteger, 4
            xdb.Append "Time", adInteger, 4'
        Case "Logs"
            xdb.Append "Name", adVarChar, 20
            xdb.Append "Time", adChar, 6
        Case "UA"
            xdb.Append "Name", adVarChar, 50
            xdb.Append "Mark", adVarChar, 50
            xdb.AddNew
            xdb("Name") = "M3Gate"
            xdb("Mark") = "M3Gate"
            xdb.Update
            xdb.AddNew
            xdb("Name") = "Opera"
            xdb("Mark") = "Opera"
            xdb.Update
            xdb.AddNew
            xdb("Name") = "IE"
            xdb("Mark") = "MSIE"
            xdb.Update
        Case "OS"
            xdb.Append "Name", adVarChar, 50
            xdb.Append "Mark", adVarChar, 50
            xdb.AddNew
            xdb("Name") = "Windows 2003"
            xdb("Mark") = "Windows NT 5.2"
            xdb.Update
            xdb.AddNew
            xdb("Name") = "Windows XP"
            xdb("Mark") = "Windows NT 5.1"
            xdb.Update
            xdb.AddNew
            xdb("Name") = "Linux"
            xdb("Mark") = "Linux"
            xdb.Update
        Case "Online"
            xdb.Append "UserId", adInteger, 4
            xdb.Append "UserName", adVarChar, 50
            xdb.Append "LastTime", adInteger, 4
        Case Else
            Err.Raise vbObjectError + 1, "WM_XMLDB", "Missing XMLDB: " & strName
        End Select
    End If
    Set WM_XMLDB = xdb
    Set xdb = Nothing
End Function

Public Function WM_CacheName(ByVal strName)
    WM_CacheName = "WAPmo.XML." & strName
End Function

Public Function WM_GetCache(ByVal strName)
    Dim strCacheName
    strCacheName = WM_CacheName(strName)
    If Not HasCache(strCacheName) Then
        WM_SetCache strName
    End If
    Set WM_GetCache = GetCache(strCacheName).cloneNode(True)
End Function

Public Sub WM_SetCache(ByVal strName)
    Dim strCacheName
    strCacheName = WM_CacheName(strName)
    Select Case strName
    Case "mime"
        SetCache strCacheName, XMLLoadFile(GetMapPath("config/mime.xml"))
    Case "templet"
        SetCache strCacheName, XMLLoadFile(GetMapPath("config/templet.xml"))
    Case "staple"
        SetCache strCacheName, MyKernel.DB.SQLToXML("SELECT * FROM " & T_STAPLE & " ORDER BY SERIAL ASC", "staples", "staple")
    Case "group"
        SetCache strCacheName, MyKernel.DB.SQLToXML("SELECT * FROM " & T_ADMIN_GROUP, "groups", "group")
    Case "team"
        SetCache strCacheName, MyKernel.DB.SQLToXML("SELECT * FROM " & T_ADMIN_GROUP, "teams", "team")
    Case "category"
        SetCache strCacheName, MyKernel.DB.SQLToXML("SELECT * FROM " & T_CATEGORY & " ORDER BY SERIAL", "categories", "category")
    Case "forum"
        SetCache strCacheName, MyKernel.DB.SQLToXML("SELECT * FROM " & T_FORUM & " ORDER BY SERIAL", "forums", "forum")
    Case "ad"
        SetCache strCacheName, MyKernel.DB.SQLToXML("SELECT * FROM " & T_ADS, "ads", "ad")
    Case Else
        Err.Raise vbObjectError + 1, "WM_SetCache", "Unknown WM_Cache: " & strName
    End Select
End Sub

Public Function GetSequenceName()
    GetSequenceName = IIf(WM_DataType = adMySQL, "AUTO_INCREMENT", "IDENTITY(1,1)")
End Function

Public Sub WM_Call(ByVal strName)
    Execute "Call vbsre.mocom.WAPmo." & strName & ".main"
End Sub

Private Function GetMatterMark()
    Dim lngMax
    lngMax = GetCache("WAPmo.Matter")
    If IsEmpty(lngMax) Then
        lngMax = atol(MyKernel.DB.GetRow("SELECT MAX(Mark) FROM " & T_MATTER))
    End If
    If lngMax <= 0 Then lngMax = GetTime(Now())
    GetMatterMark = atol(lngMax)
End Function

Private Sub SetMatterMark(ByVal lngMax)
    SetCache "WAPmo.Matter", lngMax
End Sub

Public Function GetPageCount(objPage)
    If objPage.Where = "" Then
        GetPageCount = atol(MyKernel.DB.GetRow("SELECT COUNT(*) FROM " & objPage.Table))
    Else
        GetPageCount = atol(MyKernel.DB.GetRow("SELECT COUNT(*) FROM " & objPage.Table & " WHERE " & objPage.Where))
    End If
End Function

Public Function GetVisitCount()
    Dim vtCount
    vtCount = GetCache("WAPmo.VisitCount")
    If IsEmpty(vtCount) Then
        vtCount = MyKernel.DB.GetRow("SELECT SUM(VisitCount) FROM " & T_USER)
        SetVisitCount atol(vtCount)
    End If
    GetVisitCount = atol(vtCount)
End Function

Public Sub SetVisitCount(ByVal lngIn)
    SetCache "WAPmo.VisitCount", lngIn
End Sub
%>