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

📄 dv_news.asp

📁 前台及后台用户名密码都是:gz35gz35.com
💻 ASP
📖 第 1 页 / 共 2 页
字号:
								NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input3").text
								For i=0 to Nodes.getAttribute("depth")
									NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input2").text
								Next
								ii = 1
							Else
								ii = ii + 1
								NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input4").text
							End If
						End If
					Else
						NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input3").text
					End If
					If Nodes.getAttribute("depth") = "0" Then
						ii = 1
						NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input0").text
					Else
						NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input1").text
					End If
					NewsMainStr = NewsMainStr & Skin_Main
				Else
					For i=0 to Nodes.getAttribute("depth")
						NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input2").text
					Next
					If Nodes.getAttribute("child") >"0" or Nodes.getAttribute("depth") = "0" Then
						NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input0").text
					Else
						NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input1").text
					End If
					NewsMainStr = NewsMainStr & Skin_Main & Node.selectSingleNode("Board_Input3").text
				End If
			End If
		End If
	Next
	NewsMainStr = Node.selectSingleNode("Skin_Head").text & NewsMainStr & Node.selectSingleNode("Skin_Footer").text
End Sub

'会员调用
''UserID,UserName,UserTopic,UserPost,UserBest,UserWealth,UserCP,UserEP,UserDel,UserSex,JoinDate 
Sub NewsType_4()
	Dim Skin_Main
	Dim SQL,Rs,i
	SQL = Node.selectSingleNode("Search").text
	SET Rs = Dvbbs.Execute(SQL)
	If Not Rs.eof Then
		SQL=Rs.GetRows(-1)
	Else
		OutPut "暂未有会员数据!"
		Exit Sub
	End If
	Rs.close:Set Rs = Nothing
	For i=0 To Ubound(SQL,2)
		Skin_Main = Node.selectSingleNode("Skin_Main").text
		Skin_Main = Replace(Skin_Main,"{$UserID}",SQL(0,i))
		Skin_Main = Replace(Skin_Main,"{$UserName}",Stringhtml(SQL(1,i)))
		Skin_Main = Replace(Skin_Main,"{$UserTopic}",SQL(2,i))
		Skin_Main = Replace(Skin_Main,"{$UserPost}",SQL(3,i))
		Skin_Main = Replace(Skin_Main,"{$UserBest}",SQL(4,i))
		Skin_Main = Replace(Skin_Main,"{$UserWealth}",SQL(5,i))
		Skin_Main = Replace(Skin_Main,"{$UserCP}",SQL(6,i))
		Skin_Main = Replace(Skin_Main,"{$UserEP}",SQL(7,i))
		Skin_Main = Replace(Skin_Main,"{$UserDel}",SQL(8,i))
		Skin_Main = Replace(Skin_Main,"{$UserSex}",UserSex(Cstr(SQL(9,i))))
		Skin_Main = Replace(Skin_Main,"{$JoinDate}",FormatTime(SQL(10,i),Node.getAttribute("FormatTime")))
		Skin_Main = Replace(Skin_Main,"{$UserLogins}",SQL(11,i))
		NewsMainStr = NewsMainStr & Skin_Main
	Next
	NewsMainStr = Node.selectSingleNode("Skin_Head").text & NewsMainStr & Node.selectSingleNode("Skin_Footer").text
End Sub

'公告调用
Sub NewsType_5()
	Dim Skin_Main
	Dim SQL,Rs,i
	SET Rs = Dvbbs.Execute(Node.selectSingleNode("Search").text)
	If Not Rs.eof Then
		SQL=Rs.GetRows(-1)
	Else
		OutPut "暂未有新公告!"
		Exit Sub
	End If
	Rs.close:Set Rs = Nothing
	Dim Topic,Topiclen
	Topiclen = Node.getAttribute("Topiclen")
	If Not Isnumeric(Topiclen) or Topiclen = "" Then
		Topiclen = 20
	Else
		Topiclen = Cint(Topiclen)
	End If
	'ID,Boardid,Title,UserName,AddTime
	Dim BoardNode,Nodes
	Set Dvbbs.BoardXML=Application(Dvbbs.CacheName&"_Boradlist").cloneNode(True)
	Set BoardNode = Dvbbs.BoardXML.documentElement.getElementsByTagName("board")
	For i=0 To Ubound(SQL,2)
		Topic = SQL(2,i)
		If Len(Topic)>Topiclen then
			Topic = Left(Topic,Topiclen)&"..."
		End if
		Skin_Main = Node.selectSingleNode("Skin_Main").text
		If Instr(Skin_Main,"{$BoardName}") Then
			If Cstr(SQL(1,i)) >"0" Then
				For Each Nodes in BoardNode
					If Nodes.getAttribute("boardid") = Cstr(SQL(1,i)) Then
							Skin_Main = Replace(Skin_Main,"{$BoardName}",Nodes.getAttribute("boardtype"))
						Exit For
					End If
				Next
			Else
				Skin_Main = Replace(Skin_Main,"{$BoardName}","")
			End If
		End If
		Skin_Main = Replace(Skin_Main,"{$ID}",SQL(0,i))
		Skin_Main = Replace(Skin_Main,"{$Boardid}",SQL(1,i))
		Skin_Main = Replace(Skin_Main,"{$Topic}",Topic)
		Skin_Main = Replace(Skin_Main,"{$UserName}",SQL(3,i))
		Skin_Main = Replace(Skin_Main,"{$PostTime}",FormatTime(SQL(4,i),Node.getAttribute("FormatTime")))
		NewsMainStr = NewsMainStr & Skin_Main
	Next
	NewsMainStr = Node.selectSingleNode("Skin_Head").text & NewsMainStr & Node.selectSingleNode("Skin_Footer").text
End Sub

'展区调用
Sub NewsType_6()
	Dim Skin_Main
	Dim SQL,Rs,i
	Set MyBoardOnline=New Cls_UserOnlne 
	Dvbbs.GetForum_Setting
	SET Rs = Dvbbs.Execute(Node.selectSingleNode("Search").text)
	If Not Rs.eof Then
		SQL=Rs.GetRows(-1)
	Else
		OutPut "暂未有新展区文件!"
		Exit Sub
	End If
	Rs.close:Set Rs = Nothing
	Dim Topic,Topiclen
	Topiclen = Node.getAttribute("Topiclen")
	If Not Isnumeric(Topiclen) or Topiclen = "" Then
		Topiclen = 10
	Else
		Topiclen = Cint(Topiclen)
	End If	'F_ID,F_AnnounceID,F_BoardID,F_Username,F_Filename,F_Readme,F_Type,F_FileType,F_AddTime,F_Viewname,F_ViewNum,F_DownNum,F_FileSize 
	'F_Typ : 1=图片集,2=FLASH集,3=音乐集,4=电影集,0=文件集
	Dim FileArray,Filename,Picheight,Picwidth
	Dim RootID,ReplyID,F_AnnounceID
	Dim BoardNode,Nodes,t,tab
	Dim TColor,TColor1,TColor2
	FileArray = "文件集||图片集||FLASH集||音乐集||电影集"
	FileArray = Split(FileArray,"||")
	Picheight = Node.getAttribute("PicHeight")
	Picwidth  = Node.getAttribute("PicWidth")
	Tab = Node.getAttribute("Tab")
	TColor1 = Node.getAttribute("TColor1")
	TColor2 = Node.getAttribute("TColor2")
	t=0
	Set BoardNode = Dvbbs.BoardXML.documentElement.getElementsByTagName("board")
	For i=0 To Ubound(SQL,2)
		Topic = SQL(5,i)
		If Len(Topic)>Topiclen then
			Topic = Left(Topic,Topiclen)&"..."
		End if
		If TColor=TColor2 Then 
			TColor=TColor1
		Else
			TColor=TColor2
		End If
		Skin_Main = Node.selectSingleNode("Skin_Main").text
		Skin_Main = Replace(Skin_Main,"{$ID}",SQL(0,i))
		Skin_Main = Replace(Skin_Main,"{$Boardid}",SQL(2,i))
		Skin_Main = Replace(Skin_Main,"{$UserName}",SQL(3,i))
		Skin_Main = Replace(Skin_Main,"{$Readme}",Topic&"")
		Skin_Main = Replace(Skin_Main,"{$AddTime}",FormatTime(SQL(8,i),Node.getAttribute("FormatTime")))
		Skin_Main = Replace(Skin_Main,"{$ViewFilename}",SQL(9,i)&"")
		Skin_Main = Replace(Skin_Main,"{$ViewNum}",SQL(10,i))
		Skin_Main = Replace(Skin_Main,"{$DownNum}",SQL(11,i))
		Skin_Main = Replace(Skin_Main,"{$FileSize}",SQL(12,i))
		Skin_Main = Replace(Skin_Main,"{$FileType}",FileArray(SQL(6,i)))
		Skin_Main = Replace(Skin_Main,"{$TColor}",TColor)
		
		If Instr(SQL(1,i)&"","|") Then
			F_AnnounceID=Split(SQL(1,i),"|")
			RootID = F_AnnounceID(0)
			ReplyID = F_AnnounceID(1)
		Else
			RootID = ""
			ReplyID = ""
		End If
		Skin_Main = Replace(Skin_Main,"{$ReplyID}",ReplyID)
		Skin_Main = Replace(Skin_Main,"{$RootID}",RootID)
		If Instr(Skin_Main,"{$BoardName}") Then
			If Cstr(SQL(1,i)) >"0" Then
				For Each Nodes in BoardNode
					If Nodes.getAttribute("boardid") = Cstr(SQL(2,i)) Then
							Skin_Main = Replace(Skin_Main,"{$BoardName}",Nodes.getAttribute("boardtype"))
						Exit For
					End If
				Next
			Else
				Skin_Main = Replace(Skin_Main,"{$BoardName}","")
			End If
		End If
		If SQL(9,i)<>"" Then
			Filename = Bbsurl & SQL(9,i)
		Else
			Filename = SQL(4,i)
			If InStr(Filename,":") = 0 Or InStr(Filename,"//") = 0 Then
				Filename = Bbsurl & Dvbbs.Forum_Setting(76) & Filename
			End If
		End If
		
		If SQL(6,i)=1 Then
			Filename = "<IMG SRC="""&Filename&""" style=""border: 1 solid #000000"" width="&Picwidth&" height="&Picheight&" >"
		Else
			Filename = SQL(7,i) & " 类文件"
		End If
		Skin_Main = Replace(Skin_Main,"{$Filename}",Filename)
		NewsMainStr = NewsMainStr & Skin_Main
		If Tab<>"" Then
			If t=Tab-1 or Tab=1 Then 
				NewsMainStr = NewsMainStr & Node.selectSingleNode("Board_Input0").text
			end if
			If t>Tab-1 Then 
				t=1
			Else
				t=t+1
			End If
		End If
	Next
	NewsMainStr = Node.selectSingleNode("Skin_Head").text & NewsMainStr & Node.selectSingleNode("Skin_Footer").text
End Sub

Function UserSex(Val)
	If Val = "1" Then
		UserSex = "先生"
	Else
		UserSex = "女士"
	End If
End Function

Function Stringhtml(str)
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="<(.[^>]*)>"
	str=re.replace(str, "")
	re.Pattern="\[(.[^\[]*)\]"
	str=re.replace(str, "")
	str = replace(str, ">", "&gt;")
	str = replace(str, "<", "&lt;")
	If str="" Then str="..."
	Stringhtml=str
End Function

Function Fixjs(Strings)
	Dim Str
	Str = Strings
	str = Replace(str, CHR(39), "\'")
	str = Replace(str, CHR(13), "")
	str = Replace(str, CHR(10), "")
	str = Replace(str, "]]>","]]&gt;")
	Fixjs = str
End Function

Function FormatTime(Strings,val)
	If IsDate(Strings) and val<>"" Then
		Strings = FormatdateTime(Strings,val)
	End If
	FormatTime = Strings
End Function

Function CheckServer(str)
	Dim i,servername
	If str="" Then
		CheckServer = True
		Exit Function
	Else
		CheckServer = False
	End If
	str=split(Cstr(str),",")
	servername=Request.ServerVariables("HTTP_REFERER")
	For i=0 to Ubound(str)
	If Right(str(i),1)="/" Then str(i)=left(Trim(str(i)),Len(str(i))-1)
		If Lcase(left(servername,Len(str(i))))=Lcase(str(i)) then
			checkserver = True
			Exit For
		Else
			checkserver = False
		End if
	Next
End Function
%>

⌨️ 快捷键说明

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