class_mobile.asp

来自「现在好了」· ASP 代码 · 共 538 行 · 第 1/2 页

ASP
538 行
字号
12
<%
'=========================================================
' Copyright (C) 2003,2004 AspSky.Net. All rights reserved.
' Web: http://www.aspsky.net,http://www.dvbbs.net
' Email: info@aspsky.net,eway@aspsky.net
' File: Class_Mobile.asp
' Date: 2004-8-3
' Author: Dv Dever ,www.aspsky.net
' 文件用途，手机移动论坛访问
'=========================================================
Class Mobile_Forum
	Rem ====================声明部分开始==============
	Public Path,StartID,Number,Mobile,Stype,OP,Child,Self
	Public PathCount
	Public OtherContent
	Private ViewIpLimited
	Dim Re


	Rem ====================声明部分结束==============
	
	Rem ======================过程部分================
	'Class加载时自动执行的代码
	Private Sub Class_Initialize()
		Dvbbs.UserID = 0
		OtherContent = ""
		Path = Trim(Checkstr(Request("Path")))
		StartID = ChkNumeric(Trim(Request("StartID")))
		Number = ChkNumeric(Trim(Request("Number")))
		Mobile = ChkNumeric(Trim(Request("Mobile")))
		Stype = ChkNumeric(Trim(Request("Stype")))
		OP = ChkNumeric(Trim(Request("OP")))
		Child = ChkNumeric(Trim(Request("Child")))
		Self = Child
		Path = Split(Path,"/")
		PathCount = Ubound(Path)
		ViewIpLimited = ",219.238.232.59,219.153.18.230,219.153.18.162,,"
		'ViewIpLimited = ",61.132.138.120,"
		'ChkIpLimited
		ChkWapUser
	End Sub

	Private Sub ChkIpLimited()
		Dim ReServerIp
		ReServerIp = Trim(Request.ServerVariables("REMOTE_ADDR"))
		If ReServerIp = "" Or Instr(ViewIpLimited,ReServerIp) = 0 Then
			ShowMobileErr("您的IP："& ReServerIp &" 来至于受限制的地址！")
		End If
	End Sub

	'验证用户
	Private Sub ChkWapUser
		Mobile = Ccur(Mobile)
		If Mobile=0 or Len(Mobile)<11 Then
			If InStr(Dvbbs.ScriptName,"wap_userlogin.asp")=0 Then
				ShowMobileErr("您的手机号码："& Mobile &" 不能访问本论坛！")
			End If
		End If
		If Mobile=0 Then
			Dvbbs.UserID = 0
			Dvbbs.UserGroupID = 7
		Else
			'Session(CacheName & "UserID")用户资料=0dvbbs+1刷新时间+2发帖时间+3所在版面ID+4用户ID+5用户名+6用户密码+7用户邮箱+8用户文章数+9用户主题数+10用户性别+11用户头像+12用户头像宽+13用户头像高+14用户注册时间+15用户最后登陆时间+16用户登陆次数+17用户状态+18用户等级+19用户组ID+20用户组名+21用户金钱+22用户积分UserEp+23用户魅力UserCp+24用户威望+25用户生日+26最后登陆IP+27用户被删除数+28用户精华数+29用户隐身状态+30用户短信情况+31用户阳光会员+32用户手机+33用户组图标+34用户头衔+35验证密码+36用户今日信息+37用户金币+38用户点券+	39跟踪用户ID+40VIP登记时间+41VIP截止时间+42是否存在全局自定义权限IsUserPermissionAll+43是否有多属性用户组IsUserPermissionOnly+44临时数据+45Dvbbs
			Dim Rs,SQL,MyUserInfo
			Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime"
			Sql=Sql+" From [Dv_User] Where UserMobile = '" & Mobile &"'"
			Set Rs = Dvbbs.Execute(Sql)
			If Rs.Eof Then
				Rs.Close:Set Rs = Nothing
				Dvbbs.UserID = 0
				Dvbbs.UserGroupID = 7
			Else
				MyUserInfo=Rs.GetString(,1, "|||","","")
				Rs.Close:Set Rs = Nothing
				MyUserInfo = "Dvbbs|||"& Now & "|||" & DateAdd("s",-3600,Now()) &"|||0|||"& MyUserInfo &"|||"&Dvbbs.FoundUserPermission_All()&"|||0||||||Dvbbs"
				MyUserInfo = Split(MyUserInfo,"|||")
				Dvbbs.UserID = Clng(MyUserInfo(4))
				Dvbbs.MemberName = MyUserInfo(5)
				Dvbbs.UserGroupID = Cint(MyUserInfo(19))
				Dvbbs.MyUserInfo = MyUserInfo
			End If
		End If
		GetGroupSetting
		If Dvbbs.UserID>0 Then
			Dvbbs.Lastlogin = MyUserInfo(15)
			If Not IsDate(Dvbbs.LastLogin) Then Dvbbs.LastLogin = Now()
			If Trim(MyUserInfo(36))="" Then
				Dvbbs.Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & Dvbbs.UserID)
				Dvbbs.MyUserInfo(36) = "0|0|0|0|0"
				Dvbbs.UserToday = Split(Dvbbs.MyUserInfo(36),"|")
			Else
				Dvbbs.UserToday = Split(Dvbbs.MyUserInfo(36),"|")
				If Ubound(Dvbbs.UserToday) <> 4 Then
					Dvbbs.Execute("Update [Dv_User] Set UserToday='0|0|0|0|0' Where UserID = " & Dvbbs.UserID)
					Dvbbs.MyUserInfo(36) = "0|0|0|0|0"
					Dvbbs.UserToday = Split(Dvbbs.MyUserInfo(36),"|")
				End If
			End If
			Dvbbs.FoundIsChallenge = True
			If DateDiff("d",Dvbbs.LastLogin,Now())<>0 Then
				Dvbbs.Execute("Update [Dv_User] Set UserToday='0|0|0|0|0',LastLogin = " & SqlNowString & " Where UserID = " & Dvbbs.UserID)
				Dvbbs.MyUserInfo(36) = "0|0|0|0|0"
				Dvbbs.LastLogin = Now()
			ElseIf DateDiff("s",Dvbbs.Lastlogin,Now())>Clng(Dvbbs.Forum_Setting(8))*60 Then
				Dvbbs.Execute("Update [Dv_User] Set UserLastIP = '" & Dvbbs.UserTrueIP & "',LastLogin = " & SqlNowString & " Where UserID = " & Dvbbs.UserID)
				Dvbbs.Lastlogin = Now()
			End If
		End If
	End Sub

	'更新该用户的权限
	Private Sub GetGroupSetting()
		Dvbbs.Name="GroupSetting_"& Dvbbs.UserGroupID
		If Dvbbs.ObjIsEmpty() Then 
			Dim Rs,SQL
			SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = " & Dvbbs.UserGroupID
			Set Rs = Dvbbs.Execute(SQL)
			If Rs.Eof Then
				Set Rs=Nothing
				SQL = "Select GroupSetting From [Dv_UserGroups] where UserGroupID = 4"
				Set Rs = Dvbbs.Execute(SQL)
				Dvbbs.value=Rs(0)
			Else
				Dvbbs.value=Rs(0)
			End If
		End If
		Dvbbs.GroupSetting = Split(Dvbbs.value,",")
		If Cint(Dvbbs.GroupSetting(0))=0 And Not Dvbbs.Page_Admin Then
			ShowXMLStar
			AddErrCode(8)
			ShowXMLEnd
			Response.End
		End If
		Select Case Dvbbs.UserGroupID
		Case 4
			Dvbbs.Vipuser = True
		Case 3
			Dvbbs.Boardmaster = True
		Case 2
			Dvbbs.Superboardmaster = True
		Case 1
			Dvbbs.Master = True
		End Select
		Dvbbs.IsUserPermissionAll = Dvbbs.MyUserInfo(Ubound(Dvbbs.MyUserInfo)-3)
		If Dvbbs.UserID > 0 And Dvbbs.BoardID=0 Then
			If Dvbbs.IsUserPermissionAll="1" Then Dvbbs.LoadUserPermission_All()
		End If
	End Sub


	'输出XML开始的标记
	Public Sub ShowXMLStar()
		Response.Clear
		Response.CharSet="gb2312"
		Response.ContentType="text/xml" 
		Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"
		Response.Write vbNewLine
		Response.Write "<bbs_query>"
		Response.Write vbNewLine
		Response.Write "<forumname>"&ForMatHtmlTitle(Dvbbs.Forum_Info(0))&"</forumname>"
	End Sub 
	Public Sub ShowErr(ErrCode,ErrMsg)
		'Call ShowXMLStar
		'If Dvbbs.ScriptName="wap_board.asp" Then
			'ShowCodes "" ,4 ,0 ,4 ,ErrMsg ,"" ,Dvbbs.Forum_Info(0) ,Now ,Now
		'Else
			Response.Write "<errcode>"
			Response.Write ErrCode
			Response.Write "</errcode>"
			Response.Write vbNewLine
			Response.Write "<errmsg>"
			Response.Write ForMatHtml(ErrMsg)
			Response.Write "</errmsg>"
		'End If
	End Sub

	'输出模板
	Public Sub ShowCodes(S_Self ,S_Child ,S_Sid ,S_Stype ,S_Name ,S_Content ,S_OtherContent,S_Author ,S_Createtime ,S_Modifytime)
		Dim CodesString
		CodesString = "<query_result>" & vbNewLine
		CodesString = CodesString & "<self>" & S_Self & "</self>" & vbNewLine
		CodesString = CodesString & "<child>" & S_Child & "</child>" & vbNewLine
		CodesString = CodesString & "<sid>" & S_Sid & "</sid>" & vbNewLine
		CodesString = CodesString & "<stype>" & S_Stype & "</stype>" & vbNewLine
		CodesString = CodesString & "<name><![CDATA[" & ForMatHtmlTitle(S_Name) & "]]></name>" & vbNewLine
		CodesString = CodesString & S_Content
		CodesString = CodesString & S_OtherContent & vbNewLine
		CodesString = CodesString & "<author>" & S_Author & "</author>" & vbNewLine
		CodesString = CodesString & "<createtime>" & S_Createtime & "</createtime>" & vbNewLine
		CodesString = CodesString & "<modifytime>" & S_Modifytime & "</modifytime>" & vbNewLine
		CodesString = CodesString & "</query_result>" & vbNewLine
		Response.Write CodesString
	End Sub

	Public Function Format_Content(sType,sBody)
		Dim CodesString
		If sType = 1 Then
			CodesString = "<content type=""other"" src="""&sBody&"""></content>" & vbNewLine
		Else
			CodesString = "<content type=""text""><![CDATA[" & sBody &"]]></content>" & vbNewLine
		End if
		Format_Content = CodesString
	End Function

	'输出XML结束的标记
	Public Sub ShowXMLEnd()
		Response.Write vbNewLine
		Response.Write "</bbs_query>"
	End Sub
	Rem ====================过程部分结束==============
	
	Rem ======================函数部分================
	'通用参数过滤函数
	Public Function Checkstr(Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Replace(Str,"'","''")
	End Function

	'判断参数是否数字型并且不含豆号
	Public Function IsTrueNumeric(Str)
		Dim Numeric
		Numeric=Str & ""
		If IsNumeric(Numeric) And InStr(Numeric,",")=0 Then 
			IsTrueNumeric=True
		Else
			IsTrueNumeric=False
		End If
	End Function

	'判断参数是否数字型并且不含豆号
	Public Function ChkNumeric(Str)
		ChkNumeric = 0
		If Str = Null Then Exit Function
		If IsNumeric(Str) And InStr(Str,",")=0 Then 
			ChkNumeric = cCur(Str)
		End If
	End Function

	'过滤HTML标记，保留换行符等	内容
	Function ForMatHtml(str)
		OtherContent = ""
		Dim Tempstr,RegFound
		RegFound = False
		If Str<>"" And Not IsNull(Str) Then
			Set Re = new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern = "(<br>)"
			Str = re.Replace(Str , CHR(13) & CHR(10))
			re.Pattern="(</p><p>)"
			Str=re.Replace(Str, CHR(13) & CHR(10))
			re.Pattern="(<[|\/]p>)"
			Str=re.Replace(Str, CHR(13) & CHR(10))
			re.Pattern="<(.[^>]*)>"
			Str=re.Replace(Str,"")
			re.Pattern = "(&nbsp;)"
			Str = re.Replace(Str,Chr(9))
			're.Pattern = "\[(i|b|u|center)\]((.|\n)*)\[\/(\1)\]"
			'Str = re.Replace(Str,"<$1>$2</$4>")
			re.Pattern = "\[(fly|move)\]((.|\n)*)\[\/(\1)\]"
			Str = re.Replace(Str,CHR(10)&"$2"&CHR(10))
			re.Pattern = "\[(size|color|face|glow|shadow)=(.[^\[]*)\]((.|\n)*)\[\/(\1)\]"
			Str = re.Replace(Str,"$3")
			re.Pattern = "\[align=(center|left|right)\]((.|\n)*)\[\/align\]"
			Str = re.Replace(Str,"[$1]$2[/$1]")
12

class_mobile.asp - 源码说明

本页面展示了「现在好了」中的 class_mobile.asp 源码文件，采用 ASP 编程语言编写，共 538 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

⌨️ 快捷键说明

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