<%@ Language=VBScript %>
<%
on error resume next
public vArea
t1=timer()
%>
<%
' ======================== 参 数 设 置 ===========================
public CFG_Connpath,CFG_DefaultSite,CFG_ZoneServer,CFG_IPLong,CFG_CheckOnlineS,CFG_CacheName,CFG_isCan,CFG_SaveOnline_0,CFG_AutoDel,CFG_AutoDelBig,CFG_SaveOnline
' 数据库路径
%>
<%CFG_Connpath = "to-dream_zzz.asp"%>
<%
' 默认站点的ID
CFG_DefaultSite = 1
' 服务器所在时区
CFG_ZoneServer = 8
' IP保存位数
CFG_IPLong = 1
' 检测在线用户间隔（秒）
CFG_CheckOnlineS = 40
' 服务器缓存名称
CFG_CacheName = "AJSTAT1"
' 统计器启用
%>
<%CFG_IsCan = true%>
<%
' 自动删除×天前的内容信息
CFG_AutoDel = 10
' 对于大站，自动删除×天前的内容信息
CFG_AutoDelBig = 1
' 允许使用在线用户统计的站点
CFG_SaveOnline_0 = "All"
' 超管用户名
CFG_sAdminName = "admin"
' 超管密码
CFG_sAdminPass = "adminQWE"
' FSO名称
CFG_StrFSO = "Scripting.FileSystemObject"
' ===================== 公用代码，请勿修改 =======================
Public SiteID
SiteID = Request("SiteID")
if SiteID = "" then SiteID = CFG_DefaultSite
if IsNumeric(Siteid)=false then Response.Redirect "help.asp?errid=5"
CFG_SaveOnline = CFG_CanSave(SiteID,CFG_SaveOnline_0)
function CFG_CanSave(SiteID,CanSiteID)
select case lcase(CanSiteID)
case "all"
CFG_CanSave=true
case "no"
CFG_CanSave=false
case else
if instr(","&CanSiteID&",",","&SiteID&",") then
CFG_CanSave=true
else
CFG_CanSave=false
end if
end select
end function
%>
<%
class CheckUserAgent
public vOs
public vSoft
public function execute(strUA)
vOs=trim(getos(cwin(strUA)))
vSoft=trim(getsoft(strUA))
if vOs="" and instr(vSoft,"Konqueror") then vOs="Linux"
if instr(vSoft,"Mozilla") and instr(strUA,"compatible") then vSoft=""
select case vOs
case "Windows NT 5.0"
vOs = "Windows 2000"
case "Windows NT 5.1"
vOs = "Windows XP"
case "Windows NT 5.2"
vOs = "Windows Server 2003"
case else
vOs = vOs
end select
end function
private function getos(strUA)
dim regEx ,match,matches,maxlong
getos=""
maxlong=0
Set regEx = New RegExp
regEx.Pattern = "(Windows|Mac |Mac_|Win|PPC|Linux|unix|SunOS|BSD)[^;\(\)\[]{0,20}"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strUA)
For Each Match in Matches
if match.length>maxlong then
maxlong=match.length
getos=match.value
end if
Next
end function
private function getsoft(strUA)
dim regEx ,match,matches,maxlong
getsoft=""
Set regEx = New RegExp
regEx.Pattern = "(Konqueror|Opera|Safar|Firebird|NetCaptor|MSN |Netscape|MSIE|MyIE|OmniWeb|AOL|WebTV|iCab|Mozilla)[\d\/]?\d*\.?\d*\.*\d*[^;\(\)\[]*"
regEx.IgnoreCase = True
regEx.Global = True
Set Matches = regEx.Execute(strUA)
For Each Match in Matches
if instr(getsoft,"Mozilla") then
getsoft = match.value
else
getsoft = getsoft & "," & match.value
end if
Next
getsoft=replace(getsoft,"/"," ")
end function
private function cwin(strUA)
dim regEx
Set regEx = New RegExp
regEx.Pattern = "Win\s?(\d+|NT)"
regEx.IgnoreCase = True
regEx.Global = True
cwin=regEx.Replace (strUA,"Windows $1")
end function
end class
%>
<%
public conn
public DBPath
sub openconn
on error resume next
set conn=server.createobject("adodb.connection")
'conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath
DBPath = Server.MapPath( CFG_Connpath )
err=0
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath
if err<>0 then
response.write "Error! There was an error when the system try to open the database."
response.end
end if
end sub
call openconn
sub closeconn
conn.Close
set conn=nothing
end sub
%>
<%
set rsSite=conn.Execute("select * from Site where Site_ID="& SiteID)
if rssite.eof then Response.Redirect "help.asp?errid=4"
Site_Name = rsSite("S_Name")
Site_Name_ENG = rsSite("S_Name_ENG")
Site_Content = rsSite("S_Content")
Site_Content_ENG = rsSite("S_Content_ENG")
Site_URL = rsSite("S_URL1")
Site_URL2 = rsSite("S_URL2")
Site_StartTime = rsSite("S_StartTime")
Site_MasterName = rsSite("S_MasterName")
Site_MasterUname = rsSite("S_MasterUname")
Site_MasterPassword = rsSite("S_MasterPassword")
Site_MasterEmail = rsSite("S_MasterEmail")
Site_MasterTimeZone = rsSite("S_MasterTimeZone")
Site_MasterLang = rsSite("S_MasterLang")
Site_KillRefresh = rsSite("S_KillRefresh")
Site_SaveNum = rsSite("S_SaveNum")
Site_TodayDate = rsSite("S_TodayDate")
Site_CanGuest = rsSite("S_CanGuest")
Site_Gra = rsSite("S_Gra")
Site_Can = rsSite("S_Can")
Site_BigSite = rsSite("S_BigSite")
if Site_BigSite>0 then CFG_SaveOnline=false
SSS = split(rsSite("S_Style"),",")
if ubound(SSS)=1 then
S_Oldip=SSS(0):S_Oldpv=SSS(1)
else
S_Oldip=0:S_Oldpv=0
end if
dim site_CanS(15)
for i=0 to 15
if instr("," & Site_Can & ",","," & i & ",") then
site_CanS(i)=true
else
site_CanS(i)=false
end if
next
%>
<%
' ********************************************************
' 自 定 义 函 数 和 子 程 序
' ********************************************************
' 保存客户端信息
Sub SaveClient(SNum,SCon)
set tmprs=conn.Execute("select * from Client where C_Type=" & SNum & " and C_Content='"&SCon&"' and Site_Id=" & SiteID)
if tmprs.eof then
conn.Execute ("insert into Client (Site_id,C_Type,C_Content,C_Total,C_Yesterday,C_Today,C_LastTime) Values("&Siteid&","&SNum&",'"&SCon&"',1,0,1,'"&truenow&"')")
else
conn.Execute ("update Client set C_Total=C_Total+1,C_Today=C_Today+1,C_LastTime='"&truenow&"' where C_Type=" & SNum & " and C_Content='"&SCon&"' and Site_Id=" & SiteID)
end if
set tmprs=nothing
end Sub
' 保存内容信息
sub SaveOP(SNum,SCon,SCon2)
SCon=replace(SCon,"'","''")
SCon2=replace(SCon2,"'","''")
set tmprs=conn.Execute("select id from Origin_Page where O_Type=" & SNum & " and O_Content='"&SCon&"' and Site_Id=" & SiteID)
if tmprs.eof then
conn.Execute ("insert into Origin_Page (Site_id,O_Type,O_Content,O_LastURL,O_Total,O_Yesterday,O_Today,O_LastTime) Values("&Siteid&","&SNum&",'"&SCon&"','"&SCon2&"',1,0,1,now()-"&CFG_ZoneServer&"/24)")
else
conn.Execute ("update Origin_Page set O_Total=O_Total+1,O_Today=O_Today+1,O_LastURL='"&SCon2&"',O_LastTime=now()-"&CFG_ZoneServer&"/24 where O_Type=" & SNum & " and O_Content='"&SCon&"' and Site_Id=" & SiteID)
end if
set tmprs=nothing
end sub
' 保存大站模式信息
Sub SaveBig(SNum,SCon)
set tmprs=conn.Execute("select * from BigSite where B_Type=" & SNum & " and B_Content='"&SCon&"' and Site_Id=" & SiteID)
if tmprs.eof then
conn.Execute "insert into BigSite (Site_ID,B_type,B_Content,B_Today,B_Yesterday,B_Total,B_LastTime) VALUES("&Siteid&","&Snum&",'"&SCon&"',1,0,1,(now()-"&CFG_ZoneServer&"/24))"
else
conn.Execute ("update BigSite set B_Today=B_Today+1,B_Total=B_Total+1,B_LastTime=(now()-"&CFG_ZoneServer&"/24) where B_Type=" & SNum & " and B_Content='"&SCon&"' and Site_Id=" & SiteID)
end if
set tmprs=nothing
end Sub
' 找到当前URL对应的站点
function findhost(furl)
if furl<> "" then
ffurl = split(furl,"/")
findhost = ffurl(2)
if left(findhost,8)="192.168." or left(findhost,3)="10." or findhost="127.0.0.1" or instr(findhost,".")=0 then findhost="LAN"
else
findhost = ""
end if
end function
' 找到文件地址的全路径
Function finddir(filepath)
finddir=left(filepath,instrRev(filepath,"/")-1)
end Function
' 从URL中获取关键词
function findKeystr(urlstr)
dim regEx,vKey,vP,findKeystr1
findkeystr=""
vP = "(?: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=|sogou.+?query=|163.+?q=|baidu.+?w=|baidu.+?wd=|baidu.+?word=|3721\.com.+?name=|3721\.com.+?p=|Alltheweb.+?q=)([^&]*)"
set regEx=new regexp
regEx.Global = true
regEx.IgnoreCase = true
regEx.Pattern = vP
set Matches = regEx.Execute(urlstr)
for each Match in Matches
' 没有使用subMatches是因为有的服务器可能并没有安装VBS5.5版本
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
' 找到IP地址对应的地区
function findArea(vIP)
dim inIP,inIPnum,inIPs
inIP=vip
inIPs=split(inIP,".")
inIPnum=16777216*inips(0) + 65536*inips(1) + 256*inips(2) + inips(3)
set connip=server.createobject("adodb.connection")
connip.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath("ip.mdb")
set rsip=connip.Execute("select ip1,ip2,country,city from address where ip2>="&inipnum&" and ip1<=" _
& inipnum & " order by ip2-ip1")
if rsip.eof then
findArea=""
else
findArea=rsip("country")&rsip("city")
if instr(findarea,"未知") then findarea=""
end if
end function
' 写入最后访问的用户
Sub SaveLastUser()
CacheName=CFG_CacheName & "_Last_" & Siteid
if isempty(Application(CacheName)) then
Application(CacheName)=vIP & "#AjStat2#" & vAgent & "#AjStat2#" & vPage & "#AjStat2#" & vComeHost & "#AjStat2#" & vcome & "#AjStat2#" & truenow
else
onA=split(Application(CacheName),Vbcrlf)
onAs=ubound(onA)
strOut=vIP & " " & vArea & "#AjStat2#" & vAgent & "#AjStat2#" & vPage & "#AjStat2#" & vComeHost & "#AjStat2#" & vcome & "#AjStat2#" & truenow
j=1
for i=0 to onAs step 1
strOut=strOut & vbcrlf & onA(i)
j=j+1
if j>= Site_SaveNum then exit for
next
Application.Lock
Application(CacheName)=strOut
Application.UnLock
end if
end sub
' 更新要保存的IP
function vsaveips(inips)
vsaveips=left(inips,len(inips)-1)
vsaveips=right(vsaveips,len(vsaveips)-1)
howip=split(vsaveips,"#")
if ubound(howip) < Site_KillRefresh then
vsaveips="#" & vsaveips & "#" & vip & "#"
else
vsaveips=replace("#" & vsaveips,"#" & howip(0) & "#","#") & "#" & vip & "#"
end if
end function
' 解开URL编码的函数(这是别人写的,我查到的地方标注为: 来源： CSDN 作者： dyydyy )
Function URLDecode(enStr)
dim deStr
dim c,i,v
deStr=""
for i=1 to len(enStr)
c=Mid(enStr,i,1)
if c="%" then
v=eval("&h"+Mid(enStr,i+1,2))
if v<128 then
deStr=deStr&chr(v)
i=i+2
else
if isvalidhex(mid(enstr,i,3)) then
if isvalidhex(mid(enstr,i+3,3)) then
v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
deStr=deStr&chr(v)
i=i+5
else
v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
deStr=deStr&chr(v)
i=i+3
end if
else
destr=destr&c
end if
end if
else
if c="+" then
deStr=deStr&" "
else
deStr=deStr&c
end if
end if
next
URLDecode=deStr
end function
function isvalidhex(str)
isvalidhex=true
str=ucase(str)
if len(str)<>3 then isvalidhex=false:exit function
if left(str,1)<>"%" then isvalidhex=false:exit function
c=mid(str,2,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
c=mid(str,3,1)
if not (((c>="0") and (c<="9")) or ((c>="A") and (c<="Z"))) then isvalidhex=false:exit function
end function
%>
<%
isCan = CFG_IsCan and cbool(site_CanS(14))
newdayCacheName=CFG_CacheName & "_NewDay"
if isempty(Application(newdayCacheName)) then Application(newdayCacheName)=cdate("1900-1-1")
LastIPCacheName=CFG_CacheName & "_LastIP_" & Siteid
if isempty(Application(LastIPCacheName)) then Application(LastIPCacheName)="#218.246.226.8#"
public Style,vZone,vColor,vSize,vCome,vPage,vLang,vIP,vIPt,vSoft,vOS,theurl,vAgent,truenow,S_SaveNum
dim isRe,sql,isNewDay
canCacheName=CFG_CacheName & "_can"
if isempty(Application(canCacheName)) then Application(canCacheName)=0
LastTCacheName=CFG_CacheName & "_LastTime"
if isempty(Application(LastTCacheName)) then Application(LastTCacheName)=now()
if now()-Application(LastTCacheName) > 0.01 then Application(canCacheName) = 0:Application(LastTCacheName)=now()
if Application(canCacheName) >= 2 then isCan=false
' 网页立即超时，防止漏统计
Response.Expires = 0
if isCan then
Application.Lock
Application(canCacheName) = Application(canCacheName) + 1
Application.UnLock
' ******************************************************************************************
' 大 站 模 式
if Site_BigSite>0 then
' ********************** 获取数据 **********************
vCome = Request("referrer")
vPage = Request.ServerVariables("HTTP_REFERER")
FromUrl = REPLACE(TRIM(Request("fromurl")&""),",","")
IF FromUrl <> "" THEN
vCome = FromUrl
vPage = FromUrl
end if
vComeHost = findhost(vCome)
vPageHost = findhost(vPage)
vIP = Request.ServerVariables("Remote_Addr")
vIPs = split(vip,".")
vIPt = vIPs(0)
if CFG_IPLong>1 then vIPt=vIPt & "." & vips(1)
theurl = "http://" & Request.ServerVariables("http_host") & finddir(Request.ServerVariables("url"))
' 零时区的当前时间
truenow = dateadd("h",0 - CFG_ZoneServer,now())
' ① 是否新的一天
isNewDay = false
if DateValue(Site_TodayDate) < DateValue(dateadd("h",Site_MasterTimeZone-CFG_ZoneServer,now())) then isNewDay=true ' 是否新的一天
if cdate(Site_StartTime) < cdate("2000-1-1") then
conn.Execute ("update Site set S_StartTime=(now()-"&CFG_ZoneServer&"/24) where site_id=" & siteID)
isnewday=true
end if
' ② 新的一天，今天→昨天，今天=0
if isnewday then
if Application(newdayCacheName)<=now()-1 then
Application.Lock:Application(newdayCacheName)=now():Application.UnLock
' 为流量库添加当天的所有行
today0hour=dateadd("h",0-Site_MasterTimeZone,datevalue(now()))
for i= 0 to 23
conn.execute ("delete * from [View] where Site_ID="&SiteID&" and V_DTime=#"&dateadd("h",i,today0hour)&"#")
conn.execute ("insert into [View] (Site_id,V_DTime,V_View,V_IP) Values("&Siteid&",'"&dateadd("h",i,today0hour)&"',0,0)")
next
' 删除内容信息中较陈旧的
if CFG_AutoDelBig > 0 then conn.execute "delete * from BigSite where B_LastTime <= (now()-"&CFG_ZoneServer&"/24-"&CFG_AutoDelBig&")"
' 更新SITE表的最后日期
conn.Execute ("update Site set S_TodayDate = datevalue(now()+"&Site_MasterTimeZone-CFG_ZoneServer&"/24) where Site_Id=" & SiteID)
conn.Execute ("update Bigsite set B_Yesterday=B_Today,B_Today=0 where Site_Id=" & SiteID)
Application.Lock:Application(newdayCacheName)=cdate("1900-1-1"):Application.UnLock
end if
end if
' ③ 是否刷新
isRe = false
if instr(Application(LastIPCacheName),"#" & vIP & "#") then isRe=true ' 如果IP已经存在于保存的列表中，是刷新
' if vComeHost=vPageHost then isre=true ' 如果来路站点和被访问站点是同一个站点，则是刷新
if not isre then
' 更新最近需要防刷的IP
Application.Lock
Application(LastIPCacheName)=vsaveips(Application(LastIPCacheName))
Application.UnLock
' ④ 写入内容信息
if site_CanS(9) then SaveBig 0,vcomehost ' 0 大站模式·来路
if site_CanS(10) then SaveBig 1,vpage ' 1 大站模式·入口
if site_CanS(11) then
vKeyw=findKeystr(vCome)
if vKeyw<> "" then vKeyw=trim(Lcase(vKeyw)) : SaveBig 2,vKeyw ' 2 大站模式·关键词
end if
end if
if site_CanS(13) then SaveBig 4,vpage ' 4 大站模式·被浏览页面
' ⑤ 写入流量信息
nowHour=cdate(DateValue(truenow) & " " & hour(truenow)&":00:00") ' 现在是几点
if isre then ' 如果是刷新，则只更新浏览量
conn.execute("update [View] set V_View=V_View+1 where site_id=" & SiteID & " and V_DTime=#" & nowHour & "#")
else ' 如果不是刷新，则更新浏览量和访问量
conn.execute("update [View] set V_View=V_View+1,V_IP=V_IP+1 where site_id=" & SiteID & " and V_DTime=#" & nowHour & "#")
end if
' 写入最后访问用户到服务器缓存
if not isre then call SaveLastUser():Application(LastTCacheName)=now()
' 关闭数据库
call closeconn
' ******************************************************************************************
' 普 通 模 式
else
' ********************** 获取数据 **********************
theurl = "http://" & Request.ServerVariables("http_host") & finddir(Request.ServerVariables("url"))
vStyle = Request("style")
vZone = Request("tzone")
vColor = Request("tcolor")
vSize = Request("sSize")
vCome = Request("referrer")
vPage = Request.ServerVariables("HTTP_REFERER")
FromUrl = REPLACE(TRIM(Request("fromurl")&""),",","")
IF FromUrl <> "" THEN
vCome = FromUrl
vPage = FromUrl
end if
vComeHost = findhost(vCome)
vPageHost = findhost(vPage)
if right(vpage,1)="/" then vpage=left(vpage,len(vpage)-1)
vLang = Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")
vLang = split(vLang,",")(0)
vLang = lcase(split(vLang,";")(0))
vIP = Request.ServerVariables("Remote_Addr")
vIPs = split(vip,".")
vIPt = vIPs(0)
if CFG_IPLong>1 then vIPt=vIPt & "." & vips(1)
vAgent = Request.ServerVariables("HTTP_USER_AGENT")
if instr(vAgent,"Alexa") then
vAlexa = "1"
else
vAlexa = "0"
end if
' 零时区的当前时间
truenow = dateadd("h",0 - CFG_ZoneServer,now())
' 是否新的一天
isNewDay = false
if DateValue(Site_TodayDate) < DateValue(dateadd("h",Site_MasterTimeZone-CFG_ZoneServer,now())) then isNewDay=true ' 是否新的一天
if cdate(Site_StartTime) < cdate("2000-1-1") then
conn.Execute ("update Site set S_StartTime=(now()-"&CFG_ZoneServer&"/24) where site_id=" & siteID)
isnewday=true
end if
' 新的一天，今天→昨天，今天=0
if isnewday then
if Application(newdayCacheName)<=now()-1 then
Application.Lock:Application(newdayCacheName)=now():Application.UnLock
' 为流量库添加当天的所有行
today0hour=dateadd("h",0-Site_MasterTimeZone,datevalue(now()))
for i= 0 to 23
conn.execute ("delete * from [View] where Site_ID="&SiteID&" and V_DTime=#"&dateadd("h",i,today0hour)&"#")
conn.execute ("insert into [View] (Site_id,V_DTime,V_View,V_IP) Values("&Siteid&",'"&dateadd("h",i,today0hour)&"',0,0)")
next
' 删除内容信息中较陈旧的
if CFG_AutoDel > 0 then conn.execute "delete * from Origin_Page where O_LastTime <= (now()-"&CFG_ZoneServer&"/24-"&CFG_AutoDel&")"
' 更新SITE表的最后日期
conn.Execute ("update Site set S_TodayDate = datevalue(now()+"&Site_MasterTimeZone-CFG_ZoneServer&"/24) where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzy=C_Yesterdayzzzzzzz+C_Yesterdayzzzzzz+C_Yesterdayzzzzz+C_Yesterdayzzzz+C_Yesterdayzzz+C_Yesterdayzz+C_Yesterdayz+C_Yesterdayz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzzzzzzz=C_Yesterdayzzzzzz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzzzzzz=C_Yesterdayzzzzz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzzzzz=C_Yesterdayzzzz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzzzz=C_Yesterdayzzz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzzz=C_Yesterdayzz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayzz=C_Yesterdayz where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterdayz=C_Yesterday where Site_Id=" & SiteID)
conn.Execute ("update Client set C_Yesterday=C_Today,C_Today=0 where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzy=O_Yesterdayzzzzzzz+O_Yesterdayzzzzzz+O_Yesterdayzzzzz+O_Yesterdayzzzz+O_Yesterdayzzz+O_Yesterdayzz+O_Yesterdayz+O_Yesterdayz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzzzzzzz=O_Yesterdayzzzzzz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzzzzzz=O_Yesterdayzzzzz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzzzzz=O_Yesterdayzzzz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzzzz=O_Yesterdayzzz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzzz=O_Yesterdayzz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayzz=O_Yesterdayz where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterdayz=O_Yesterday where Site_Id=" & SiteID)
conn.Execute ("update Origin_Page set O_Yesterday=O_Today,O_Today=0 where Site_Id=" & SiteID)
Application.Lock:Application(newdayCacheName)=cdate("1900-1-1"):Application.UnLock
end if
end if
' 是否刷新
vUser = clng(Request.Cookies("Ajiang"&CFG_CacheName&SiteID)("Ajstat2")) ' 当前用户访问量
vPageS = clng(Request.Cookies("AjStat"&CFG_CacheName&SiteID)("AjstatPages")) ' 当前用户本次浏览页面数
vUPageS = clng(Request.Cookies("AjStat"&CFG_CacheName&SiteID)("UserPages")) ' 当前用户浏览页面总数
isRe = false
if instr(Application(LastIPCacheName),"#" & vIP & "#") then isRe=true ' 如果IP已经存在于保存的列表中，是刷新
' if vComeHost=vPageHost then isre=true ' 如果来路站点和被访问站点是同一个站点，则是刷新
if isre then
vPageS = vPageS + 1
else
vPageS = 1
vUser = vUser+1
Response.Cookies("Ajiang"&CFG_CacheName&SiteID)("Ajstat2")=vuser
Response.Cookies("Ajiang"&CFG_CacheName&SiteID).Expires=dateadd("d",100,date() )
' 更新最近需要防刷的IP
Application.Lock
Application(LastIPCacheName)=vsaveips(Application(LastIPCacheName))
Application.UnLock
end if
Response.Cookies("AjStat"&CFG_CacheName&SiteID)("AjstatPages")=vPageS
Response.Cookies("AjStat"&CFG_CacheName&SiteID)("UserPages")=vUPageS + 1
Response.Cookies("AjStat"&CFG_CacheName&SiteID).Expires=dateadd("d",100,date() )
' ==========================================================
' 写 入 详 细 信 息
' ==========================================================
if not isre then ' Client类型
set CUA=new CheckUserAgent
CUA.execute vAgent
vOs = cua.vos
vSoft = cua.vsoft
if vos<> "" and site_CanS(0) then SaveClient 0,vOs ' 0 操作系统
if vsoft<>"" and site_CanS(1) then ' 1 浏览器
if instr(vSoft,",") then
vvsoft=split(vsoft,",")
for each dsoft in vvsoft
if trim(dsoft)<> "" then SaveClient 1,dSoft
next
else
SaveClient 1,vSoft
end if
end if
if site_CanS(2) then SaveClient 2,vLang ' 2 语言
if site_CanS(3) then SaveClient 3,vZone ' 3 时区
if site_CanS(4) then SaveClient 4,vSize ' 4 屏幕大小
if site_CanS(5) then SaveClient 5,vColor ' 5 屏幕色彩
if site_CanS(6) then SaveClient 6,vUser ' 6 访问次数
if site_CanS(15) then SaveClient 9,vAlexa ' 9 ALEXA工具条
if site_CanS(7) then ' 7 访问者地区
vArea=findArea(vIP)
if vArea<>"" then SaveClient 7,vArea
end if
end if
if site_CanS(8) then SaveClient 8,vPageS ' 8 浏览的页面数
' ==========================================================
if not isre then
if site_CanS(9) then SaveOP 0,vComeHost,vcome ' 0 来路
if site_CanS(10) then SaveOP 1,vpage,"" ' 1 入口
vKeyw=findKeystr(vCome) ' 2 关键词
if vKeyw<> "" and site_CanS(11) then vKeyw=trim(Lcase(vKeyw)) : SaveOP 2,vKeyw,vcome
if site_CanS(12) then SaveOP 3,vipt,vip ' 3 IP
end if
if site_CanS(13) then SaveOP 4,vpage,"" ' 4 页面
' ==========================================================
' 写 入 流 量 信 息
' ==========================================================
nowHour=cdate(DateValue(truenow) & " " & hour(truenow)&":00:00") ' 现在是几点
if isre then ' 如果是刷新，则只更新浏览量
conn.execute("update [View] set V_View=V_View+1 where site_id=" & SiteID & " and V_DTime=#" & nowHour & "#")
else ' 如果不是刷新，则更新浏览量和访问量
conn.execute("update [View] set V_View=V_View+1,V_IP=V_IP+1 where site_id=" & SiteID & " and V_DTime=#" & nowHour & "#")
end if
' 写入最后访问用户到服务器缓存
if not isre then call SaveLastUser()
' 关闭数据库
call closeconn
end if '是否大站模式
Application.Lock
Application(canCacheName) = Application(canCacheName) - 1
Application.UnLock
end if 'if isCan
%>
