<!--#include file="conn.asp"-->
<%
'-------------------------------------
'功能：处理点入的程序
'天天智能友情链接管理系统
'天天DV网制作 http://www.ttdv.cn
'博大网址库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

%>