⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 query_get.asp

📁 公司企业网站管理系统全站源码,用于企业内部对网站的管理
💻 ASP
📖 第 1 页 / 共 2 页
字号:
🔍
12 
							node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/vnd.ms-powerpoint"
						Case "ra","ram","rm","rmvb"
							node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="audio/x-pn-realaudio"
						Case "swf","fla"
							node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/x-shockwave-flash"
						Case "doc","dot"
							node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/msword"
						Case "xla","xlc","xlm","xls","xlw"
							node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/vnd.ms-excel"
						Case Else
							node2.appendChild(XMLDOM.createNode(1,"MIMEType","")).text="application/" & tRs(1)
						End Select
						node2.appendChild(XMLDOM.createNode(1,"FileName","")).text=Split(tRs(0),"/")(Ubound(Split(tRs(0),"/")))
						node2.appendChild(XMLDOM.createNode(1,"Size","")).text=tRs(2)
						node2.appendChild(XMLDOM.createNode(1,"Description","")).text=Server.HtmlEncode(Dvbbs.ChkBadWords(Rs("topic"))&"")
					tRs.MoveNext
					Loop
					tRs.Close:Set tRs=Nothing
				End If
				Rs.MoveNext
				Loop	
			End If
		End If
		Rs.Close:Set Rs=Nothing
	End If
	Response.Clear
	Select Case Session.CodePage
			 	Case 65001
			 		Response.CharSet="utf-8" 
			 		Response.Write "<?xml version=""1.0"" encoding=""utf-8""?>"&vbNewLine
			 	Case 936
			 		Response.CharSet="gb2312"
			 		Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine 
			 	Case 950
			 		Response.CharSet="big5" 
			 		Response.Write "<?xml version=""1.0"" encoding=""big5""?>"&vbNewLine
			End Select
	Response.ContentType="text/xml"
	Response.Write XMLDom.documentElement.XML
End Sub
Sub GetUserData()
	Dim iUserID,Rs,Sql,node,node1,blist
	iUserID = Request("tid")
	If iUserID = "" Or Not IsNumeric(iUserID) Then Exit Sub
	Set Rs=Dvbbs.Execute("Select UserID,UserName,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,IsChallenge,UserMobile,TitlePic,UserTitle,UserAnswer From Dv_User Where UserID = " & iUserID)
	If Rs.Eof And Rs.Bof Then
		Rs.Close:Set Rs=Nothing
		Exit Sub
	Else
		Set XMLDOM=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
		XMLDOM.appendChild(XMLDOM.createElement("userinfo"))
		Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"userencode",""))
		Node.attributes.setNamedItem(XMLDom.createNode(2,"encodestr","")).text = MD5(Rs("UserAnswer") & ":" & FormatDateTime(Rs("JoinDate"),2),32)
		SQL=RS.GetRows(1)
		Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows")
		For each node1 in node.documentElement.selectNodes("row")
			node1.selectSingleNode("@useranswer").text="加密字段"
		Next
		XMLDom.documentElement.appendChild(node.documentElement)
	End If
	Rs.Close:Set Rs=Nothing
	Response.Clear
	Select Case Session.CodePage
		Case 65001
			Response.CharSet="utf-8" 
			Response.Write "<?xml version=""1.0"" encoding=""utf-8""?>"&vbNewLine
		Case 936
			Response.CharSet="gb2312"
			Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine 
		Case 950
			Response.CharSet="big5" 
			Response.Write "<?xml version=""1.0"" encoding=""big5""?>"&vbNewLine
	End Select
	Response.ContentType="text/xml"
	Response.Write XMLDom.documentElement.XML
End Sub
Sub GetForumInfo()
	Dim Rs,Sql,node,node1,blist,iUserID
	blist=boardlists()
	iUserID = Request("tid")
	If iUserID = "" Or Not IsNumeric(iUserID) Then iUserID = 0
	iUserID = cCur(iUserID)
	Set XMLDOM=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	XMLDOM.appendChild(XMLDOM.createElement("foruminfo"))
	Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"baseforuminfo",""))
	Node.attributes.setNamedItem(XMLDom.createNode(2,"forumname","")).text = Dvbbs.Forum_Info(0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"forumurl","")).text = Dvbbs.Forum_Info(1)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"homename","")).text = Dvbbs.Forum_Info(2)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"homeurl","")).text = Dvbbs.Forum_Info(3)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"systememail","")).text = Dvbbs.Forum_Info(5)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"topicnum","")).text = Dvbbs.CacheData(7,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"postnum","")).text = Dvbbs.CacheData(8,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"todaynum","")).text = Dvbbs.CacheData(9,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"yestodaynum","")).text = Dvbbs.CacheData(11,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"usernum","")).text = Dvbbs.CacheData(10,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"maxonline","")).text = Dvbbs.CacheData(5,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"maxpost","")).text = Dvbbs.CacheData(12,0)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"uploadpath","")).text = Dvbbs.Forum_Setting(76)
	Node.attributes.setNamedItem(XMLDom.createNode(2,"forumversion","")).text = "7.1.0 Sp1"

	If iUserID > 0 Then
		Set Rs=Dvbbs.Execute("Select UserID,UserName,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,IsChallenge,UserMobile,TitlePic,UserTitle,UserAnswer From Dv_User Where UserID = " & iUserID)
		If Not (Rs.Eof And Rs.Bof) Then
			Set node=XMLDOM.documentElement.appendChild(XMLDOM.createNode(1,"userencode",""))
			Node.attributes.setNamedItem(XMLDom.createNode(2,"encodestr","")).text = MD5(Rs("UserAnswer") & ":" & FormatDateTime(Rs("JoinDate"),2),32)
			SQL=RS.GetRows(1)
			Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","userdatarows")
			For each node1 in node.documentElement.selectNodes("row")
				node1.selectSingleNode("@useranswer").text="加密字段"
			Next
			XMLDom.documentElement.appendChild(node.documentElement)
		End If
	End If

	SQL="Select Top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where isbest=1 order by topicid Desc"
	Set Rs=Dvbbs.Execute(SQL)
	SQL=RS.GetRows(-1)
	Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","bestdatarows")
	For each node1 in node.documentElement.selectNodes("row")
		If node1.selectSingleNode("@hidename").text="1" Then
			node1.selectSingleNode("@postusername").text="匿名用户"
		End If
	Next
	XMLDom.documentElement.appendChild(node.documentElement)
	If IsSqlDataBase = 1 Then
		SQL="Select top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Boardid in ("& blist &") and Datediff(d,LastPostTime, " & SqlNowString & ") < 5 order by hits Desc"
	Else
		SQL="Select top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Boardid in("& blist &") and Datediff('d',LastPostTime, " & SqlNowString & ") < 5 order by hits Desc"
	End If
	Set Rs=Dvbbs.Execute(SQL)
	SQL=RS.GetRows(-1)
	Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","hotdatarows")
	For each node1 in node.documentElement.selectNodes("row")
		If node1.selectSingleNode("@hidename").text="1" Then
			node1.selectSingleNode("@postusername").text="匿名用户"
		End If
	Next
	XMLDom.documentElement.appendChild(node.documentElement)
	SQL="Select Top 12 TopicID,Title,PostUsername,hidename,boardid,child,hits,dateandtime,lastposttime,istop,isvote,isbest From Dv_topic Where Not BoardID In (444,777) order by topicid Desc"
	Set Rs=Dvbbs.Execute(SQL)
	SQL=RS.GetRows(-1)
	Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","newdatarows")
	For each node1 in node.documentElement.selectNodes("row")
		If node1.selectSingleNode("@hidename").text="1" Then
			node1.selectSingleNode("@postusername").text="匿名用户"
		End If
	Next
	XMLDom.documentElement.appendChild(node.documentElement)
	Rs.Close
	Set Rs=Nothing

	Response.Clear
	Select Case Session.CodePage
		Case 65001
			Response.CharSet="utf-8" 
			Response.Write "<?xml version=""1.0"" encoding=""utf-8""?>"&vbNewLine
		Case 936
			Response.CharSet="gb2312"
			Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine 
		Case 950
			Response.CharSet="big5" 
			Response.Write "<?xml version=""1.0"" encoding=""big5""?>"&vbNewLine
	End Select
	Response.ContentType="text/xml"
	Response.Write XMLDom.documentElement.XML
End Sub
Sub GetForumPic()
	Dim Rs,Sql,node,node1,blist,ForumID
	blist=boardlists()
	Set XMLDOM=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
	XMLDOM.appendChild(XMLDOM.createElement("forumpic"))
	SQL="Select Top 50 * From Dv_upfile Where f_BoardID in ("&blist&") and f_announceid<>'0' order by f_id Desc"
	Set Rs=Dvbbs.Execute(SQL)
	SQL=RS.GetRows(-1)
	Set Node=Dvbbs.ArrayToxml(SQL,rs,"row","datarows")
	XMLDom.documentElement.appendChild(node.documentElement)

	Rs.Close
	Set Rs=Nothing

	Response.Clear
	Select Case Session.CodePage
		Case 65001
			Response.CharSet="utf-8" 
			Response.Write "<?xml version=""1.0"" encoding=""utf-8""?>"&vbNewLine
		Case 936
			Response.CharSet="gb2312"
			Response.Write "<?xml version=""1.0"" encoding=""gb2312""?>"&vbNewLine 
		Case 950
			Response.CharSet="big5" 
			Response.Write "<?xml version=""1.0"" encoding=""big5""?>"&vbNewLine
	End Select
	Response.ContentType="text/xml"
	Response.Write XMLDom.documentElement.XML
End Sub
Function GetparentBoard(bid)
	Dim Node
	Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]/@parentid")
	If Not Node is Nothing Then
		If Node.text<>"0" Then
			If Not Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&Node.text&"]/@boardtype") Is Nothing Then
				GetparentBoard=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&Node.text&"]/@boardtype").text
			End If
		End If
	End If
End Function
Function checkoutbaord(bid)
Dim Node
	Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]")
	If Not Node is Nothing Then
		If Node.selectSingleNode("@checkout").text="0" Then
			checkoutbaord=0
		End If
	End If
End Function
Function GetBoardhidden(bid)
	Dim Node
	Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]")
	If Not Node is Nothing Then
		If Node.selectSingleNode("@hidden").text="0" Then
			GetBoardhidden=0
		End If
	End If
End Function
Function Getbbsname(bid)
	Dim Node
	Set Node=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid="&bid&"]/@boardtype")
	If Not Node is Nothing Then
		Getbbsname=Node.text
	End If
End Function
Function GetLastPostID()
	Dim Rs
	Set Rs=Dvbbs.Execute("Select Max(topicID) From Dv_topic")
	If IsNull(rs(0)) Then
		GetLastPostID=0
	Else
		GetLastPostID=Rs(0)
	End If
End Function
Function IpInList()
	Ipinlist=False
	If not IsObject(Application(Dvbbs.CacheName & "_iplist")) Then
		SendData()
	ElseIf DateDiff("D",Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("@date").text,Date())<> 0 Then
		SendData()
	End If
	Dim ip,iparray
	ip=Request.ServerVariables("REMOTE_ADDR")
	iparray=split(ip,".")
	If UBound(iparray)=3 Then
		If Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&".*.*.*']") Is Nothing Then
			Ipinlist=True
		ElseIf Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&"."&iparray(1)&".*.*']") Is Nothing Then
			Ipinlist=True
		ElseIf Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&"."&iparray(1)&"."&iparray(2)&".*']") Is Nothing Then
			Ipinlist=True
		ElseIf Not Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("ip[.='"&iparray(0)&"."&iparray(1)&"."&iparray(2)&"."&iparray(3)&"']") Is Nothing Then
			Ipinlist=True	
		End If
	End If
End Function
Function strAnsi2Unicode(asContents)
	Dim len1,i,varchar,varasc
	strAnsi2Unicode = ""
	len1=LenB(asContents)
	If len1=0 Then Exit Function
	  For i=1 to len1
	  	varchar=MidB(asContents,i,1)
	  	varasc=AscB(varchar)
	  	If varasc > 127  Then
	  		If MidB(asContents,i+1,1)<>"" Then
	  			strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
	  		End If
	  		i=i+1
	     Else
	     	strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
	     End If	
	  Next
End Function
Sub SendData()
	Dim xmlhttp,xml,DataToSend,xmlserverurl
  On Error Resume Next
  Set xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP"&MsxmlVersion)
	xmlserverurl="http://server.dvbbs.net/dvbbs/iplist.asp"
	xmlhttp.setTimeouts 65000, 65000, 65000, 65000
  xmlhttp.Open "POST",xmlserverurl,false
  xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  xmlhttp.send
  Set XML=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
  If XML.loadxml(strAnsi2Unicode(xmlhttp.responseBody)) Then
  	Xml.documentElement.selectSingleNode("@date").text=Date()
		Set Application(Dvbbs.CacheName & "_iplist")=Xml.cloneNode(true)
	End If
	Set xmlhttp = Nothing
End Sub
%>
12

⌨️ 快捷键说明

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