📄 dv_news.asp

📁 公司企业网站管理系统全站源码,用于企业内部对网站的管理
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
				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 BoardNode = Application(Dvbbs.CacheName&"_boardlist").cloneNode(True).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 = Application(Dvbbs.CacheName&"_boardlist").cloneNode(True).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

Sub NewsType_7()
	Dim Skin_Main
	Dim SQL,Rs,i
	SQL = Node.selectSingleNode("Search").text
	If Not IsObject(Dv_IndivGroup_Conn) Then Dv_IndivGroup_ConnectionDatabase
	SET Rs = Dv_IndivGroup_Conn.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,"{$IGID}",Dvbbs.CheckNumeric(SQL(0,i)))
		Skin_Main = Replace(Skin_Main,"{$IGName}",Stringhtml(SQL(1,i)))
		Skin_Main = Replace(Skin_Main,"{$GrouInfo}",Stringhtml(SQL(2,i)))
		Skin_Main = Replace(Skin_Main,"{$AppUserID}",Dvbbs.CheckNumeric(SQL(3,i)))
		Skin_Main = Replace(Skin_Main,"{$AppUserName}",SQL(4,i))
		Skin_Main = Replace(Skin_Main,"{$IGUserNum}",Dvbbs.CheckNumeric(SQL(5,i)))
		Skin_Main = Replace(Skin_Main,"{$Stats}",IGStatsStr(SQL(6,i)))
		Skin_Main = Replace(Skin_Main,"{$IGPostNum}",Dvbbs.CheckNumeric(SQL(7,i)))
		Skin_Main = Replace(Skin_Main,"{$IGTopicNum}",Dvbbs.CheckNumeric(SQL(8,i)))
		Skin_Main = Replace(Skin_Main,"{$IGTodayNum}",Dvbbs.CheckNumeric(SQL(9,i)))
		Skin_Main = Replace(Skin_Main,"{$IGYesterdayNum}",Dvbbs.CheckNumeric(SQL(10,i)))
		Skin_Main = Replace(Skin_Main,"{$LimitUser}",Dvbbs.CheckNumeric(SQL(11,i)))
		Skin_Main = Replace(Skin_Main,"{$PassDate}",FormatTime(SQL(12,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_8()
	Dim TempStr
	Dvbbs.GetForum_Setting
	NewsMainStr = Node.selectSingleNode("Skin_Main").text
	Dvbbs.loadTemplates("")
	If Dvbbs.Forum_Setting(79)=1 Then
		NewsMainStr = Replace(NewsMainStr,"{$CheckCode}","验证码："&Dvbbs.mainhtml(15)&"<img src="""& Dvbbs.Get_ScriptNameUrl & DvCodeFile &""" alt=""验证码,看不清楚?请点击刷新验证码"" style=""cursor:pointer; vertical-align:middle;height:18px;"" onclick=""this.src='"& Dvbbs.Get_ScriptNameUrl & DvCodeFile &"?t='+Math.random()""/>")
	Else
		NewsMainStr = Replace(NewsMainStr,"{$CheckCode}","")
	End If
	NewsMainStr = Node.selectSingleNode("Skin_Head").text & NewsMainStr & Node.selectSingleNode("Skin_Footer").text
	NewsMainStr = "<form action="""&Dvbbs.Get_ScriptNameUrl&"login.asp?action=chk"" method=""post"">"&NewsMainStr&"</form>"
End Sub

Function IGStatsStr(Stats)
	Select Case Stats
		Case 1
			IGStatsStr="正常"
		Case 2
			IGStatsStr="锁定"
		Case 3
			IGStatsStr="关闭"
		Case 0
			IGStatsStr="审核"
		Case Else
			IGStatsStr="未知"
	End Select
End Function

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
%>
上一页 12
💿 文件大小 12830 K
👤 上传用户 caim3587
📂 所属分类企业管理
🏷️ 相关标签

#企业网站 #管理系统 #源码 #网站
⌨️ 快捷键说明

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