counter.asp

来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 513 行 · 第 1/2 页

    If FoundInArr(RegCount_Fill, "FVisit", ",") = True Then
        Visit = Request.Cookies("VisitNum")
        If Visit <> "" Then
            Visit = Visit + 1
        Else
            Visit = 1
        End If
        Response.Cookies("VisitNum") = Visit
        Response.Cookies("VisitNum").Expires = "January 01, 2010"
        Sql = "Select * From PE_StatVisit"
        Rs.Open Sql, Conn_Counter, 1, 3
        If Rs.EOF Or Rs.BOF Then
            Rs.AddNew
        End If
        If Visit <= 10 Then
            If IsNumeric(Rs(Visit - 1)) = 0 Then
                Rs(Visit - 1) = 1
            Else
                Rs(Visit - 1) = Rs(Visit - 1) + 1
                If Visit > 1 Then
                   If Rs(Visit - 2) > 0 Then Rs(Visit - 2) = Rs(Visit - 2) - 1
                End If
            End If
        End If
        Rs.Update
        Rs.Close
    End If

    Call UpdateVisit

    StrHour = CStr(Hour(Time))
    StrDay = CStr(Day(Date))
    StrMonth = CStr(Month(Date))
    StrYear = CStr(Year(Date))
    Strweek = CStr(Weekday(Date))
    StrDayLong = CStr(Year(Date) & "-" & Month(Date) & "-" & Day(Date))
    StrMonthLong = CStr(Year(Date) & "-" & Month(Date))
    StrHourLong=StrDayLong&" "&Cstr(Hour(Time))&":00:00"

    Sql = "Select * From PE_StatInfoList"
    Rs.Open Sql, Conn_Counter, 1, 3
    Rs("TotalNum") = Rs("TotalNum") + 1
    Rs("TotalView") = Rs("TotalView") + 1
    Rs(Scope) = Rs(Scope) + 1
    If IsNull(Rs("StartDate")) Then Rs("StartDate") = StrDayLong
    If IsNull(Rs("OldDay")) Then Rs("OldDay") = StrDayLong
    OldDay = Rs("OldDay")
    Rs.Update
    Rs.Close
    Call ModiMaxNum

    If VisitorKeyword <> "" And FoundInArr(RegCount_Fill, "FKeyword", ",") = True Then
        VisitorKeyword = FindKeystr(Request.QueryString("Referer"))
        VisitorKeyword = ReplaceBadChar(Trim(LCase(VisitorKeyword)))
        AddNum VisitorKeyword, "PE_Statkeyword", "Tkeyword", "TkeywordNum"
    End If
    If FoundInArr(RegCount_Fill, "FSystem", ",") = True Then
        AddNum System, "PE_StatSystem", "TSystem", "TSysNum"
    End If
    If FoundInArr(RegCount_Fill, "FBrowser", ",") = True Then
        AddNum Browser, "PE_StatBrowser", "TBrowser", "TBrwNum"
    End If
    If FoundInArr(RegCount_Fill, "FMozilla", ",") = True Then
        AddNum Mozilla, "PE_StatMozilla", "TMozilla", "TMozNum"
    End If
    If FoundInArr(RegCount_Fill, "FScreen", ",") = True Then
        AddNum Screen, "PE_StatScreen", "TScreen", "TScrNum"
    End If
    If FoundInArr(RegCount_Fill, "FColor", ",") = True Then
        AddNum Color, "PE_StatColor", "TColor", "TColNum"
    End If
    If FoundInArr(RegCount_Fill, "FTimezone", ",") = True Then
        AddNum Timezone, "PE_StatTimezone", "TTimezone", "TTimNum"
    End If
    If FoundInArr(RegCount_Fill, "FRefer", ",") = True Then
        AddNum Referer, "PE_StatRefer", "TRefer", "TRefNum"
    End If
    If FoundInArr(RegCount_Fill, "FWeburl", ",") = True Then
        AddNum WebUrl, "PE_StatWeburl", "TWeburl", "TWebNum"
    End If
    If FoundInArr(RegCount_Fill, "FAddress", ",") = True Then
        AddNum Address, "PE_StatAddress", "TAddress", "TAddNum"
    End If
    If FoundInArr(RegCount_Fill, "FIP", ",") = True Then
        AddNum Ip, "PE_StatIp", "TIp", "TIpNum"
    End If

    AddNum StrDayLong, "PE_StatDay", "TDay", StrHour
    AddNum "Total", "PE_StatDay", "TDay", StrHour
    AddNum StrYear, "PE_StatYear", "TYear", StrMonth
    AddNum "Total", "PE_StatYear", "TYear", StrMonth
    AddNum StrMonthLong, "PE_StatMonth", "TMonth", StrDay
    AddNum "Total", "PE_StatMonth", "TMonth", StrDay
    AddNum "Total", "PE_StatWeek", "TWeek", Strweek
    If DateDiff("Ww", CDate(OldDay), Date) > 0 Then
        Sql = "Delete From PE_StatWeek Where TWeek='Current'"
        Conn_Counter.Execute (Sql)
    End If
    AddNum "Current", "PE_StatWeek", "TWeek", Strweek
End Sub

Sub AddNum(Data, TableName, CompareField, AddField)
    Dim RowCount
    conn_counter.execute "update "&TableName&" set ["&AddField&"]=["&AddField&"]+1 where  "&CompareField&"='"&Data&"'", RowCount
    If RowCount = 0 Then conn_counter.execute "insert into "&TableName&" ("&CompareField&",["&AddField&"]) values ('"&Data&"',1)"
End Sub

Sub ModiMaxNum()
    Sql = "Select * From PE_StatInfoList"
    Rs.Open Sql, Conn_Counter, 1, 3
    If Rs("OldMonth") = StrMonthLong Then
        Rs("MonthNum") = Rs("MonthNum") + 1
    Else
        Rs("OldMonth") = StrMonthLong
        Rs("MonthNum") = 1
    End If
    If Rs("MonthNum") > Rs("MonthMaxNum") Then
        Rs("MonthMaxNum") = Rs("MonthNum")
        Rs("MonthMaxDate") = StrMonthLong
    End If
    If Rs("OldDay") = StrDayLong Then
        Rs("DayNum") = Rs("DayNum") + 1
    Else
        Rs("OldDay") = StrDayLong
        Rs("DayNum") = 1
    End If
    If Rs("DayNum") > Rs("DayMaxNum") Then
        Rs("DayMaxNum") = Rs("DayNum")
        Rs("DayMaxDate") = StrDayLong
    End If
    If Rs("OldHour") = StrHourLong Then
        Rs("HourNum") = Rs("HourNum") + 1
    Else
        Rs("OldHour") = StrHourLong
        Rs("HourNum") = 1
    End If
    If Rs("HourNum") > Rs("HourMaxNum") Then
        Rs("HourMaxNum") = Rs("HourNum")
        Rs("HourMaxTime") = StrHourLong
    End If
    Rs.Update
    Rs.Close
End Sub

Sub UpdateVisit()
    Dim rsOut, VisitCount, OutNum
    VisitCount = 0
    Set rsOut = Conn_Counter.Execute("select count(ID) From PE_StatVisitor")

    VisitCount = rsOut(0)
    If VisitCount >= VisitRecord Then
        Dim rsOd
        Set rsOd = Conn_Counter.Execute("select top 1 VTime from PE_StatVisitor order by VTime asc")
        If CountDatabaseType = "SQL" Then
            conn_counter.Execute("update PE_StatVisitor set VTime='"&Now()&"',IP='"&IP&"',Address='"&Address&"',Browser='"&Browser&"',System='"&System&"',Screen='"&Screen&"',Color='"&Color&"',Timezone="&VisitTimezone&",Referer='"&Referer&"' where VTime='" & rsOd("VTime") & "'")
        Else
            conn_counter.Execute("update PE_StatVisitor set VTime='"&Now()&"',IP='"&IP&"',Address='"&Address&"',Browser='"&Browser&"',System='"&System&"',Screen='"&Screen&"',Color='"&Color&"',Timezone="&VisitTimezone&",Referer='"&Referer&"' where VTime=#" & rsOd("VTime") & "#")
        End If
        Set rsOd = Nothing
    Else
        conn_counter.Execute  "insert into PE_StatVisitor (VTime,IP,Address,Browser,System,Screen,Color,Timezone,Referer) Values('"&Now()&"','"&IP&"','"&Address&"','"&Browser&"','"&System&"','"&Screen&"','"&Color&"',"&VisitTimezone&",'"&Referer&"')"
    End If
    Set rsOut = Nothing
End Sub

Function SaveIP(InIP)
    SaveIP = Left(InIP, Len(InIP) - 1)
    SaveIP = Right(SaveIP, Len(SaveIP) - 1)
    Dim FriendIP
    FriendIP = Split(SaveIP, "#")
    If UBound(FriendIP) < KillRefresh Then
        SaveIP = "#" & SaveIP & "#" & Ip & "#"
    Else
        SaveIP = Replace("#" & SaveIP, "#" & FriendIP(0) & "#", "#") & "#" & Ip & "#"
    End If
End Function

' 从URL中获取关键词
Function FindKeystr(urlstr)
    Dim vKey, findKeystr1
    FindKeystr = ""
    regEx.Pattern = "(?:yahoo.+?[\?|&]p=|openfind.+?q=|google.+?q=|lycos.+?query=|aol.+?query=|onseek.+?keyword=|search\.tom.+?word=|search\.qq\.com.+?word=|zhongsou\.com.+?word=|search\.msn\.com.+?q=|yisou\.com.+?p=|sina.+?word=|sina.+?query=|sina.+?_searchkey=|sohu.+?word=|sohu.+?key_word=|sohu.+?query=|163.+?q=|baidu.+?word=|3721\.com.+?name=|Alltheweb.+?q=|3721\.com.+?p=|baidu.+?wd=)([^&]*)"
  
    Set Matches = regEx.Execute(urlstr)
    For Each Match In Matches
        findKeystr1 = regEx.Replace(Match.value, "$1")
    Next
  
    If findKeystr1 <> "" Then
        FindKeystr = LCase(decodeURI(findKeystr1))
        If FindKeystr = "undefined" Then
            FindKeystr = URLDecode(findKeystr1)
        End If
    End If
End Function


Function GetYesterdayNum()
    If CacheIsEmpty("nYesterDayVisitorNum") Then
        Dim YesterdayStrLong
        YesterdayStrLong = Year(DateAdd("d", "-1", Date)) & "-" & Month(DateAdd("d", "-1", Date)) & "-" & Day(DateAdd("d", "-1", Date))
        Set Rs = server.CreateObject("adodb.recordset")
        If CountDatabaseType = "SQL" Then
            sql="SELECT * FROM PE_StatDay WHERE TDay='"&YesterdayStrLong&"'"
        Else
            sql="SELECT * FROM PE_StatDay WHERE TDay=#"&YesterdayStrLong&"#"
        End If
        Rs.Open Sql, Conn_Counter, 1, 1
        If Not Rs.BOF Or Not Rs.EOF Then
            For I = 0 To 23
                nYesterDayNum = nYesterDayNum + Rs(CStr(I))
            Next
        Else
            nYesterDayNum = 0
        End If
        CacheData = Application("nYesterDayVisitorNum")
        If IsArray(CacheData) Then
            CacheData(0) = nYesterDayNum
            CacheData(1) = Now()
        Else
            ReDim CacheData(2)
            CacheData(0) = nYesterDayNum
            CacheData(1) = Now()
        End If
        Application.Lock
        Application("nYesterDayVisitorNum") = CacheData
        Application.UnLock
    Else
        CacheData = Application("nYesterDayVisitorNum")
        If IsArray(CacheData) Then
            nYesterDayNum = CacheData(0)
        Else
            nYesterDayNum = 0
        End If
    End If
End Function

Function CacheIsEmpty(MyCacheName)
    CacheIsEmpty = True
    CacheData = Application(MyCacheName)
    If Not IsArray(CacheData) Then Exit Function
    If Not IsDate(CacheData(1)) Then Exit Function
    If DateDiff("s", CDate(CacheData(1)), Now()) < 60 * 1440 Then
        CacheIsEmpty = False
    End If
End Function
%>
<script language="javascript" runat="server" type="text/javascript">
//解码URI
function decodeURI(furl){
    var a=furl;
    try{return decodeURIComponent(a)}catch(e){return 'undefined'};
    return '';
}
</script>