user_fun.asp

一个完整的BBS论坛源代码

	else
		dateflag = 0
	End If

	If Form_bday <> "" then
		If IsNumeric(Form_bday) = 0 or instr(Form_bday,",")>0 then
			GBL_CHK_TempStr = GBL_CHK_TempStr & "出生日期错误!<br>"
			GBL_CHK_Flag = 0
			Exit Function
		else
			If Form_bday>31 or Form_bday<0 then
				Form_bday = cCur(Form_bday)
				GBL_CHK_TempStr = GBL_CHK_TempStr & "出生日期错误!<br>"
				GBL_CHK_Flag = 0
				Exit Function
			End If
		End If
	else
		dateflag = 0
	End If


	If strLength(Form_Homepage) > 250 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "主页地址太长!<br>"
		GBL_CHK_Flag = 0
		Exit Function
	End If

	Form_birthday = 0
	If dateflag = 1 then Form_birthday = GetTimeValue(dateserial(Form_byear,Form_bmonth,Form_bday))

	If isNumeric(Form_Userphoto) = 0 or instr(Form_Userphoto,",")>0 then
		If Form_Sex = "男" then
			Form_Userphoto = 1
		else
			If Form_Sex = "女" then
				Form_Userphoto = 2
			else
				Form_Userphoto = 3
			End If
		End If
	End If
	
	Form_Userphoto = cCur(Form_Userphoto)
	
	If Form_Userphoto < 1 or Form_Userphoto > DEF_faceMaxNum Then
		If Form_Sex = "男" then
			Form_Userphoto = 1
		else
			If Form_Sex = "女" then
				Form_Userphoto = 2
			else
				Form_Userphoto = 3
			End If
		End If
	End If
	
	Rem -----------特殊数据验证-------------
	If Len(Form_Underwrite) > 255 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "用户签名太长，不能超过255字符!<br>"
		GBL_CHK_Flag = 0
		Exit Function
	End If
	
	if len(Form_ApplyTime)<14 or isDate(RestoreTime(Form_ApplyTime))=false Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "申请时间错误，可能不是正常的日期格式或未填写! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	
	If IsNumeric(Form_UserLevel) = 0 or instr(Form_UserLevel,",")>0 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "用户等级必须是数字! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	Form_UserLevel = cCur(Form_UserLevel)
	If Form_UserLevel<0 or Form_UserLevel>DEF_UserLevelNum Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "用户等级必须大等于0并且小于" & DEF_UserLevelNum & "! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	
	Dim Form_Officer_Temp,Temp_N
	Form_Officer_Temp = Form_Officer
	Form_Officer_Temp = "," & Form_Officer_Temp & ","
	Form_Officer = "0"
	For Temp_N = 1 to DEF_UserOfficerNum
		if inStr(Form_Officer_Temp,"," & Temp_N & ",") Then
			Form_Officer = Form_Officer & "," & Temp_N
		End If
	Next
	If Form_Officer<>"0" Then Form_Officer = Mid(Form_Officer,3)
	If Len(Form_Officer)>255 Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "所任官职太多!<br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If

	If IsNumeric(Form_Points) = 0 or instr(Form_Points,",")>0 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "用户积分必须是数字! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	Form_Points = cCur(Form_Points)

	If IsNumeric(Form_Online) = 0 or instr(Form_Online,",")>0 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "用户在线状态必须是数字! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	Form_Online = cCur(Form_Online)
	
	if len(Form_Prevtime)<14 or isDate(RestoreTime(Form_Prevtime))=false Then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "最后登录时间错误，可能不是正常的日期格式或未填写! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	
	If IsNumeric(Form_Login_oknum) = 0 or instr(Form_Login_oknum,",")>0 then
		Form_Login_oknum = 0
		Exit Function
	End If
	If IsNumeric(Form_Login_falsenum) = 0 or instr(Form_Login_falsenum,",")>0 then
		GBL_CHK_TempStr = GBL_CHK_TempStr & "持败登次必须是数字! <br>" & VbCrLf
		GBL_CHK_Flag = 0
		Exit Function
	End If
	
	If DEF_AllDefineFace = 1 Then
		Form_FaceUrl = Trim(Request("Form_FaceUrl"))
		Form_FaceWidth = Left(Trim(Request("Form_FaceWidth")),14)
		Form_FaceHeight = Left(Trim(Request("Form_FaceHeight")),14)
		
		If IsNumeric(Form_FaceWidth) = 0 or instr(Form_FaceWidth,",")>0 or Form_FaceWidth = "" then
			If Form_FaceUrl <> "" Then
				GBL_CHK_TempStr = "自定义头像宽度填写错误!<br>"
				GBL_CHK_Flag = 0
				Exit Function
			End If
		End If		
		If IsNumeric(Form_FaceHeight) = 0 or instr(Form_FaceHeight,",")>0 or Form_FaceHeight = "" then
			If Form_FaceUrl <> "" Then
				GBL_CHK_TempStr = "自定义头像高度填写错误!<br>"
				GBL_CHK_Flag = 0
				Exit Function
			End If
		End If
		
		If Form_FaceUrl <> "" Then
			Form_FaceWidth = cCur(Form_FaceWidth)
			Form_FaceHeight = cCur(Form_FaceHeight)
			If Form_FaceWidth <20 or Form_FaceWidth > DEF_AllFaceMaxWidth or Form_FaceHeight < 20 or Form_FaceHeight > DEF_AllFaceMaxWidth*2 Then
				GBL_CHK_TempStr = "自定义头像高度和宽度大小只能在20-" & DEF_AllFaceMaxWidth & "之间!<br>"
				GBL_CHK_Flag = 0
				Exit Function
			End If
		End If
	End If


	If Form_FaceUrl = "" Then
		If IsNumeric(Form_FaceWidth) = 0 or instr(Form_FaceWidth,",")>0 or Form_FaceWidth = "" then
			Form_FaceWidth = 0
		Else
			Form_FaceWidth = cCur(Form_FaceWidth)
		End If
		
		If IsNumeric(Form_FaceHeight) = 0 or instr(Form_FaceHeight,",")>0 or Form_FaceHeight = "" then
			Form_FaceHeight = 0
		Else
			Form_FaceHeight = cCur(Form_FaceHeight)
		End If
	Else
		If Lcase(Left(Replace(Form_FaceUrl,"\","/"),7)) <> "http://" and Lcase(Left(Replace(Form_FaceUrl,"\","/"),6)) <> "ftp://" and Lcase(Left(Replace(Form_FaceUrl,"\","/"),8)) <> "https://" Then
			Dim Temp
			Temp = Lcase(Right(Form_FaceUrl,4))
			If Temp <> ".gif" and Temp <> ".jpg" and Temp <> "jpeg" and Temp <> ".jpe" and Temp<>".png" Then
				GBL_CHK_TempStr = "自定头像填写错误，必须是jpg,gif,png等图像格式!<br>"
				GBL_CHK_Flag = 0
				Exit Function
			End If

			on error resume next
			If DEF_FSOString <> "" Then
				Dim fs
				Set fs = CreateObject(DEF_FSOString)
				if (Err = 0) Then
					if not fs.FileExists(Server.Mappath("../" & Form_FaceUrl)) then
						if err Then
							GBL_CHK_TempStr = "自定头像填写错误，请确定是否填写正确!<br>"
							err.clear
						Else
							GBL_CHK_TempStr = "自定头像填写错误，本服务器上没有此文件!<br>"
						End If
						GBL_CHK_Flag = 0
						Set fs = Nothing
						Exit Function
					End If
				Else
					'Set fs = Nothing
					'If DEF_EnableGFL = 1 Then
					'	Dim TempW,TempH
					'	TempW = DEF_AllFaceMaxWidth
					'	TempH = DEF_AllFaceMaxWidth
					'	If CheckIsGoodImg(Server.Mappath("../" & Form_FaceUrl),TempW,TempH*2) = 0 Then
					'		GBL_CHK_TempStr = "自定头像错误，原因是" & GBL_CHK_TempStr & "!<br>"
					'		GBL_CHK_Flag = 0
					'		Exit Function
					'	Else
					'		Form_FaceWidth = TempW
					'		Form_FaceHeight = TempH
					'	End If
					'End If
				End If
			End If
		End If
	End If

	Form_PrintUnderwrite = UBB_Code_UnderWrite(Form_Underwrite)
	If StrLength(Form_PrintUnderwrite) > 1024 Then 
		GBL_CHK_TempStr = GBL_CHK_TempStr & "签名太长!<br>"
		GBL_CHK_Flag = 0
		Exit Function
	End If
	
	GBL_CHK_Flag = 1

End Function

Function CheckIsGoodImg(LoadFile,W,H)

	on error resume next

	Dim MyObj
	Set MyObj = Server.CreateObject("GflAx190.GflAx")
	If err Then
		CheckIsGoodImg = 0
		GBL_CHK_TempStr = "论坛未完整安装！"
		Exit Function
	End If
	MyObj.EnableLZW = True
	MyObj.LoadBitmap(LoadFile)
	if err Then
		CheckIsGoodImg = 0
		GBL_CHK_TempStr = "非图像文件！"
		Set MyObj = Nothing
		Exit Function
	End If
	
	Dim Img_Width,Img_Height
	
	Img_Height = MyObj.Height
	Img_Width = MyObj.Width
	
	Set MyObj = Nothing
	
	If Img_Height > H or Img_Height < 20 or Img_Width > W or Img_Width < 20 Then
		CheckIsGoodImg = 0
		GBL_CHK_TempStr = "图像大小不符合要求！"
		Exit Function
	End If
	
	W = Img_Width
	H = Img_Height
	
	CheckIsGoodImg = 1

End Function

Rem 检测某用户名是否存在
Function CheckUserNameExist(UserName)

	Dim Rs
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 * from LeadBBS_User where UserName='" & Replace(UserName,"'","''") & "' and id<>" & Form_ID,con,1,1
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		CheckUserNameExist = 0
	Else
		CheckUserNameExist = 1
	End if
	Rs.Close
	Set Rs = Nothing

End Function

Rem 检测某用户名ID是否存在
Function CheckUserIDExist(UserID)

	Dim Rs
	Set Rs = Server.CreateObject("ADODB.RecordSet")
	Rs.Open "Select top 1 * from LeadBBS_User where ID=" & UserID,con,1,1
	GBL_DBNum = GBL_DBNum + 1
	If Rs.Eof Then
		CheckUserIDExist = 0
	Else
		CheckUserIDExist = 1
	End if
	Rs.Close
	Set Rs = Nothing

End Function

Function DisplayOfficerString(Officer)

	Dim Officer_Temp,Temp_N,dotFlag
	dotFlag = 0
	Officer_Temp = split(Officer,",")
	For Temp_N = 0 to Ubound(Officer_Temp,1)
		If isNumeric(Officer_Temp(Temp_N)) Then
			Officer_Temp(Temp_N) = cCur(Officer_Temp(Temp_N))
			If Officer_Temp(Temp_N)>=0 and Officer_Temp(Temp_N)<=DEF_UserOfficerNum Then
				If dotFlag = 0 Then
					dotFlag = 1
					DisplayOfficerString = DisplayOfficerString & DEF_UserOfficerString(Officer_Temp(Temp_N))
				Else
					DisplayOfficerString = DisplayOfficerString & "," & DEF_UserOfficerString(Officer_Temp(Temp_N))
				End If
			End If
		End If
	Next

End Function

Function DisplayOfficerList

	Dim Temp_N
	Response.Write "<br><p><u>职务对照表</u><br><img src=" & DEF_BBS_HomeUrl & "images/blank.gif height=5 width=3><br>"
	For Temp_N = 0 to DEF_UserOfficerNum
		Response.Write Temp_N & " - " & DEF_UserOfficerString(Temp_N) & "<br>" & VbCrLf
	Next

End Function

Function DisplayLevelList

	Dim Temp_N
	Response.Write "<br><p><u>等级对照表</u><br><img src=" & DEF_BBS_HomeUrl & "images/blank.gif height=5 width=3><br>"
	For Temp_N = 0 to DEF_UserLevelNum
		Response.Write Temp_N & " - " & DEF_UserLevelString(Temp_N) & "<br>" & VbCrLf
	Next

End Function
%>