cls_user.asp

后台目录:qwbAdmin/Login.asp 登陆用户名:admin 登陆密码:admin

					m_StrTel = f_RsUserObj("Tel")
					m_StrMSN = f_RsUserObj("MSN")
					m_StrQQ = f_RsUserObj("QQ")
					m_StrCorner = f_RsUserObj("Corner")
					m_StrProvince = f_RsUserObj("Province")
					m_StrCity = f_RsUserObj("City")
					m_StrAddress = f_RsUserObj("Address")
					m_StrPostCode = f_RsUserObj("PostCode")
					m_PassQuestion = f_RsUserObj("PassQuestion")
					m_SelfIntro = f_RsUserObj("SelfIntro")
					m_UserFavor =  f_RsUserObj("UserFavor")
					m_isOpen = f_RsUserObj("isOpen")
					m_Vocation = f_RsUserObj("Vocation")
					m_HeadPic = f_RsUserObj("HeadPic")
					m_HeadPicsize = f_RsUserObj("HeadPicsize")
					m_StrNickName = f_RsUserObj("NickName")
					Mobile = f_RsUserObj("Mobile")
					m_CloseTime = f_RsUserObj("CloseTime")
					m_IsCorporation = f_RsUserObj("IsCorporation")
					isMessage = f_RsUserObj("isMessage")
					m_StrEmail = f_RsUserObj("Email")
					m_NumSex = f_RsUserObj("sex")
					safeCode = f_RsUserObj("safeCode")
					m_UserLoginCode =  f_RsUserObj("UserLoginCode")
				end if
			Else
				checkStat = False
			End If
			f_RsUserObj.Close:set f_RsUserObj = Nothing
		End If
	End Function
	
	Public Function CheckPostinput()
		On Error Resume Next
		Dim server_v1, server_v2
		CheckPost = False
		server_v1 = CStr(Request.ServerVariables("HTTP_REFERER"))
		server_v2 = CStr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1, 8, Len(server_v2)) = server_v2 Then
			CheckPost = True
		End If
	End Function

	Public Sub out()
		Session("FS_UserName") = ""
		Session("FS_UserNumber") = ""
		Session("FS_UserPassword") = ""
		Session("FS_Group") = ""
		Session("FS_IsCorp") = ""
		Session("FS_NickName") = ""
		response.Cookies("FoosunUserCookies")("UserLogin_Style_Num")  = ""
		Session("UserLoginCode") = ""
	End Sub

	Public Function ChangePWD(f_StrName,StrOldPWD,StrNewPWD)
		If f_StrName="" Or StrOldPWD="" Then
			ChangePWD = "帐号或密码不正确"
		Else
			Dim ObjPWD
			Set ObjPWD = server.CreateObject("Adodb.RecordSet")
			objPWD.open "select Password from FS_Members where MemName='"&f_StrName&"' and Password='"&StrOldPWD&"'",User_Conn,3,3
			If Not ObjPWD.EOF Then
				ObjPWD("Password")=StrNewPWD
				ObjPWD.update
				Response.Cookies("Foosun")("MemPassword") = StrNewPWD
				ChangePWD = True
			Else
				ChangePWD = "您不是风讯会员"
			End If		
		End If
	End Function

	Public Function FriendList()
		FriendList = ""
		Dim f_RsFriend,f_StrFriend
		Set f_RsFriend = User_Conn.Execute("Select  top 50 F_UserNumber from FS_ME_Friends where FriendType =0 and UserNumber='"& session("FS_UserNumber") &"' order by FriendID desc")
		Do While Not f_RsFriend.EOF 
			if f_RsFriend("F_UserNumber")= "0" then
					f_RsFriend.MoveNext
			Else
				f_StrFriend = f_RsFriend(0)
				Dim f_GetUserClsObj ,f_strGetCls,f_StrTmpFriend,f_StrUserNamechar
				'Call UserExist(f_StrFriend)
				Set f_GetUserClsObj = User_Conn.execute("select UserNumber,RealName,UserName from FS_ME_Users where UserNumber ='"& f_RsFriend("F_UserNumber") &"'")
				if Not f_GetUserClsObj.eof then
					if f_GetUserClsObj("RealName") = "" then
						f_strGetCls = f_GetUserClsObj("UserName")
					Else
						f_strGetCls = f_GetUserClsObj("RealName")
					End if
					f_StrTmpFriend = f_GetUserClsObj("UserName")
					f_StrUserNamechar = "("&f_GetUserClsObj("UserName")&")"
			    Else
					f_RsFriend.MoveNext
			    End if
				FriendList = FriendList & "<option value="""&f_StrTmpFriend&""">·"&f_strGetCls & f_StrUserNamechar&"</option>" & vbcrlf
				f_RsFriend.MoveNext
			End if
		Loop 
		set f_GetUserClsObj = nothing
		Set f_RsFriend = Nothing 
	End Function

	Public Function AddFriend(f_FriendName,f_FriendCName,f_SelfName,f_type)
		Dim f_RsFriend
		Set f_RsFriend = Server.CreateObject(G_FS_RS)
		f_RsFriend.Open "select * from FS_Friend where FriendName='"&f_FriendName&"'",User_Conn,1,3
		If f_RsFriend.EOF = False Then 
			AddFriend = False
		Else
			f_RsFriend.addNew
			f_RsFriend("FriendName")=f_FriendName
			f_RsFriend("RealName")=f_FriendCName
			f_RsFriend("MemName")=f_SelfName
			f_RsFriend("type")=f_type
			f_RsFriend.Update
			AddFriend = True 
		End If 
		Set f_RsFriend = Nothing 
	End Function
	
	Public Function InsertMyPara(f_strUserNumber)
			Dim f_Rsmypara
			Set f_Rsmypara = server.CreateObject(G_FS_RS) 
			f_Rsmypara.open "select  * From FS_ME_MySysPara where 1=0",User_Conn,1,3
			f_Rsmypara.addnew
			f_Rsmypara("DownFileRule") = ",,,,"
			f_Rsmypara("NewsFileRule") = ",,,,"
			f_Rsmypara("ProductFileRule") = ",,,,"
			f_Rsmypara("ilogFileRule") = ",,,,"
			f_Rsmypara("mysiteName") = "我的个人空间"
			f_Rsmypara("UserNumber") = f_strUserNumber
			f_Rsmypara("Keywords") = "风讯,CMS,Foosun"
			f_Rsmypara("Description") = "风讯,CMS,Foosun"
			f_Rsmypara("NaviPic") = ""
			f_Rsmypara("isHtml") = 0
			'f_Rsmypara("RedirectUrl") = ""
			f_Rsmypara.update
			f_Rsmypara.close:Set f_Rsmypara = nothing
	End Function
	
	Public Function DelFriend(f_NumID)
		On Error Resume Next
		User_Conn.Execute("Delete From FS_Friend Where id in("&f_NumID&")")
		If Err Then 
			Err.clear
			DelFriend = False
		Else
			DelFriend = True
		End If 
	End Function 
	
	Public Function GetFriendNumber(f_strNumber)
		Dim RsGetFriendNumber
		Set RsGetFriendNumber = User_Conn.Execute("Select UserNumber From FS_ME_Users Where UserName = '"& f_strNumber &"'")
		If  Not RsGetFriendNumber.eof  Then 
			GetFriendNumber = RsGetFriendNumber("UserNumber")
		Else
			GetFriendNumber = ""
		End If 
		set RsGetFriendNumber = nothing
	End Function 
	
	Public Function GetFriendName(f_strNumber)
		if f_strNumber="0" then
				GetFriendName = "管理员"
		else
			Dim RsGetFriendName
			Set RsGetFriendName = User_Conn.Execute("Select UserName From FS_ME_Users Where UserNumber = '"& f_strNumber &"'")
			If  Not RsGetFriendName.eof  Then 
				GetFriendName = RsGetFriendName("UserName")
			Else
				GetFriendName = "用户已经被删除"
			End If 
			set RsGetFriendName = nothing
		end if
	End Function 
	
	Public Function ChangeFriend(f_NumID,f_Type)
		On Error Resume Next
		User_Conn.Execute("update FS_Friend set type="&f_Type&" Where id in("&f_NumID&")")
		If Err Then 
			Err.clear
			ChangeFriend = False
		Else
			ChangeFriend = True
		End If 
	End Function 
	
	Public Function getUserConfig(f_Num)
		Dim f_RsUserConfig
		Set f_RsUserConfig = User_Conn.Execute("select MemberType,UserConfer,NumberContPoint,NumberLoginPoint,isEmail,isChange,SendPoint,MaxContent,QPoint,IsReg,IsCheck,IsCorpus,IsFavorite,IsMessage,FirstPoint,IsEmailCert,RegOption,UserGroup,BadName,NumberBadLoginPoint,NumberContPassPoint,NumberContBadPoint,BadLoginTime,BadLoginNum from Fs_Config")
		If f_RsUserConfig.EOF Then 
			getUserConfig = False
		Else
			getUserConfig = f_RsUserConfig(f_Num)
		End If
		Set f_RsUserConfig = Nothing 
	End Function 

	Public Function AddCorpus(f_title,f_subtitle,f_Content,f_User,f_Corpus)
		If f_title="" Or f_Content="" Or f_Corpus="" Or f_User="" Then
			AddCorpus = False
		Else
			Dim f_fields,f_values
			f_fields = "UserName,Corpus,Title,SubTitle,Content,AddTime"
			f_values = "'"&f_User&"','"&f_Corpus&"','"&f_title&"','"&f_subtitle&"','"&f_Content&"','"&Now()&"'"
		'	On Error Resume Next 
			User_Conn.Execute("insert into FS_Corpus("&f_fields&") values("&f_values&")")
			If Err Then 
				Err.clear 
				AddCorpus = False
			Else
				AddCorpus = True 
			End if 
		End If 
	End Function 

	Public Function AddLog(f_type,f_StrUserName,f_Strpoints,fs_Strmoneys,f_StrContent,f_Numstyle)'用户编号,点数,金币,描述
		If f_StrUserName="" Or f_Strpoints="" Or fs_Strmoneys="" Then
			AddLog = False
		Else
			dim f_AddlogObj
			Set f_AddlogObj = server.CreateObject(G_FS_RS)
			f_AddlogObj.open "select  * From FS_ME_Log where 1=0",User_Conn,1,3
			f_AddlogObj.addnew
			f_AddlogObj("LogType")=f_type
			f_AddlogObj("UserNumber")=f_StrUserName
			f_AddlogObj("points")=f_Strpoints
			f_AddlogObj("moneys")=fs_Strmoneys
			f_AddlogObj("LogTime")=Now
			f_AddlogObj("LogContent")=f_StrContent
			if f_Numstyle = 0 then
				f_AddlogObj("Logstyle")=0
			Else
				f_AddlogObj("Logstyle")=1
			End if
			f_AddlogObj.update
			f_AddlogObj.close
			set f_AddlogObj = nothing
			If Err Then 
				Err.clear
				AddLog = False
			Else
				AddLog = True
			End If 
		End If 
	End Function 

	Public Function update(f_Fields,f_values,f_NumID)
		If f_Fields="" Or f_values="" Or f_NumID="" Then
			update = False
		Else
			On Error Resume Next 
			Dim f_ArrField,f_ArrValue,f_StrDeal,i
			If InStr(f_Fields,",")>0 And InStr(f_values,",")>0 Then 
				f_ArrField = Split(f_Fields,",")
				f_ArrValue = Split(f_values,",")
				If UBound(f_ArrField) <> UBound(f_ArrValue) Then update = False : Exit Function 
			Else
				f_ArrField = Array(f_Fields)
				f_ArrValue = Array(f_values)
			End If 
			f_StrDeal = ""
			For i=LBound(f_ArrField) To UBound(f_ArrField)
				If i=LBound(f_ArrField) Then 
					f_StrDeal = f_ArrField(i)&"="&f_ArrValue(i)
				Else
					f_StrDeal = f_StrDeal&","&f_ArrField(i)&"="&f_ArrValue(i)
				End If 
			Next 
			User_Conn.Execute("update FS_members set "&f_StrDeal&" where id="&f_NumID)
			If Err Then
				Err.clear
				update = False
			Else
				update = True
			End if
		End If
	End Function
End Class

Class Cls_Message
	Private m_RsMessage,m_Number,m_UserName,m_LenContent
	Public Property Let UserName(ByVal StrValue)
		m_UserName = StrValue
		m_RsMessage.open "Select count(MessageID) from FS_ME_Message Where M_ReadUserNumber='"& m_UserName &"' and M_ReadTF=0 and isDelR=0 and isRecyle=0 and isDraft=0",User_Conn,1,1
		m_Number = m_RsMessage(0)
		m_RsMessage.close
	End Property 
	Public Property Get Number()	'未读信息数量
		Number = m_Number
	End Property

	Public Function LenContent(f_StrUserNumber)	'内容总长度
		m_RsMessage.open "Select sum(LenContent) from FS_ME_Message where M_ReadUserNumber='"& f_StrUserNumber &"' and IsDelR = 0",User_Conn,1,3
		LenContent = m_RsMessage(0)
		m_RsMessage.close
	End Function 
	
	Public Function LenbContent(f_StrUserNumber)	'内容总长度
		dim m_book
		set m_book= Server.CreateObject(G_FS_RS)
		m_book.open "Select sum(LenContent) from FS_ME_book where M_ReadUserNumber='"& f_StrUserNumber &"'",User_Conn,1,3
		LenbContent = m_book(0)
		m_book.close
	End Function 

	Private Sub Class_Initialize()
		Set m_RsMessage = server.CreateObject(G_FS_RS)
	End Sub

	Private Sub Class_Terminate()
		Set m_RsMessage = Nothing 
	End Sub

	Public Function update(f_Fields,f_values,f_NumID)
		If f_Fields="" Or f_values="" Or f_NumID="" Then
			update = False
		ElseIf f_NumID="_new_" Then
			On Error Resume Next 
			User_Conn.Execute("insert into FS_Me_Message("&f_Fields&") values("&f_values&")")
			If Err Then
				Err.clear
				update = False
			Else
				update = True
			End if
		Else 
			On Error Resume Next 
			Dim f_ArrField,f_ArrValue,f_StrDeal,i
			If InStr(f_Fields,",")>0 And InStr(f_values,",")>0 Then 
				f_ArrField = Split(f_Fields,",")
				f_ArrValue = Split(f_values,",")
				If UBound(f_ArrField) <> UBound(f_ArrValue) Then update = False : Exit Function 
			Else
				f_ArrField = Array(f_Fields)
				f_ArrValue = Array(f_values)
			End If 
			f_StrDeal = ""
			For i=LBound(f_ArrField) To UBound(f_ArrField)
				If i=LBound(f_ArrField) Then 
					f_StrDeal = f_ArrField(i)&"="&f_ArrValue(i)
				Else
					f_StrDeal = f_StrDeal&","&f_ArrField(i)&"="&f_ArrValue(i)
				End If 
			Next 
			User_Conn.Execute("update FS_Message set "&f_StrDeal&" where MeId in("&f_NumID&")")
			If Err Then
				Err.clear
				update = False
			Else
				update = True
			End if
		End If
	End Function 
	
	Public Function CreateUserDir(f_UserNumber,f_number)
			
	End Function
End Class
%>