<!--#include file=inc.asp-->
<%
If Not BBS94KK.Founduser Then BBS94KK.GoToErr(10)
BBS94KK.Head("论坛婚姻")
select case request("action")
case "over"
	call doover()
case "love"
	call dolove()
case "agree"
	call agree()
case else
	call main()
end select
bbs94kk.footer()

sub main()	
response.write "<br><table border=0 align=center cellpadding=0 cellspacing=0 width=75% ><tr><td valign=top width=""20%"">"
call mylove()
call loveme()
response.write "</td><td valign=top width=""70%"">"
Call alllove()
call guize()
response.write "</td></tr></table><br><br><br>"
end sub
sub mylove()
dim sql,rs
response.write "<table border=0 align=center cellpadding=0 cellspacing=0>"
response.write "<form name=""form1"" method=""get"" action=""love.asp"">"
response.write "<tr><td align=center height=25><font color=#ff0000><b>我的丘比特</b></font></td></tr>"
response.write "<tr><td align=center height=23>"
sql="select wife,wantlove from [kk_user] where name='"&bbs94kk.myname&"'"
set rs=bbs94kk.execute(sql)
if rs("wife")<>"" and rs("wife")<>"无" then
response.write "<br>您的恋人是：<a href=userinfo.asp?name="&Rs("wife")&" target=_blank>"&Rs("wife")&"</a><br><br>"
response.write "<div align=right><a href='?action=over'>我要解除恋爱关系</a></div>"
elseif rs("wantlove")<>"" then
response.write "<br>您目前正在向<a href=userinfo.asp?name="&Rs("wantlove")&" target=_blank>"&Rs("wantlove")&"</a>求爱<br><br>"
response.write "<input name=""username"" type=""text"" id=""username"" size=""12"" maxlength=""16""><b> <input type=""submit"" value=""移情别恋""><br><br>"
else	
response.write "<br><input name=""username"" type=""text"" id=""username"" size=""14"" 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=0 cellspacing=0>"
response.write "<form name=""form1"" method=""get"" action=""love.asp?action=agree"">"
response.write "<tr><td align=center height=25><font color=#ff0000><b>我的追求者</B></font></td></tr>"
response.write "<tr><td align=center height=23>"	
sql="select name from [kk_user] where wantlove='"&bbs94kk.myname&"'"
Set Rs=Server.CreateObject("ADODB.Recordset")
Rs.open sql,conn,1,1
if Rs.recordcount=0 then
response.write "<br><br>暂时没有人向您求爱<br><br><br>"
else
response.write "<br><select name=""username"">"
for i=1 to Rs.recordcount	
response.write "<option value="""&Rs("name")&""">"&Rs("name")&"</option>"
Rs.movenext
next
response.write "</select>"
response.write "<br><br><input type=""submit""  class=submit value=""接受求爱"" name=""action2""> <input type=""submit"" class=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,rs1
l=0	
sql="select name,wife,Pic,PicW,PicH from [kk_user] where wife<>'' and sex=true order by ID"
response.write "<table border=0 align=center cellpadding=0 cellspacing=0>"
response.write "<tr><td align=center height=25><font color=#FF0000><B>所有恋人</b></font></td></tr>"
response.write "<tr><td>"
Set Rs=Server.CreateObject("ADODB.Recordset")
Rs.open sql,conn,1,1
if Rs.recordcount=0 then
response.write "<br><br>目前暂时没有论坛恋人<br><br><br>"
else
response.write "<marquee height=100 width=300 direction=up scrollamount=2 onMouseOver=this.stop() onMouseOut=this.start()><table align=center width=300 ><tr>"
for i=1 to Rs.recordcount	
response.write "<td width='50%'><img src="&Rs("Pic")&" Width="&Rs("PicW")&" Height="&Rs("PicH")&"><br><a href=userinfo.asp?name="&Rs("name")&" target=_blank>"&Rs("name")&"</a></td>"
Set Rs1=Bbs94kk.execute("select name,wife,Pic,PicW,PicH from [kk_user] where name='"&Rs("wife")&"'")
If not Rs1.eof then
response.write"<td width='50%'><img src="&Rs1("Pic")&" Width="&Rs1("PicW")&" Height="&Rs1("PicH")&"><br><a href=userinfo.asp?name="&Rs("wife")&" target=_blank>"&Rs("wife")&"</a></td>"
End if
rs1.close
l=l+1
if l=1 then
response.write "</tr><tr>"
l=0
end if
Rs.movenext
next
response.write "</tr></table></marquee>"
end if
response.write "</td></tr>"
response.write "</table><br>"
Set Rs1=nothing
end sub

sub guize()
response.write "<table border=0 align=center cellpadding=0 cellspacing=0>"
response.write "<tr><td align=center height=25><font color=#FF0000><B>社区婚姻—丘比特规则</B></FONT></td></tr>"
response.write "<tr><td align=left height=23>"
response.write "<ol>"
response.write "<br><br><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>　　向别人求爱，金钱扣除999做聘礼元，对方金钱+999元。同理，有人向你求爱，您的金钱+999。<br>　　求爱被拒绝，金钱扣除2000元<br>　　移情别恋(您本来向甲求爱，改而向乙求爱)金钱扣除1500元。<br>　　确定恋爱关系，双方金钱增加1000元。<br>　　解除恋爱关系，双方金钱扣除1000元或1500元。</li>"
response.write "</ol>"
response.write "</td></tr>"
response.write "</table>"
end sub

sub doover()
dim rs,sql,wife

sql="select wife from [kk_user] where name='"&bbs94kk.myname&"'"
set rs=bbs94kk.execute(sql)
wife=rs("wife")
if rs("wife")="" or rs("wife")="无" then
call pageTo("您已经是单身贵族了。","love.asp")
else
bbs94kk.execute("update [kk_user] set wife='',coin=coin-1000 where wife='"&bbs94kk.myname&"'")
bbs94kk.execute("update [kk_user] set wife='',coin=coin-1500 where wife='"&rs("wife")&"'")
bbs94kk.execute("Insert into [kk_sms] (myname,name,content) Values('"&wife&"','"&bbs94kk.myname&"','很不幸的告诉你，我已经单方面的与你解除了论坛的恋爱关系。节哀吧。')")
BBS94KK.ExeCute("Update [KK_user] Set NewSmsNum=NewSmsNum+1 Where Name='"&wife&"'")
call pageTo("成功解除了你们的恋爱关系。\r欢迎你回到单身贵族的行列。","love.asp")
end if
end sub

sub dolove()
dim sql,rs,wantlove,rs2,notice
wantlove=replace(request("username"),"'","''")
sql="select wantlove,sex from [kk_user] where name='"&bbs94kk.myname&"'"
set rs=bbs94kk.execute(sql)
if Rs("wantlove")=wantlove then
setAlert("死缠烂打是没有用的。\r求爱宣言发一次就够了。")	
elseif rs("wantlove")<>"" then
conn.execute("update [kk_user] set wantlove='',coin=coin-1500 where name='"&bbs94kk.myname&"'")
notice="您移情别恋，扣除了金钱1500元。\r\r"
end if
sql="select wife,Sex from [kk_user] where name='"&wantlove&"'"
set rs2=bbs94kk.execute(sql)
if rs2.eof then
call pageTo(notice&"没有找到您要求爱的对象，请检查您的输入。","love.asp")
'elseif Rs("sex")=Rs2("sex") then '如果允许同性恋就在本行最前面加上'
'call pageTo(notice&"目前本论坛不允许同性恋公开化！","love.asp")'同上
elseif Rs2("wife")<>"" then
bbs94kk.execute("update [kk_user] set wantlove='"&wantlove&"',coin=coin-999 where name='"&bbs94kk.myname&"'")
bbs94kk.execute("update [kk_user] set coin=coin+999 where name='"&wantlove&"'")
notice=notice&"您向"&wantlove&"求婚，给了"&wantlove&"的领导999元做聘礼。\r"
notice=notice&wantlove&"增加了999元。\r\r"			
call sendmessage(bbs94kk.myname,"亲爱的，您愿意成为我的论坛恋人吗？向全论坛宣告我们的爱情？答应我吧。您可以到论坛娱乐中心的（幸福恋人）做出选择") 	
call pageTo(notice&"你爱的人已经有恋人了。\r您的求爱宣言也许要很久以后才会有回音。","love.asp")
end if
bbs94kk.execute("update [kk_user] set wantlove='"&wantlove&"',coin=coin-999 where name='"&bbs94kk.myname&"'")
bbs94kk.execute("update [kk_user] set coin=coin+999 where name='"&wantlove&"'")
notice=notice&"您向"&wantlove&"求爱，给了"&wantlove&"的上级999元做聘礼。\r"
notice=notice&wantlove&"增加了999元。\r\r"			
call sendmessage(bbs94kk.myname,"亲爱的，您愿意成为我的论坛恋人吗？向全论坛宣告我们的爱情？答应我吧。您可以到论坛设施中心的（幸福恋人）做出选择") 
	call pageTo(notice&"已经为你传递了向"&wantlove&"的求爱宣言。","love.asp")
end sub

sub agree()
dim sql,rs,wantlove,rs2,notice,checkstr
	wantlove=trim(replace(request("username"),"'","''"))
	sql="select wantlove from [kk_user] where name='"&wantlove&"'"
	set rs=bbs94kk.execute(sql)		
	if rs.eof then
		call pageTo("该用户不存在。\r请检查您是否从本站安全链接进入。","love.asp")
	'elseif rs("wantlove")<>bbs94kk.myname then
	'call pageTo("该用户没有向您发出求爱请求。\r或许该请求已被回应，或许对方已经撤回请求。","love.asp")
	end if
	
if request("action2")="接受求爱" then	
	sql="select wife from [kk_user] where name='"&bbs94kk.myname&"'"
	set rs=bbs94kk.execute(sql)		
	if rs("wife")>"" then
		call setAlert("您必须先和您的恋人解除恋爱关系才可以接受别人的求爱。")
	end if
	
	bbs94kk.execute("update [kk_user] set wantlove='',wife='"&wantlove&"',coin=coin+1000 where name='"&bbs94kk.myname&"'")
	bbs94kk.execute("update [kk_user] set wantlove='',wife='"&bbs94kk.myname&"',coin=coin+1000 where name='"&wantlove&"'")				
	call sendmessage("红娘",bbs94kk.myname&"已经接受了您的请求，与你确定了恋爱关系了！你们各得1000元礼金！") 
	call pageTo("恭喜你们成功确定了恋爱关系！\r你和您的恋人各得1000元礼金！\r记得请大家吃糖哦^_^","love.asp")
else
	bbs94kk.execute("update [kk_user] set wantlove='',coin=coin-2000 where name='"&wantlove&"'")
	call sendmessage("红娘",bbs94kk.myname&"拒绝了您的求爱请求！您的金钱扣除了2000元！") 
	call pageTo("拒绝了对方的求爱。\r并减去他2000元。","love.asp")
end if	
end sub

sub sendmessage(user_to,message)
dim newsmsnum
	bbs94kk.execute("Insert into [kk_sms] (myname,name,content) Values('"&replace(request("username"),"'","''")&"','"&user_to&"','"&message&"')")
	BBS94KK.ExeCute("Update [KK_user] Set NewSmsNum=NewSmsNum+1 Where Name='"&replace(request("username"),"'","''")&"'")
end sub
Const Text1="<html><head><meta http-equiv=Content-Type content=text/html; charset=gb2312><title>提示</title><meta http-equiv=pragma content=no-cache>"
Const Text2="</head><body></body></html>"
sub setAlert(str)
   response.write Text1&"<SCRIPT language=JavaScript>alert('"&str&"');javascript:history.go(-1)</SCRIPT>"&Text2
   response.end
end sub
sub setAlert2(str)
   response.write Text1&"<SCRIPT language=JavaScript>alert('"&str&"');javascript:history.go(-2)</SCRIPT>"&Text2
   response.end
end sub
sub pageTo(alerttext,topage)
   response.write Text1&"<SCRIPT language=JavaScript>alert('"&alerttext&"');location.href='"&topage&"';</SCRIPT>"&Text2
   response.end
end sub
sub closewin(alerttext)
   response.write Text1&"<SCRIPT language=JavaScript>alert('"&alerttext&"');window.close();</SCRIPT>"&Text2
   response.end
end sub
%>