wapmo.asp

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

<!--#include file="env.asp"-->
<!--#include file="config.asp"-->
<!--#include file="func.asp"-->
<!--#include file="permit.asp"-->
<%
Class WAPmoKernelImpl
Public IO, DB, Memory, Config, Query, Modlist, PermitHost
Public IsCoop, NetType
Private objXML

Private Sub Class_Initialize()
    Set IO = vbsre.mocom.util.IO
    Set DB = vbsre.mocom.util.DB
    Set Memory = vbsre.mocom.util.Memory
    Set Config = vbsre.mocom.WAPmo.Config
    Set Query = Server.CreateObject(PROGID_HASH)
    Set objXML = Nothing
    Modlist = Array2(7, 0)
    DB.DataType = WM_DataType
    Select Case WM_DataType
    Case adAccess
        DB.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0;Data Source=" & GetMapPath(MDB_PATH)
    Case adSQLServer
        DB.ConnectionString = "PROVIDER=SQLOLEDB;" & _
            "DATA SOURCE=" & SQL_ADR & ";" & _
            "INITIAL CATALOG=" & SQL_DAT & ";" & _
            "USER ID=" & SQL_UID & ";" & _
            "PASSWORD=" & SQL_PWD
    Case adOracle
        DB.ConnectionString = "PROVIDER=OraOLEDB.Oracle;" & _
            "DATA SOURCE=" & ORA_SID & ";" & _
            "USER ID=" & ORA_UID & ";" & _
            "PASSWORD=" & ORA_PWD
    Case adMySQL
        DB.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" & _
            "SERVER=" & MYS_ADR & ";" & _
            "DATABASE=" & MYS_DAT & ";" & _
            "UID=" & MYS_UID & ";" & _
            "PASSWORD=" & MYS_PWD & ";" & _
            "OPTION=3;"
    End Select
    Memory.Implement = DB
    Memory.Table = T_MEMORY
    Call CheckPermit
    NetType = GetNetType()
End Sub

Private Sub Class_Terminate()
    Set objXML = Nothing
    Set Query = Nothing
    Set Config = Nothing
    Set Memory = Nothing
    Set DB = Nothing
    Set IO = Nothing
End Sub

Private Function GetNetType()
    Dim strAccept, strUA, strOS, strContentType
    Dim ret
    strAccept = IO.Env("HTTP_ACCEPT")
    strUA = IO.Env("HTTP_USER_AGENT")
    strOS = IO.Env("HTTP_UA_OS")
    If Config("CheckXHTML") <> "1" Then
        ret = "wap12"
    ElseIf InStr(strAccept, "application/vnd.wap.xhtml+xml") > 0 Then
        ret = "wap20"
    ElseIf InStr(strUA, "Opera") > 0 Then
        ret = "wap20"
    ElseIf InStr(strAccept, "application/xhtml+xml") > 0 Then
        If strUA = "" Then
            ret = "wap20"
        ElseIf InStr(strUA, "SymbianOS") > 0 Then
            ret = "wap20"
        ElseIf InStr(strUA, "Windows CE") > 0 Then
            ret = "wap20"
        ElseIf InStr(strUA, "Linux") > 0 Then
            ret = "wap20"
        ElseIf strOS <> "" Then
            ret = "wap20"
        Else
            ret = "web"
        End If
    ElseIf strOS <> "" Then
        ret = "wap20"
    ElseIf InStr(strAccept, "wap") > 0 Then
        ret = "wap12"
    ElseIf strUA = "" Then
        ret = "wap12"
    Else
        ret = "web"
    End If
    If ret = "web" And Config("search_engine") <> "" Then
        ret = IIf(IsSearchEngine(), "wap12", "web")
    End If
    GetNetType = ret
End Function

Private Function IsSearchEngine()
    Dim strUA, arr, ptr
    strUA = LCase(IO.Env("HTTP_USER_AGENT"))
    arr = Split(LCase(Config("search_engine")), "|")
    For Each ptr In arr
        If InStr(strUA, ptr) > 0 Then
            IsSearchEngine = True
            Exit Function
        End If
    Next
    IsSearchEngine = False
End Function

Public Function Command(ByVal strName)
    Set Command = vbsre.mocom.util.Command.newInstance()
    Command.Implement = DB
    Command.Table = strName
End Function

Public Function UserStat()
    Dim xdb
    Dim arr(9), i
    Dim lngTotal
    Set xdb = WM_XMLDB("Stat")
    arr(0) = stRegToday
    arr(1) = stRegYeday
    arr(2) = stRegAll
    arr(3) = stVisitToday
    arr(4) = stVisitYeday
    arr(5) = stIPToday
    arr(6) = stIPYeday
    arr(7) = stIPAll
    arr(8) = stOnlineUser
    arr(9) = stOnlineIP
    For i = 0 To UBound(arr)
        xdb.Filter = "@SeqId=" & arr(i)
        If xdb.EOF Then
            xdb.AddNew
            xdb("SeqId") = arr(i)
            Select Case arr(i)
            Case stRegToday
                xdb("Name") = "今日注册用户"
            Case stRegYeday
                xdb("Name") = "昨日注册用户"
            Case stRegAll
                xdb("Name") = "所有注册用户"
            Case stVisitToday
                xdb("Name") = "今日来访用户"
            Case stVisitYeday
                xdb("Name") = "昨日来访用户"
            Case stIPToday
                xdb("Name") = "今日来访IP"
            Case stIPYeday
                xdb("Name") = "昨日来访IP"
            Case stIPAll
                xdb("Name") = "所有来访IP"
            Case stOnlineUser
                xdb("Name") = "当前在线用户"
            Case stOnlineIP
                xdb("Name") = "当前在线IP"
            End Select
            xdb("Total") = GetUserStat(arr(i))
            xdb("Time") = GetTime(Now())
            xdb.Update
        ElseIf arr(i) = stRegToday Then
            lngTotal = xdb("Total")
            If xdb("Time") < GetTime(Date) Then
                xdb("Total") = 0
                xdb("Time") = GetTime(Now())
                xdb.Update
                xdb.Filter = "@SeqId=" & stRegYeday
                If Not xdb.EOF Then
                    xdb("Total") = lngTotal
                    xdb("Time") = GetTime(Now())
                    xdb.Update
                End If
            End If
        ElseIf arr(i) = stVisitToday Then
            lngTotal = xdb("Total")
            If xdb("Time") < GetTime(Date) Then
                xdb("Total") = 0
                xdb("Time") = GetTime(Now())
                xdb.Update
                If Not xdb.EOF Then
                    xdb.Filter = "@SeqId=" & stVisitYeday
                    xdb("Total") = lngTotal
                    xdb("Time") = GetTime(Now())
                    xdb.Update
                End If
            End If
        ElseIf arr(i) = stIPToday Then
            lngTotal = xdb("Total")
            If xdb("Time") < GetTime(Date) Then
                xdb("Total") = 0
                xdb("Time") = GetTime(Now())
                xdb.Update
                xdb.Filter = "@SeqId=" & stIPYeday
                If Not xdb.EOF Then
                    xdb("Total") = lngTotal
                    xdb("Time") = GetTime(Now())
                    xdb.Update
                End If
            End If
        ElseIf arr(i) = stOnlineUser Then
            If xdb("Time") < GetTime(DateAdd("n", -20, Now())) Then
                xdb("Total") = GetUserStat(stOnlineUser)
                xdb("Time") = GetTime(Now())
                xdb.Update
            End If
        ElseIf arr(i) = stOnlineIP Then
            If xdb("Time") < GetTime(DateAdd("n", -20, Now())) Then
                xdb("Total") = GetUserStat(stOnlineIP)
                xdb("Time") = GetTime(Now())
                xdb.Update
            End If
        End If
    Next
    xdb.Filter = "@SeqId>0"
    Set UserStat = xdb
End Function

Private Function GetUserStat(ByVal intType)
    Dim strSQL
    Dim t1, t2
    Select Case intType
    Case stRegToday
        t1 = GetTime(Date)
        strSQL = "SELECT COUNT(1) FROM $(Table) WHERE REGTIME>=$(Startime)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
    Case stRegYeday
        t1 = GetTime(DateAdd("d", -1, Date))
        t2 = GetTime(Date)
        strSQL = "SELECT COUNT(1) FROM $(Table) WHERE REGTIME>=$(Startime) AND REGTIME<=$(Stoptime)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
    Case stRegAll
        strSQL = "SELECT COUNT(1) FROM $(Table)"
        strSQL = Replace(strSQL, "$(Table)", T_USER)
    Case stVisitToday