📄 dv_news.asp
字号:
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, ">", ">")
str = replace(str, "<", "<")
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, "]]>","]]>")
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 + -