class.asp

图书管理系统图书管理系统图书管理系统图书管理系统图书管理系统图书管理系统图书管理系统图书管理系统图书管理系统

<%
'-------------------------------------
'功能：CuteLink类
'天天智能友情链接管理系统
'天天DV网制作 http://www.ttdv.cn
'电脑家园http://www.pc326.com
'文秘家园http://www.wm326.com
'博大网址库http://www.ip126.com

'可自由传播和免费使用，但必须保留此完整版权信息
'本程序撷取了ITlearner、博大网址库智能友情链接系统、飞
'越智能友情链接系统等优秀程序中的源代码，对他们的作者表示感谢
'-------------------------------------

class cls_cutelink
	Public BaseUrl
	Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
	Public rs
	Private Sub Class_Initialize()
		WebName="天天DV网"
		WebUrl="http://www.ttdv.cn"
		SysName="自助友情链接系统"		
		SysNameE="TTLink"
		SysVersion="V2.0"
		BaseUrl = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
		if IPanti = 1 then			
			ip = checkstr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),15)
			if ip = "" then ip = checkstr(Request.ServerVariables("REMOTE_ADDR"),15)
		else
			ip = checkstr(Request.ServerVariables("REMOTE_ADDR"),15)
		end if
		'初始化当天数据
		if application(hxCacheName&"_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
			conn.close
			set conn=nothing
			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 tt_WebType where id="&id)
		if rs.eof then
			showwebtype="另类其它"
		else
			showwebtype=rs(0)
		End if
		set rs=nothing
	End Function

'num:0表示option 1表示横排
	Public Sub listwebtype(id,num)
		set rs=execute("select * from tt_WebType order by orderid")
		do while not rs.eof
		if num=0 then
			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>"
		else
			response.write "<li><a href=""?webtype="&rs("id")&""""
			if int(rs("id"))=int(id) then response.write " class=""sel"""
			response.write ">"
			response.write rs("name")
			response.write "</a></li>"		
		end if
		rs.movenext
		loop	
		set rs=nothing           
	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 LinkFile<>"" and right(LinkFile,1)<>"&" then 
		LinkFile=LinkFile&"&"
	end if
		LinkFile = Replace(LinkFile,"&","&amp;")
	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
		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.ttdv.cn"" target=""_blank"">本程序由天天DV网提供</a>"	
		OutStr = OutStr & "</p>"
		Response.Write(OutStr)
	End Sub
	
	Public Sub write_log(num)
		Execute("insert into tt_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 tt_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 tt_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(hxCacheName&"_Date")=date()
	End Sub

	'网站名称过滤参数V1.5新加
	'V1.6增加num参数，1判断字符，2判断域名
	Public Function blnfilter(str,num) 
		dim StrFilter
		if num = 1 then StrFilter = FilterWord :else StrFilter = FilterDomain 
		if StrFilter <> "" then
		dim arrfilter,j
		arrfilter = split(StrFilter,"|")
		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 = 本类模块是ITlearner根据动网先锋(作者：迷城浪子)的缓存类模块修改而成。                                   =
	Rem = CacheName 缓存组的总名称　Reloadtime 缓存时间	            									                            =
	Rem = CuteLink V1.4新增类	V1.6略做修改									              									                      =
	Rem ===========================================================================================================
	Public Reloadtime,CacheName
	Private LocalCacheName,CacheData,DelCount
	Private Sub Class_Initialize()
		Reloadtime=CacheTime
		CacheName=hxCacheName
	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
%>