ttindex.asp

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

<!--#include file="conn.asp"-->
<%
'-------------------------------------
'功能：处理点入的程序
'天天智能友情链接管理系统
'天天DV网制作 http://www.ttdv.cn
'电脑家园http://www.pc326.com
'文秘家园http://www.wm326.com
'博大网址库http://www.ip126.com

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

'on error resume next
'Response.Buffer=true
dim username,comeurl
username=hx.checkstr(request("id"),12)

	If username="" then
		Call GoToUrl
	End If
	
	comeurl=hx.checkstr(Request.ServerVariables("http_referer"),200)

	If hx.ip="" or comeurl="" or instr(comeurl,hx.BaseUrl&"addlink.asp")>0 then
		Call GoToUrl
	End If

	If not hx.isrec(0) then
		dim rs,sql
		set rs=server.createobject("adodb.recordset")
		sql="select TOP 1 inc,inj,inp,indate,fromdate,tturl from tt_Link where username='"&username&"'"
		rs.open sql,conn,1,2
		If not rs.eof then
			'判断点入来源是否在其登记的网站域名上
			If Isanti = 1 then
				dim tturl
			  tturl=rs("tturl") 
			  if left(tturl,7)="http://" then
			  	tturl=Mid(tturl,8)
			  End If
			  if instr(tturl,"/")>0 then
	        tturl=Mid(tturl,1,instr(tturl,"/")-1)
	      End If
				if instr(comeurl,tturl) = 0 then
					set rs=nothing
					Call GoToUrl
				End If
			End If

			If rs("inc")=0 then
				'记录开始统计的时间
				rs("fromdate")=now()
			End If
			
			If DateDiff("d",rs("indate"),Date())=0 then
					rs("inj")=rs("inj")+1
				else
					rs("inj")=1
				End If
		
			rs("inc")=rs("inc")+1
				rs("indate")=Now()
			rs.update
			rs("inp")=rs("inc")/(DateDIff("d",rs("fromdate"),Date())+1)
			rs.update
		else
			Response.Write "无此用户名，或者此用户名已经删除，点此访问 <a href= " & WebUrl & "> " & WebName &" </a>"
			Response.Write "3秒后自动进入"&WebName&"。"
			Response.Flush
			Response.Write "<script language=JavaScript>"
			Response.Write "setTimeout(""window.location='"&WebUrl&"'"",3000);"
			Response.Write "</script>"
			rs.close
			set rs=nothing
			set hx=nothing
			Response.End
		End If
		rs.close
		set rs=nothing
	
		'删除系统缓存	
		set hxcache=new cls_cache
		hxcache.DelCahe("js")
		set hxcache=nothing
	End If
	
	Call GoToUrl

	Sub GoToUrl
		set hx = nothing
		Response.Redirect WebUrl
		Response.End
	End Sub

%>