📄 dv_clsmain.asp

📁 现在好了
💻 ASP
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
				BoardPath = "board/"&BoardPath 
			Next
			Set Node=BoardXML.documentElement.selectSingleNode(BoardPath&"[@boardid='"&Rs(0)&"']")
			For i = 0 To Rs.Fields.Count-1
				Node.attributes.getNamedItem(LCase(Rs(i).name)).text = Rs(i)&""
			Next
			lastpost=Split(Rs("lastpost")&"","$")
			For i=0 to UBound(LastPost)
				Node.attributes.getNamedItem("lastpost"&i).text=LastPost(i)
			Next
			For Each cnode In Node.selectNodes("boardmasterlist")
				node.removeChild(Cnode)
			Next
			BoardMasterList=Split(Rs("BoardMaster")&"","|")
			i=0
			For Each BoardMaster in BoardMasterlist
				Set CNode=Node.appendChild(BoardXML.createNode(1,"boardmasterlist",""))
				CNode.attributes.setNamedItem(BoardXML.createNode(2,"master","")).text=BoardMaster
				CNode.attributes.setNamedItem(BoardXML.createNode(2,"urlencode","")).text=Server.urlencode(BoardMaster)
				CNode.attributes.setNamedItem(BoardXML.createNode(2,"order","")).text=i
				i=i+1
			Next
			Rs.MoveNext
		Loop
		Rs.Close 
		Set Rs = Nothing
	End Sub
	'更新分版面部分缓存数组，入口：版面ID列表,豆号分隔、更新内容、节点名称
	Public Sub ReloadBoardCache(lBoardID,MyValue,TagName)
   		NodeUpdate=True
		'Response.Write "ReloadBoardCache="& lBoardID &" MyValue="&MyValue&" TagName="&TagName&"<br>"
   		lBoardID=Split(lBoardID,",")
   		Dim Nodelist,Node,i,lastpost,j,cnode,BoardMasterList,BoardMaster
		'Set Nodelist=BoardXML.documentElement.getElementsByTagName("board")
		For i=0 to UBound(lBoardID)
			'For Each Node in nodelist
				'If Cstr(lBoardID(i))=Node.attributes.getNamedItem("boardid").text Then
			'------------------------------------
			Set node = BoardXML.selectSingleNode("//*[@boardid='"&lBoardID(i)&"']")
			If not (node is nothing) Then
			'------------------------------------
					Node.attributes.getNamedItem(TagName).text=MyValue
					If TagName="lastpost" Then
						lastpost=Split(MyValue,"$")
						For j=0 to UBound(LastPost)
							Node.attributes.getNamedItem("lastpost"&j).text=LastPost(j)
						Next
					End If
					If TagName="boardmaster" Then
						For Each cnode In Node.selectNodes("boardmasterlist")
							node.removeChild(Cnode)
						Next
						BoardMasterList=Split(MyValue,"|")
						j=0
						For Each BoardMaster in BoardMasterlist
							Set CNode=Node.appendChild(BoardXML.createNode(1,"boardmasterlist",""))
							CNode.attributes.setNamedItem(BoardXML.createNode(2,"master","")).text=BoardMaster
							CNode.attributes.setNamedItem(BoardXML.createNode(2,"urlencode","")).text=Server.urlencode(BoardMaster)
							CNode.attributes.setNamedItem(BoardXML.createNode(2,"order","")).text=j
							j=j+1
						Next
					End If
					Exit For
			'------------------------------------
			End If
			'------------------------------------
				'End If
			'Next
		Next 
	End Sub

	'取得带端口的URL
	Property Get Get_ScriptNameUrl()
		If request.servervariables("SERVER_PORT")="80" Then
			Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
		Else
			Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
		End If
	End Property
	Public Sub GetBrowser()
		Dim Agent,Tmpstr,i
		IsSearch = False
		If Not IsEmpty(Session(Dvbbs.CacheName & "Cls_Browser")) Then
			Tmpstr = Split(Session(Dvbbs.CacheName & "Cls_Browser"),"|||")
			Browser = Dvbbs.checkStr(Tmpstr(0))
			version = Dvbbs.checkStr(Tmpstr(1))
			platform = Dvbbs.checkStr(Tmpstr(2))
			If Tmpstr(3)="1" Then 
				IsSearch = True
			End If
			Exit Sub
		End If
		Browser="unknown"
		version="unknown"
		platform="unknown"
		Agent=Request.ServerVariables("HTTP_USER_AGENT")
		'Agent="Opera/7.23 (X11; Linux i686; U)  [en]"	
		If Left(Agent,7) ="Mozilla" Then '有此标识为浏览器
			Agent=Split(Agent,";")
			If InStr(Agent(1),"MSIE")>0 Then
				Browser="Microsoft Internet Explorer "
				version=Trim(Left(Replace(Agent(1),"MSIE",""),6))
			ElseIf InStr(Agent(4),"Netscape")>0 Then 
				Browser="Netscape "
				tmpstr=Split(Agent(4),"/")
				version=tmpstr(UBound(tmpstr))
			ElseIf InStr(Agent(4),"rv:")>0 Then
				Browser="Mozilla "
				tmpstr=Split(Agent(4),":")
				version=tmpstr(UBound(tmpstr))
				If InStr(version,")") > 0 Then 
					tmpstr=Split(version,")")
					version=tmpstr(0)
				End If
			End If
			If UBound(Agent)>2 Then
				platform = UserPlatForm(Agent(2),Agent(3),UBound(Agent))
			Else
				platform = UserPlatForm(Agent(2),"",UBound(Agent))
			End If
		ElseIf Left(Agent,5) ="Opera" Then 
			Agent=Split(Agent,"/")
			Browser="Mozilla "
			tmpstr=Split(Agent(1)," ")
			version=tmpstr(0)
			If UBound(Agent)>2 Then
				platform = UserPlatForm(Agent(1),Agent(3),UBound(Agent))
			Else
				platform = UserPlatForm(Agent(1),"",UBound(Agent))
			End If
		Else
			'识别搜索引擎
			Dim botlist
			Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
			Botlist=split(Botlist,",")
			For i=0 to UBound(Botlist)
				If InStr(Agent,Botlist(i))>0  Then 
					platform=Botlist(i)&"搜索器"
					IsSearch=True
					Exit For
				End If
			Next 
		End If
		If version<>"unknown" Then 
			Dim Tmpstr1
			Tmpstr1=Trim(Replace(version,".",""))
			If Not IsNumeric(Tmpstr1) Then
				version="unknown"
			End If
		End If
		If IsSearch Then
			Browser=""
			version=""
			Session(Dvbbs.CacheName & "Cls_Browser") = Browser &"|||"& version &"|||"& platform&"|||1"
		Else
			Session(Dvbbs.CacheName & "Cls_Browser") = Browser &"|||"& version &"|||"& platform&"|||0"
		End If
	End Sub
	Private Function UserPlatForm(UserAgent1,UserAgent2,UserAgentNum)
		If InStr(UserAgent1,"NT 5.2")>0 Then
			UserPlatForm="Windows 2003"
		ElseIf InStr(UserAgent1,"Windows CE")>0 Then
			UserPlatForm="Windows CE"
		ElseIf InStr(UserAgent1,"NT 5.1")>0 Then
			UserPlatForm="Windows XP"
		ElseIf InStr(UserAgent1,"NT 4.0")>0 Then
			UserPlatForm="Windows NT"
		ElseIf InStr(UserAgent1,"NT 5.0")>0 Then
			UserPlatForm="Windows 2000"
		ElseIf InStr(UserAgent1,"NT")>0 Then
			UserPlatForm="Windows NT"
		ElseIf InStr(UserAgent1,"9x")>0 Then
			UserPlatForm="Windows ME"
		ElseIf InStr(UserAgent1,"98")>0 Then
			UserPlatForm="Windows 98"
		ElseIf InStr(UserAgent1,"95")>0 Then
			UserPlatForm="Windows 95"
		ElseIf InStr(UserAgent1,"Win32")>0 Then
			UserPlatForm="Win32"
		ElseIf InStr(UserAgent1,"Linux")>0 Then
			UserPlatForm="Linux"
		ElseIf InStr(UserAgent1,"SunOS")>0 Then
			UserPlatForm="SunOS"
		ElseIf InStr(UserAgent1,"Mac")>0 Then
			UserPlatForm="Mac"
		ElseIf UserAgentNum>2 Then
			If InStr(UserAgent2,"NT 5.1")>0 Then UserPlatForm="Windows XP"
			If InStr(UserAgent2,"Linux")>0 Then UserPlatForm="Linux"
		End If
	End Function

	'---------------------------------------------------
	'记录道具操作日志信息(发生数量，记录事件类型，备注内容，用户最后剩余金币和点券（金币|点券）)
	'Log_ID,ToolsID,CountNum,Log_Money,Log_Ticket,AddUserName,AddUserID,Log_IP,Log_Time,Log_Type,BoardID,Conect,HMoney
	'Log_Type类型(0=其它,1=使用,2=转让,3=充值,4=购买,5=奖励,6=vip交易)
	'HMoney最后剩余金币和点券（金币|点券）
	'boardid 记录版面参数，后台为-1
	'---------------------------------------------------
	Public Sub ToolsLog(Log_ToolsID,CountNum,Log_Money,Log_Ticket,Log_Type,Conect,HMoney)
		Dim Sql
		Conect = CheckStr(Conect)
		HMoney = CheckStr(HMoney)
		Sql = "Insert into [Dv_MoneyLog] (ToolsID,CountNum,Log_Money,Log_Ticket,AddUserName,AddUserID,Log_IP,Log_Type,BoardID,Conect,HMoney) values (" &_
			CheckNumeric(Log_ToolsID) &","&_
			CheckNumeric(CountNum) &","&_
			CheckNumeric(Log_Money) &","&_
			CheckNumeric(Log_Ticket) &",'"&_
			MemberName &"',"&_
			UserID &",'"&_
			UserTrueIP &"',"&_
			Log_Type &","&_
			BoardID &",'"&_
			Conect &"','"&_
			HMoney &"'"&_
			")"
		'Response.Write Sql
		Dvbbs.Execute(Sql)
	End Sub
End Class
Class cls_Templates
	Public html,Strings,pic
	Public Property Let Value(ByVal vNewValue)
		Dim TemplateStr,tmpstr:TemplateStr = vNewValue
		TemplateStr = Replace(TemplateStr,"{$PicUrl}",Dvbbs.Forum_PicUrl)
		tmpstr = Split(TemplateStr,"@@@")
		html = Split(tmpstr(0),"|||"):Strings = Split(tmpstr(1),"|||"):pic = Split(tmpstr(2),"|||")
	End Property
End Class
Class cls_UserOnlne
	Public Forum_Online,Forum_UserOnline,Forum_GuestOnline
	Private l_Online,l_GuestOnline
	Private Sub Class_Initialize()
		Dvbbs.Name="Forum_Online"
		Dvbbs.Reloadtime=60
		If Dvbbs.ObjIsEmpty() Then ReflashOnlineNum
		Dvbbs.Name="Forum_Online"
		Forum_Online = Dvbbs.Value
		Dvbbs.Name="Forum_UserOnline"
		If Dvbbs.ObjIsEmpty() Then ReflashOnlineNum
		Forum_UserOnline=Dvbbs.Value
		If Forum_Online < 0  Or Forum_UserOnline < 0 Or Forum_UserOnline > Forum_Online Then ReflashOnlineNum
		Forum_GuestOnline = Forum_Online - Forum_UserOnline
		l_Online=-1:l_GuestOnline=-1
		Dvbbs.Reloadtime=28800
	End Sub
	Public Sub OnlineQuery()
		Dim SQL,SQL1
		Dim TempNum,TempNum1
		Dvbbs.Name="delOnline_time"
		If Dvbbs.ObjIsEmpty() Then Dvbbs.Value=Now()
		If DateDiff("s",Dvbbs.Value,Now()) > Clng(Dvbbs.Forum_Setting(8))*10 Then
			Dvbbs.Value=Now()
			If Not IsObject(Conn) Then ConnectionDatabase
			If IsSqlDataBase = 1 Then
				SQL = "Delete From [DV_Online] Where UserID=0 And Datediff(Mi, Lastimebk, " & SqlNowString & ") > " & Clng(Dvbbs.Forum_Setting(8))
				SQL1 = "Delete From [DV_Online] Where UserID>0 And Datediff(Mi, Lastimebk, " & SqlNowString & ") > " & Clng(Dvbbs.Forum_Setting(8))
			Else
				SQL = "Delete From [Dv_Online] Where UserID=0 And Datediff('s', Lastimebk, " & SqlNowString & ") > " & Dvbbs.Forum_Setting(8) & "*60" 
				SQL1 = "Delete From [Dv_Online] Where UserID>0 And Datediff('s', Lastimebk, " & SqlNowString & ") > " & Dvbbs.Forum_Setting(8) & "*60"
			End If
			Conn.Execute SQL,TempNum
			Conn.Execute SQL1,TempNum1
			Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 2
			'如果删除客人数大于0，则应该更新总数
			If TempNum>0 Then
				'更新缓存总在线数据
				Forum_Online = Forum_Online - TempNum
				Forum_GuestOnline = Forum_GuestOnline - TempNum
			End If
			'如果删除用户数大于0，则应该更新总数和用户数
			If TempNum1>0 Or  TempNum>0 Then
				'更新缓存总在线数据
				Forum_Online = Forum_Online - TempNum1
				Forum_UserOnline = Forum_UserOnline - TempNum1
				
			End If
			Dvbbs.Name="Forum_Online"
			Dvbbs.Value=Forum_Online
			'更新缓存总用户在线数据
			Dvbbs.Name="Forum_UserOnline"
			Dvbbs.Value=Forum_UserOnline
			Forum_Online = Forum_Online - TempNum1
		End If
	End Sub
	'刷新在线数据缓存
	Public Sub ReflashOnlineNum
		Dim Rs
		Dvbbs.Name="Forum_Online"
		Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online")
		Dvbbs.Value=Rs(0)
		Forum_Online = Dvbbs.Value
		Dvbbs.Name="Forum_UserOnline"
		Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online Where UserID>0")
		If Not IsNull(Rs(0)) Then
			Dvbbs.Value=Rs(0)
		Else
			Dvbbs.Value=0
		End If
		Forum_UserOnline = Dvbbs.Value
		Set Rs=Nothing
	End Sub
	'查询在某版面的在线总数
	Public Property Get Board_Online
		Board_Online=Board_UserOnline+Board_GuestOnline
	End Property
	Public Property Get Board_GuestOnline
		If l_GuestOnline=-1 Then
			Dim Rs
			Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online where BoardID="&Dvbbs.BoardID&" and UserID=0")
			l_GuestOnline=Rs(0):Set Rs= Nothing 
		End If
		If IsNull(l_GuestOnline) Then l_GuestOnline=0
		Board_GuestOnline=l_GuestOnline
	End Property
	Public Property Get Board_UserOnline
		If l_Online=-1 Then
			Dim Rs
			Set Rs=Dvbbs.Execute("Select Count(*) From Dv_Online where BoardID="&Dvbbs.BoardID&" and UserID>0")
			l_Online=Rs(0):Set Rs= Nothing 
		End If
		Board_UserOnline=l_Online
	End Property
End Class
%>
上一页 1 2 3 45
💿 文件大小 3237 K
👤 上传用户 my99ab1
📂 所属分类其他
⌨️ 快捷键说明

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