<!--#include file=connection.asp-->
<!-- #include file=inc/const.asp -->
<!-- #include file=plus/inc/vb.asp -->
<!-- #include file=plus_love_config.asp -->
<%
If Dvbbs.userid=0 Then Dvbbs.AddErrCode(6):Dvbbs.Showerr()
Dvbbs.LoadTemplates("")
Dvbbs.stats="幸福恋人"

if request("action")>"" then
select case request("action")
case "over"
	call doover()
case "love"
	call dolove()
case "agree"
	call agree()
end select
end if

Dvbbs.Nav()
Dvbbs.Head_var 2,0,"",""			

call main()
Call copyright()
Dvbbs.ActiveOnline()
Dvbbs.footer()

sub main()	
	response.write "<table border=0 align=center cellpadding=0 cellspacing=0 width="&dvbbs.mainsetting(0)&"><tr><td valign=top width=""25%"">"
	call mylove()
	call loveme()
	response.write "</td><td valign=top width=""75%"">"
	Call alllove()
	call guize()
	response.write "</td></tr></table>"
end sub

sub mylove()
dim sql,rs
	response.write "<table border=0 align=center cellpadding=3 cellspacing=1 style=width:97%; class=tableborder1>"
	response.write "<form name=""form1"" method=""get"" action=""plus_love.asp"">"
	response.write "<tr><th align=center height=25>我的丘比特</th></tr>"
	response.write "<tr><td align=center height=23 Class=TableBody1>"
	sql="select plus_love_love,plus_love_wantlove from Jauser where jauname='"&dvbbs.membername&"'"
	set rs=conn.execute(sql)
	if rs("plus_love_love")>"" and rs("plus_love_love")<>"无" then
	response.write "<br>您的恋人是：<a href=dispuser.asp?name="&Rs("plus_love_love")&" target=_blank>"&Rs("plus_love_love")&"</a><br><br>"	
	response.write "<div align=right><a href='?action=over'>我要解除恋爱关系</a></div>"
	elseif rs("plus_love_wantlove")>"" then
	response.write "<br>您目前正在向<a href=dispuser.asp?name="&Rs("plus_love_wantlove")&" target=_blank>"&Rs("plus_love_wantlove")&"</a>求爱<br><br>"
	response.write "<input name=""username"" type=""text"" id=""username"" size=""12"" maxlength=""16""><input type=""submit"" value=""移情别恋""><br><br>"
	else	
	response.write "<br><input name=""wantlove"" type=""text"" id=""wantlove"" size=""12"" maxlength=""16""><input type=""submit"" value=""向他求爱""><br><br>"
	end if
	response.write "</td></tr>"
	response.write "<input name=""action"" type=""hidden"" id=""action"" value=""love""></form>"
	response.write "</table><br>"
end sub

sub loveme()
dim i,sql,rs
	response.write "<table border=0 align=center cellpadding=3 cellspacing=1 style=width:97%; class=tableborder1>"
	response.write "<form name=""form1"" method=""get"" action=""plus_love.asp"">"
	response.write "<tr><th align=center height=25>我的追求者</th></tr>"
	response.write "<tr><td align=center height=23 Class=TableBody1>"	
	sql="select Jauname from jauser where plus_love_wantlove='"&dvbbs.membername&"'"
	Set Rs=Server.CreateObject("ADODB.Recordset")
	Rs.open sql,Conn,3,2
	if Rs.eof then
	response.write "<br><br>暂时没有人向您求爱<br><br><br>"
	else
		response.write "<br><select name=""username"">"
		do while not rs.eof
			response.write "<option value="""&Rs("Jauname")&""">"&Rs("Jauname")&"</option>"
		Rs.movenext
		loop
		response.write "</select>"
	response.write "<input type=""submit"" value=""接受求爱"" name=""action2""><br><input type=""submit"" value=""拒绝求爱"" name=""action2""><br>"
	end if
	response.write "</td></tr>"
	response.write "<input name=""action"" type=""hidden"" id=""action"" value=""agree""></form>"
	response.write "</table>"
end sub

sub alllove()
dim sql,rs,i,l
l=0	
	sql="select jauname,plus_love_love from jauser where plus_love_love>'' and Jasex='男' order by Jauid"
	
	response.write "<table border=0 align=center cellpadding=3 cellspacing=1  style=width:97%; class=tableborder1 height=150>"
	response.write "<tr><th align=center height=25>所有恋人</th></tr>"
	response.write "<tr><td Class=TableBody1>"
	
	Set Rs=Server.CreateObject("ADODB.Recordset")
	Rs.open sql,Conn,3,2
	if Rs.recordcount=0 then
		response.write "<br><br>目前暂时没有论坛恋人<br><br><br>"
	else
	response.write "<div style=width:100%;height:150px;overflow:auto;><table align=center width=""96%""><tr>"
		do while not rs.eof	
			response.write "<td width=''50%''><img src=skins/default/Male.gif><a href=dispuser.asp?name="&Rs("Jauname")&" target=_blank>"&Rs("Jauname")&"</a>　<img src=skins/default/FeMale.gif><a href=dispuser.asp?name="&Rs("plus_love_love")&" target=_blank>"&Rs("plus_love_love")&"</a></td>"
			l=l+1
			if l=2 then
			response.write "</tr><tr>"
			l=0
			end if
		Rs.movenext
		loop 
	response.write "</tr></table></div>"
	end if
	
	response.write "</td></tr>"
	response.write "</table><br>"
end sub

sub guize()
	response.write "<table border=0 align=center cellpadding=3 cellspacing=1 style=width:97%; class=tableborder1>"
	response.write "<tr><th align=center height=25>丘比特规则</th></tr>"
	response.write "<tr><td align=left height=23 Class=TableBody1>"
	response.write "<ol>"
	response.write "<li><b>恋爱自由</b><br>　　只要双方都愿意即可确定恋爱关系</li>"
	response.write "<li><b>解除恋爱关系同样自由</b><br>　　只要一方申请即可解除恋爱关系</li>"
	response.write "<li><b>专一原则</b><br>　　如果您已经有恋人了，必须解除恋爱关系才能向其他人求爱。<br>　　如果您还没有恋人，同一时间您也只能向一个人求爱。</li>"
	response.write "<li><b>恋爱开放原则</b><br>　　即使对方已经有恋人了，您还是可以向他求爱。</li>"
	response.write "<li><b>求爱保密原则</b><br>　　除了当事人，其他任何人都无法知道您的求爱记录。</li>"
	response.write "<li><b>奖励和惩罚</b><br>　　死缠烂打的言语攻击辱骂的请在交流区提起诉讼。系统封ID!</li>"
	response.write "</ol>"
	response.write "</td></tr>"
	response.write "</table><br>"
end sub

sub doover()
dim rs,sql
	sql="select plus_love_love from Jauser where jauname='"&dvbbs.membername&"'"
	set rs=conn.execute(sql)
	if rs("plus_love_love")="" or rs("plus_love_love")="无" then
		call pageTo("您已经是单身贵族了。","plus_love.asp")
	else
		conn.execute("update jauser set plus_love_love='',userCP=userCP"&config_love(4,0)&",userEP=userEP"&config_love(4,1)&" where plus_love_love='"&dvbbs.membername&"'")
		conn.execute("update jauser set plus_love_love='',userCP=userCP"&config_love(4,0)&",userEP=userEP"&config_love(4,1)&" where plus_love_love='"&rs("plus_love_love")&"'")		
		'call sendmessage(rs("plus_love_love"),"很不幸的告诉你，我已经单方面的与你解除了论坛的恋爱关系。节哀吧。") 
		'update_user_msg(Rs("plus_love_love"))
		call pageTo("成功解除了你们的恋爱关系。\r欢迎你回到单身贵族的行列。","plus_love.asp")
	end if
end sub

sub dolove()
	dim sql,rs,plus_love_wantlove,rs2,notice
	plus_love_wantlove=request("wantlove")
	
	sql="select plus_love_wantlove,Jasex from Jauser where Jauname='"&dvbbs.membername&"'"
	set rs=conn.execute(sql)
	if Rs("plus_love_wantlove")=plus_love_wantlove then
		setAlert("死缠烂打是没有用的。\r求爱宣言发一次就够了。")	
	elseif rs("plus_love_wantlove")>"" then
		conn.execute("update jauser set plus_love_wantlove='',userCP=userCP"&config_love(2,0)&",userEP=userEP"&config_love(2,1)&" where jauname='"&dvbbs.membername&"'")
		notice="您移情别恋，魅力值"&config_love(2,0)&",经验值"&config_love(2,1)&"。\r\r"
	end if
	
	sql="select plus_love_love,Jasex from jauser where jauname='"&plus_love_wantlove&"'"
	set rs2=conn.execute(sql)
	if rs2.eof then
		call pageTo(notice&"没有找到您要求爱的对象，请检查您的输入。","plus_love.asp")
	elseif Rs("Jasex")=Rs2("Jasex") then
		call pageTo(notice&"目前本论坛不允许同性恋公开化！","plus_love.asp")
	elseif len(Rs2("plus_love_love"))>=len("") then
		conn.execute("update jauser set plus_love_wantlove='"&plus_love_wantlove&"',userCp=userCp"&config_love(0,0)&",userEp=userEp"&config_love(0,1)&" where jauname='"&dvbbs.membername&"'")
		conn.execute("update jauser set userCp=userCp"&config_love(0,2)&" where jauname='"&plus_love_wantlove&"'")
	notice=notice&"您向"&plus_love_wantlove&"求爱，魅力值"&config_love(0,0)&",经验值"&config_love(0,1)&"。\r"
	notice=notice&plus_love_wantlove&"魅力值。"&config_love(0,2)&"\r\r"			
		'call sendmessage(plus_love_wantlove,"亲爱的，您愿意成为我的论坛恋人吗？向全论坛宣告我们的爱情？答应我吧。<br><br>您可以选择：<a href=plus_love.asp?action=agree&action2=接受求爱&username="&dvbbs.membername&">答应</a>　　<a href=plus_love.asp?action=agree&action2=&username="&dvbbs.membername&">不答应</a>") 
		'update_user_msg(plus_love_wantlove)	
		call pageTo(notice&"你爱的人已经有恋人了。\r您的求爱宣言也许要很久以后才会有回音。","plus_love.asp")
	end if
	
	conn.execute("update jauser set plus_love_wantlove='"&plus_love_wantlove&"',userCp=userCp"&config_love(0,0)&",userEp=userEp"&config_love(0,1)&" where jauname='"&dvbbs.membername&"'")
	conn.execute("update jauser set userCp=userCp"&config_love(0,2)&" where jauname='"&plus_love_wantlove&"'")
	notice=notice&"您向"&plus_love_wantlove&"求爱，魅力值"&config_love(0,0)&",经验值"&config_love(0,1)&"。\r"
	notice=notice&plus_love_wantlove&"魅力值。"&config_love(0,2)&"\r\r"			
	'call sendmessage(plus_love_wantlove,"亲爱的，您愿意成为我的恋人吗？向全论坛宣告我们的爱情？答应我吧。<br><br>您可以选择：<a href=plus_love.asp?action=agree&action2=接受求爱&username="&dvbbs.membername&">答应</a>　　<a href=plus_love.asp?action=agree&action2=&username="&dvbbs.membername&">不答应</a>") 
	'update_user_msg(plus_love_wantlove)
	call pageTo(notice&"已经为你传递了向"&plus_love_wantlove&"的求爱宣言。","plus_love.asp")
end sub

sub agree()
dim sql,rs,plus_love_wantlove,rs2,notice
	plus_love_wantlove=request("username")
	sql="select plus_love_wantlove from jauser where jauname='"&plus_love_wantlove&"'"
	set rs=conn.execute(sql)
	if rs.eof then
		call pageTo("该用户不存在。\r请检查您是否从本站安全链接进入。","plus_love.asp")
	elseif lcase(rs("plus_love_wantlove"))<>lcase(dvbbs.membername) then
		call pageTo("该用户没有向您发出求爱请求。\r或许该请求已被回应，或许对方已经撤回请求。","plus_love.asp")
	end if
	
if request("action2")="接受求爱" then	
	sql="select plus_love_love from jauser where jauname='"&dvbbs.membername&"'"

	set rs=conn.execute(sql)		
	if len(rs("plus_love_love"))>len("") then
		call setAlert("您必须先和您的恋人解除恋爱关系才可以接受别人的求爱。")
	end if
	conn.execute("update jauser set plus_love_wantlove='',plus_love_love='"&plus_love_wantlove&"',userCp=userCp"&config_love(3,0)&",userEp=userEp"&config_love(3,1)&" where jauname='"&dvbbs.membername&"'")
	conn.execute("update jauser set plus_love_wantlove='',plus_love_love='"&dvbbs.membername&"',userCp=userCp"&config_love(3,0)&",userEp=userEp"&config_love(3,1)&" where jauname='"&plus_love_wantlove&"'")				
	'call sendmessage(plus_love_wantlove,dvbbs.membername&"已经接受了您的请求，与你确定了恋爱关系了双方均经验值"&config_love(3,1)&"、魅力值"&config_love(3,0)&"！") 
	'update_user_msg(plus_love_wantlove)
	call pageTo("恭喜你们成功确定了恋爱关系！\r你和您的恋人各加100点经验值和100点魅力值！\r记得请大家吃糖哦^_^","plus_love.asp")
else
	conn.execute("update jauser set plus_love_wantlove='',userCp=userCp-50,userEp=userEp-20 where jauname='"&plus_love_wantlove&"'")
	'call sendmessage(plus_love_wantlove,dvbbs.membername&"拒绝了您的求爱请求！您的魅力值"&config_love(1,0)&"，经验值"&config_love(1,1)&"！") 
	'update_user_msg(plus_love_wantlove)
	call pageTo("拒绝了对方的求爱。\对方魅力值"&config_love(1,0)&"、经验值"&config_love(1,1)&"。","plus_love.asp")
end if	
end sub

sub sendmessage(user_to,message)
	conn.execute("Insert into Dv_Message (sender,title,incept,content,sendtime,isSend) Values('"&dvbbs.membername&"','爱神丘比特','"&user_to&"','"&message&"',#"&Now()&"#,1)")
end sub


Function update_user_msg(username)
	Dim msginfo
	If newincept(username)>0 Then
		msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
	Else
		msginfo="0||0||null"
	End If
	Dvbbs.Execute("update Jauser set UserMsg='"&dvbbs.CheckStr(msginfo)&"' where Jauname='"&dvbbs.CheckStr(username)&"'")
End Function
'统计留言
Function newincept(iusername)
	Dim thers
	set thers=conn.Execute("Select Count(*) from dv_Message Where flag=0 and issend=1 and delR=0 And incept='"& iusername &"'")
	newincept=thers(0)
	Set thers=Nothing
	If IsNull(newincept) Then newincept=0
End Function
Function inceptid(stype,iusername)
	Dim ars
	set ars=conn.Execute("Select top 1 id,sender from dv_Message Where flag=0 and issend=1 and delR=0 And incept ='"& iusername &"'")
	if stype=1 then
	inceptid=ars(0)
	else
	inceptid=ars(1)
	end if
	set ars=nothing
End Function

sub copyright()
%>
<!-- 
插件名：幸福恋人1.1 For 动网7.0
修改时间：2004-2-2
本插件由精益工作室http://www.genghao.net提供
本插件版权属精益工作室所有，未经许可，禁止任何人转载或在网上公开源程序。否则将追究法律责任
以上注释对Asp文件执行速度没有任何影响，使用时请保留
-->
<%
end sub
%>