<!--#include file="inc/inc_syssite.asp"-->
<!--#include file="inc/inc_antispam.asp"-->
<!--#include file="inc/class_blog.asp"-->
<!--#include file="inc/hl_md5.asp"-->
<!--#include file="inc/upiconfig.asp"-->
<%
'*********Design By Jackie For HoWaveV4.05_Oblog4.0_0905*****
'***************定义接口变量*********************************
Dim Action,UpiUserName,UpiUserPass,UpiMd5Info,UpiQuestion,UpiAnswer,UpiEmail,UpiUserSex,UpiSaveCookies,OldPassword
Dim HLMd5Info

Action = Trim(Request("action"))                           '---接口动作
UpiUserName = oblog.filt_badstr(Trim(Request("name")))     '---用户名
UpiUserPass = oblog.filt_badstr(Trim(Request("pass")))     '---密码
UpiMd5Info = Ucase(Trim(Request("Md5Info")))               '---密钥
UpiQuestion = oblog.filt_badstr(Trim(Request("question"))) '---问题
UpiAnswer = Trim(Request("answer"))                        '---答案
UpiEmail = oblog.filt_badstr(Trim(Request("email")))       '---邮箱
UpiUserSex = Trim(Request("sex"))                          '---性别
UpiSaveCookies = Trim(Request("save"))                     '---Cookie保存时间
OldPassword=oblog.filt_badstr(Trim(Request("oldpass"))) 
'***********将32位加密转换成16位***********************   
If Len(UpiUserPass) = 32 Then UpiUserPass = Mid(UpiUserPass,9,16)
If Len(UpiAnswer)=32 Then UpiAnswer=Mid(UpiAnswer,9,16)
If Len(OldPassword) = 32 Then OldPassword = Mid(OldPassword,9,16)
'***********收到退出命令后执行退出子程序***************
If Action="LogoutUser" Then Call LogoutUser()

If Not (Action = "" or UpiUserName = "" or UpiMd5Info = "" ) And HLIntegration = True Then
	   Md5OLD=0          '整合中文同步设置兼容PHP
	   HLMd5Info = MD5(UpiUserName&SecurityKey,32)	   
	If UpiMd5Info <> UCase(HLMd5Info) Then	
	   Md5OLD=1          '整合中文同步设置不兼容PHP
 	   HLMd5Info = MD5(UpiUserName&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"
			Call ModifyUserInfo()
		Case"ModifyPsw"
		    Call ModifyUserPsw()
		Case "DelUser"
			Call DelUser()
   End Select
	
End If

Sub LoginUser()
	dim rearr,gohref	
	if oblog.chkiplock() then
		oblog.adderrstr("对不起！你的IP已被锁定,不允许登录，！")
	end if	
	if UpiSaveCookies="" then UpiSaveCookies=0	else UpiSaveCookies=Clng(UpiSaveCookies)	
		oblog.ob_chklogin UpiUserName,UpiUserPass,UpiSaveCookies   
	
End Sub

Sub LogoutUser()

	If cookies_domain <> "" Then
        response.Cookies(cookies_name).domain = cookies_domain
    End If
	    Response.Cookies(cookies_name)("username")=oblog.CodeCookie("")
	    Response.Cookies(cookies_name)("password")=oblog.CodeCookie("")
	    Response.Cookies(cookies_name)("userurl")=oblog.CodeCookie("")
	
	Set oBlog=Nothing
	response.End()
End Sub

Sub AddUser()
Dim rsreg, sql, ajax, buttonface, rearr
    Dim regusername, regpassword, sex, question, answer, email, reguserlevel, userispass, blogname, usertype, nickname
    Dim re_regpassword, user_domain, user_domainroot
	Dim ErrMessages
	Dim userRegfloder  
   ' chk_regtime()  '屏蔽注册时间限制
	ErrMessages=""
    regusername = UpiUserName
    regpassword = UpiUserPass    
    email = UpiEmail
    question = UpiQuestion
    answer = UpiAnswer
    blogname =  UpiUserName&"的博客"
    usertype =1	
  
	user_domain = ""
    user_domainroot = ""
    If regusername = "" Or oblog.strLength(regusername) > 14 Or oblog.strLength(regusername) < 4 Then ErrMessages="用户名不能为空(不能大于14小于4)！"
'    If oblog.chk_regname(regusername) Then ErrMessages="用户名已经存在或系统不允许注册！"
    If oblog.chk_badword(regusername) > 0 Then ErrMessages="用户名中含有系统不允许的字符！"
    If en_nameisnum = 0 And IsNumeric(regusername) Then ErrMessages="用户名不允许全部为数字！"
'   If oblog.chkdomain(regusername) = False Then ErrMessages="用户名不合规范，只能使用小写字母，数字及下划线！"
'    If oblog.CacheConfig(4) <>"" And oblog.CacheConfig(5) = 1 Then
'        If user_domain = "" Or oblog.strLength(user_domain) > 14 Then ErrMessages="域名不能为空(不能大于14个字符)！"
'        If user_domain <> request("old_userdomain") And oblog.strLength(user_domain) < 4 Then ErrMessages="域名不能小于4个字符！"
'        If oblog.chk_regname(user_domain) Then ErrMessages="此域名系统不允许注册！"
'        If oblog.chk_badword(user_domain) > 0 Then ErrMessages="域名中含有系统不允许的字符！"
'        If oblog.chkdomain(user_domain) = False Then ErrMessages="域名不合规范，只能使用小写字母，数字！"
'        If user_domainroot = "" Then ErrMessages="域名根不能为空！"
'		If oblog.CheckDomainRoot(user_domainroot) = False Then oblog.adderrstr  ("域名根不合法！")
'    End If

    If oblog.chk_badword(blogname) > 0 Then ErrMessages="blog名中含有系统不允许的字符！"
    If InStr(regusername, "=") > 0 Or InStr(regusername, "%") > 0 Or InStr(regusername, Chr(32)) > 0 Or InStr(regusername, "?") > 0 Or InStr(regusername, "&") > 0 Or InStr(regusername, ";") > 0 Or InStr(regusername, ",") > 0 Or InStr(regusername, "'") > 0 Or InStr(regusername, ",") > 0 Or InStr(regusername, Chr(34)) > 0 Or InStr(regusername, Chr(9)) > 0 Or InStr(regusername, "") > 0 Or InStr(regusername, "$") > 0 Then ErrMessages="用户名中含有非法字符！"
    '进行重复性判断22/47/25
    If oblog.CacheConfig(22)="1" Then
    	Set rsreg=oblog.execute("select Count(userid) From oblog_user Where useremail='" &email & "'")
    	If rsreg(0)>0 Then
    		ErrMessages="您使用的Email: " & email & " 已被他人使用，请更换其他Email"
    	End If
    	rsreg.Close
	End If
	If oblog.CacheConfig(25)="1" Then
		Set rsreg=oblog.execute("select Count(userid) From oblog_user Where blogname='" & blogname & "'")
    	If rsreg(0)>0 Then
    		ErrMessages="您使用的博客名称: " & blogname & " 已被他人使用，请更换博客名称"
    	End If
    	rsreg.Close
	End If
    '进行IP控制
	Dim sIP
    sIP=oblog.userip
    If oblog.CacheConfig(21)>"0" Then
	    sql="select Count(userid) from oblog_user where regip='"& sIP &"' And "
	    If Is_sqldata = 1 Then
	        sql = sql & " Datediff(hour,adddate,getdate())<=1"
	    Else
	        sql = sql & " Datediff('h',adddate,Now())<=1"
	    End If
	    Set rsreg = oblog.execute(sql)
	    If rsreg(0) > CInt(oblog.CacheConfig(21)) Then 
	    	oblog.KillIP(sIP)
	    	ErrMessages="您的IP因为恶意注册被临时禁止"
			rsreg.Close
			Response.Write ErrMessages
			response.end
	    End If
    	rsreg.Close
    End If
    If oblog.CacheConfig(14) > "0"  Then
        sql="select Count(userid) from oblog_user where regip='"& sIP &"' And "
        If Is_sqldata = 1 Then
            sql = sql & " Datediff(hour,adddate,getdate())<=24"
        Else
            sql = sql & " Datediff('h',adddate,Now())<=24"
        End If
        Set rsreg = oblog.execute(sql)
        If rsreg(0) > CInt(oblog.CacheConfig(14)) Then
           '进行IP屏蔽
           	oblog.KillIP(sIP)
			'进行批量屏蔽
           oblog.execute("Update [oblog_user] Set user_level=6 Where regip='"&oblog.userip&"'")
            ErrMessages="您的IP因为恶意注册而被系统禁止"
			rsreg.Close
			Response.Write ErrMessages
			response.end
        End If
        rsreg.Close
    End If
'    If user_domain <> "" Then
'        Set rsreg = oblog.execute("select userid from oblog_user where user_domain='" & oblog.filt_badstr(user_domain) & "' and user_domainroot='" & oblog.filt_badstr(user_domainroot) & "'")
'        If Not rsreg.EOF Or Not rsreg.bof Then ErrMessages="系统中已经有这个域名存在，请更改域名！"
'    End If
    If ErrMessages <> "" Then
		Response.Write ErrMessages
		response.end
	end if
    '是否需要审核
    If oblog.CacheConfig(18) = 1 Then reguserlevel = 6 Else reguserlevel = 7

    If Not IsObject(conn) Then link_database
    Set rsreg = server.CreateObject("adodb.recordset")
    rsreg.open "select * from [oblog_user] where username='" & oblog.filt_badstr(regusername) & "'", conn, 1, 3
    If rsreg.EOF Then
    	rsreg.addnew
        rsreg("username") = regusername
        rsreg("password") = regpassword
        If oblog.CacheConfig(4)<>"" And oblog.CacheConfig(5) = 1 Then
            rsreg("user_domain") = user_domain
            rsreg("user_domainroot") = user_domainroot
        End If
        rsreg("question") = question
        rsreg("answer") =answer
        rsreg("useremail") = email
        rsreg("user_level") = reguserlevel
        rsreg("user_isbest") = 0
        rsreg("blogname") = blogname
        rsreg("user_classid") = usertype
        'rsreg("nickname")=nickname
        rsreg("province") = "广东"
        rsreg("city") ="广州" 
		rsreg("adddate") = ServerDate(Now())
        rsreg("regip") = oblog.userip
        rsreg("lastloginip") = oblog.userip
        rsreg("lastlogintime") = ServerDate(Now())
        rsreg("user_dir") =oblog.setup(8,0)
        rsreg("user_folder") = regusername
        rsreg("user_group") = oblog.defaultGroup
        rsreg("scores") = oblog.cacheScores(1)
        rsreg("newbie") = 1
		if oblog.CacheConfig(40)=1 then rsreg("comment_isasc")=1
        rsreg.Update
		Session("chk_regtime") = Now()
        oblog.execute ("update oblog_setup set user_count=user_count+1")
        oblog.execute ("update oblog_groups set g_members=g_members+1 WHERE groupid = " &oblog.defaultGroup)
        If is_unamedir = 0 or oblog.chkdomain(regusername) = False Then '如果用户名为中文名则采用该用户的ID为文件夹名
            oblog.execute ("update oblog_user set user_folder=userid where username='" & oblog.filt_badstr(regusername) & "'")
        End If
        If oblog.CacheConfig(17)=1 Then
			Dim tid1,tid2
        	'获取Userid
        	Set rsreg=oblog.Execute("Select userid From oblog_user where username='" & oblog.filt_badstr(regusername) & "'")
			tid1=rsreg(0)
        	oblog.Execute("Update oblog_obcodes Set istate=1,useip='" &oblog.userip & "',usetime='" & Now & "',useuser=" & tid1 & " Where obcode='" &oblog.filt_badstr(request("obcode")) & "'"  )
        	rsreg.Close
			'增加积分
			Set rsreg = oblog.execute ("SELECT creatuser FROM oblog_obcodes Where obcode='" &oblog.filt_badstr(request("obcode")) & "'"  )
			tid2=rsreg(0)
			oblog.GiveScore "",oblog.cacheScores(2),tid2
			rsreg.Close
			'互相加好友
			oblog.execute("insert into [oblog_friend] (userid,friendid,isblack) values ("&tid1&","&tid2&",0)")
			oblog.execute("insert into [oblog_friend] (userid,friendid,isblack) values ("&tid2&","&tid1&",0)")
			dim blog
			set blog=new class_blog
			blog.userid=tid1
			blog.update_friends tid1
			blog.userid=tid2
			blog.update_friends tid2
			set blog=nothing
        End If
        If C_Reg_AutoCreate = 1 Then oblog.CreateUserDir regusername, 1
        If C_Reg_AutoTemplate = 1 Then 
			Set rsreg=oblog.Execute("Select userid From oblog_user where username='" & oblog.filt_badstr(regusername) & "'")
			C_Template rsreg(0)
			rsreg.Close
		End If 
        If oblog.CacheConfig(18) = 1 Then
            rearr=rearr&"注册成功，但当前系统设置为需要通过审核，您暂时没有管理权限！<br />"			
        Else
            oblog.savecookie regusername,regpassword,0,user_domain&"."&user_domainroot
            rearr="恭喜！您已经注册成功！<br />" 
        End If
		response.Write rearr
		response.end
    Else
        ErrMessages= "系统中已经有这个用户名存在，请更改用户名！"
        response.Write ErrMessages       
		response.end
        Exit Sub
    End If
    rsreg.Close
    Set rsreg = Nothing
End Sub

Sub ModifyUserPsw()
Dim oldpasswords, newpassword, rs,ErrMessages
    oldpasswords = OldPassword
    newpassword = UpiUserPass
	If oldpasswords = "" Then 	
	ErrMessages="错误：原密码不能为空!"    
    Response.End()
	End IF	
   
	If Not IsObject(conn) Then link_database	
    Set rs = server.CreateObject("adodb.recordset")
    rs.open "select password from oblog_user where username='"&UpiUserName&"' and password='"&oldpasswords&"'",conn,1,3    	
	If rs.EOF Then
        rs.Close
        Set rs = Nothing
         ErrMessages= "错误：原密码输入错误!"
         Response.Write ErrMessages
         Response.End()
    Else
        rs("password") = newpassword
        rs.Update
        rs.Close
        Set rs = Nothing
        oblog.savecookie UpiUserName, newpassword, 0, ""
      
    End If
End Sub

Sub ModifyUserInfo()
Dim rs,ErrMessages
If Not IsObject(conn) Then link_database	
    Set rs = server.CreateObject("adodb.recordset")
    rs.open "select useremail,question,answer from oblog_user where username='"&UpiUserName&"' and password='"&UpiUserPass&"'",conn,1,3    	
	If rs.EOF Then
        rs.Close
        Set rs = Nothing
         ErrMessages= "错误：没有该用户!"
         Response.Write ErrMessages
         Response.End()
    Else
        rs(0) = UpiEmail
		rs(1) = UpiQuestion
		if UpiAnswer<>"" Then rs(2) = UpiAnswer
        rs.Update
        rs.Close
        Set rs = Nothing
       Response.Write "修改完成"
    End If
End Sub   
  
Sub DelUser()
   Dim i,DeloneName   
   if Instr(UpiUserName,",") > 0 then   
		DeloneName = Split(UpiUserName,",")		
		For i = 0 To UBound(DeloneName)		  
           DelOneUser(Trim(DeloneName(i)))
        Next
   else
        DelOneUser(UpiUserName)
   End if
End Sub

Sub DelOneUser(DelUserName)

    Dim rs, fso, f, uname, udir,u_id
	If Not IsObject(conn) Then link_database	
    Set rs = oblog.execute("select user_dir,username,user_folder,userid from oblog_user where username='" & DelUserName &"'")
	
    If Not rs.EOF Then
        udir = rs(0)
        uname = rs(1)
	 	u_id= rs(3)
	    
        Set fso = Server.CreateObject("scripting.filesystemobject")
		
        if fso.FolderExists(server.MapPath(blogdir & udir&"/"&rs("user_folder"))) then
            Set f = fso.GetFolder(server.MapPath(blogdir & udir&"/"&rs("user_folder")))
            f.Delete True
        End If
		
        Set f = Nothing
        Set fso = Nothing
        oblog.execute ("delete from oblog_log where userid=" & u_id)
        oblog.execute ("delete from oblog_comment where userid=" & u_id)
        oblog.execute ("delete from oblog_message where userid=" & u_id)
        oblog.execute ("delete from oblog_subject where userid=" & u_id)
        oblog.execute ("delete from oblog_user where userid=" & u_id)
        oblog.execute ("delete from oblog_upfile where userid=" & u_id)
        oblog.execute ("delete from oblog_friend where userid=" & u_id)
        oblog.execute("update oblog_pm set dels=1 where sender='" &uname&"'")
   
	End If
    Set rs = Nothing
	
End Sub

Sub chk_regtime()
    Dim lasttime,rearr,ErrMessages
    lasttime = Session("chk_regtime")
    If IsDate(lasttime) Then
        If DateDiff("s", lasttime, Now()) < CLng(oblog.CacheConfig(20)) Then
			ErrMessages=oblog.CacheConfig(20) & "秒后才能重复注册。"			
			Response.Write ErrMessages
			response.end
        End If
    End If
End Sub

sub C_Template(userid)
	dim rs,rsskin
	set rsskin=oblog.execute("select skinmain,skinshowlog,id from oblog_userskin where isdefault=1")
	set rs=server.CreateObject("adodb.recordset")
	rs.open "select user_skin_main,user_skin_showlog,defaultskin from [oblog_user] where userid="&userid,conn,1,3
	rs(0)=rsskin(0)
	rs(1)=rsskin(1)
	rs(2)=rsskin(2)
	set rsskin=nothing
	rs.update
	rs.close
	set rs=nothing
	dim blog
	set blog=new class_blog
	blog.userid=userid
	blog.update_index 0
	blog.update_message 0
	blog.CreateFunctionPage
	set blog=nothing	
	oblog.execute "Update oblog_user Set newbie=0 Where userid=" & userid
End sub
%>
