<%
class Cls_CuteCounter
	Public BaseUrl
	Public WebName,WebNameE,WebUrl,SysName,SysNameE,SysVersion
	Public rs
	Public vHour,vDate

	Private Sub Class_Initialize()
		BaseUrl = "http://"&LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(Request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(Request.ServerVariables("SCRIPT_NAME"),"/"))),""))
		WebName="IT学习者"
		WebNameE="ITlearner"
		WebUrl="http://www.itlearner.com"
		SysName="网站访问统计系统"		
		SysNameE="CuteCounter"
		SysVersion="V1.3"
		vHour=hour(now())
		vDate=date()
		if Application.Contents(CacheName & "_isStart")="" then Application.Contents(CacheName & "_isStart")=1	
	End Sub

	Private Sub class_terminate()
		If IsObject(Conn) Then 
			Conn.Close
			Set Conn = Nothing
		End If 
	End Sub

	Public Function Execute(Command)
		If Not IsObject(Conn) Then ConnectionDatabase	
		On Error Resume Next
		Set Execute = Conn.Execute(Command)
		If Err Then
			If IsDeBug = 1 Then
				Response.Write Lang.item("g_054") & Command
				Response.Write Lang.item("g_055") & Err.description
			Else
				Response.Write Lang.item("g_056")
			End If
			Err.Clear
			Response.End
		End If	
	End Function
	
	Public Function Getrs(Sql,num1,num2)
		On Error Resume Next
		If Not IsObject(Conn) Then ConnectionDatabase
		Dim rs
		Set rs = Server.CreateObject("ADODB.Recordset")
		rs.Open Sql,Conn,num1,num2
		Set Getrs = rs
		If Err Then
			If IsDeBug = 1 Then
				Response.Write Lang.item("g_054") & Command
				Response.Write Lang.item("g_055") & Err.description
			Else
				Response.Write Lang.item("g_056")
			End If
			Err.Clear
			Response.End
		End If	
	End Function

	Public Function Checkstr(Str,length)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
			CheckStr = trim(Replace(Str,"'","''"))
		if instr(Str,"%27") then
			CheckStr = trim(Replace(Str,"%27","''"))
		End if
		if length>0 and strlength(CheckStr)>length then
			CheckStr= Strleft(CheckStr,length)
		End if
	End Function


	Public Function htmlencode2(str)
		htmlencode2=replace(str,chr(10),"&nbsp;")
		htmlencode2=replace(htmlencode2,chr(13),"&nbsp;")
		htmlencode2=replace(htmlencode2,chr(32),"&nbsp;")
	End Function
	
	Public Function Strlength(Str)
		dim Temp_Str,I,Test_Str
		Temp_Str=Len(Str)
		For I=1 To Temp_Str
			Test_Str=(Mid(Str,I,1))
			If Asc(Test_Str)>0 Then
				Strlength=Strlength+1
			Else
				Strlength=Strlength+2
			End If
		Next
	End Function
	
	Public Function Strleft(Str,L)
		dim Temp_Str,I,lens,Test_Str
		Temp_Str=Len(Str)
		For I=1 To Temp_Str
			Test_Str=(Mid(Str,I,1))
			Strleft=Strleft&Test_Str
			If Asc(Test_Str)>0 Then
				lens=lens+1
			Else
				lens=lens+2
			End If
				If lens>=L Then Exit For
		Next
	End Function
	
	Public Function OutStr(Str,L)
		if Strlength(Str)>L then
			OutStr=StrLeft(Str,L)
			OutStr=OutStr & ".."
		else
			OutStr=Str
		end if
	End Function

	Public Sub ShowPageInfo(table,id,condition,PageNo,PageSize,LinkFile)
		dim StrSql,TotalCount,TotalPageCount,OutStr
		StrSql="SELECT count("&id&") FROM "&table&" "&condition&""
		Set rs = Execute(StrSql)
		TotalCount=rs(0)
		Set rs=Nothing

	'如果记录数为0，那么退出
	If TotalCount=0 Then
		Exit Sub
	End If
		OutStr="<P align=Center>"
	'如果记录数>MaxRecord，则记录数为MaxRecord
	if TotalCount>MaxRecord then
		OutStr = OutStr & Lang.item("g_022") & TotalCount & Lang.item("g_024") & " " & Lang.item("g_023") & MaxRecord & Lang.item("g_024")
		TotalCount=MaxRecord
	else
		OutStr = OutStr & Lang.item("g_022") & TotalCount & Lang.item("g_024")		
	end if
	'得到总页数
	If (TotalCount mod PageSize)=0 Then
		TotalPageCount=TotalCount\PageSize
	Else
		TotalPageCount=(TotalCount\PageSize)+1
	End If
	'防止提交的page参数大于第二次提交的总页数
	if PageNo>TotalPageCount then 
		PageNo=TotalPageCount
	End if
		OutStr = OutStr & "&nbsp;<font color='#FF0000'>"&PageNo&"</font>/<font color='#FF0000'>"&TotalPageCount&"</font>"
	If PageNo>1 Then
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo=1'>"& Lang.item("g_025") & "</a>"
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&PageNo-1&"'>"& Lang.item("g_026") & "</a>"
	End If
	If PageNo<TotalPageCount Then
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&PageNo+1&"'>"& Lang.item("g_027") & "</a>"
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&TotalPageCount&"'>"& Lang.item("g_028") & "</a>"
	End If
		OutStr = OutStr & "</P>"
		Response.Write(OutStr)	
	End Sub

	Public Sub ShowFooter()
		dim Endtime,Runtime,OutStr
		Endtime=timer()
		OutStr = "<p align=center>"
		OutStr = OutStr & "Copyright &copy; " &Year(Date())& "  <a href="&WebUrl&">"&WebName&"</a> All Rights Reserved <br>"

		Runtime=FormatNumber((endtime-startime)*1000,2) 
		if Runtime>0 then
			if Runtime>1000 then
				OutStr = OutStr & Lang.item("g_019") & FormatNumber(runtime/1000,2) & Lang.item("g_021")
			else
				OutStr = OutStr & Lang.item("g_019") & Runtime & Lang.item("g_020")
			end if	
		end if
		OutStr = OutStr & "&nbsp;&nbsp;"
		OutStr = OutStr & "<a href=""http://www.it" + "learner.com/CuteCounter/"" target=_blank>ITlearner CuteCounter "&SysVersion&"</a>"				
		OutStr = OutStr & "</p>"
		Response.Write(OutStr)
	End Sub
	
	Public Function twonum(num)
		if len(num)=1 then
			twonum="0"&num
		else
			twonum=num
	   	end if
	End Function

	Public Function IsVisited(ip)	'判断是否要重新记数
		Dim StrName
		Dim rs,sql
		Dim AppName1
		AppName1=CacheName & "_Date"
		If Application.Contents(AppName1) <> vDate Then
			Application.Contents(AppName1) = vDate
			If IsSqlDataBase = 1 Then
			sql="select CDate from CC_D where CDate='"&vDate&"'"
			else
			sql="select CDate from CC_D where CDate=date()"			
			end if
			set rs=GetRs(sql,1,2)
			If rs.eof then
				rs.addnew
				rs(0)=vDate
				rs.update
			End If
			rs.close
		Else
			'处理PageView信息
			If IsSqlDataBase = 1 Then
			Execute("update CC_D set PageView=PageView+1 where CDate='"&vDate&"'")
			else
			Execute("update CC_D set PageView=PageView+1 where CDate=date()")			
			end if
		End If
		
		Dim AppName2
		AppName2=CacheName & "_Hour"
		If Application.Contents(AppName2) <> vHour Then
			Application.Contents(AppName2) = vHour
			If IsSqlDataBase = 1 Then
				Execute "update CC_H set CTH=0 where DATEDIFF(hour,vtime,"&SqlNowString&") > 1 and Hour=" & vHour 
			Else
				Execute "update CC_H set CTH=0 where DATEDIFF('h',vtime,"&SqlNowString&") > 1 and Hour=" & vHour 
			End If
		End If
		If Len(Session.Contents(CacheName)) = 0 Then
			ip=Getip(ip)
			Session.Contents(CacheName) = 1
			Sql = "select Ip,vtime,CIP from CC_I where Ip='" & ip & "'"
			set rs=Getrs(Sql,1,2)
			If rs.EOF then
				rs.AddNew
				rs(0)=ip
				rs(1)=now()
				rs.update
				isVisited=False
			Elseif DateDiff("h",rs(1),now())>ExpireTime Then
				rs(1)=now()
				rs(2)=rs(2)+1
				rs.update	
				isVisited=False	
			Else
				isVisited=True
			End If
				rs.close
			set rs=nothing
		Else
			isVisited = True
		End If
	End Function

	Public Function GetSearchKeyword(RefererUrl)	'搜索关键词
		on error resume next
		Dim re
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		Dim a,b,j
		'模糊查找关键词，此方法速度较快，范围也较大
		re.Pattern = "(word=([^&]*)|q=([^&]*)|p=([^&]*)|query=([^&]*)|name=([^&]*)|_searchkey=([^&]*))"
		Set a = re.Execute(RefererUrl)
		If a.Count>0 then
			Set b = a(a.Count-1).SubMatches
			For j=1 to b.Count
				If Len(b(j))>0 then GetSearchKeyword=b(j) : Exit Function
			Next
		End If
		if err then
		err.clear
		GetSearchKeyword = RefererUrl
		else
		GetSearchKeyword = ""		
		end if		
	End Function
	
	Public Function GetPage(PageUrl)
		Dim re
		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		PageUrl = PageUrl
		re.Pattern = "[\?#].*"
		GetPage = re.Replace(PageUrl,"")
	End Function
		
	Private Function Getip(ip)
		Dim a,i,Sip
		a = Split(ip,".")
		if ubound(a)<>3 then Getip=0:Exit Function
		For i=0 to 3
			Sip= Sip + CInt(a(i)) * (256^(3-i))
 			Getip=Getip & String(3-Len(a(i)),"0") & a(i) & "."
		Next
		Getip=left(Getip,15)

		Dim sql,Where,rs2
		sql = "select country from address where ip1 <= "&Sip&" and ip2 >= "&Sip&""
		set rs=Execute(sql)
		if not rs.Eof then
			Where = rs(0)
		else
			Where = "未知地址"
		end if
		set rs=nothing

		sql="select CW,[Where] from CC_W where [Where] = '"&Where&"'"
		set rs2=Getrs(sql,1,2)
		if rs2.eof then
			rs2.addnew
			rs2(1)=Where
		else
			rs2(0)=rs2(0) + 1
		end if
		rs2.update
		set rs2=nothing
	End Function

End class
%>