<%
If Is_ot_User=1 Then
If Not IsObject(conn) Then link_database
Response.Redirect(ot_regurl)
Set conn = Nothing
Response.End()
End If
'------------------------------------------------
'检测搜索引擎,截断程序执行,节省资源. *#0801Spider
oblog.ChkSpider(1)
'------------------------------------------------
Dim Action, sReg, sKeepKey,G_P_Show ,nTime
Action = Trim(Request("action"))
sKeepKey = Application(oblog.Cache_Name & "_RegKey")
If sKeepKey = "" Then
Application(oblog.Cache_Name & "_RegKey") = GetDateCode(Now(),2) & RndPassword(12)
Else
nTime = oblog.CacheConfig(60)
If nTime < 30 Or nTime > 1440 Then nTime = 30
If DateDiff("n", DeDateCode(Left(sKeepKey, 12)), Now) > nTime Then
Application(oblog.Cache_Name & "_RegKey") = GetDateCode(Now(),2) & RndPassword(12)
End If
End If
G_P_Show = Replace (G_P_Show,"$show_title_list$", "新用户注册--"&oblog.cacheConfig(2) )
Call CheckBase()
select Case action
Case Application(oblog.Cache_Name & "_RegKey")
Call Save
Case "checkssn"
Call checkssn
Case "protocol"
Call protocol
Case Else
Call ShowRegForm
End select
G_P_Show=oblog.readfile("oblogstyle/reg/","reg.html")
G_P_Show = Replace(G_P_Show, "$show_title$", "新用户注册－" &oblog.CacheConfig(2))
G_P_Show = Replace(G_P_Show, "$show_list$", sReg)
G_P_Show = Replace(G_P_Show,"$footer$", oblog.site_bottom)
Response.Write G_P_Show
'进行基础检测
Sub CheckBase()
If oblog.CacheConfig(15) = 0 Then
If oblog.CheckAdmin(0) = False Then
oblog.adderrstr ("当前系统已关闭注册。")
oblog.showerr
Exit Sub
End If
End If
End Sub
'进行数据有效性服务端检测
'----------------------------------------------
Sub protocol()
G_P_Show=oblog.readfile("oblogstyle/reg/","reg.html")
G_P_Show = Replace(G_P_Show, "$show_list$", "当前位置：首页→注册条款" & oblog.setup(9, 0))
G_P_Show = Replace(G_P_Show, "$show_title$", oblog.CacheConfig(2) & "－注册条款")
G_P_Show = Replace(G_P_Show,"$footer$", oblog.site_bottom)
Response.Write G_P_Show
Response.End
End Sub
Sub ShowRegForm()
Dim sUserType
sUserType = ""
sReg=sReg&"" & vbcrlf
End Sub
Sub Save()
' If oblog.ChkPost() = False Then
' oblog.adderrstr ("系统不允许从外部提交！")
' End If
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 chk_regname
chk_regname=oblog.chk_regname(regusername)
buttonface=2
set ajax=new AjaxXml
chk_regtime()
If oblog.CacheConfig(16)=1 Then
If Not oblog.codepass Then
oblog.adderrstr ("验证码错误，请刷新后重新输入！")
rearr=split(oblog.errstr&"$$1","$$")
ajax.re(rearr)
Response.end
end if
End If
If oblog.CacheConfig(17)=1 Then
if oblog.CheckOBCode(Request("obcode"),0)=false Then
oblog.adderrstr ("邀请码错误或已经被使用！")
rearr=split(oblog.errstr&"$$1","$$")
ajax.re(rearr)
Response.end
End If
End If
regusername = oblog.filt_badstr(Trim(Request("username")))
regpassword = Trim(Request("password"))
re_regpassword = Trim(Request("repassword"))
email = Trim(Request("email"))
question = Trim(Request("question"))
answer = Trim(Request("answer"))
blogname = Trim(Request("blogname"))
usertype = CLng(Request("usertype"))
user_domain = LCase(Trim(Request("domain")))
user_domainroot = Trim(Request("user_domainroot"))
If regusername = "" Or oblog.strLength(regusername) > 14 Or oblog.strLength(regusername) < 4 Then oblog.adderrstr ("用户名不能为空(不能大于14小于4)！")
if chk_regname>0 then
' if chk_regname = 1 Then oblog.adderrstr("用户名不合规范，只能使用小写字母，数字及下划线！")
if chk_regname = 2 Then oblog.adderrstr("用户名中含有系统不允许的字符！")
if chk_regname = 3 Then oblog.adderrstr("用户名中含有系统保留注册的字符！")
if chk_regname = 4 Then oblog.adderrstr("用户名中不允许全部为数字！")
End If
If oblog.CacheConfig(6) <> "1" Then
If oblog.chkdomain(regusername) = False Then oblog.adderrstr ("用户名不合规范，只能使用小写字母，数字及下划线！")
End if
If oblog.CacheConfig(4) <>"" And oblog.CacheConfig(5) = 1 Then
If user_domain = "" Or oblog.strLength(user_domain) > 14 Then oblog.adderrstr ("域名不能为空(不能大于14个字符)！")
If user_domain <> Request("old_userdomain") And oblog.strLength(user_domain) < 4 Then oblog.adderrstr ("域名不能小于4个字符！")
If oblog.chk_regname(user_domain) Then oblog.adderrstr ("此域名系统不允许注册！")
If oblog.chk_badword(user_domain) > 0 Then oblog.adderrstr ("域名中含有系统不允许的字符！")
If oblog.chkdomain(user_domain) = False Then oblog.adderrstr ("域名不合规范，只能使用小写字母，数字！")
If user_domainroot = "" Then oblog.adderrstr ("域名根不能为空！")
If oblog.CheckDomainRoot(user_domainroot,0) = False Then oblog.adderrstr ("域名根不合法！")
End If
If regpassword = "" Or oblog.strLength(regpassword) > 14 Or oblog.strLength(regpassword) < 4 Then oblog.adderrstr ("密码不能为空(不能大于14小于4)！")
If re_regpassword = "" Then oblog.adderrstr ("重复密码不能为空！")
If regpassword <> re_regpassword Then oblog.adderrstr ("两次输入密码不同！")
If question = "" Or oblog.strLength(question) > 50 Then oblog.adderrstr ("找回密码提示问题不能为空(不能大于50)！")
If answer = "" Or oblog.strLength(answer) > 50 Then oblog.adderrstr ("找回密码问题答案不能为空(不能大于50)！")
If blogname = "" Or oblog.strLength(blogname) > 50 Then oblog.adderrstr ("blog名不能为空(不能大于50字符)！")
If oblog.chk_badword(blogname) > 0 Then oblog.adderrstr ("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 Or InStr(regusername, ".") > 0 Then oblog.adderrstr ("用户名中含有非法字符！")
'进行重复性判断22/47/25
If oblog.CacheConfig(22)="1" Then
Set rsreg=oblog.execute("select Count(userid) From oblog_user Where useremail='" & ProtectSQL(email) & "'")
If rsreg(0)>0 Then
oblog.adderrstr ("您使用的Email: " & email & " 已被他人使用，请更换其他Email")
End If
rsreg.Close
End If
If oblog.CacheConfig(48)="1" Then
Set rsreg=oblog.execute("select Count(userid) From oblog_user Where blogname='" & ProtectSQL(blogname) & "'")
If rsreg(0)>0 Then
oblog.adderrstr ("您使用的博客名称: " & blogname & " 已被他人使用，请更换博客名称")
End If
rsreg.Close
End If
'进行IP控制
Dim sIP
sIP=oblog.userip
If oblog.CacheConfig(21)>"0" And oblog.ChkWhiteIP(sIP) = False Then
sql="select Count(userid) from oblog_user where regip='"& sIP &"' And "
If Is_Sqldata = 0 Then
sql = sql & " Datediff('n',adddate,Now())<=60"
Else
sql = sql & " adddate BETWEEN DATEADD(Minute,-60,GETDATE()) AND GETDATE()"
End if
Set rsreg = oblog.execute(sql)
If rsreg(0) > Int(oblog.CacheConfig(21)) Then
oblog.KillIP(sIP)
oblog.adderrstr ("您的IP因为恶意注册被临时禁止")
rsreg.Close
rearr=split(Replace(oblog.errstr,"_"," ")&"$$2$$index","$$")
ajax.re(rearr)
Response.end
End If
rsreg.Close
End If
If oblog.CacheConfig(14) > "0" And oblog.ChkWhiteIP(sIP) = False Then
sql="select Count(userid) from oblog_user where regip='"& sIP &"' And "
If Is_Sqldata = 0 Then
sql = sql & " Datediff('h',adddate,Now())<=24"
Else
sql = sql & " adddate BETWEEN DATEADD(Hour,-24,GETDATE()) AND GETDATE()"
End IF
Set rsreg = oblog.execute(sql)
If rsreg(0) > Int(oblog.CacheConfig(14)) Then
'进行IP屏蔽
oblog.KillIP(sIP)
'进行批量屏蔽
oblog.execute("Update [oblog_user] Set user_level=6 Where regip='"&oblog.userip&"'")
oblog.adderrstr ("您的IP因为恶意注册而被系统禁止")
rsreg.Close
rearr=split(Replace(oblog.errstr,"_"," ")&"$$2$$index","$$")
ajax.re(rearr)
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 oblog.adderrstr ("系统中已经有这个域名存在，请更改域名！")
End If
If oblog.errstr <> "" Then
rearr=split(Replace(oblog.errstr,"_"," ")&"$$1","$$")
ajax.re(rearr)
Response.end
end if
'是否需要审核
If oblog.CacheConfig(18) = 1 Then reguserlevel = 6 Else reguserlevel = 7
If API_Enable Then
Dim blogAPI
Set blogAPI = New DPO_API_OBLOG
blogAPI.LoadXmlFile True
blogAPI.UserName=regusername
blogAPI.PassWord=regpassword
blogAPI.EMail=email
blogAPI.Question=Question
blogAPI.Answer=Answer
blogAPI.userip=oblog.userip
blogAPI.UserStatus=0
Call blogAPI.ProcessMultiPing("reguser")
Set blogAPI=Nothing
Dim strUrl,i,turl
For i=0 To UBound(aUrls)
strUrl=Lcase(aUrls(i))
If Left(strUrl,7)="http://" Then
turl=strUrl&"?syskey="&MD5(regusername&oblog_Key)&"&username="®username&"&password="&MD5(regpassword)&"&savecookie=1@@@"& turl
End If
Next
session("turl")=turl
End If
Dim TruePassWord
TruePassWord = RndPassword(16)
If Not IsObject(conn) Then link_database
Set rsreg = Server.CreateObject("adodb.recordset")
rsreg.open "select * from [oblog_user] where username='" & regusername & "'", conn, 1, 3
If rsreg.EOF Then
rsreg.addnew
rsreg("username") = regusername
rsreg("password") = MD5(regpassword)
rsreg("TruePassWord") = TruePassWord
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") = MD5(answer)
rsreg("useremail") = email
rsreg("user_level") = reguserlevel
rsreg("user_isbest") = 0
rsreg("blogname") = blogname
rsreg("user_classid") = usertype
'rsreg("nickname")=nickname
rsreg("province") = Request("province")
rsreg("city") = Request("city")
rsreg("adddate") = oblog.ServerDate(Now())
rsreg("regip") = oblog.userip
rsreg("lastloginip") = oblog.userip
rsreg("lastlogintime") = oblog.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
rsreg("isdigg") = 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 oblog.CacheConfig(58) = "0" Or oblog.CacheConfig(6) = "1" Then
oblog.execute ("update oblog_user set user_folder=userid where username='" & regusername & "'")
End If
If oblog.CacheConfig(17) = "1" Then
Dim tid1,tid2
'获取Userid
Set rsreg=oblog.Execute("select userid From oblog_user where username='" & regusername & "'")
If Not rsreg.Eof Then
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")) & "'" )
End if
rsreg.Close
'增加积分
Set rsreg = oblog.execute ("select creatuser FROM oblog_obcodes Where obcode='" &oblog.filt_badstr(Request("obcode")) & "'" )
If Not rsreg.Eof Then
tid2=rsreg(0)
oblog.GiveScore "",oblog.cacheScores(2),tid2
End if
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)")
End If
If oblog.CacheConfig(59) = "1" Then
oblog.CreateUserDir regusername, 1
If oblog.CacheConfig(17) = "1" Then
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
'自动选择默认用户模板
Set rsreg=oblog.Execute("select userid From oblog_user where username='" & regusername & "'")
C_Template rsreg(0)
rsreg.Close
End if
If oblog.CacheConfig(18) = 1 Then
rearr=rearr&"注册成功，但当前系统设置为需要通过审核，您暂时没有管理权限！ "
rearr=rearr&"$$2$$index"
Else
oblog.savecookie regusername,TruePassWord,0
rearr=rearr&"恭喜！您已经注册成功！ "
rearr=rearr&"现在将转到管理后台让您选择喜欢的页面风格。 "
rearr=rearr&"$$2$$user_index"
If API_Enable Then
rearr=rearr&"$$"&MD5(regusername & oblog_Key )&"$$"®username&"$$ "&MD5(regpassword)
End If
End If
ajax.re(split(rearr,"$$"))
Response.end
Else
oblog.adderrstr ("系统中已经有这个用户名存在，请更改用户名！")
ajax.re(split(Replace(oblog.errstr,"_"," ")&"$$1","$$"))
Response.end
Exit Sub
End If
rsreg.Close
Set rsreg = Nothing
End Sub
Sub chk_regtime()
Dim lasttime,rearr,ajax
set ajax=new AjaxXml
lasttime = Session("chk_regtime")
If IsDate(lasttime) Then
If DateDiff("s", lasttime, Now()) < CLng(oblog.CacheConfig(20)) Then
oblog.adderrstr (oblog.CacheConfig(20) & "秒后才能重复注册。")
rearr=split(oblog.errstr&"$$1","$$")
ajax.re(rearr)
Response.End
End If
End If
End Sub
Sub checkssn()
Dim ajax,rearr,msgstr,buttomface
dim regusername,user_domain,user_domainroot,email
Dim chk_regname
buttomface=2
regusername=oblog.filt_badstr(Trim(Request("username")))
user_domain=oblog.filt_badstr(Trim(Request("domain")))
user_domainroot=oblog.filt_badstr(Trim(Request("domainroot")))
email=oblog.filt_badstr(Trim(Request("email")))
chk_regname=oblog.chk_regname(regusername)
if regusername="" or oblog.strLength(regusername)>14 or oblog.strLength(regusername)<4 then oblog.adderrstr("用户名不能为空(不能大于14小于4)！")
if chk_regname>0 then
' if chk_regname = 1 Then oblog.adderrstr("用户名不合规范，只能使用小写字母，数字及下划线！")
if chk_regname = 2 Then oblog.adderrstr("用户名中含有系统不允许的字符！")
if chk_regname = 3 Then oblog.adderrstr("用户名中含有系统保留注册的字符！")
if chk_regname = 4 Then oblog.adderrstr("用户名中不允许全部为数字！")
End If
If oblog.CacheConfig(6) <> "1" Then
If oblog.chkdomain(regusername) = False Then oblog.adderrstr ("用户名不合规范，只能使用小写字母，数字及下划线！")
End if
if oblog.CacheConfig(4)<>"" And oblog.CacheConfig(5) then
if user_domain="" or oblog.strLength(user_domain)>20 then oblog.adderrstr("域名不能为空(不能大于14个字符)！")
if user_domain<>Request("old_userdomain") and oblog.strLength(user_domain)<4 then oblog.adderrstr("域名不能小于4个字符！")
if oblog.chk_regname(user_domain) then oblog.adderrstr("此域名系统不允许注册！")
if oblog.chk_badword(user_domain)>0 then oblog.adderrstr("域名中含有系统不允许的字符！")
if oblog.chkdomain(user_domain)=false then oblog.adderrstr("域名不合规范，只能使用小写字母，数字及下划线！")
if user_domainroot="" then oblog.adderrstr("域名根不能为空！")
end If
If API_Enable Then
Dim blogAPI
Set blogAPI = New DPO_API_OBLOG
blogAPI.LoadXmlFile True
blogAPI.UserName=regusername
blogAPI.email=email
Call blogAPI.ProcessMultiPing("checkname")
End If
If oblog.errstr<>"" Then
msgstr=Replace(oblog.errstr,"_"," ")
buttomface=1
else
dim rs
set rs=oblog.execute("select userid from oblog_user where username='"®username&"'")
if not rs.eof then
msgstr="对不起，"®username&"此用户名已存在,请更换！ "
buttomface=1
Else
If API_Enable Then
If blogAPI.FoundErr=False Then
msgstr="恭喜，"®username&"此用户名可使用！ "
End If
Else
msgstr="恭喜，"®username&"此用户名可使用！ "
End If
end if
if oblog.CacheConfig(4)<>"" And oblog.CacheConfig(5) Then
set rs=oblog.execute("select userid from oblog_user where user_domain='"&user_domain&"' and user_domainroot='"&user_domainroot&"'")
if not rs.eof then
msgstr=msgstr&"对不起，"&user_domain&"."&user_domainroot&"此域名已存在,请更换！ "
buttomface=1
else
msgstr=msgstr&"恭喜，"&user_domain&"."&user_domainroot&"此域名可使用！ "
end If
If oblog.CheckDomainRoot(user_domainroot,0) = False Then msgstr=("域名根不合法！"):buttomface=1
end if
End If
set rs=nothing
If API_Enable Then Set blogAPI=Nothing
rearr=split(msgstr&"$$"&buttomface,"$$")
set ajax=new AjaxXml
ajax.re(rearr)
Response.End()
End Sub
Sub C_Template(userid)
Dim rs,rsskin
Set rsskin=oblog.execute("select skinmain,skinshowlog,id from oblog_userskin where isdefault=1")
If rsskin.EOF Then
Set rsskin=oblog.execute("select top 1 skinmain,skinshowlog,id from oblog_userskin order by id desc")
End if
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
function show_city()
Dim tmpstr
tmpstr = ""
tmpstr = tmpstr & " "
tmpstr = tmpstr & ""
tmpstr = tmpstr & ""
show_city = tmpstr
End Function
%>