<!--#include file="conn.asp"-->
<!--#include file="common.asp"-->
<!--#include file="md5.asp"-->
<%
Dim oRe, oMatch, oMatches
Dim L,SiteUrl,CurrentDoMain,alternation,arr2,CookiesDoMain

Set oRe = New RegExp

'获取传入的链接
L=request.QueryString("L")
L=lcase(L)
L=replace(L,"\","/")

'提取域名
oRe.Pattern = "^http://[^/]+"
Set oMatches = oRe.Execute(L)
if oMatches.Count<1 then response.end
SiteUrl=oMatches(0).value

'查找数据库,如有有此域名,就给点入加1,如果没有就新建用户,并加入链接列表
sql="select * from link where Y_SiteURL='"&SiteUrl&"'"
rs.open sql,conn,1,3
response.write sql
response.end

if rs.eof then
	'提取页面title
	Dim SiteTitle,Bt,username,passsword,GoTop
	SiteTitle= GetSiteKey(SiteUrl)
	Bt=now()
	
	username=Bt
	passsword=md5(Bt)
	GoTop=Bt
	
	Y_SiteName=SiteTitle
	Y_Alt=SiteTitle
	Y_SiteURL=SiteUrl
	Y_MyLink=L
	
	jointime=Bt
	sql="insert into link (username,passsword,Y_SiteName,Y_Alt,Y_SiteURL,Y_MyLink,jointime,GoTop) values "&_
		"('"&username&"','"&passsword&"','"&Y_SiteName&"','"&Y_Alt&"','"&Y_SiteURL&"','"&Y_MyLink&"','"&Bt&"','"&GoTop&"')"

	conn.execute (sql)
else
		arr2=Split(rs("Y_MyLink"),"/")
		CurrentDoMain=arr2(2)
			CookiesDoMain=request.Cookies("visit")(CurrentDoMain)
			if CookiesDoMain="" then
				if DateDiff("d",rs("inToday"),now)=0 then
					rs("goin")=rs("goin")+1
					rs("goinToday")=rs("goinToday")+1
				else
					rs("goin")=rs("goin")+1
					rs("goinToday")=1
					rs("inToday")=now
				end if
				rs.update
				rs.close

			end if

		
end if

'写入访问COOKIES
sql="select alternation from setting"
set rs=conn.execute (sql)
if not rs.eof then
alternation=rs("alternation")
rs.close
end if
response.cookies("visit")(CurrentDoMain)="71C570102EE77010556F615C1FC82B7F"
Response.Cookies("visit").Expires= DateAdd("n",alternation,now())
'response.Redirect(L_SiteURL)

function GetSiteKey(URLTEMP)
	'on error resume next
	
	'建立URL字串
	URL=URLTEMP
	URL=lcase(URL)
	URL=replace(URL,"\","/")
	
	'取得页面源码
	Set Retrieval = CreateObject("Microsoft.XMLHTTP") 
	With Retrieval 
	.Open "Get", URL, False, "", "" 
	.Send 
	wstr1 = .ResponseBody
	wstr2 = .ResponseText
	End With

	'判断页面编码	
	MyCharSet="gb2312"
	
	Dim oRe, oMatch, oMatches
	Set oRe = New RegExp
	oRe.IgnoreCase = True
	oRe.Pattern = "CharSet=([^""|<|>]+)"
	Set oMatches = oRe.Execute(wstr2)

	if oMatches.Count>0 then
		Set oMatch = oMatches(0)
		MyCharSet = oMatch.SubMatches(0)
	end if
	set oMatch=nothing
	
	'转换为相应编码格式
	dim objstream
	set objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1
	objstream.Mode =3
	objstream.Open
	objstream.Write wstr1
	objstream.Position = 0
	objstream.Type = 2
	objstream.Charset = MyCharSet
	wstr = objstream.ReadText 
	objstream.Close
	set objstream = nothing
	
	'判断编码方式结束
	
	'取得页面TITLE
	oRe.Pattern = "(<title>)(.+)(</title>)"
	Set oMatches = oRe.Execute(wstr)
	
	if oMatches.Count=0 then
		GetSiteKey = "--"
		exit function
	else
		Set oMatch = oMatches(0)
		
		GetSiteKey = oMatch.SubMatches(1)
		exit function
	end if
end function
%>