<%
dim connj,dbm1

dim rsm,sqlm,lovetitle,lovetime,marrytitle,marrytime,isvisual,islovemore,ismarrymore,isbl,ispassdel,isnodel,lovepass,marrypass

dim lovecp1,lovecp2,marrycp1,marrycp2,marrymoney,isfriend,friend1,isfendel,limoeny,isann,isfayuan
dim lovemoney,lipass,limoney,friendlow,delfengmoney,isml,longm,levelm

dim sendmsg


'如果想更改数据库名.请更改此处和plus_marry_show.asp文件另一处.

dbm1="Dv_plus/marry/plus_marry_db.mdb"

set connj = Server.CreateObject("ADODB.connection")
connj.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(dbm1)
connj.open


'=========================导航菜单
sub marry_nav()
	%>
	<style type="text/css">
<!--
body {
	font-size: 9pt;
}
table { 
	font-size: 9pt;
}

-->
</style>
	<DIV ALIGN="center">
	<table border=1 cellpadding=3 cellspacing=1 WIDTH="96%" BGCOLOR="#FFECEF" BORDERCOLORLIGHT="#FF9BB1" BORDERCOLORDARK="#FF9BB1" STYLE="border-collapse: collapse" BACKGROUND="Dv_plus/marry/bg-1.gif"><tr>
	<td align=center BACKGROUND="Dv_plus/marry/g3.gif" HEIGHT="25">
	<FONT FACE="Wingdings 2" COLOR="#FF00FF">ea</FONT><a href=plus_marry_index.asp>【礼堂首页】</a><FONT FACE="Wingdings 2" COLOR="#FF00FF">bf 
	ea</FONT><a href=plus_marry_court.asp>【婚恋事务】</a><FONT FACE="Wingdings 2" COLOR="#FF00FF">bf
	</FONT>&nbsp;<FONT FACE="Wingdings 2" COLOR="#FF00FF">ea</FONT><a href=plus_marry_list.asp>【详细列表】</a><FONT FACE="Wingdings 2" COLOR="#FF00FF">bf
	</FONT>&nbsp;<FONT FACE="Wingdings 2" COLOR="#FF00FF">ea</FONT><a href=plus_marry_cabaret.asp>【社区酒店】</a><FONT FACE="Wingdings 2" COLOR="#FF00FF">bf</FONT>				
	</td></tr><TR><TD ><BR>
<!--	<BR></td></table>-->
<%
end sub

'=======================清除LOVE表
sub clearlove()

dim n,j,sqlm7,chkdel

lovepass=getm("lovepass")
isfendel=getm("isfendel")
isnodel=getm("isnodel")
ispassdel=getm("ispassdel")
lipass=getm("lipass")

set rsm=server.createobject("adodb.recordset")
sqlm="select * from m_love where love<>1"
rsm.open sqlm,connj,1,3	


			
DO while not rsm.eof and not rsm.bof 
   j=rsm("love_id")
   chkdel=0
    Select Case rsm("love")
      case "0"
         n=datediff("h",rsm("addtime"),now()) 
   	   if clng(n)>clng(lovepass) then
              if ispassdel=0 then 
              	rsm("love")=3 
              	rsm("oktime")=now()	
              else
                 chkdel=1 
              end if 	
   	   end if
     case "2"
         if isnodel=1 then chkdel=1
     case "3"
         if ispassdel=1 then chkdel=1
     case "6"
         if isfendel=1 then chkdel=1
     case "7"
         if isfendel=1 then chkdel=1
     case else
         n=datediff("h",rsm("fentime"),now())
         if clng(n)>clng(lipass) then
            if isfendel=0 then 
              rsm("oktime")=now()
              rsm("love")=7
            else
              chkdel=1
         	end if
         end if
    end select
    
   if chkdel=1 then
                  sqlm7="delete * from m_love where love_id="&j
   			connj.execute(sqlm7)
   	else
   			rsm.update
   end if
   rsm.movenext
loop


rsm.close
set rsm=nothing
set sqlm=nothing
end sub
'======================清除MARRY表
sub clearmarry()

dim n,j,sqlm7,chkdel

marrypass=getm("marrypass")
isfendel=getm("isfendel")
isnodel=getm("isnodel")
ispassdel=getm("ispassdel")
lipass=getm("lipass")

set rsm=server.createobject("adodb.recordset")
sqlm="select * from m_marry where marry<>1 and marry<>8"
rsm.open sqlm,connj,1,3	


			
DO while not rsm.eof and not rsm.bof 
   j=rsm("marry_id")
   chkdel=0
    Select Case rsm("marry")
      case "0"
         n=datediff("h",rsm("addtime"),now()) 
   	   if clng(n)>clng(marrypass) then
              if ispassdel=0 then 
              	rsm("marry")=3 
              	rsm("oktime")=now()	
              else
                 chkdel=1 
              end if 	
   	   end if
     case "2"
         if isnodel=1 then chkdel=1
     case "3"
         if ispassdel=1 then chkdel=1
     case "6"
         if isfendel=1 then chkdel=1
     case "7"
         if isfendel=1 then chkdel=1
     case "9"
         n=datediff("h",rsm("oktime"),now())
         if clng(n)>clng(rsm("marrylong")) then
              
              rsm("marry")=8
         end if
     case else
         n=datediff("h",rsm("fentime"),now())
         if clng(n)>clng(lipass) then
            if isfendel=0 then 
              rsm("oktime")=now()
              rsm("marry")=7
            else
              chkdel=1
         	end if
         end if
    end select
    
   if chkdel=1 then
                  sqlm7="delete * from m_marry where marry_id="&j
   			connj.execute(sqlm7)
   	else
   			rsm.update
   end if
   rsm.movenext
loop


rsm.close
set rsm=nothing
set sqlm=nothing
end sub


'======================================================
'0 求爱 1接受,2,拒绝,3,过期,4,FORNAME提出分手,5,TONAME提出分手.6,对方同意已分手,7,过期分手

'0 求婚 1接受(未登记） 2 拒绝,3,过期,4,FORNAME提出离婚,5,TONAME提出离婚.6,对方同意已离婚,7,过期离婚，8,结婚.9,婚礼中
 

Function getm(config)
      dim c(30)      
      c(0)="id"                                              
      c(1)="isvisual"                         '是否启用虚拟形象&nbsp;
      c(2)="isfriend"                         '是否开启亲友团功能&nbsp;
      c(3)="friend1"                          '亲友团同意票数百分比
      c(4)="lovepass"                         '求爱过期时间
      c(5)="marrypass"                        '求婚过期时间
      c(6)="lipass"                           '分手,离婚宣判过期时间
      c(7)="islovemore"                       '是否允许多人恋爱&nbsp;
      c(8)="ismarrymore"				'是否充许多人结婚&nbsp;
      c(9)="isbl"						'是否充许同性恋&nbsp;
      c(10)="ispassdel"					'过期后是否自动删除
      c(11)="isnodel"					'拒绝后是否自动删除&nbsp;
      c(12)="isfendel"					'离婚,分手后信息是否自动删除&nbsp;
      c(13)="lovetitle"					'恋爱阶段图片
      c(14)="lovetime"					'恋爱时段
      c(15)="marrytitle"				'婚姻阶段图片&nbsp;
      c(16)="marrytime"					'婚姻时段
      c(17)="lovemoney"				      '求爱时的最低金币
      c(18)="marrymoney"                        '求婚时的最低金币
      c(19)="lovecp1"                           '求爱成功双方各增加的魅力值
      c(20)="lovecp2"                           '分手时双方减少的魅力值
      c(21)="marrycp1"                          '求婚成功双方各增加的魅力值
      c(22)="marrycp2"                          '离婚时双方减少的魅力值
      c(23)="limoney"                          '离婚时付给对方的金币
      c(24)="friendlow"                        ' 同意票数最低
      c(25)="delfengmoney"                     '删除分手(离婚)消息所需的金币数
      c(26)="isml"                              '是否同意婚外恋
      c(27)="longm" 					'结婚费用时间加成
      c(28)="levelm"                            '结婚费用规格加成
      c(29)="isann"                             '结婚登记后是否在论坛发布公告
      c(30)="isfayuan"                          '是否必须通过法院递交离婚申请
      dim j,k
      k=0
      for j=0 to 30
                if lcase(c(j))=lcase(config) then
          k=j
          end if
      next
      
      dim rsm9,sqlm9
      set rsm9=server.createobject("ADODB.Recordset")
	sqlm9="select * from m_config"
	rsm9.open sqlm9,connj,1,1
	getm= rsm9(k)
	rsm9.close
	set rsm9=nothing
	set sqlm9=nothing	
end Function



'头像函数

function mface(name)
     dim userface1,userfacetemp ,mrs2,msql2
      msql2="select userface from [Dv_user] where username='"&name&"'"
      mrs2=dvbbs.execute(msql2)
      userfacetemp=mrs2(0)
      if instr(userfacetemp,"|")>"0" then
	    Userface1=split(userfacetemp,"|")
                If Ubound(Userface1)>0 Then
                      mface=Userface1(1)
                    else
                      mface=Userface1(0)
                end if
          else
          mface=userfacetemp
      end if
 
          mface="<IMG BORDER=0 SRC="&mface&" WIDTH=120 HEIGHT=120 ALIGN=middle>"
end function
'恋爱照函数

function  mlovephoto(k)
      dim mrs2,msql2,photo1
      msql2="select lovephoto from [m_love] where love_id="&k
      mrs2=connj.execute(msql2)
      photo1=mrs2(0)
	  mlovephoto="<IMG BORDER=0 SRC="&photo1&" WIDTH=280 HEIGHT=220 ALIGN=middle>"
end function

'结婚照函数

function  mmarryphoto(k)
      dim mrs2,msql2,photo1
      msql2="select marryphoto from [m_marry] where marry_id="&k
      mrs2=connj.execute(msql2)
      photo1=mrs2(0)
	  mmarryphoto="<IMG BORDER=0 SRC="&photo1&" WIDTH=280 HEIGHT=220 ALIGN=middle>"
end function

'LOVE等级函数

function mlovetitle(k)
   lovetitle=getm("lovetitle")
   lovetime=getm("lovetime")
   dim lovetitle1,lovetime1,n,mrs2,msql2,oktime,j
   msql2="select oktime from [m_love] where love_id="&k
   mrs2=connj.execute(msql2)
   oktime=mrs2(0)
   n=datediff("h",oktime,now())
        if n<0 then  
        mlovetitle="dv_plus/marry/l1.gif"
        else
                             lovetitle1=split(lovetitle,"|")
                             lovetime1=split(lovetime,"|")
				     
				     j=ubound(lovetime1) 
				     do while j>=0  
                     if clng(n)>=clng(lovetime1(j)) then 
				         mlovetitle=lovetitle1(j)
				         exit do
				     else 
				     j=j-1
				     end if
		            loop
 	  end if
 	set msql2=nothing
	set mrs2=nothing
	
	mlovetitle="<img border=0 src="&mlovetitle&" width=110 height=110>"
	
end function


'=======================================marry等级函数

function mmarrytitle(k)
   marrytitle=getm("marrytitle")
   marrytime=getm("marrytime")
   dim marrytitle1,marrytime1,n,mrs2,msql2,oktime,j
   msql2="select oktime from [m_marry] where marry_id="&k
   mrs2=connj.execute(msql2)
   oktime=mrs2(0)
   n=datediff("h",oktime,now())
      if n<0 then  
        mmarrytitle="dv_plus/marry/m1.gif"
        else

                             marrytitle1=split(marrytitle,"|")
                             marrytime1=split(marrytime,"|")
				     
				     j=ubound(marrytime1) 
				     do while j>=0  
                     if clng(n)>=clng(marrytime1(j)) then 
				         mmarrytitle=marrytitle1(j)
				         exit do
				     else 
				     j=j-1
				     end if
		            loop
	  end if	            
 	set msql2=nothing
	set mrs2=nothing
	
	mmarrytitle="<img border=0 src="&mmarrytitle&" width=110 height=110>"
	
end function

'=====================LOVE礼物子程序 

sub mloveliwu()
   response.write "<br>礼物<br><BR>"
   response.write rsm("liwugod")
   response.write "<br><BR>"
   response.write "金币"	
end sub

'=====================marry礼物子程序 

sub mmarryliwu()
   response.write "<br>聘礼<br><BR>"
   response.write rsm("liwugod")
   response.write "<br><BR>"
   response.write "金币"	
end sub


'====================字符换行函数

function msgbr(k)
 dim k1,kn,j
 kn=len(k)
 if kn>60 then kn=60
 if kn>16 then
    msgbr=""
    for j=1 to kn
      k1=mid(k,j,1)
      if j mod 15=0 then
      msgbr=msgbr&k1&"<br>"
      else
      msgbr=msgbr&k1
      end if
     next
  else 
     msgbr=k
  end if
end function







'============提示信息子程序
sub send_msg()%>

	<br>
	<DIV ALIGN="center">
	<table cellpadding=3 cellspacing=1  WIDTH="760" BORDERCOLORLIGHT="#FF9BB1" BORDERCOLORDARK="#FF9BB1" STYLE="border-collapse: collapse" BORDER="1" BGCOLOR="#FFECEF">
		<tr align=center>
			<td width="760" BACKGROUND="Dv_plus/marry/g3.gif" HEIGHT="25"><FONT FACE="华文彩云" SIZE="2">提示:</FONT></td>
		</tr>
		<tr>
			<td width="100%" ><b>操作结果：</b><br><%
				
					response.write "<font color=red><b>"&sendmsg&"</font></b>"
				
			%></td>
		</tr>
		<tr align=center>
			<td width="100%" ><a href="javascript:history.back(-1)">[返回上页]</a><a href="javascript:window.close()">[关闭窗口]</a>&nbsp;&nbsp;</td>
		</tr>
	</table>
</DIV>

<%end sub
'====================================================================翻页子程序
Sub ShowPageBar(TotalPage,CurPage,strUrl) 
'参数TotalPage：整个页数 
'参数CurPage：当前页数 
'参数strUrl：翻页使用的连接地址 

DIM strPage 
CurPage=GetValidPageNO(TotalPage,CurPage) 
Response.Write "<TABLE WIDTH=''100%''>" 
Response.Write "<TR><td width=''100%'' align=''right''>" 
Response.Write "页数：" & CurPage & "/" & TotalPage & " " 
IF InSTR(strUrl,"?")=0 THEN 
strPage="?Page=" 
ELSE 
strPage="&Page=" 
END IF 

IF Curpage>1 THEN 
Response.Write "<a href=" & strUrl &strPage&"1>首页</a>|" 
ELSE 
Response.Write "首页|" 
END IF 

IF CurPage>=2 THEN 
Response.Write "<a href=" & strUrl & strPage &CurPage-1&">上一页</a>|" 
ELSE 
Response.Write "上一页|" 
END IF 

IF cInt(CurPage)<cInt(TotalPage) THEN 
Response.Write "<a href=" & strUrl & strPage &CurPage+1&">下一页</a>|" 
ELSE 
Response.Write "下一页|" 
END IF 

IF cInt(CurPage) <>cInt(TotalPage) THEN 
Response.Write "<a href=" & strUrl & strPage & TotalPage&">尾页</a>" 
ELSE 
Response.Write "尾页" 
END IF 
Response.Write "</TD></tr></table>" 
END SUB 

Function GetValidPageNo(PageCount,CurPage) 
Dim iPage 
iPage=CurPage 
IF cInt(CurPage)<1 THEN 
iPage= 1 
END IF 
IF cInt(iPage) > cInt(PageCount) THEN 
iPage= PageCount 
END IF 
GetValidPageNo=iPage 
END Function 
'============================================金币加减函数

Sub UpdateUserMoney(UserName, money)
      money=clng(money)
      
	If money > 0 Then
		Dvbbs.Execute ("Update [Dv_User] Set UserMoney=UserMoney+" & money & " Where UserName='" & UserName & "'")
	Else
		Dvbbs.Execute ("Update [Dv_User] Set UserMoney=UserMoney-" & Abs(money) & " Where UserName='" & UserName & "'")
	End If
	If LCase(UserName) = LCase(Dvbbs.MemberName) Then
		
		Dvbbs.MyUserInfo(37) = cCur(Dvbbs.MyUserInfo(37)) + money
		
		Session(Dvbbs.CacheName & "UserID") = Dvbbs.MyUserInfo

	Else
		Dvbbs.NeedUpdateList UserName, 1
	End If
End Sub

'============================================魅力加减函数
Sub UpdateUserCP(UserName, CP)
      CP=clng(CP)
     
	If CP > 0 Then
		Dvbbs.Execute ("Update [Dv_User] Set UserCP=UserCP+" & CP & " Where UserName='" & UserName & "'")
	Else
		Dvbbs.Execute ("Update [Dv_User] Set UserCP=UserCP-" & Abs(CP) & " Where UserName='" & UserName & "'")
	End If
	If LCase(UserName) = LCase(Dvbbs.MemberName) Then
		
		Dvbbs.MyUserInfo(23) = cCur(Dvbbs.MyUserInfo(23)) + CP
		
		Session(Dvbbs.CacheName & "UserID") = Dvbbs.MyUserInfo

	Else
		Dvbbs.NeedUpdateList UserName, 1
	End If
End Sub


'===============================================
'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
Sub UPDATE_User_Msg(username)
	Dim msginfo,i,UP_UserInfo,newmsg
	newmsg=newincept(username)
	If newmsg>0 Then
		msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
	Else
		msginfo="0||0||null"
	End If
	Dvbbs.execute("UPDATE [Dv_User] Set UserMsg='"&Dvbbs.CheckStr(msginfo)&"' WHERE username='"&Dvbbs.CheckStr(username)&"'")
	If username=Dvbbs.MemberName Then
		UP_UserInfo=Session(Dvbbs.CacheName & "UserID")
		UP_UserInfo(30)=msginfo
		Session(Dvbbs.CacheName & "UserID")=UP_UserInfo
	Else
		Call Dvbbs.NeedUpdateList(username,1)
	End If
End Sub

Function newincept(iusername)
Dim Rs
Rs=Dvbbs.execute("SELECT Count(id) FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'")
    newincept=Rs(0)
	Set Rs=nothing
	If isnull(newincept) Then newincept=0
End Function

Function inceptid(stype,iusername)
      dim rs
	Set Rs=Dvbbs.execute("SELECT top 1 id,sender FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'")
	If not rs.eof Then
		If stype=1 Then
			inceptid=Rs(0)
		Else
			inceptid=Rs(1)
		End If
	Else
		If stype=1 Then
			inceptid=0
		Else
			inceptid="null"
		End If
	End If
	Set Rs=nothing
End Function
















%>