hit

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

Public Sub main()
    Set MyXML = MyKernel.XMLParser
    MyXML.Align = "center"
    MyXML.Printf MyKernel.Config("SiteName") & " 排行榜"
    MyXML.Align = "left"
    If MyIO.Env("REQUEST_METHOD") = "POST" Then
        Call doPost
    Else
        Call doGet
    End If
    Call BackHome
    Call SetLog("hit", 0)
    Call MyKernel.OutputXML(Empty)
End Sub

Private Sub doGet()
    Dim xdb
    Dim i
    Select Case MyIO.QueryString("p")
    Case "1"
        MyXML.Println "[ 总排行榜 ]" & vbCrLf
        set xdb = GetHint(wmHitAll)
    Case "2"
        MyXML.Println "[今日排行榜]" & vbCrLf
        set xdb = GetHint(wmHitToday)
    Case "3"
        MyXML.Println "[昨日排行榜]" & vbCrLf
        set xdb = GetHint(wmHitYeday)
    Case "4"
        MyXML.Println "[本周排行榜]" & vbCrLf
        set xdb = GetHint(wmHitThisWeek)
    Case "5"
        MyXML.Println "[上周排行榜]" & vbCrLf
        set xdb = GetHint(wmHitPrevWeek)
    Case "6"
        MyXML.Println "[本月排行榜]" & vbCrLf
        set xdb = GetHint(wmHitThisMonth)
    Case "7"
        MyXML.Println "[上月排行榜]" & vbCrLf
        set xdb = GetHint(wmHitPrevMonth)
    Case Else
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitAll, "[ 总排行榜 ]", "", "")
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitToday, "[今日排行榜]", "", "")
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitYeday, "[昨日排行榜]", "", "")
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitThisWeek, "[本周排行榜]", "", "")
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitPrevWeek, "[上周排行榜]", "", "")
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitThisMonth, "[本月排行榜]", "", "")
        MyXML.Println MyXML.CreateA("hit.asp?p=" & wmHitPrevMonth, "[上月排行榜]", "", "")
        Exit Sub
    End Select
    i = 1
    Do While Not xdb.EOF
        MyXML.Printf i & "、"
        MyXML.Printf MyXML.CreateA(GetStapleURL(xdb("StapleId"), 1), "[" & xdb("StapleTitle") & "]", "", "")
        MyXML.Printf MyXML.CreateA(GetContentURL(xdb("StapleId"), 1, 0, xdb("ContentId"), xdb("ContentTime"), 1), xdb("ContentTitle"), "", "")
        MyXML.Println "(" & xdb("Hit") & ")"
        xdb.MoveNext
        i = i + 1
    Loop
    Set xdb = Nothing
    MyXML.Println MyXML.CreateA("hit.asp", "返回排行榜", GetImagePrefix("images/back.gif"), "")
End Sub

Private Sub doPost()
End Sub

Private Function GetHint(ByVal x)
    Dim xdb
    Dim strName
    Dim lngTime
    Dim blnAdd
    Dim dtmTmp, lngTot
    strName = "Hit" & x
    blnAdd = False
    Set xdb = vbsre.mocom.util.XMLDB.newInstance()
    If Not xdb.Execute(strName) Then
        xdb.Append "Type", adInteger, 4
        xdb.Append "StapleId", adInteger, 4
        xdb.Append "StapleTitle", adVarChar, 50
        xdb.Append "ContentId", adInteger, 4
        xdb.Append "ContentTitle", adVarChar, 255
        xdb.Append "ContentTime", adInteger, 4
        xdb.Append "Hit", adInteger, 4
        blnAdd = True
    Else
        lngTime = atol(xdb.Config(strName))
        If lngTime = 0 Then
            blnAdd = True
        Else
            dtmTmp = Date()
            lngTot = 0
            Select Case x
            Case wmHitAll
                '一天更新一次统计
            Case wmHitToday
                '20分钟更新一次统计
                dtmTmp = Now()
                lngTot = 20 * 60
            Case wmHitYeday
                '一天更新一次统计
            Case wmHitThisWeek
                '8小时更新一次统计
                dtmTmp = Now()
                lngTot = 8 * 60 * 60
            Case wmHitPrevWeek
                '一周更新一次统计
                dtmTmp = DateAdd("d", 2 - Weekday(dtmTmp), dtmTmp)
            Case wmHitThisMonth
                '1天更新一次统计
            Case wmHitPrevMonth
                '1月更新一次统计
                dtmTmp = DateAdd("d", 1 - Day(dtmTmp), dtmTmp)
            End Select
            If lngTime < GetTime(dtmTmp) - lngTot Then
                blnAdd = True
            End If
        End If
    End If
    If blnAdd Then
        lngTime = GetTime(Now())
        xdb.Config(strName) = lngTime
        addHit xdb, x
    End If
    xdb.Filter = "@Type=" & x
    Set GetHint = xdb
    Set xdb = Nothing
    MyXML.Println "最后统计时间：" & FormatTime(lngTime, "Y-m-d H:i:s")
End Function

Private Sub addHit(xdb, ByVal x)
    Dim rs, strSQL
    Dim t1, t2
    t1 = Date()
    t2 = Date()
    Const HIT_TOTAL = 20
    Select Case x
    Case wmHitAll
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,SEQID AS CONTENTID,TITLE AS CONTENTTITLE,INTIME AS CONTENTTIME,HIT", T_CONTENT, "HIT>0 AND HIDDEN=0 AND EXAMINE=1", "", "HIT DESC")
    Case wmHitToday
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME,HIT", T_CONTENT_LOG, "INTIME>=$(Startime)", "", "HIT DESC")
    Case wmHitYeday
        t1 = DateAdd("d", -1, t1)
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME,HIT", T_CONTENT_LOG, "(INTIME BETWEEN $(Startime) AND $(Stoptime))", "", "HIT DESC")
    Case wmHitThisWeek
        t1 = DateAdd("d", 2 - Weekday(t1), t1)
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME,SUM(HIT) AS HIT", T_CONTENT_LOG, "INTIME>=$(Startime)", "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME", "SUM(HIT) DESC")
    Case wmHitPrevWeek
        t1 = DateAdd("d", 2 - Weekday(t1) - 7, t1)
        t2 = DateAdd("d", 2 - Weekday(t2), t2)
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME,SUM(HIT) AS HIT", T_CONTENT_LOG, "(INTIME BETWEEN $(Startime) AND $(Stoptime))", "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME", "SUM(HIT) DESC")
    Case wmHitThisMonth
        t1 = DateAdd("d", 1 - Day(t1), t1)
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME,SUM(HIT) AS HIT", T_CONTENT_LOG, "INTIME>=$(Startime)", "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME", "SUM(HIT) DESC")
    Case wmHitPrevMonth
        t1 = DateAdd("m", -1, t1)
        t1 = DateAdd("d", 1 - Day(t1), t1)
        t2 = DateAdd("d", 1 - Day(t2), t2)
        strSQL = MyKernel.DB.GetLimitSQL(HIT_TOTAL, "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME,SUM(HIT) AS HIT", T_CONTENT_LOG, "(INTIME BETWEEN $(Startime) AND $(Stoptime))", "STAPLEID,STAPLETITLE,CONTENTID,CONTENTTITLE,CONTENTTIME", "SUM(HIT) DESC")
    End Select
    xdb.Filter = "@Type=" & x
    xdb.Delete True
    strSQL = Replace(strSQL, "$(Startime)", GetTime(t1))
    strSQL = Replace(strSQL, "$(Stoptime)", GetTime(t2))
    Set rs = MyKernel.DB.Exec2(strSQL)
    Do While Not rs.EOF
        xdb.AddNew
        xdb("Type") = x
        xdb("StapleId") = rs("StapleId")
        xdb("StapleTitle") = rs("StapleTitle")
        xdb("ContentId") = rs("ContentId")
        xdb("ContentTitle") = rs("ContentTitle")
        xdb("ContentTime") = rs("ContentTime")
        xdb("Hit") = rs("Hit")
        xdb.Update
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End Sub