📄 dv_clsmain.asp
字号:
'fString = Replace(fString, CHR(39), "'") '单引号过滤
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
fString=ChkBadWords(fString)
HTMLEncode = fString
End If
End Function
'用于论坛本身的过滤，不带脏话过滤
Public Function iHTMLEncode(fString)
If Not IsNull(fString) Then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
'fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
iHTMLEncode = fString
End If
End Function
Public Function strLength(str)
If isNull(str) Or Str = "" Then
StrLength = 0
Exit Function
End If
Dim WINNT_CHINESE
WINNT_CHINESE=(len("例子")=2)
If WINNT_CHINESE Then
Dim l,t,c
Dim i
l=len(str)
t=l
For i=1 To l
c=asc(mid(str,i,1))
If c<0 Then c=c+65536
If c>255 Then t=t+1
Next
strLength=t
Else
strLength=len(str)
End If
End Function
Public Function ChkBadWords(Str)
If IsNull(Str) Then Exit Function
Dim i
For i = 0 To Ubound(BadWords)
If i > UBound(rBadWord) Then
Str = Replace(Str,BadWords(i),"*")
Else
Str = Replace(Str,BadWords(i),rBadWord(i))
End If
Next
ChkBadWords = Str
End Function
Public Function Checkstr(Str)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
CheckStr = Replace(Str,"'","''")
End Function
Public Function Get_Chan_Ad()
Dim TempData,i
Dim rndnum
Dim Temp_Ad,Forum_AdLoop1,Forum_AdLoop2
Temp_Ad = Split(CacheData(22,0),"||")
If Temp_Ad(0)<>"" Then
Forum_AdLoop1=Split(Temp_Ad(0),",")
Else
Forum_AdLoop1=Split("",",")
End If
If Temp_Ad(1)<>"" Then
Forum_AdLoop2=Split(Temp_Ad(1),",")
Else
Forum_AdLoop2=Split("",",")
End If
Forum_AdLoop3 = Temp_Ad(2)
'顶部banner
Randomize
rndnum=Cint(Ubound(Forum_AdLoop1)*rnd+1)
If UBound(Forum_AdLoop1)=-1 Then
adcode_1=""
Else
Name = "ForumAdCode1"
If ObjIsEmpty() Then LoadForumAdCode1
If IsArray(Value) And Forum_ChanSetting(3)="1" Then
TempData=Value
adcode_1=ReCssUrl(TempData(1,rndnum-1))
Else
adcode_1=""
End If
End If
'尾部通栏
Randomize
rndnum=Cint(Ubound(Forum_AdLoop2)*rnd+1)
If UBound(Forum_AdLoop2)=-1 Then
adcode_2=""
Else
Name = "ForumAdCode2"
If ObjIsEmpty() Then LoadForumAdCode2
If IsArray(Value) And Forum_ChanSetting(4)="1" Then
TempData=Value
adcode_2=ReCssUrl(TempData(1,rndnum-1))
Else
adcode_2=""
End If
End If
Name = "ForumAdCode3"
If ObjIsEmpty() Then LoadForumAdCode3
If IsArray(Value) And Forum_ChanSetting(2)="1" Then
TempData=Value
adcode_4=ReCssUrl(TempData(1,i))
Else
adcode_4=""
End If
i3 = 0
If Forum_AdLoop3<>"" And Forum_ChanSetting(5)="1" And Instr(ScriptName,"dispbbs")>0 Then
Name = "TopicAdCode"
If ObjIsEmpty() Then LoadTopicAdCode
If IsArray(Value) Then
TempData = Value
For i=0 To Ubound(TempData,2)
If TempData(1,i)=239 Or TempData(1,i)=240 Or TempData(1,i)=1 Or TempData(1,i)=2 Then
ad_3(i3)=" "
Else
ad_3(i3)=ReCssUrl(TempData(0,i))
End If
i3 = i3 + 1
Next
End If
End If
If i3=0 Then Ad_3(0)=" "
End Function
Private Function LoadTopicAdCode()
Dim Rs
Set Rs=Execute("Select a_adcode,a_id From Dv_AdCode Where a_id In ("&Forum_AdLoop3&")")
If Not Rs.Eof Then
Value = Rs.GetRows(-1)
Else
Value = ""
End If
Set Rs=Nothing
End Function
Private Function LoadForumAdCode1()
Dim Rs
Set Rs=Execute("Select a_address,a_adcode,a_id From Dv_AdCode Where a_address='0001'")
If Not Rs.Eof Then
Value = Rs.GetRows(-1)
Else
Value = ""
End If
Set Rs=Nothing
End Function
Private Function LoadForumAdCode2()
Dim Rs
Set Rs=Execute("Select a_address,a_adcode,a_id From Dv_AdCode Where a_address='0002'")
If Not Rs.Eof Then
Value = Rs.GetRows(-1)
Else
Value = ""
End If
Set Rs=Nothing
End Function
Private Function LoadForumAdCode3()
Dim Rs
Set Rs=Execute("Select a_address,a_adcode,a_id From Dv_AdCode Where a_address='0004'")
If Not Rs.Eof Then
Value = Rs.GetRows(-1)
Else
Value = ""
End If
Set Rs=Nothing
End Function
Public Function ReCssUrl(str)
if str="" then exit function
str=replace(str,"%css%","Get_Css.asp?SkinID="&SkinID)
str=replace(str,"%url%",Forum_info(1))
If CacheData(23,0)="" or isnull(CacheData(23,0)) Then
str=replace(str,"%username%","dvbbs")
str=replace(str,"%mouseId%","dvbbs")
Else
str=replace(str,"%username%",CacheData(23,0))
str=replace(str,"%mouseId%",CacheData(23,0))
End If
ReCssUrl=str
End Function
Public Function ReloadBoardInfo(lBoardID)
If lBoardID=0 Then Exit Function
'数组(21)TempStr用来记录版面的下拉菜单,(22)TempStr1用来保存该版面的导航,(23)TempStr2用来保存该版面的新闻和小字报,(24)TempStr3版块点击统计
Dim Rs
Set Rs=Execute("select BoardID,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,BoardID As TempStr,BoardID As TempStr1,BoardID As TempStr2,BoardID As TempStr3,cid,BoardID As TempStr4 from Dv_board where BoardID="&lBoardID)
If Not Rs.Eof Then
Name = "BoardInfo_" & lBoardID
Value = Rs.GetRows(1)
Else
'自动修正所有版面的boards数
Call ReloadAllBoardInfo()
'Response.Redirect "index.asp"
End If
Rs.Close
Set Rs = Nothing
End Function
'缓存版面公告和小字报信息
Public Function LoadBoardNews_Paper(lBoardID)
Dim tRs,bgs,MyGetData,TempStr,NoAnn,NoColor
If Not IsArray(lanstr) Then
NoAnn = "当前没有公告"
Else
NoAnn = lanstr(9)
End If
If Not IsArray(mainsetting) Then
NoColor = "blue"
Else
NoColor = mainsetting(10)
End If
Set tRs=Execute("Select Top 1 title,addtime,bgs From [Dv_bbsnews] Where boardid="&lBoardID&" Order By ID Desc")
If tRs.BOF And tRs.EOF Then
TempStr = NoAnn & "|||"
Else
bgs=tRs(2)
If bgs="" or IsNull(bgs) Then
TempStr=tRs(0) & "|||" & tRs(1)
Else
TempStr="<img src=Skins/Default/filetype/mid.gif border=0><bgsound src="&bgs&" border=0>"&tRs(0)&"|||"&tRs(1)
End if
End If
'小字报部分
If IsSqlDataBase=1 Then
Set tRs=Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff(D,S_addtime,"&SqlNowString&")<=1 And S_boardid="&lBoardID&" Order By S_addtime Desc")
Else
Set tRs=Execute("Select Top 5 S_id as id,S_username as postuser,S_title as topic From Dv_Smallpaper Where Datediff('D',S_addtime,"&SqlNowString&")<=1 And S_boardid="&lBoardID&" Order By S_addtime Desc")
End If
If tRs.Eof And tRs.Bof Then
TempStr=TempStr & "|||"
Else
Dim TempData,i
TempData=tRs.GetRows(-1)
For i=0 To Ubound(TempData,2)
If i=0 Then
TempStr = TempStr & "||| <font color="&NoColor&">"&HtmlEncode(TempData(1,i))&"</font>：<a href=javascript:openScript(""viewpaper.asp?id="&TempData(0,i)&"&boardid="&BoardID&""",500,400)>"&HtmlEncode(TempData(2,i))&"</a> "
Else
TempStr = TempStr & " <font color="&NoColor&">"&HtmlEncode(TempData(1,i))&"</font>：<a href=javascript:openScript(""viewpaper.asp?id="&TempData(0,i)&"&boardid="&BoardID&""",500,400)>"&HtmlEncode(TempData(2,i))&"</a> "
End If
Next
End If
MyGetData = Value
MyGetData(23,0) = TempStr
Value = MyGetData
Set tRs=Nothing
End Function
'缓存导航相关信息
Public Sub LoadBoardParentStr(MyParentStr)
Dim tRs,GetData,MyGetData
Set tRs=Execute("Select Boardid,Boardtype,Boardmaster,Parentid From Dv_Board Where Boardid In ("&MyParentStr&") Order By Orders")
If Not tRs.Eof Then
GetData = tRs.GetRows(-1)
MyGetData = Value
MyGetData(22,0) = GetData
value=MyGetData
End If
Set tRs = Nothing
End Sub
'对应Dvbbs.Board_Data(21,0)，Act=1.导航菜单缓存;Dvbbs.Board_Data(26,0)，Act=0不含隐藏论坛的导航菜单缓存;
Public Sub LoadBoardList(lBoardID,Act)
Dim Forum_Boards,i,ii,Depth,Board_Datas,MyBoardList,MyBoardRootID,MyBoard_Data,b_setting
If lBoardID=0 Then Exit Sub
Name="BoardInfo_" & lBoardID
MyBoard_Data=value
MyBoardRootID=Clng(MyBoard_Data(5,0))
Forum_Boards=Split(CacheData(27,0),",")
For i=0 To Ubound(Forum_Boards)
Name="BoardInfo_" & Forum_Boards(i)
If ObjIsEmpty() Then ReloadBoardInfo(Forum_Boards(i))
Board_Datas = Value
b_setting=split(Board_Datas(16,0),",")
If b_setting(1)<>"1" Or Act=1 Then
Depth=Board_Datas(4,0)
If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "<a href=list.asp?boardid="&Forum_Boards(i)&">"
Select Case Depth
Case 0
If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & "╋"
Case 1
If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & " ├"
End Select
If Depth>1 Then
For ii=2 To Depth
If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & " │"
Next
If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & " ├"
End If
If MyBoardRootID = Board_Datas(5,0) And (Not Board_Datas(2,0) = 0) Then MyBoardList = MyBoardList & Server.htmlencode(Board_Datas(1,0)) & "</a><br>"
End If
Next
Name="BoardInfo_" & lBoardID
MyBoard_Data=value
If Act=1 Then
MyBoard_Data(21,0)=Replace(Replace(MyBoardList,"'","\'"),Chr(34), """)
Board_Data(21,0)=MyBoard_Data(21,0)
Else
MyBoard_Data(26,0)=Replace(Replace(MyBoardList,"'","\'"),Chr(34), """)
Board_Data(26,0)=MyBoard_Data(26,0)
End If
value=MyBoard_Data
Forum_Boards=Null
Board_Datas=Null
End Sub
Public Sub ReloadAllBoardInfo()
Dim Rs,Boards
Set Rs=Execute("Select BoardID From Dv_Board Order By RootID,Orders")
If Not Rs.Eof Then
Boards=Rs.GetString(,-1, "",",","")
Boards=Left(Boards,Len(Boards)-1)
End If
Rs.close:Set Rs=Nothing
Execute("Update dv_Setup Set Forum_Boards='"&Boards&"'")
ReloadSetupCache Boards,27
End Sub
'更新分版面部分缓存数组，入口：版面ID、更新内容、数组位置、更新方式，0直接赋值，1数值相加
Public Sub ReloadBoardCache(lBoardID,MyValue,N,act)
If lBoardID=0 Then Exit Sub
If lBoardID=444 Or lBoardID=777 Or lBoardID="" Then
Response.Write "错误的版面参数"
Response.End
End If
Dim Tmpdata
Name="BoardInfo_" & lBoardID
If ObjIsEmpty() Then ReloadBoardInfo(lBoardID)
Tmpdata=Value
If act=1 And IsNumeric(Tmpdata(N,0)) And IsNumeric(MyValue) Then
Tmpdata(N,0)=CLng(Tmpdata(N,0))+MyValue
ElseIf act=2 And IsNumeric(Tmpdata(N,0)) And IsNumeric(MyValue) Then
Tmpdata(N,0)=CLng(Tmpdata(N,0))-MyValue
Else
Tmpdata(N,0) = MyValue
End If
Value=Tmpdata
End Sub
Public Function ReloadForumPlusMenu()
Dim Rs,tRs,TempMenu,TempMenu1,MSetting
Name="ForumPlusMenu"&SkinID
Set Rs=Dvbbs.Execute("Select * From Dv_Plus Where Plus_Type='0' and Isuse=1 Order By ID")
If Rs.Eof And Rs.Bof Then
Value=""
Exit Function
End If
Do While Not Rs.Eof
MSetting=Split(Split(Rs("Plus_Setti⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -