<%
'-------------------------------------
'功能：CuteLink类
'更新：2004-12-27 19:02
'作者：未知-部落忍者
'演示：http://www.0cc.cn/link/
'-------------------------------------

class cls_cutelink
	Public BaseUrl
	Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
	Public rs
	Private Sub Class_Initialize()
		WebName="零星部落"
		WebUrl="http://www.0cc.cn"
		SysName="自助友情链接系统"		
		SysNameE="CuteLink"
		SysVersion="V1.5"
		BaseUrl = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
		ip=checkstr(request.ServerVariables("REMOTE_ADDR"),15)

		'初始化当天数据
		if application("CL_Date")<>Date() then
			init_data
		end if
	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 "你执行的语句是：" & Command
				Response.Write "<BR>错误信息为：" & Err.description
			Else
				Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
			End If
			Err.Clear
			CloseDatabase
			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=Server.Htmlencode(str)
		htmlencode2=replace(htmlencode2,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 isInteger(para)
		on error resume next
		dim str
		dim l,i
		if isNUll(para) then 
			isInteger=false
			exit function
		End if
		str=cstr(para)
		if trim(str)="" then
			isInteger=false
			exit function
		End if
		l=len(str)
		for i=1 to l
		if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
			isInteger=false 
			exit function
			End if
		next
		isInteger=true
		if err.number<>0 then err.clear
	End Function

	Public Function showwebtype(id)
		dim rs
		set rs=execute("select name from CL_WebType where id="&id)
		if rs.eof then
			showwebtype="另类其它"
		else
			showwebtype=rs(0)
		End if
		set rs=nothing
	End Function

	Public Sub listwebtype(id)
		set rs=execute("select * from CL_WebType order by id")
		do while not rs.eof
		response.write " <option value= " & rs("id")
		if int(rs("id"))=int(id) then response.write " selected"
		response.write ">"
		response.write rs("name")
		response.write "</option>"
		rs.movenext
		loop	           
	End Sub

	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)
		rs.Close
		Set rs=Nothing
	'如果记录数为0，那么退出
	If TotalCount=0 Then
	Exit Sub
	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 & "共有"&TotalCount&"条记录"
		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'>首页</a>"
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&PageNo-1&"'>上一页</a>"
	End If
	If PageNo<TotalPageCount Then
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&PageNo+1&"'>下一页</a>"
		OutStr = OutStr & "&nbsp;<a Href='?"&LinkFile&"&PageNo="&TotalPageCount&"'>尾页</a>"
	End If
		'OutStr = OutStr & "</P>"
		Response.Write(OutStr)
	End Sub

	Public Sub ShowFooter()
		dim Endtime,Runtime,OutStr
		Endtime=timer()
		OutStr = "<p align=center>"
		Runtime=FormatNumber((endtime-startime)*1000,2) 
		if Runtime>0 then
			if Runtime>1000 then
				OutStr = OutStr & "页面执行时间：约"& FormatNumber(runtime/1000,2) & "秒"
			else
				OutStr = OutStr & "页面执行时间：约"& Runtime & "毫秒"
			end if	
		end if
		OutStr = OutStr & "&nbsp;&nbsp;"
		OutStr = OutStr & "<a href='http://www.0cc.cn/link/readme.asp' target='_blank'>未知 CuteLink "&SysVersion&"</a>"				
		OutStr = OutStr & "</p>"
		Response.Write(OutStr)
	End Sub
	
	Public Sub write_log(num)
		Execute("insert into CL_Log (username,ip,come,inout) values('"&username&"','"&ip&"','"&comeurl&"',"&num&")")
	End Sub
	
	Public Function isrec(num)
		dim rs
		set rs=execute("select top 1 dateandtime from CL_Log where ip='"&ip&"' and username='"&username&"' and inout="&num&" order by id desc")
		if rs.eof then
			Call write_log(num)
			isrec=false
		elseif DateDiff("h",rs(0),now())>HitsTime then
			Call write_log(num)
			isrec=false
		else
			isrec=true				
		end if
	End Function
	
	Public Sub init_data
		dim sql	
		set rs=Server.CreateObject("ADODB.RecordSet")
		sql="select outc,outj,outp,outdate,fromdate,inc,inj,inp,indate from CL_Link order by outdate desc"
		rs.open sql,conn,1,2
		do while not rs.eof
		If DateDiff("d",rs("outdate"),Date())<>0 then
			rs("outj")=0
			rs("outp")=rs("outc")/(DateDIff("d",rs("fromdate"),date())+1)
		End If
		If DateDiff("d",rs("indate"),Date())<>0 then                
			rs("inj")=0
			rs("inp")=rs("inc")/(DateDIff("d",rs("fromdate"),date())+1)
		End If
			rs.update
			rs.movenext
		loop
		rs.close
		set rs = nothing
		application("CL_Date")=date()
	End Sub

	'网站名称过滤参数V1.5新加
	Public Function blnfilter(str) 
		if FilterWord <> "" then
		dim arrfilter,j
		arrfilter = split(FilterWord,"|")
		for j = 0 to ubound(arrfilter)
		if instr(str,arrfilter(j))>0 then
			blnfilter = true
			Exit Function
		end if
		next
		end if
		blnfilter = false
	End Function	
End class

Class Cls_Cache
	Rem ==================使用说明=================================================================================
	Rem = 本类模块是根据动网先锋(作者：迷城浪子)的缓存类模块修改而成。                                   =
	Rem = CacheName 缓存组的总名称，缺省值为"hx",如果一个站点中有超过一个缓存组，则需要外部改变这个值。           =
	Rem = CuteLink V1.4新增类									              =
	Rem ===========================================================================================================
	Public Reloadtime,CacheName
	Private LocalCacheName,CacheData,DelCount
	Private Sub Class_Initialize()
		Reloadtime=14400
		CacheName="hx"
	End Sub
	Private Sub SetCache(SetName,NewValue)
		Application.Lock
		Application(SetName) = NewValue
		Application.unLock
	End Sub 
	Private Sub makeEmpty(SetName)
		Application.Lock
		Application(SetName) = Empty
		Application.unLock
	End Sub 
	Public  Property Let Name(ByVal vNewValue)
		LocalCacheName=LCase(vNewValue)
	End Property
	Public  Property Let Value(ByVal vNewValue)
		If LocalCacheName<>"" Then 
			CacheData=Application(CacheName&"_"&LocalCacheName)
			If IsArray(CacheData)  Then
				CacheData(0)=vNewValue
				CacheData(1)=Now()
			Else
				ReDim CacheData(2)
				CacheData(0)=vNewValue
				CacheData(1)=Now()
			End If
			SetCache CacheName&"_"&LocalCacheName,CacheData
		Else
			Err.Raise vbObjectError + 1, "hxCacheServer", " please change the CacheName."
		End If		
	End Property
	Public Property Get Value()
		If LocalCacheName<>"" Then 
			CacheData=Application(CacheName&"_"&LocalCacheName)	
			If IsArray(CacheData) Then
				Value=CacheData(0)
			Else
				Err.Raise vbObjectError + 1, "hxCacheServer", " The CacheData Is Empty."
			End If
		Else
			Err.Raise vbObjectError + 1, "hxCacheServer", " please change the CacheName."
		End If
	End Property
	Public Function ObjIsEmpty()
		ObjIsEmpty=True
		CacheData=Application(CacheName&"_"&LocalCacheName)
		If Not IsArray(CacheData) Then Exit Function
		If Not IsDate(CacheData(1)) Then Exit Function
		If DateDiff("s",CDate(CacheData(1)),Now()) < 60*Reloadtime  Then
			ObjIsEmpty=False
		End If
	End Function
	Public Sub DelCahe(MyCaheName)
		makeEmpty(CacheName&"_"&MyCaheName)
	End Sub

	
End Class
%>