<!--#include file="Conn.asp" -->
<!--#include file="inc/hl_md5.asp" -->
<!--#include file="inc/function.asp"-->
<!--#include file="inc/Upiconfig.asp"-->
<%
Dim useremail,userpassword,question,answer,RndPassword,OldPassword
Dim HLMd5Info,UpiMd5Info,UpiUserSex,conn1,DBPath1,rsreg,sql

Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "")
UpiMd5Info = UCase(Trim(Request("Md5Info")))
Action = ReplaceBadChar(Trim(Request("action")))
RegSiteId=Trim(Request("RegSiteId"))
username = ReplaceBadChar(replace(Trim(Request("name")),"'",""))
userpassword = replace(Trim(Request("pass")),"'","")
If Len(userpassword) = 32 Then userpassword = Mid(userpassword,9,16)
   question = Trim(Request("question"))
   answer = Trim(Request("answer"))
If Len(answer)=32 Then answer=Mid(answer,9,16)
UpiUserSex = Trim(Request("sex"))
TrueName=Trim(Request("TrueName"))
useremail = Trim(Request("email"))
UpiSaveCookies = Trim(Request("save"))
RndPassword = GetRndPassword(16)
OldPassword=ReplaceBadChar(Trim(Request("oldpass")))'验证旧密码
If Len(OldPassword)=32 Then OldPassword=Mid(OldPassword,9,16)
Dim v_ymd, v_hms, v_mmm
v_ymd = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
v_hms = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
Randomize
v_mmm = Right("0" & CStr(CInt(99 * Rnd) + 1), 2)
ClientNum = v_ymd & v_hms & v_mmm
					
'-----------------------------------------------------------------
Randomize
CheckNum = CStr(Int(7999 * Rnd + 2000)) & CStr(Int(7999 * Rnd + 2000)) '随机验证码
CheckUrl = Request.ServerVariables("HTTP_REFERER")
CheckUrl = Left(CheckUrl, InStrRev(CheckUrl, "/")) & "User_RegCheck.asp?Action=Check&UserName=" & UserName & "&Password=" & UserPassword & "&CheckNum=" & CheckNum
If Action="LogoutUser" then Call LogoutUser()
If Not (Action = "" or username = "" or UpiMd5Info = "") And HLIntegration = True Then
	   Md5OLD=0          '兼容PHP整合中文同步设置
 	   HLMd5Info = MD5(username&SecurityKey,32)
	If UpiMd5Info <> UCase(HLMd5Info) Then	
	   Md5OLD=1          '不兼容PHP整合中文同步设置
 	   HLMd5Info = MD5(username&SecurityKey,32)
	   If UpiMd5Info <> UCase(HLMd5Info) Then
	      Response.End()
	   End IF
	End IF	
	Select Case Action
		Case "AddUser"
			Call AddUser()		
		Case "LoginUser"
			Call LoginUser()
		Case "LogoutUser"
			Call LogoutUser()
		Case "ModifyInfo"
		        session("666")="1278786"		
			Call ModifyUserInfo()
		Case"ModifyPsw"
		       Call ModifyUserPsw()
		Case "DelUser"
			Call DelUser()
	End Select   
End If

Sub AddUser()
Dim rsConfig
    Set rsConfig = Conn.Execute("select top 1 * from PE_Config")
    If rsConfig.BOF And rsConfig.EOF Then
        rsConfig.Close
        Set rsConfig = Nothing
        Response.Write "网站配置数据丢失！系统无法正常运行！"
        Response.End
    Else
        EmailCheckReg = rsConfig("EmailCheckReg")
        AdminCheckReg = rsConfig("AdminCheckReg")
        EnableMultiRegPerEmail = rsConfig("EnableMultiRegPerEmail")
        UserNameLimit = rsConfig("UserNameLimit")
        UserNameMax = rsConfig("UserNameMax")
        UserName_RegDisabled = rsConfig("UserName_RegDisabled")
        PresentExp = rsConfig("PresentExp")
        PresentMoney = rsConfig("PresentMoney")
        PresentPoint = rsConfig("PresentPoint")
        PresentValidNum = rsConfig("PresentValidNum")
        PresentValidUnit = rsConfig("PresentValidUnit")
        EnableWap = rsConfig("EnableWap")
        ShowWapShop = rsConfig("ShowWapShop")
        EmailOfRegCheck = rsConfig("EmailOfRegCheck")
        EnableCheckCodeOfReg = rsConfig("EnableCheckCodeOfReg")
        EnableQAofReg = rsConfig("EnableQAofReg")
        QAofReg = rsConfig("QAofReg")
    End If
    rsConfig.Close
    Set rsConfig = Nothing
	UserTrueIP = ReplaceBadChar(UserTrueIP)
    Set rsReg = Conn.Execute("select max(UserID) from PE_User")
    If IsNull(rsReg(0)) Then
       MaxUserID = 0
    Else
    MaxUserID = rsReg(0)
    End If
    Set rsReg = Nothing
	
session("a")=MaxUserID+100
Dim sqlReg, rsReg, trs, RndPassword
    Set trs = Conn.Execute("select max(UserID) from PE_User")
    If IsNull(trs(0)) Then
        UserID = 1
    Else
        UserID = trs(0) + 1
		
    End If
    Set trs = Nothing
	
    sqlReg = "select * from PE_User "
    Set rsReg = Server.CreateObject("adodb.recordset")
    rsReg.Open sqlReg,Conn,1,3
    RndPassword = GetRndPassword(16)
    rsReg.addnew
    rsReg("UserID") = UserID
    rsReg("ClientID") = 0
    rsReg("ContacterID") = 0
    rsReg("UserType") = 0
    rsReg("UserName") = username
    rsReg("UserPassword") = userpassword
    rsReg("LastPassword") = RndPassword
    rsReg("Question") = question
    rsReg("Answer") = answer
    rsReg("Email") = useremail
    rsReg("RegTime") = Now()
    rsReg("LoginTimes") = 0
    rsReg("IsLocked") = False
    rsReg("Balance") = PresentMoney
    rsReg("UserExp") = PresentExp
    rsReg("PostItems") = 0
    rsReg("PassedItems") = 0
    rsReg("DelItems") = 0
    rsReg("UnsignedItems") = ""
    rsReg("UnreadMsg") = 0
    rsReg("arrClass_Browse") = ""
    rsReg("arrClass_View") = ""
    rsReg("arrClass_Input") = ""
    rsReg("UserSetting") = ""
    rsReg("UserFriendGroup") = "黑名单$我的好友"
    rsReg("LoginTimes") = 1
    rsReg("LastLoginIP") = UserTrueIP
    rsReg("LastLoginTime") = Now()
    rsReg("LastPresentTime") = Now()
	If EmailCheckReg = True Then
        Dim strMailBody
        strMailBody = Replace(EmailOfRegCheck, "{$CheckNum}", CheckNum)
        strMailBody = Replace(strMailBody, "{$CheckUrl}", CheckUrl)

        Dim PE_Mail
        Set PE_Mail = CreateObject("PE_CMS6.SendMail")
        PE_Mail.iConn = Conn
        ErrMsg = PE_Mail.Send(Email, UserName, "注册确认信", strMailBody, SiteName, WebmasterEmail, 3)
        Set PE_Mail = Nothing
        Set trs = Conn.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=0")
    Else
        If AdminCheckReg = True Then
            Set trs = Conn.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=1")
        Else
            Set trs = Conn.Execute("select GroupID,GroupSetting from PE_UserGroup where GroupType=2")
        End If
    End If
    Dim GroupID, GroupSetting
    GroupID = trs(0)
	response.Write "<br>groupid="&GroupID
    GroupSetting = Split(trs(1), ",")
    Set trs = Nothing
    rsReg("GroupID") = GroupID
    'rsReg("ChargeType") = GroupSetting(14)
    rsReg("UserPoint") = PresentPoint
    rsReg("BeginTime") = FormatDateTime(Now(), 2)
    rsReg("ValidNum") = PresentValidNum
    rsReg("ValidUnit") = PresentValidUnit
    rsReg("CheckNum") = CheckNum
    rsReg("SpecialPermission") = False
    rsReg.Update
    rsReg.Close
    Set rsReg = Nothing
    Response.Cookies(Site_Sn)("UserName") = username
    Response.Cookies(Site_Sn)("UserPassword") = userpassword
    Response.Cookies(Site_Sn)("LastPassword") = RndPassword
	
	 If PresentMoney > 0 Then
        Conn.Execute ("insert into PE_BankrollItem (UserName,ClientID,DateAndTime,[Money],MoneyType,CurrencyType,eBankID,Bank,Income_PayOut,OrderFormID,PaymentID,Remark,LogTime,IP,Inputer) values('" & UserName & "',0," & PE_Now & "," & PresentMoney & ",4,1,0,'',1,0,0,'注册新用户，赠送资金'," & PE_Now & ",'" & UserTrueIP & "','System')")
    End If
    If PresentPoint > 0 Then
        Conn.Execute ("insert into PE_ConsumeLog (UserName,ModuleType,InfoID,Point,Income_Payout,Remark,LogTime,Times,IP,Inputer) values ('" & UserName & "',0,0," & PresentPoint & ",1,'注册新会员，赠送" & PointName & "'," & PE_Now & ",1,'" & UserTrueIP & "','System')")
    End If
    If PresentValidNum > 0 Or PresentValidNum = -1 Then
        Conn.Execute ("insert into PE_RechargeLog (UserName,ValidNum,ValidUnit,Income_Payout,Remark,LogTime,IP,Inputer) values ('" & UserName & "'," & PresentValidNum & "," & PresentValidUnit & ",1,'注册新会员，赠送有效期'," & PE_Now & ",'" & UserTrueIP & "','System')")
    End If
 rsReg.update
 rs.close
 set rs=nothing
 if link=1 then Call RegSiteID()
 
End Sub '注册新用户===end========

Sub LoginUser()'用户登录==============begin
RndPassword = GetRndPassword(16)
 Set rs = Server.CreateObject("adodb.recordset")
            sql = "select UserID,UserName,UserPassword,LastPassword,LastLoginIP,LastLoginTime,LoginTimes from PE_User where UserName='" & UserName & "'"
            rs.Open sql, Conn, 1, 3
			If rs.bof And rs.EOF Then
			Exit Sub
			Else
			   If rs("UserPassword")=userpassword then
			rs("LastPassword") = RndPassword
            rs("LastLoginIP") = Request.ServerVariables("REMOTE_ADDR")
            rs("LastLoginTime") = Now()
            rs("LoginTimes") = rs("LoginTimes") + 1
            rs.Update
			
			Select Case UpiSaveCookies
                Case 0
                    'not save
                Case 1
                    Response.Cookies(Site_Sn).Expires = Date + 1
                Case 2
                    Response.Cookies(Site_Sn).Expires = Date + 31
                Case 3
                    Response.Cookies(Site_Sn).Expires = Date + 365
            End Select

			Response.Cookies(Site_Sn)("UserName") = username
            Response.Cookies(Site_Sn)("UserPassword") = userpassword
            Response.Cookies(Site_Sn)("LastPassword") = Rndpassword
            Response.Cookies(Site_Sn)("CookieDate") = UpiSaveCookies
			   End If
			End If
			rs.close
			set rs=nothing
			
End Sub '登陆用户

Sub LogoutUser()
Response.Cookies(Site_Sn)("UserName") = ""
Response.Cookies(Site_Sn)("UserPassword") = ""
Response.Cookies(Site_Sn)("LastPassword") = ""
End Sub '登销登陆

Sub ModifyUserInfo()
	On Error Resume Next
	Dim tempSQL
	session("777")=City
	tempSQL = "UPDATE PE_User Set "
		
	If question <> "" Then
		tempSQL = tempSQL & "Question='" & question & "'"
	End If
	If answer <> "" and Len(answer) = 16 Then
		tempSQL = tempSQL & ",Answer='" & answer & "'"
	End If
	If useremail <> "" Then
		tempSQL = tempSQL & ",Email='" & useremail & "'"
	End If
	If UpiUserSex <> "" and IsNumeric(UpiUserSex) Then
		If UpiUserSex <0 or UpiUserSex > 1 Then UpiUserSex = 0
		tempSQL = tempSQL & ",Sex='" & UpiUserSex&"'"
	End If
	If truename <> "" Then
		tempSQL = tempSQL & ",TrueName='" & truename & "'"
	End If
	
	tempSQL = tempSQL & " WHERE UserName='" & username & "'and UserPassword='"&userpassword&"'"
	conn.Execute(TempSQL)
	
End Sub

Sub DelUser()'=======================删除用户
Dim SqlDel,RsDel,DleName,DleoneName,str,j
DleoneName = Split(username, ",")
str=""
For j = 0 To UBound(DleoneName)
str=str+"UserName='"&Trim(DleoneName(j))&"' or "
Next
str=str+"r"
str=replace(str,"or r","")
set RsDel=server.CreateObject("Adodb.recordset")
    SqlDel="delete * from PE_User where "&str
	response.Write SqlDel
	RsDel.open SqlDel,conn,1,3
	RsDel.close
	Set RsDel=nothing
End Sub

Sub ModifyUserPsw()
Dim temp1SQL
temp1SQL = "UPDATE PE_User Set "
temp1SQL = temp1SQL & "UserPassword='" & userpassword & "'"
temp1SQL = temp1SQL & " WHERE UserName='" & username & "'and UserPassword='"&OldPassword&"'"
Response.Cookies(Site_Sn)("UserPassword") = userpassword
conn.Execute(Temp1SQL)
end sub

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    ReplaceBadChar = tempChar
End Function

Function PE_CLng(ByVal str1)
    If IsNumeric(str1) Then
        PE_CLng = CLng(str1)
    Else
        PE_CLng = 0
    End If
End Function

Function PE_CDbl(ByVal str1)
    If IsNumeric(str1) Then
        PE_CDbl = CDbl(str1)
    Else
        PE_CDbl = 0
    End If
End Function

Sub RegSiteID()
set rs_1=server.CreateObject("adodb.recordset")'检查是否有注册目标系统reg_site包含注册系统的id
    str_1="select reg_site,id from hl_user where username='"&replace(request("name"),"'","")&"'"
	RegSiteIds=request("RegSiteId")
	rs_1.open str_1,conns,1,3
	if InStr(rs_1("reg_site"),RegSiteIds)>0 then 
	  response.End()
	   else
	   RegSiteIds=rs_1("reg_site")&","&RegSiteIds
	   rs_1("reg_site")=RegSiteIds
	   rs_1.update
	   rs_1.close
	   set rs_1=nothing
	end if
	
End sub
%>
<%
'===================================================
' HoWaveV4.05                      请保留此版权信息
'				Powered by HoWave.Net
'===================================================
' Mail: websky888@126.com 
' Q  Q: 18469685, 615939753    Tel:020-88386767
' Web : http://www.HoWave.net, http://www.jsp163.com
' Bbs : http://bbs.HoWave.net, http://bbs.jsp163.com
' Copyright (C) 2005 HoWave.net All Rights Reserved.
'===================================================
%>