📄 reg_u.asp
字号:
3.星号*为必须填写项目，请一定填写，否则无法注册。</font></td>
</tr>
</table></td>
</tr>
<tr>
<td height="20"> </td>
</tr>
<tr>
<td align="left" valign="top"><br></td>
</tr>
</form>
</table>
</td></tr></table>
</td></tr></table>
<br><br>
<%rs.close
set rs=nothing
End SUB
SUB reglic()
%><FORM METHOD=POST action="reg_u.asp?action=main" style="margin:0px;">
<table width="550" border="0" align="center" cellpadding="0" cellspacing="1" bgcolor="#333369"><tr><td>
<table width="100%" height="100%" border="0" align="center" cellpadding="1" cellspacing="0" bgcolor="#ffffff"><tr><td>
<table width="100%" height="100%" align="center" cellpadding="0" cellspacing="0" bgcolor="#C6DBD8" border=0>
<tr>
<td width="2%" bgcolor="#4662C1"></td>
<td height="24" bgcolor="#4662C1"><strong><font color="#ffffff">方 舟 网（http://www.99081.com）空 间 注 册 协 议 书</font></strong>
<td height="5" align="center" bgcolor="#4662C1"></td>
</tr>
<tr>
<td></td><td><br><font color="#000000"><!--#include file="inc/regtext.asa"--></font></td><td width="2%" align="center" > </td>
</tr>
<tr>
<td colspan=3 align="center" ><hr size=1 color="#eeeeee">
<INPUT TYPE="submit" value="我同意" class=btx>
<INPUT TYPE="button" value="我不同意" onclick="{javascript:window.history.back();}" class=btx><br><br></td>
</tr>
</table>
</FORM>
<%
End SUB
SUB SaveReg()
'Call SendEmail("AAA","lfgbox@hotmail.com","d46fdt234")
dim rs,sql,i,chkregs
dim UserName,UserPassA,UserPassB,UserPath,UserEmail 'display input
dim Fso,myfolder
dim reg
dim founderr,errinfo
dim NewCreatePath
dim Reg_Quota,Reg_GroupID,Reg_sFlag
dim ActiveID
dim reg_name
NewCreatePath=false
founderr=false
sql="select top 1 regFlag from [config]"
set rs=CONN.execute(sql)
reg=rs(0)
if reg=0 then
errinfo=errinfo+"<br><li>用户注册已经关闭，不能注册！"
founderr=true
end if
rs.close
reg_name=request.form("Reg_Name")
UserPassA=request.form("UserPass")
UserPassB=request.form("UserPass1")
'UserPath=request.form("UserPath")
UserName=CheckStr(request.form("UserName"))
UserEmail=CheckStr(request.form("UserEmail"))
if UserName="" then
errinfo=errinfo+"<br><li>用户名长度不能为空,请重输入！"
founderr=true
end if
if Checkchar(UserName,"")=false then
errinfo=errinfo+"<br><li>用户名中含有非法字符,请重输入！"
founderr=true
end if
'验证用户名是否已经存在于数据库!
set rs=server.createobject("adodb.recordset")
sql="select * from [userlist] where UserName='"&UserName&"'"
rs.open sql,CONN,0,1
if not rs.eof and not rs.bof then
errinfo=errinfo+"<br><li>对不起，您输入的用户名已经被注册,请重新输入！"
founderr=true
end if
rs.close
if UserPassA="" or strLength(UserPassA)<5 then
errinfo=errinfo+"<br><li>用户密码至少五位！请重输入！"
founderr=true
end if
if UserPassB="" then
errinfo=errinfo+"<br><li>核对密码未填！"
founderr=true
end if
if UserPassA<>UserPassB then
errinfo=errinfo+"<br><li>核对密码和用户密码不一致,请重新输入！"
founderr=true
end if
set Fso=Server.createobject("scripting.filesystemobject")
myfolder=server.mappath(UseRootpathCreate&UserName)
if Fso.folderexists(myfolder) then
errinfo=errinfo+"<br><li>对不起，该目录已经存在,请换别的帐号名称重新注册！"
founderr=true
end if
if UserEmail<>"" then
if IsValidEmail(UserEmail)=false then
errinfo=errinfo+"<br><li>无效的Email格式输入！"
founderr=true
else
sql="select * from [UserList] where UserEmail='"&UserEmail&"'"
rs.open sql,CONN,0,1
if not rs.eof and not rs.bof then
errinfo=errinfo+"<br><li>对不起，您输入的Email已经被注册,请重新输入！"
founderr=true
end if
rs.close
end if
else
UserEmail="未填"
end if
chkregs=chkreg()
if chkregs<>"" then
founderr=true
errinfo=errinfo+chkregs
end if
if founderr then call GetError(errinfo)
on error resume next
if not Fso.folderexists(server.mappath(UseRootpathCreate)) then
GetError "注册初试根目录"&(UseRootpathCreate)&"无效!注册失败"
'Fso.createfolder(server.mappath(UseRootpathCreate))
end if
if not Fso.folderexists(myfolder) then
NewCreatePath=true
Fso.createfolder(myfolder)
end if
if err.number<>0 then
Response.write "<br>"+"<li>"&Err.Description&"<br>站点不支持Fso创建目录，你需要Ftp手动添加用户目录"
err.clear
Response.end()
end if
err.clear
on error goto 0
'on error resume next
dim err1,curUserID,err1Number,Reg_Active
Randomize timer()
ActiveID=md5(cstr(nowTime)&cstr(int(899999*Rnd+100000))&timer(),md5order)
set rs=server.createobject("adodb.recordset")
rs.open "config",conn,0,1
Reg_Quota=rs("Reg_Quota")
Reg_GroupID=rs("Reg_GroupID")
Reg_sFlag=rs("Reg_sFlag")
Reg_Active=rs("Reg_Active")
rs.close
rs.open "select * from [userlist] where (UserID is null)",CONN,1,3
rs.addnew
rs("UserName")=UserName
rs("UserPassword")=md5(UserPassA,md5order)
rs("UserPath")=UseRootpathCreate&UserName&"/"
rs("UserEmail")=UserEmail
rs("ActivePort")=ActiveID
rs("reg_name")=reg_name
rs("UseSize")="0"
if Reg_Active=0 then
rs("Active")=1
else rs("Active")=0
end if
rs("GroupID")=Reg_GroupID
if Reg_GroupID>0 then '设置为群组则使用如下数值
rs("UseQuota")=0
rs("sFlag")="000000000,000000000,000000000"
else
rs("UseQuota")=Reg_Quota
rs("sFlag")=Reg_sFlag
end if
rs("addDate")=now()
rs.update
curUserID=rs("userID")
rs.close
rs.open "select * from [RegInfo] where (UserID is null)",CONN,1,3
rs.addnew
for i=0 to rs.fields.count-1
if rs(i).Name<>"UserID" then
rs(rs(i).Name)=GetValue(trim(Request.Form(rs(i).Name)),"str"," ")
else
rs("UserID")=curUserID
end if
next
rs.update
rs.close
set rs=nothing
if err.number<>0 and Not isNull(curUserID) then
CONN.Execute("delete from [userlist] where UserID="&curUserID)
err1=Err.Description
err1Number=err.number
err.clear
if NewCreatePath then '如果是新建目录则在注册失败后删除相应目录
Fso.DeleteFolder myfolder,true 'true 也删除只读的文件夹
end if
if err.number<>0 or err1Number<>0 then
Response.write "<br>注册失败"+"<li>"&err1&"<li>"&Err.Description&"<br><input name='button32' type='button' class='btxx' onClick=""window.open('login.asp?action=exit','_self');"" value='确 认'>"
err.clear
Response.end()
end if
end if
set Fso=Nothing
on error goto 0
CONN.close
set CONN=nothing
'Response.Redirect "regok.asp"
if reg_Active=1 then
Call SendEmail(UserName,UserEmail,ActiveID)
Response.write("<center>激活帐号的信息已经发送到你的邮箱 "&UserEmail&"</center>")
elseif reg_Active=2 then
Response.write("<center>注册完成,请等待管理员激活你的注册帐号</center>")
else
server.transfer "regok.asp"
end if
Response.end
End sub
Function checkStr(str)
if isnull(str) then
checkStr = ""
exit Function
end if
checkStr=replace(str,"'","")
checkStr=replace(str,";","")
End Function
Function chkreg()
chkreg=""
dim rs,reg_config,rNameArr,TexAtt,i,tmpStr,newstr
set rs=server.createobject("adodb.recordset")
rs.open "select reg_config from [config]",conn,0,1
reg_config=split(rs(0),"|")
rs.close
rNameArr=array("Reg_Name","Reg_Number","Reg_phone","Reg_moCall","Reg_OICQ","Reg_MSN","Reg_From","Reg_work","Reg_for","Reg_birthday","Reg_descript")
TexAtt =array("真实姓名","身份证号码","联系电话","联系手机","OICQ","MSN","所在地","从事职业","空间用途","出生日期","个人简历")
for i=0 to ubound(rNameArr)
if reg_config(i)="1" then
tmpStr=checkStr(Request.form(rNameArr(i)))
if tmpStr="" then
chkreg=chkreg&"<li><b>"&TexAtt(i)&"</b> 要求必须填写</li>"
end if
end if
next
'if chkreg="" then
' newstr="'"&checkStr(Request.form(rNameArr(0)))&"'"
' for i=1 to ubound(rNameArr)
' newstr=newstr&",'"&checkStr(Request.form(rNameArr(i)))&"'"
' next
' Conn.execute("insert into ("&join(rNameArr,",")&") values ("&newstr&")")
'else
' GetError chkreg
'end if
End function
SUB Active() 'Email激活帐号
dim ActiveID,rs
'注册激活才建立用户目录
ActiveID=GetValue(request.queryString("ActiveID"),"str","")
if ActiveID="" then
GetError "激活号码不能为空"
end if
if len(ActiveID)<16 or CONN.execute("Select ActivePort from [UserList] where ActivePort='"&ActiveID&"' and MasterFlag<1").eof then
GetError "无效的注册激活号码"
else
CONN.execute("update [UserList] Set Active=1,ActivePort='0' where ActivePort='"&ActiveID&"' and MasterFlag<1")
Response.write "<center>帐号已经激活,请执行<a href=login.asp><b>[登陆]</b></a></center>"
response.end
end if
End SUB
SUB SendEmail(inceptUserName,inceptUserMail,Aid)
if IsValidEmail(inceptUserMail)=true then
dim imailbody,cooUrl,cooLogo,iMailTopic
dim SCRIPT_NAME,SERVER_NAME
SCRIPT_NAME=CheckStr(Request.ServerVariables("SCRIPT_NAME"))
SERVER_NAME=CheckStr(Request.ServerVariables("SERVER_NAME"))
cooUrl=""
cooLogo=""
imailbody="<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
imailbody=imailbody & "<html><head><meta http-equiv=Content-Type content=""text/html;charset=gb2312""></head>"
imailbody=imailbody & "<body bgcolor=#FFFFFF text=#000000 leftmargin=20 topmargin=20 marginwidth=20 marginheight=20>"
'imailbody=imailbody & "<table border=0 cellpadding=0 cellspacing=0 width=500>"
'imailbody=imailbody & "<tr><td><a href="""&cooUrl&""" target=_blank><img src=""http://"&SERVER_NAME & SCRIPT_NAME)&"/"& cooLogo&""" width=500 border=0></a></td></tr></table><br>"
imailbody=imailbody & "<table width=500 border=0 cellspacing=0 cellpadding=15>"
imailbody=imailbody & "<tr><td background=""http://"&SERVER_NAME & SCRIPT_NAME&"/"&"pic/mailbg.gif"" valign=top style=""font-size:12px;font-family:MS Shell Dlg;line-height:140%"">"
imailbody=imailbody & inceptUserName&"，您好：<br>"
imailbody=imailbody & "您在"&CooSelTitle&">>注册连接如下，请点击激活你的注册帐号：<br>"
imailbody=imailbody & "<hr size=1>"
imailbody=imailbody & "<a href=http://"&SERVER_NAME & SCRIPT_NAME&"?action=Active&ActiveID="&Aid&" target=_blank><u>点这里激活你注册的 "&inceptUserName&" 帐号</u></a></td></tr>"
imailbody=imailbody & "</table><br></body></html>"
iMailTopic="["&CooSelTitle&"]>> 空间注册激活信息"
Call Jmail(inceptUserMail,iMailTopic,imailbody)
'Call CDOmail(inceptUserMail,iMailTopic,imailbody)
end if
End SUB
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -