<!--#include file="Conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/chan_const.asp"-->
<!--#include file="inc/chkinput.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<!--#include file="inc/md5.asp"-->
<!--#include file="dv_dpo/cls_dvapi.asp"-->
<%
Dim comeurl
Dim TruePassWord
session("flag")=empty
Dvbbs.LoadTemplates("login")
Dvbbs.stats=template.Strings(1)

dim redUrl

redUrl=request.QueryString("rUrl")

TruePassWord=Dvbbs.Createpass

Dvbbs_ChkLogin
Dvbbs.Showerr()

Function Dvbbs_ChkLogin
	Dim UserIP
	Dim username
	Dim userclass
	Dim password
	Dim article
	Dim usercookies
	Dim mobile
	Dim chrs,i
	UserIP=Dvbbs.UserTrueIP	
	'if mobile<>"" and request("username")="" then
	'	if len(mobile)>12 then
	'		Dvbbs.AddErrCode(9)
	'	end if
	'end if
	'if mobile<>"" then
	'	if len(mobile)>12 And Not IsNumeric(mobile) then mobile=""
	'end if			
	'-----------------------------------------------------------------

	usercookies=0	
	username=Request.Cookies("sdjy")("username")
	password=Request.Cookies("sdjy")("password")
	
	If ChkUserLogin(username,password,mobile,usercookies,1)=false Then
		'本地验证未通过，使用手机号登录的
		If mobile<>"" Then
			challenge_check mobile,password
			Exit Function
		'本地验证未通过，使用用户名登录的，并且是高级用户则继续主服务器验证流程
		Else
			set chrs=Dvbbs.Execute("select Passport,IsChallenge from [Dv_User] where username='"&username&"' and IsChallenge=1")
			If chrs.eof and chrs.bof Then
				Dvbbs.AddErrCode(12)
				Exit Function
			Else
				challenge_check chrs("Passport"),password
				Exit Function
			End If
			set chrs=nothing
		End If
	End If
	
	Dim ArrenStr
	if redUrl="" then
	 ArrenStr="<meta http-equiv=""refresh"" content=""2; url=../myhome.asp""/>"
	 ArrenStr=ArrenStr+"<p>&nbsp;</p><table cellpadding=""3"" cellspacing=""1"" align=""center"" class=""tableborder1"">"
	ArrenStr=ArrenStr+"<tr>"
	ArrenStr=ArrenStr+"<td height=""25"" style='font-size:12px'>登录成功：<font color='#FF0000'>红嫂视屏交友网</font>欢迎您的到来</td>"
	ArrenStr=ArrenStr+"</tr>"	
	ArrenStr=ArrenStr+"</table>"	
  else
     ArrenStr="<meta http-equiv=""refresh"" content=""2; url=index.asp""/>"
	 ArrenStr=ArrenStr+"<p>&nbsp;</p><table cellpadding=""3"" cellspacing=""1"" align=""center"" class=""tableborder1"">"
	 ArrenStr=ArrenStr+"<tr>"
	 ArrenStr=ArrenStr+"<td height=""25"" style='font-size:12px'>登录成功：<font color='#FF0000'>红嫂视屏交友网</font>欢迎您的到来</td>"
	 ArrenStr=ArrenStr+"</tr>"	
	 ArrenStr=ArrenStr+"</table>"	
  end if	
	
		
	'If Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1 And Dvbbs.Forum_ChanSetting(12)=1 Then
	'	TempStr = Replace(TempStr,"{$ray_logininfo}",template.html(3))
	'Else
	'	TempStr = Replace(TempStr,"{$ray_logininfo}","")
	'End If
	'-----------------------------------------------------------------	
	'-----------------------------------------------------------------	
	Response.Write ArrenStr
	ArrenStr=""	
End Function

'全网认证
Function challenge_check(mobile,password)
	'If Not(Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1) Then
	'	Dvbbs.AddErrCode(13)
	'	Exit Function
	'End If
	Dim rs,iUserID
	Dim MyForumID
	Dim PostChanWord
	'生成订单号:01+yyyyMMddhhmmss+六位随机数
	'生成日期字串
	Dim NowTimes,PayMonth,PayDay,PayHour,PayMin,PaySe,PayDayStr,RandomizeStr,num2
	Dim PayCode,PayCodeEnCode
	NowTimes = Now()
	PayMonth = Month(NowTimes)
	If Len(PayMonth)=1 Then PayMonth = "0" & PayMonth
	PayDay = Day(NowTimes)
	If Len(PayDay)=1 Then PayDay = "0" & PayDay
	PayHour = Hour(NowTimes)
	If Len(PayHour)=1 Then PayHour = "0" & PayHour
	PayMin = Minute(NowTimes)
	If Len(PayMin)=1 Then PayMin = "0" & PayMin
	PaySe = Second(NowTimes)
	If Len(PaySe)=1 Then PaySe = "0" & PaySe
	PayDayStr = Year(NowTimes) & PayMonth & PayDay & PayHour & PayMin & PaySe
	'生成随机字串
	Randomize
	Do While Len(RandomizeStr)<5
		num2 = CStr(Chr((57-48)*rnd+48))
		RandomizeStr = RandomizeStr & num2
	Loop
	PayCode = PayDayStr & RandomizeStr & Left(MD5(Dvbbs.Forum_ChanSetting(4)&Dvbbs.Forum_ChanSetting(6),32),8)
	Dim FoundMobile,UserAnswer,UserJoinTime
	Set Rs=Dvbbs.Execute("Select UserID,Passport,UserAnswer,JoinDate From Dv_User Where Passport = '"&Dvbbs.CheckStr(Mobile)&"'")
	If Rs.Eof And Rs.Bof Then
		FoundMobile = False
		Rs.Close:Set Rs=Nothing
		Set Rs=Dvbbs.Execute("Select Top 1 UserID,Passport,UserAnswer,JoinDate From Dv_User Order By UserID")
		iUserID = "-" & Rs(0)
		UserAnswer = Rs(2)
		UserJoinTime = Rs(3)
	Else
		FoundMobile = True
		iUserID = Rs(0)
		UserAnswer = Rs(2)
		UserJoinTime = Rs(3)
	End If
	Rs.Close
	Set Rs=Nothing
	Session("challengeWord_key") = MD5(PayCode & ":" & MD5(UserAnswer & ":" & FormatDateTime(UserJoinTime,2),32),32)
	Session("challengeUserID") = iUserID

	Dim TempStr,TempArray
	TempArray = Split(template.html(19),"||")
	TempStr = TempArray(0)
	TempStr = Replace(TempStr,"{$Dvbbs_Server}","http://www.dvbbs.net/passport/login.asp")
	TempStr = Replace(TempStr,"{$passport}",mobile)
	TempStr = Replace(TempStr,"{$userid}",iUserID)
	'TempStr = Replace(TempStr,"{$password}",password)
	'TempStr = Replace(TempStr,"{$MyForumID}",MyForumID)
	TempStr = Replace(TempStr,"{$serverurl}",Dvbbs.Get_ScriptNameUrl())
	TempStr = Replace(TempStr,"{$PostChanWord}",PayCode)
	TempStr = Replace(TempStr,"{$remobile}",mobile)
	TempStr = Replace(TempStr,"{$usermobile}",mobile)
	If FoundMobile Then
		TempStr = Replace(TempStr,"{$ifpassnull}","，您正在进行论坛通行证用户<B>快速登录</B>。请点击下一步继续。")
		TempStr = Replace(TempStr,"{$ifpassnull1}","如果您希望用此论坛通行证注册新用户，请登录论坛后修改当前用户绑定的论坛通行证为其它通行证帐号或取消通行证绑定。")
	Else
		TempStr = Replace(TempStr,"{$ifpassnull}","，您正在进行论坛通行证用户<B>快速注册</B>，请点击下一步继续。")
		TempStr = Replace(TempStr,"{$ifpassnull1}","本操作将引导您在本论坛注册，并且同步您在论坛通行证服务器上的用户基本信息。")
	End If
	Response.Write TempStr
	TempStr = ""
	set rs=nothing
	If not IsObject(Application(Dvbbs.CacheName & "_iplist")) Then
		SendData()
	ElseIf DateDiff("D",Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("@date").text,Date())<> 0 Then
		SendData()
	End If
	'Response.Write Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("@date").text
End Function

Function strAnsi2Unicode(asContents)
	Dim len1,i,varchar,varasc
	strAnsi2Unicode = ""
	len1=LenB(asContents)
	If len1=0 Then Exit Function
	  For i=1 to len1
	  	varchar=MidB(asContents,i,1)
	  	varasc=AscB(varchar)
	  	If varasc > 127  Then
	  		If MidB(asContents,i+1,1)<>"" Then
	  			strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
	  		End If
	  		i=i+1
	     Else
	     	strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
	     End If	
	  Next
End Function
Sub SendData()
	Dim xmlhttp,xml,DataToSend,xmlserverurl
  'on error resume next
  Set xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP"&MsxmlVersion)
	xmlserverurl="http://server.dvbbs.net/dvbbs/iplist.asp"
	xmlhttp.setTimeouts 65000, 65000, 65000, 65000
  xmlhttp.Open "POST",xmlserverurl,false
  xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  xmlhttp.send
  Set XML=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
  If XML.loadxml(strAnsi2Unicode(xmlhttp.responseBody)) Then
  	Xml.documentElement.selectSingleNode("@date").text=Date()
		Set Application(Dvbbs.CacheName & "_iplist")=Xml.cloneNode(true)
	End If
	Set xmlhttp = Nothing
End Sub

Function checkreal(v)
Dim w
If not isnull(v) Then
	w=replace(v,"|||","§§§")
	checkreal=w
End If
End Function


Rem ==========论坛登录函数=========
Rem 判断用户登录
Function ChkUserLogin(username,password,mobile,usercookies,ctype)

	Dim rsUser,article,userclass,titlepic
	Dim userhidden,lastip,UserLastLogin
	Dim GroupID,ClassSql,FoundGrade
	Dim regname,iMyUserInfo
	Dim sql,sqlstr,OLDuserhidden

	FoundGrade=False
	lastip=Dvbbs.UserTrueIP
	userhidden=request.form("userhidden")
	If userhidden <> "1" Then userhidden=2
	ChkUserLogin=false
	If mobile<>"" Then
		sqlstr=" Passport='"&mobile&"'"
	Else
		sqlstr=" UserName='"&username&"'"
	End If
	Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,lastlogin as cometime , LastLogin as activetime,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime,userid as boardid"
	Sql=Sql & " From [Dv_User] Where "&sqlstr&""
	set rsUser=Dvbbs.Execute(sql)
	If rsUser.eof and rsUser.bof Then
		ChkUserLogin=False
		Exit Function
	Else
		If rsUser("Lockuser") =1 Or rsUser("UserGroupID") =5 Then
			ChkUserLogin=False
			Exit Function
		Else
			If Trim(password)=Trim(rsUser("UserPassword")) Then
				ChkUserLogin=True
				Dvbbs.UserID=RsUser("UserID")
				RegName = RsUser("UserName")
				Article= RsUser("UserPost")
				UserLastLogin = RsUser("cometime")
				UserClass = RsUser("Userclass")		
				GroupID = RsUser("userGroupID")
				OLDuserhidden=RsUser("UserHidden")
				TitlePic = RsUser("UserTitle")
				If Article < 0  Then Article=0
				Set Dvbbs.UserSession=Dvbbs.RecordsetToxml(rsUser,"userinfo","xml")
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@cometime").text=Now()
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=0
				Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"isuserpermissionall","")).text=Dvbbs.FoundUserPermission_All()
				If OLDuserhidden <> CLng(userhidden) Then
					Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userhidden").text=userhidden
					Dvbbs.Execute("update Dv_user set userhidden="&userhidden&" where UserId=" & Dvbbs.UserID)
				End If
				Dim BS
				Set Bs=Dvbbs.GetBrowser()
				Dvbbs.UserSession.documentElement.appendChild(Bs.documentElement)
				If EnabledSession Then 	Session(Dvbbs.CacheName & "UserID")=Dvbbs.UserSession.xml
			Else
				ChkUserLogin=False
				Exit Function
			End If
		End If
	End If
	If ChkUserLogin Then
	REM 判断用户组(等级)资料，当用户级别为跟随文章数增长则自动更新用户组(等级)
	REM 自动更新用户数据
	REM 如果属于系统或特殊或多属性组
	Set rsUser=Dvbbs.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Dv_UserGroups Where UserGroupID="&GroupID)
	If Not (rsUser.Eof And rsUser.Bof) Then
		If rsUser(2)=1 Or rsUser(2)=2 Or rsUser(2)=4 Or rsUser(2)=5 Then
			'用户等级不按照文章升级，用户为系统或特殊或多属性组
			UserClass=rsUser(3)
			TitlePic=rsUser(4)
			FoundGrade=True
		End If
	End If
	If Not FoundGrade Then
		'如果不属于系统或特殊或多属性组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
		Set rsUser=Dvbbs.Execute("Select Top 1 usertitle,GroupPic,UserGroupID From Dv_UserGroups Where ParentGID=3 And Minarticle<="&Article&" Order By MinArticle Desc,UserGroupID")
		If Not (rsUser.Eof And rsUser.Bof) Then
			UserClass=rsUser(0)
			TitlePic=rsUser(1)
			GroupID=rsUser(2)
			FoundGrade=True
		End If
	End If
	Set rsUser=nothing
	If Not FoundGrade Then Response.Redirect "showerr.asp?ErrCodes=<li>系统没有找到您的注册用户组资料，请联系管理员进行修正。&action=OtherErr"
	select case ctype
	case 1
		If Datediff("d",UserLastLogin,Now())=0 Then
			sql="update [Dv_User] set LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
		Else
			sql="update [Dv_User] set userWealth=userWealth+"&Dvbbs.Forum_user(4)&",userEP=userEP+"&Dvbbs.Forum_user(9)&",userCP=userCP+"&Dvbbs.Forum_user(14)&",LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
		End If
	case 2
		sql="update [Dv_User] set UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Dvbbs.Forum_user(1)&",userEP=userEP+"&Dvbbs.Forum_user(6)&",userCP=userCP+"&Dvbbs.Forum_user(11)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
	case 3
		sql="update [Dv_User] set UserPost=UserPost+1,userWealth=userWealth+"&Dvbbs.Forum_user(2)&",userEP=userEP+"&Dvbbs.Forum_user(7)&",userCP=userCP+"&Dvbbs.Forum_user(12)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
	end select
	Dvbbs.Execute(sql)
	Dim StatUserID,UserSessionID
		StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
		If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
			StatUserID = Replace(Dvbbs.UserTrueIP,".","")
			UserSessionID = Replace(Startime,".","")
			If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
			StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
		End If
	StatUserID = Ccur(StatUserID)
	Dvbbs.Execute("delete from dv_online where  id="&StatUserID&"")
	If trim(username)<>trim(Dvbbs.membername) Then
		Response.Cookies(Dvbbs.Forum_sn)("username")=""
		Response.Cookies(Dvbbs.Forum_sn)("password")=""
		Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
		Response.Cookies(Dvbbs.Forum_sn)("userid")=""
		Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
		Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""
		Dvbbs.Execute("delete from dv_online where username='"&Dvbbs.membername&"'")
	End If
	If isnull(usercookies) or usercookies="" Then usercookies="0"
	select case usercookies
	case "0"
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	case 1
   		Response.Cookies(Dvbbs.Forum_sn).Expires=Date+1
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	case 2
		Response.Cookies(Dvbbs.Forum_sn).Expires=Date+31
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	case 3
		Response.Cookies(Dvbbs.Forum_sn).Expires=Date+365
		Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
	end select
	Response.Cookies(Dvbbs.Forum_sn).path = Dvbbs.cookiepath
	Response.Cookies(Dvbbs.Forum_sn)("username") = regname
	Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.UserID
	Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
	Response.Cookies(Dvbbs.Forum_sn)("userclass") = userclass
	Response.Cookies(Dvbbs.Forum_sn)("userhidden") = userhidden
	rem 清除图片上传数的限制
	Response.Cookies("upNum")=0
	Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@truepassword").text= TruePassWord
	Dvbbs.Membername=Dvbbs.Checkstr(regname)
	Dvbbs.Memberclass=Dvbbs.Checkstr(userclass)
	Dvbbs.UserGroupID=GroupID
	End If
End Function
%>
