📄 class_mobile.asp

📁 公司企业网站管理系统全站源码正式免费版
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
				Next
				OtherContent = re.Replace(OtherContent,"<content type=""$1"" src=""$3""></content>")
				Str = re.Replace(Str,"")
			End If
			If InStr(Lcase(Str),"[img]")>0 Then
				re.Pattern = "\[(img)\]([^\[\]]+)\[\/\1\]"
				If re.Test(Str) Then
					Set Matches = re.Execute(Str)
					For Each Match in Matches
						OtherContent = OtherContent & Match.Value
					Next
					OtherContent = re.Replace(OtherContent,"<content type=""image"" src=""$2""></content>")
					Str = re.Replace(Str,"")
				End If
			End If
			If InStr(Lcase(Str),"[upload=")>0 Then
				re.Pattern = "\[(upload)=(gif|jpg|jpeg|bmp|png)\]([^\[\]]+)\[\/\1\]"
				If re.Test(Str) Then
					Set Matches = re.Execute(Str)
					For Each Match in Matches
						OtherContent = OtherContent & Match.Value
					Next
					OtherContent = re.Replace(OtherContent,"<content type=""image"" src="""&Forum_Url&"$3""></content>")
					Str = re.Replace(Str,"")
				End If
			End If
			If InStr(Lcase(Str),"[upload=")>0 Then
				re.Pattern = "\[(upload)=(swf|swi)\]([^\[\]]+)\[\/\1\]"
				If re.Test(Str) Then
					Set Matches = re.Execute(Str)
					For Each Match in Matches
						OtherContent = OtherContent & Match.Value
					Next
					OtherContent = re.Replace(OtherContent,"<content type=""flash"" src="""&Forum_Url&"$3""></content>")
					Str = re.Replace(Str,"")
				End If
			End If
			If InStr(Lcase(Str),"[upload=")>0 Then
				re.Pattern = "\[(upload)=(.[^\[]*)\]([^\[\]]+)\[\/\1\]"
				If re.Test(Str) Then
					Set Matches = re.Execute(Str)
					For Each Match in Matches
						OtherContent = OtherContent & Match.Value
					Next
					OtherContent = re.Replace(OtherContent,"<content type=""other"" src="""&Forum_Url&"$3""></content>")
					Str = re.Replace(Str,"")
				End If
			End If
			
			re.Pattern="(\[(|\/)B\])"
			Str=re.Replace(Str, "[$2b]")
			re.Pattern="(\[(|\/)i\])"
			Str=re.Replace(Str, "[$2i]")
			re.Pattern="(\[(|\/)u\])"
			Str=re.Replace(Str, "[$2u]")
			Set Re=Nothing
			Str = Replace(Str,"]]>","]]&gt;")
			ForMatHtml = Str
		End If
	End Function

	'标题
	Function ForMatHtmlTitle(str)
		If Str<>"" And Not IsNull(Str) Then
			Str = Replace(Str, CHR(10), "")
			Str = Replace(Str, CHR(13), "")
			Dim Re
			Set Re = new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern="<(.[^>]*)>"
			Str=re.Replace(Str,"")
			re.Pattern = "(&nbsp;)"
			Str = re.Replace(Str,Chr(9))
			Set Re=Nothing
			Str = Replace(Str,"]]>","]]&gt;")
			ForMatHtmlTitle = Str
		End If
	End Function

	Rem ====================函数部分结束==============
	
	Rem ======================属性部分================
	
	Rem ====================属性部分结束==============

	'错误信息，ErrCode为错误信息编码
	Public Sub AddErrCode(ByVal ErrCode)
		If ErrCode<>"" and IsNumeric(ErrCode) Then
			Dvbbs.LoadTemplates("showerr")
			ShowErr 0,Template.Strings(ErrCode)
		End If
	End Sub

	Public Sub LoadBoardPass()
		If Dvbbs.BoardID < 1 Then Exit Sub
		'Dvbbs.Name="BoardInfo_" & Dvbbs.BoardID
		'If Dvbbs.ObjIsEmpty() Then Dvbbs.ReloadBoardInfo(Dvbbs.BoardID)
		'Dvbbs.Board_Data = Dvbbs.Value
		'Dvbbs.Board_Setting = Split(Dvbbs.Board_Data(16,0),",")
		'Dvbbs.sid = Dvbbs.Board_Data(15,0)
		If Dvbbs.UserID > 0 Then
			If Dvbbs.Master Then
				Dvbbs.Boardmaster=True
			ElseIf Dvbbs.Superboardmaster Then
				Dvbbs.Boardmaster=True
			ElseIf Dvbbs.UserGroupID =3 And Not Trim(Dvbbs.BoardMasterList) = "" Then
				If Instr("|"&lcase(Dvbbs.BoardMasterList)&"|","|"&lcase(Dvbbs.Membername)&"|")>0 Then
					Dvbbs.Boardmaster=True
				End If
			End If
		End If
		GetBoardPermission()
	End Sub

	Rem 获得版面用户组权限配置
	Public Sub GetBoardPermission()
		Dim Rs,IsGroupSetting
		IsGroupSetting = Dvbbs.IsGroupSetting
		If IsGroupSetting<>"" And Not IsNull(IsGroupSetting) Then
			IsGroupSetting = "," & IsGroupSetting & ","
		
			If InStr(IsGroupSetting,"," & Dvbbs.UserGroupID & ",")>0 Then
				Set Rs=Dvbbs.Execute("Select PSetting From Dv_BoardPermission Where Boardid="&Dvbbs.Boardid&" And GroupID="&Dvbbs.UserGroupID)
				If Not (Rs.Eof And Rs.Bof) Then
					Dvbbs.GroupSetting = Split(Rs(0),",")
				End If
				Set Rs=Nothing
			End If
			If Dvbbs.UserID>0 And InStr(IsGroupSetting,",0_"&Dvbbs.UserID&",")>0 Then
				Set Rs=Dvbbs.execute("Select Uc_Setting From Dv_UserAccess Where Uc_Boardid="&Dvbbs.BoardID&" And uc_UserID="&Dvbbs.Userid)
				If Not(Rs.Eof And Rs.Bof) Then
					Dvbbs.UserPermission=Split(Rs(0),",")
					Dvbbs.GroupSetting = Split(Rs(0),",")
					Dvbbs.FoundUserPer=True
				End If
				Set Rs=Nothing
			End If
		End If
		Call Chkboardlogin()
	End Sub
	Rem 能否进入论坛的判断
	Public Sub Chkboardlogin()
		Dvbbs.GetForum_Setting
		If Dvbbs.Board_Setting(1)="1" And Dvbbs.GroupSetting(37)="0" Then ShowMobileErr("您没有权限进入隐含论坛！")
		If Dvbbs.GroupSetting(0)="0"  Then ShowMobileErr("您没有权限进入本论坛！")
		If Dvbbs.Boardmaster Then Exit Sub
		'访问论坛限制(包括文章、积分、金钱、魅力、威望、精华、被删数、注册时间)
		Dim BoardUserLimited
		BoardUserLimited = Split(Dvbbs.Board_Setting(54),"|")
		If Ubound(BoardUserLimited)=8 Then
			'文章
			If Trim(BoardUserLimited(0))<>"0" And IsNumeric(BoardUserLimited(0)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户发贴最少为 "&BoardUserLimited(0)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text)<Clng(BoardUserLimited(0)) Then ShowMobileErr("本版面设置了用户发贴最少为 "&BoardUserLimited(0)&" 才能进入")
			End If
			'积分
			If Trim(BoardUserLimited(1))<>"0" And IsNumeric(BoardUserLimited(1)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户积分最少为 "&BoardUserLimited(1)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text)<Clng(BoardUserLimited(1)) Then ShowMobileErr("本版面设置了用户积分最少为 "&BoardUserLimited(1)&" 才能进入")
			End If
			'金钱
			If Trim(BoardUserLimited(2))<>"0" And IsNumeric(BoardUserLimited(2)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户金钱最少为 "&BoardUserLimited(2)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text)<Clng(BoardUserLimited(2)) Then ShowMobileErr("本版面设置了用户金钱最少为 "&BoardUserLimited(2)&" 才能进入")
			End If
			'魅力
			If Trim(BoardUserLimited(3))<>"0" And IsNumeric(BoardUserLimited(3)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户魅力最少为 "&BoardUserLimited(3)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text)<Clng(BoardUserLimited(3)) Then ShowMobileErr("本版面设置了用户魅力最少为 "&BoardUserLimited(3)&" 才能进入")
			End If
			'威望
			If Trim(BoardUserLimited(4))<>"0" And IsNumeric(BoardUserLimited(4)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户威望最少为 "&BoardUserLimited(4)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text)<Clng(BoardUserLimited(4)) Then ShowMobileErr("本版面设置了用户威望最少为 "&BoardUserLimited(4)&" 才能进入")
			End If
			'精华
			If Trim(BoardUserLimited(5))<>"0" And IsNumeric(BoardUserLimited(5)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户精华最少为 "&BoardUserLimited(5)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userisbest").text)<Clng(BoardUserLimited(5)) Then ShowMobileErr("本版面设置了用户精华最少为 "&BoardUserLimited(5)&" 才能进入")
			End If
			'删贴
			If Trim(BoardUserLimited(6))<>"0" And IsNumeric(BoardUserLimited(6)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户被删贴少于 "&BoardUserLimited(6)&" 才能进入")
				If Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userdel").text)>Clng(BoardUserLimited(6)) Then ShowMobileErr("本版面设置了用户被删贴少于 "&BoardUserLimited(6)&" 才能进入")
			End If
			'注册时间
			If Trim(BoardUserLimited(7))<>"0" And IsNumeric(BoardUserLimited(7)) Then
				If Dvbbs.UserID = 0 Then ShowMobileErr("本版面设置了用户注册时间大于 "&BoardUserLimited(7)&" 分钟才能进入")
				If DateDiff("s",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now)<Clng(BoardUserLimited(7))*60 Then ShowMobileErr("本版面设置了用户注册时间大于 "&BoardUserLimited(7)&" 分钟才能进入")
			End If
		
		End If
		'认证版块判断Board_Setting(2)
		If Dvbbs.Board_Setting(2)="1" Then
			Dim Get_BoardUser_Money,Canlogin
			Get_BoardUser_Money = False
			If Clng(Dvbbs.Board_Setting(62))>0 Or Clng(Dvbbs.Board_Setting(63))>0 Then Get_BoardUser_Money = True
			Canlogin = False
			If Dvbbs.UserID=0 Then
				ShowMobileErr("本论坛为认证论坛，请确认您的用户名已经得到管理员的认证后进入。")
			Else
				Dim Boarduser,i,BoardUser_Money
				BoardUser = Dvbbs.boarduser
				If Ubound(Boarduser)=-1 Then	'为空时值等于-1
					Canlogin = False
				Else
					For i = 0 To Ubound(Boarduser)
						If Get_BoardUser_Money Then
							BoardUser_Money = Split(Boarduser(i),"=")
							If Trim(Lcase(BoardUser_Money(0))) = Trim(Lcase(Dvbbs.MemberName)) Then
								'修改判断支付金币或点券进入版面的有效期 2004-8-29 Dv.Yz
								If Not DateDiff("d",BoardUser_Money(1),Now()) > Cint(Dvbbs.Board_Setting(64))*30 Then
									Canlogin = True
									Exit For
								End If
							End If
						Else
							If Trim(Lcase(Boarduser(i))) = Trim(Lcase(Dvbbs.MemberName)) Then
								Canlogin = True
								Exit For
							End If
						End If
					Next
				End If
			End	If
			If Get_BoardUser_Money And Instr(Lcase(Dvbbs.ScriptName),"pay_boardlimited")=0 And (Not Canlogin) Then
				'Response.Redirect "pay_boardlimited.asp?boardid=" & Dvbbs.BoardID
				ShowMobileErr("本论坛为认证论坛，请确认您的用户名已经得到管理员的认证后进入。")
			End If
			If Instr(Lcase(Dvbbs.ScriptName),"pay_boardlimited")=0 And (Not Canlogin) Then
				ShowMobileErr("本论坛为认证论坛，请确认您的用户名已经得到管理员的认证后进入。")
			End If
		End If
	End Sub
	Public Sub ShowMobileErr(ErrStr)
		ShowXMLStar
		ShowErr 0,ErrStr
		ShowXMLEnd
		Response.End
	End Sub

End Class

Dim DvbbsWap
Set DvbbsWap = New Mobile_Forum
%>
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -