goto2.asp

本源代码为 网雷弹窗联盟程序的源代码,欢迎大家的下载,学习与交流

<!--#include file="head.asp"-->
<%
'on error resume next
Response.Buffer = True  
Response.ExpiresAbsolute = Now() - 1  
Response.Expires = 0  
Response.CacheControl = "no-cache"  
Response.AddHeader "Pragma", "No-Cache"

Dim Id
Dim Url

Id=cint(request("id"))
Url=trim(request("url"))
ComeIp=trim(request("ComeIp"))

if Id="" or Id=0 then
	Id=1
end if

visitCount=request.Cookies("visitCount")
if isnull(visitCount) or visitCount="" then
	visitCount=0
end if

if visitCount<5 then
	'第一步,给弹出其它网站的站长和他的上线站长加上流量积分.
	conn.BeginTrans '事务开始
	conn.execute("update Users set RemainPop=RemainPop+1,OutPop=OutPop+1 where Id="&Id)  
	set rs=conn.execute("select OutPop,SxId,Flag from Users where Id="&Id)
	if rs.eof then
		FatherId=1
		OutPop=0
	else
		FatherId=rs(1)
		OutPop=rs(0)
		Flag=rs(2)
	end if
	rs.close()
	
	if (OutPop>Int(AutoConfirm) and Flag=0) then
		conn.execute("update Users set Flag=1 where Id="&Id)
	end if
	conn.execute("update Users set RemainPop=RemainPop+"&Give/100&" where Id="&FatherId)
	
	if conn.Errors.Count=0 then  
	  conn.CommitTrans  '如果没有conn错误，则执行事务提交
	else 
	  conn.RollbackTrans '否则回滚
	end if
end if


'第二步,找出一个可以弹出的网站,并显示它(一个剩余流量大于1的,并且是积分交换模式的,还要是已经认证的,而且不能是自己的)
sql="select top 1 * from Users where RemainPop>1 and InType=0 and Flag=1 and Id<>"&Id&" order by RemainPop desc,Id"
rs.open sql,conn,1,3
if not rs.eof then
	SiteName=rs("SiteName")
	SiteUrl=rs("SiteUrl")
	NewId=rs("Id")
	
	if visitCount<5 then
		'减去相应的流量储量
		rs("RemainPop")=CDbl(rs("RemainPop"))-CDbl(1)
		rs("InPop")=rs("InPop")+1
		rs.update
	end if
else
	NewId=1
	SiteName=NetName
	SiteUrl=NetUrl
end if

'第三步，写入流量跟踪记录
PopTime=now()
PopUrl=Url
PopIp=ComeIp
PopInUserId=Id
PopOutUserId=NewId
PopWhoUrl=SiteUrl

conn.execute("insert into [Count] (PopTime,PopUrl,PopIp,PopInUserId,PopOutUserId,PopWhoUrl) values('"&PopTime&"','"&PopUrl&"','"&PopIp&"',"&PopInUserId&","&PopOutUserId&",'"&SiteUrl&"')")

'第四步，进入弹出页面
response.Redirect("go.asp?id="&NewId)
%>