reg_send_pe.asp

一个超级漂亮的班级主页asp代码

<!--插入html头部分以及数据库接口-->
<!--#include file="in_conn.asp"-->
<!--#include file="inc/md5.asp"-->


<%
Server.ScriptTimeOut=5000

Dim UploadFilePath,UploadLimitSize,UploadfileAllowext
UploadFilePath = "face/upface/"
'文件上传路径 

UploadLimitSize = 100*1024
'最大上传文件大小，单位为K 

UploadfileAllowext = "jpg/gif"
'可以上传的文件类型 

function CanUp(Fileurl)
	if InStr(1,UploadfileAllowext,Fileurl,1)=0 OR InStr(1,UploadfileAllowext,Fileurl,1)=null Then
		CanUp=False
	else
		CanUp=True
	end if
end function

'*****************************************
'建立上传对象
on error resume next
	dim savepath
	savepath=Server.MapPath(UploadFilePath)
	dim Upload
	Set Upload=Server.CreateObject("Persits.Upload")
	Upload.SetMaxSize UploadLimitSize,True
	Upload.OverwriteFiles = false

	Count=Upload.Save(savepath)

'******************************************
'清除已上传文件的函数
Sub killup()
	For Each File in Upload.Files
		File.Delete
	Next
	set Upload=Nothing
End Sub



'判断用户名格式的函数
FUNCTION userstr(stru)
dim i,aa
dim istr
  For i=1 To Len(stru)
	istr=mid(stru,i,1)
	aa=ASC(istr)
	If aa>31 AND aa<48 Then
		userstr=False
		Exit For
	Elseif aa>57 AND aa<65 Then
		userstr=False
		Exit For
	Elseif aa>90 AND aa<95 Then
		userstr=False
		Exit For
	Elseif aa>95 AND aa<97 Then
		userstr=False
		Exit For
	Else
		userstr=True
	End if
  Next
END FUNCTION

'判断邮件格式是否正确
Function isEmail(strng)
     Dim regEx,regVal
     Set regEx=New RegExp
     regEx.Pattern="^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
     regEx.IgnoreCase=True
     isEmail=regEx.Test(strng)
End Function

dim vname,vpwd,vrepwd,vemail,vhome,vnowdo,vcontact,vface,vsign
dim vsex,vqq,vhometel,vmob,vy,vm,vd,vfacew,vfaceh
dim vbirth,vdate

'获得表单传值
vname=trim(Upload.Form("txtname"))
vpwd=trim(Upload.Form("txtpwd"))
vrepwd=trim(Upload.Form("txtrepwd"))
vemail=trim(Upload.Form("txtemail"))
vhome=trim(Upload.Form("txthome"))
vnowdo=trim(Upload.Form("txtdo"))
vcontact=trim(Upload.Form("txtcontact"))
vsign=trim(Upload.Form("txtsign"))
vmsn=trim(Upload.Form("txtmsn"))
vhp=trim(Upload.Form("txthp"))

if Upload.Form("radsex")="gg" then
	vsex=1
else
	vsex=0
end if
vqq=trim(Upload.Form("txtqq"))
vhometel=trim(Upload.Form("txthometel"))
vmob=trim(Upload.Form("txtmobile"))
vy=Upload.Form("syear")
vm=Upload.Form("smonth")
vd=Upload.Form("sday")

vdate=now()

'检查正确性
flagerr=0
IF Upload.Form("radface")="up" THEN
		if Count<1 then
			flagerr=1
		end if
		
		if Err.Number=8 then
			flagerr=2
		elseif Err.Number<>0 then
			flagerr=-1
		end if

		dim size
		For Each File in Upload.Files
				strShortFileName=File.filename    '取得文件名
				strExtension=Mid(strShortFileName, InStrRev(strShortFileName, ".")+1)    '取得扩展名		
	
			'检查正确性
			if strShortFileName="" OR InStrRev(strShortFileName, ".")=0 OR InStrRev(strShortFileName, ".")=Null then
				File.Delete
				flagerr=1
			elseif CanUp(strExtension)=False then
				File.Delete
				flagerr=3
			else
				vvvsize=file.size
				'获取图片的宽和高
				vpw=File.ImageWidth
				vph=File.ImageHeight
				'产生随机数
				randomize 
				ranNum=int(900*rnd)+100 
				'这下面两行代码功能为改名，如果不要改名，请去掉
				NewName = year(now) & "-" & month(now) & "-" & day(now) & "-" & hour(now) & "-" & minute(now) & "-" & second(now) &ranNum&"."&LCase(strExtension) 
				File.Move savepath & "\" & NewName
			end if
		next
END IF


If userstr(vname)=False or vname="" Then
	call killup()
	Response.Redirect "resp.asp?cmd=uname_err"
ElseIf isEmail(vemail)=False or vemail="" Then
	call killup()
	Response.Redirect "resp.asp?cmd=uemail_err"
ElseIF vmsn<>"" AND isEmail(vmsn)=False Then
	call killup()
	Response.Redirect "resp.asp?cmd=uemail_err"
ElseIf Len(vpwd)<6 OR Len(vpwd)>14 Then
	call killup()
	Response.Redirect "resp.asp?cmd=upwd_len"
ElseIf vpwd<>vrepwd Then
	call killup()
	Response.Redirect "resp.asp?cmd=urepwd_err"
ElseIf vcontact<>"" And Len(vcontact)>150 Then
	call killup()
	Response.Redirect "resp.asp?cmd=ucontact_len"
ElseIf vsign<>"" And Len(vsign)>255 Then
	call killup()
	Response.Redirect "resp.asp?cmd=usign_len"
ElseIf vqq<>"" And isnumeric(vqq)=False Then
	call killup()
	Response.Redirect "resp.asp?cmd=uqq_num"
End If

'检查是否重复注册
sqlstr="SELECT ID FROM tblmates WHERE name='"&vname&"'"
rs.open sqlstr,conn,1,1
	if NOT(rs.eof AND rs.bof) then
		call killup()
		Response.Redirect "resp.asp?cmd=ureg_2"
	end if
rs.close

IF Upload.Form("radface")="up" THEN
	if flagerr=0 then
			'如果上传成功
			vface=UploadFilePath&NewName
			vfacew=vpw
			vfaceh=vph
			if isNumeric(vfacew) then
				If vfacew>150 or vfaceh>150 Then
					'如果图片宽高不符界限，则
					if vfacew>vfaceh then
						vfaceh=Cint(150 / vfacew * vfaceh)
						vfacew=150
					else
						vfacew=Cint(150 / vfaceh * vfacew)
						vfaceh=150
					end if
				End If
			else
				vfacew=150
				vfaceh=150
			end if
	else
		'如果上传失败
		Response.Redirect "resp.asp?cmd=uface_up"
	end if
Else
	vface="face/"&Upload.Form("sface")&".gif"
	vfacew=42
	vfaceh=85
END IF

vy=Upload.Form("syear")
vm=Upload.Form("smonth")
vd=Upload.Form("sday")

if isDate(vy&"-"&vm&"-"&vd) then
	vbirth=CDate(vy&"-"&vm&"-"&vd)
else
	call killup()
	Response.Redirect "resp.asp?cmd=ubirth_day"
end if



'MD5加密
vpwd=md5(vpwd,32)

'开始插入数据
sqlstr="INSERT INTO tblmates(name,pwd,sex,email,qq,home,hometel,mobile,nowdo,contact,birthday,birthm,regdate,lastlog,power,faceurl,facew,faceh,cnt_water,cnt_on,signline,myfj,msn,hp) VALUES('"&stryin(vname)&"','"&stryin(vpwd)&"',"&vsex&",'"&stryin(vemail)&"','"&stryin(vqq)&"','"&stryin(vhome)&"','"&stryin(vhometel)&"','"&stryin(vmob)&"','"&stryin(vnowdo)&"','"&stryin(vcontact)&"',#"&vbirth&"#,"&vm&",#"&vdate&"#,#"&vdate&"#,0,'"&stryin(vface)&"',"&vfacew&","&vfaceh&",0,1,'"&stryin(vsign)&"',0,'"&stryin(vmsn)&"','"&stryin(vhp)&"')"
conn.Execute sqlstr

IF DEF_mb_chk=0 THEN
	sqlstr="UPDATE tblmates SET power=1,regdate=#"&now()&"# WHERE name='"&stryin(vname)&"'"
	conn.Execute sqlstr
END IF

Session("sname")=vname

set Upload=Nothing
Response.Redirect "rego.asp?cmd=reg_ok"
%>


<body>
<!--插入网站置底-->
<!--#include file="in_bottom.asp"-->
</body>

</html>