login.asp

强大的PHP内容管理系统尽量不要让站长把时间都花费在为您修正说明上。压缩包解压

	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 redir()

	Dim ErrorCode,ErrorMsg
	Dim remobile,rechallengeWord,retokerWord,reuserpassword
	Dim resex,reqq,reemail,reusername
	Dim challengeWord_key,rechallengeWord_key
	Dim userclass
	Dim rs,iUserID

	ErrorCode=trim(request("ErrorCode"))
	ErrorMsg=trim(request("ErrorMsg"))
	remobile=trim(Dvbbs.CheckStr(request("passport")))
	reuserpassword=trim(Dvbbs.CheckStr(request("password")))
	rechallengeWord=trim(Dvbbs.CheckStr(request("seqno")))
	retokerWord=trim(request("token"))
	'reemail=trim(Dvbbs.CheckStr(request("email")))
	'resex=trim(Dvbbs.CheckStr(request("sex")))
	'If resex="F" Then 
	'	resex=1
	'Else
	'	resex=0
	'End If
	'reqq=trim(Dvbbs.CheckStr(request("qq")))
	'reusername=trim(Dvbbs.CheckStr(request("username")))

	Session("re_challenge_reg_temp")=checkreal(remobile) & "|||" & checkreal(remobile)
	iUserID = Session("challengeUserID")
	If iUserID = "" Or Not IsNumeric(iUserID) Then
		Response.Redirect "index.asp"
		Exit Function
	End If
	iUserID = cCur(iUserID)

	If ErrorCode = "1" Then
		challengeWord_key=Session("challengeWord_key")
		If challengeWord_key=retokerWord Then
			Set Rs=Dvbbs.Execute("Select Passport,IsChallenge,UserID,UserClass,UserName,UserPassword From [Dv_User] Where Passport='"&remobile&"'")
			'用论坛通行证新用户注册或绑定用户
			If Rs.Eof And Rs.Bof Then
				redir_reg_1()
				Exit Function
			'已绑定通行证用户进行登录,此处仅设置用户为登录状态而不更新其帐号信息
			Else
				Dvbbs.UserID=Rs(2)
				UserClass=Rs(5)
				reUserName=Rs(4)
				If Rs("IsChallenge")=0 Then Dvbbs.Execute("Update Dv_User Set IsChallenge = 1 Where UserID = " & Rs(2))
			End If
		Else
			'Response.Write session("challengeWord")&"||"&rechallengeWord
			'Response.End
			Response.Redirect "showerr.asp?ErrCodes=<li>本地验证失败2，可能的原因有：网络超时、非法的提交请求。&action=OtherErr"
			'challengeWord_key & "," & retokerWord & "," & md5(Session("challengeWord") & ":" & "raynetwork",32) & "<br>原始随机数："&Session("challengeWord")&",返回随机数："&rechallengeWord&""
			Exit Function
		End If
	Else
		Response.redirect "showerr.asp?ErrCodes=<li>"&ErrorMsg&"&action=OtherErr"
		Exit Function
	End If

	Dim TempStr
	TempStr = template.html(20)
	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
	TempStr = Replace(TempStr,"{$reuserpassword}",reuserpassword)
	TempStr = Replace(TempStr,"{$forumname}",Dvbbs.Forum_Info(0))
	Response.Write TempStr
	TempStr=""
	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)
	If ChkUserLogin(reusername,userclass,"",0,1) Then userclass=""
	Session("challengeUserID") = Empty
	Session("challengeWord_key") = Empty
	Session("re_challenge_reg_temp") = Empty
	
End Function

Sub redir_reg_1()

	If Session("re_challenge_reg_temp")="" Then
		Dvbbs.AddErrCode(14)
		exit sub
	End If

	Dim re_challenge_reg_temp
	re_challenge_reg_temp=split(Session("re_challenge_reg_temp"),"|||")

	Dim TempStr
	TempStr = template.html(21)
	TempStr = Replace(TempStr,"{$maxuserlength}",Dvbbs.Forum_Setting(41))
	TempStr = Replace(TempStr,"{$minuserlength}",Dvbbs.Forum_Setting(40))
	TempStr = Replace(TempStr,"{$reusername}",re_challenge_reg_temp(0))
	TempStr = Replace(TempStr,"{$passport}",re_challenge_reg_temp(1))
	TempStr = Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
	Response.Write TempStr
End Sub

Sub save_redir_reg()
	If Session("re_challenge_reg_temp")="" Then
		Dvbbs.AddErrCode(14)
		Exit Sub
	End If

	Dim username,sex,pass1,pass2,password,ErrCodes
	Dim useremail,face,width,height
	Dim oicq,sign,showRe,birthday
	Dim mailbody,sendmsg,rndnum,num1
	Dim quesion,answer,topic
	Dim userinfo,usersetting
	Dim userclass,UserIM
	Dim re_challenge_reg_temp
	Dim rs,sql,i,namebadword,SplitWords
	Dim t
	Dim StatUserID,UserSessionID
	Dim TempStr
	t = Request("t")
	If t = "" Or Not IsNumeric(t) Then t = 1
	t = Cint(t)
	If t <> 1 And t <> 2 Then t = 1
	re_challenge_reg_temp=split(Session("re_challenge_reg_temp"),"|||")

	If Request("name")="" or strLength(Request("name"))>Cint(Dvbbs.Forum_Setting(41)) or strLength(Request("name"))<Cint(Dvbbs.Forum_Setting(40)) Then
		Dvbbs.AddErrCode(17)
	Else
		username=Dvbbs.CheckStr(Trim(Request("name")))
	End If

	If Instr(username,"=")>0 or Instr(username,"%")>0 or Instr(username,chr(32))>0 or Instr(username,"?")>0 or Instr(username,"&")>0 or Instr(username,";")>0 or Instr(username,",")>0 or Instr(username,"'")>0 or Instr(username,",")>0 or Instr(username,chr(34))>0 or Instr(username,chr(9))>0 or Instr(username,"