reg.asp

网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。

<!--#include file="inc/Conn.asp"-->
<!--#include file="Inc/Cls.Common.asp"-->
<!--#include file="Inc/Cls.Templates.asp"-->
<!--#include file="API/HiAPI/Class_API.asp"-->
<%
If Int(WR_User(0)) < 1 Then Call WRMPS.ErrView("·会员注册功能暂时关闭，请稍侯再试！<meta http-equiv=refresh content='100;URL=Index.asp'>",0)
Dim UserName,Pass,PassWord,Code,i,Question,Answer,Flag,regSaveType,NowLoginTime,CountOut,Integral,CodeAnswer
Dim API
Call DBConnBegin()
Set Rs=server.createobject("adodb.recordset")
Select Case WRMPS.CheckStr(Request("Action"),0)
  Case "Check"
    Select Case WRMPS.CheckStr(Request("w"),0)
	  Case "u"
	    UserName = WRMPS.CheckStr(Request("User"),0)
	    '判断用户名是否禁用
        If WRUser.RegUserName(UserName) Then Response.write "<span style=""color:red;font-weight:bold"">此用户名禁止注册</font>":Response.end
		SQL = " Where WM_UserName ='"&UserName&"'"
	    Set Rs = Conn.Execute("Select Top 1 WM_ID From WM_Member"&SQL)
	    If Not Rs.Eof Then
	      Response.write "<span style=""color:red;font-weight:bold"">此用户名已被注册</font>"
		  Response.end
	    End If
	    Rs.CLose
        Set Rs = Nothing
	    'API整合接口
	    If API_Enable Then
		  Set API = New API_WRMPS
		  API.LoadXmlFile True
		  API.UserName=UserName
		  'API.email=Email
		  Call API.ProcessMultiPing("checkname")
	    End If
	    Response.write "此用户名可以注册"
	  Case "e"
        Email = WRMPS.CheckStr(Request("Email"),0)
		SQL = " Where WM_Email ='"&Email&"'"
	    Set Rs = Conn.Execute("Select Top 1 WM_ID From WM_Member"&SQL)
	    If Not Rs.Eof Then
	      Response.write "<span style=""color:red;font-weight:bold"">此邮箱已被注册</font>"
		  Response.end
	    End If
	    Rs.CLose
        Set Rs = Nothing
	    Response.write "此邮箱可以注册"
	End Select

  Case "Reg"
      Call WRMPS.CheckSubmit()
      UserName = WRMPS.CheckStr(Request.Form("UserName"),0)
      Email = WRMPS.CheckStr(Request.Form("Email"),0)
      PassWord = WRMPS.CheckStr(Request.Form("PassWord"),0)
	  Pass = WRMPS.CheckStr(Request.Form("Pass"),0)
	  Question = WRMPS.CheckStr(Request.form("Question"),0)
	  Answer = WRMPS.CheckStr(Request.form("Answer"),0)
	  Code = WRMPS.CheckStr(Request.form("Code"),0)
	  CodeAnswer = WRMPS.CheckStr(Request.form("CodeAnswer"),0)
	  If UserName = "" Or Len(UserName) < Int(Split(WR_User(3),"|")(0)) Or Len(UserName) > Int(Split(WR_User(3),"|")(1)) Then Call WRMPS.ErrView("·用户名不正确",0)
	  '判断用户名是否禁用
      If WRUser.RegUserName(UserName) Then Call WRMPS.ErrView("·此用户名禁止注册",0)
	  '判断同一IP注册间隔时间
      If WRUser.RegIPTime Then Call WRMPS.ErrView("·系统限制同一IP注册时间间隔为"&WR_User(5)&"分钟",0)
	  If Email = "" Then Call WRMPS.ErrView("·请填写邮箱地址",0)
	  If PassWord = "" Or Len(PassWord) < Int(Split(WR_User(4),"|")(0)) Or Len(PassWord) > Int(Split(WR_User(4),"|")(1)) Then Call WRMPS.ErrView("·用户密码不正确",0)
	  If Pass <> PassWord Then Call WRMPS.ErrView("·确认密码不正确",0)
	  If Question = "" Then Call WRMPS.ErrView("·请填写密码提示问题",0)
	  If Answer = "" Then Call WRMPS.ErrView("·请填写密码提示答案",0)
	  If WRMPS.CheckCode("Reg",1) Then If Code <> WRMPS.GetCookies("Code") Then Call WRMPS.ErrView("·验证码不正确",0)
	  If WRMPS.CheckCode("Reg",2) and UBound(WR_CodeQA) >= 0 Then If Split(WR_CodeQA(WRMPS.GetCookies("IDQuestionNo")),"|")(1) <> CodeAnswer Then Call WRMPS.ErrView("·验证问题答案不正确",0)
	  WRMPS.DelCookies "IDQuestionNo"
      WRMPS.DelCookies "Code"
	  'API整合接口
	  If API_Enable Then 
		Set API = New API_WRMPS
		API.LoadXmlFile True
		API.UserName=UserName
		API.PassWord=PassWord
		API.EMail=Email
		API.Question=Question
		API.Answer=Answer
		API.Sex=1
        Select Case Int(WR_User(7))
		  Case 0
		    API.UserStatus = 4
		  Case 1
		    API.UserStatus = 0
		End Select
		Call API.ProcessMultiPing("reguser")
		Set API=Nothing
		Dim strUrl,turl
		For i=0 To UBound(aUrls)
			strUrl=Lcase(aUrls(i))
			If Left(strUrl,7)="http://" Then																
				turl=strUrl&"?syskey="&MD5(1,UserName&API_Key)&"&username="&UserName&"&password="&MD5(1,PassWord)&"&savecookie=0@@@"& turl
			End If
		Next
		WRMPS.SCookies "ApiUrl",turl,0
	  End If
	  RegSaveType = WRUser.RegSave(UserName,PassWord,Email,Question,Answer,Int(WR_User(7)),Null,Null,Null,Null,Null)
	  If RegSaveType <> "" and IsNUll(RegSaveType) = False Then Call WRMPS.ErrView(RegSaveType,0)

	  If Int(WR_User(7)) = 0 Then
	    Call WRMPS.ErrView("·用户注册成功，请等待管理员的审核<br>·1秒钟后自动跳转到首页<meta http-equiv=refresh content='1;URL=Index.asp'>",1)
	  Else
	    Set Rs = Conn.Execute("Select WM_ID,WM_GroupID,WM_Flag From WM_Member Where WM_UserName='"&UserName&"'")
	    If Not Rs.Eof Then
		   Flag = Rs(2)
	       Integral = Int(Split(Split(Flag,"§")(0),"|")(3))
	       CountOut = Int(Split(Split(Flag,"§")(0),"|")(4))
		   Call WRDB.SaveConsume(1,UserName,0,CountOut,Integral,0,"第一次登录")
	       'API整合接口
	       If API_Enable Then 
				Set API = New API_WRMPS
				API.LoadXmlFile True
				API.UserName=UserName
				API.PassWord=PassWord
				API.CookieDate=0
				Call API.ProcessMultiPing("login")
				Set API=Nothing
				For i=0 To UBound(aUrls)
					strUrl=Lcase(aUrls(i))
					If Left(strUrl,7)="http://" Then
					  Response.Write "<script language=JAVASCRIPT src="""&strUrl&"?syskey="&MD5(1,UserName&API_Key)&"&username="&UserName&"&password="&MD5(1,PassWord)&"&savecookie=0""></script>"																
					End If
				Next
	       End If
		   Call WRUser.Login(0,UserName,Rs(0),Rs(1),Flag,WRMPS.GetCache("FlagTime"),MD5(2,PassWord))
		Else
          Call WRMPS.ErrView("·用户注册出错，操作错误<meta http-equiv=refresh content='1;URL=Index.asp'>",0)
	    End If
	    Call WRMPS.ErrView("·用户注册成功，1秒钟后自动跳转到用户管理页面<meta http-equiv='refresh' content='3;URL="&WR_Setting(3)&"Member/'>",1)
	  End If
	  Set Rs = Nothing
	
  Case Else
    Dim IDQuestionNo
	Randomize Timer
	IDQuestionNo = int(rnd*UBound(WR_CodeQA))
	WRMPS.SCookies "IDQuestionNo",IDQuestionNo,0
    SitePath = ",<a href="&WR_Setting(3)&"Reg.asp>会员注册</a>"
	SitePath = WRMPS.GetSitePath(0,SitePath)
	Call WRMPS.FsoBegin()
	TempStr = WRTemp.SiteTemplates(1,0,3,0)
	Call WRMPS.FsoEnd()
	TempStr = WRMPS.GetReplace(TempStr,"{$IDQuestion}",Split(WR_CodeQA(IDQuestionNo),"|")(0))
	If Instr(TempStr,"{$IDCode}") > 0 Then
	  TempStr = WRMPS.GetReplace(TempStr,"{$IsIDCode}",WRMPS.CheckCode("Reg",1))
	  If WRMPS.CheckCode("Reg",1) Then
		  TempStr = WRMPS.GetReplace(TempStr,"{$IDCode}","")
	  Else
	      TempStr = WRMPS.GetReplace(TempStr,"{$IDCode}"," style=""display:none""")
	  End If
    End If
	If Instr(TempStr,"{$IDQACode}") > 0 and UBound(WR_CodeQA) >= 0 Then
	  TempStr = WRMPS.GetReplace(TempStr,"{$IsIDQACode}",WRMPS.CheckCode("Reg",2))
	  If WRMPS.CheckCode("Reg",2) Then
		  TempStr = WRMPS.GetReplace(TempStr,"{$IDQACode}","")
	  Else
	      TempStr = WRMPS.GetReplace(TempStr,"{$IDQACode}"," style=""display:none""")
	  End If
	Else
	  TempStr = WRMPS.GetReplace(TempStr,"{$IDQACode}"," style=""display:none""")
    End If
	TempStr = WRTemp.SiteLabel(TempStr)
	Call ClassEnd()
	Response.write TempStr
End Select
Set Rs = Nothing
Call DBConnEnd()
%>