?? dv_clsmain.asp
字號:
<%
'=========================================================
' File: Dv_ClsMain.asp
' Version:7.0 sp2
' Date: 2004-6-30
' Script Written by dvbbs.net
'=========================================================
' Copyright (C) 2003,2004 AspSky.Net. All rights reserved.
' Web: http://www.aspsky.net,http://www.dvbbs.net
' Email: info@aspsky.net,eway@aspsky.net
'=========================================================
'========================================
' 更新說明，加強過濾，加入對Chr(0)的過濾=
' 同時解決封IP中偽造cookies信息 =
' 和通過訪問一下管理頁躲過封IP的問題 =
'========================================
Dim Ad_3(100),i3
Class Cls_Forum
Rem Const
Public BoardID,SqlQueryNum,Forum_Info,Forum_Setting,Forum_user,Forum_Copyright,Forum_ads,Forum_ChanSetting
Public Forum_sn,Forum_Version,Stats,StyleName,ErrCodes,NowUseBBS,Cookiepath
Public lanstr,mainhtml,mainsetting,sysmenu,mainpic
Public MyUserInfo,UserToday,BoardJumpList,BoardList,CacheData,Maxonline
Public UserGroupID,Lastlogin,GroupSetting,FoundUserPer
Public Vipuser,Boardmaster,Superboardmaster,Master,FoundIsChallenge,FoundUser
Public ScriptName,MemberName,MemberWord,MemberClass,UserHidden,UserID,UserTrueIP,UserPermission
Public sendmsgnum,sendmsgid,sendmsguser,Page_Admin,Forum_AdLoop3
Public BadWords,rBadWord,Forum_emot,Forum_PostFace,Forum_UserFace,SkinID,Forum_PicUrl
Private adcode_1,adcode_2,adcode_4,ScriptTrueUrl,Forum_CSS,Main_Sid,ReloadCount,Nowstats,CssID
Public Reloadtime,CacheName,savelog
Private LocalCacheName,Cache_Data,IsTopTable,CookiesSid,BoardInfoData
Public Board_Setting,boarduser,LastPost,Board_Ads,Board_user,BoardType,IsGroupSetting,BoardMasterList,Board_Data,Sid,Boardreadme,BoardRootID,BoardParentID
Rem Sub
Private Sub Class_Initialize()
savelog=0'設置為1的時候會記錄攻擊或錯誤錯信息。
SqlQueryNum = 0
Reloadtime=14400
CacheName=Replace(Replace(Replace(Server.MapPath("index.asp"),"index.asp",""),":",""),"\","")
ReloadCount=0
IsTopTable = 0
Forum_sn = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
Vipuser = False:Boardmaster = False
Superboardmaster = False:Master = False:FoundIsChallenge = False:FoundUser = False
BoardID = Request("BoardID")
If IsNumeric(BoardID) = 0 or BoardID = "" Then BoardID = 0
BoardID = Clng(BoardID)
MemberName = checkStr(Trim(Request.Cookies(Forum_sn)("username")))
MemberWord = checkStr(Trim(Request.Cookies(Forum_sn)("password")))
UserHidden = Request.Cookies(Forum_sn)("userhidden")
UserID = Trim(Request.Cookies(Forum_sn)("UserID"))
If IsNumeric(UserHidden) = 0 or Userhidden = "" Then UserHidden = 2
If IsNumeric(UserID) = 0 Or UserID="" Then UserID=0
UserID = Clng(UserID)
UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
UserTrueIP = CheckStr(UserTrueIP)
Dim Tmpstr
Tmpstr = Request.ServerVariables("PATH_INFO")
Tmpstr = Split(Tmpstr,"/")
ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
MemberClass = checkStr(Request.Cookies(Forum_sn)("userclass"))
Page_Admin=False
If InStr(ScriptName,"showerr")>0 Or InStr(ScriptName,"login")>0 Or InStr(ScriptName,"admin_")>0 Then Page_Admin=True
sendmsgnum=0:sendmsgid=0:sendmsguser=""
End Sub
Private Sub class_terminate()
If IsObject(Conn) Then Conn.Close:Set Conn = Nothing
End Sub
Public Property Let Name(ByVal vNewValue)
LocalCacheName = LCase(vNewValue)
End Property
Public Property Let Value(ByVal vNewValue)
If LocalCacheName<>"" Then
ReDim Cache_Data(2)
Cache_Data(0)=vNewValue
Cache_Data(1)=Now()
Application.Lock
Application(CacheName & "_" & LocalCacheName) = Cache_Data
Application.unLock
Else
Err.Raise vbObjectError + 1, "DvbbsCacheServer", " please change the CacheName."
End If
End Property
Public Property Get Value()
If LocalCacheName<>"" Then
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If IsArray(Cache_Data) Then
Value=Cache_Data(0)
Else
Err.Raise vbObjectError + 1, "DvbbsCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
End If
Else
Err.Raise vbObjectError + 1, "DvbbsCacheServer", " please change the CacheName."
End If
End Property
Public Function ObjIsEmpty()
ObjIsEmpty=True
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If Not IsArray(Cache_Data) Then Exit Function
If Not IsDate(Cache_Data(1)) Then Exit Function
If DateDiff("s",CDate(Cache_Data(1)),Now()) < (60*Reloadtime) Then ObjIsEmpty=False
End Function
Public Sub DelCahe(MyCaheName)
Application.Lock
Application.Contents.Remove(CacheName&"_"&MyCaheName)
Application.unLock
End Sub
'取得基本設置數據
Public Sub GetForum_Setting()
Name="setup"
If ObjIsEmpty() Then ReloadSetup()
CacheData=value
'每日更新數據
'DelCahe "Date"
'第一次起用論壇或者重啟IIS的時候加載緩存
Name="Date"
If ObjIsEmpty() Then
value=Date()
Call ReloadAllForumInfo
Call ReloadAllBoardInfo
Else
If Cstr(value) <> Cstr(Date()) Then
Call ReloadAllForumInfo
Call ReloadAllBoardInfo
Name="setup"
Call ReloadSetup()
CacheData=value
End If
End If
Dim Setting
Setting=CacheData(1,0)
Setting = Split(Setting,"|||")
Forum_Info = Setting(0)
Forum_Info = Split (Forum_Info,",")
Forum_Setting = Setting(1)
Forum_Setting = Split (Forum_Setting,",")
Forum_user = Setting(2)
Forum_user = Split (Forum_user,",")
Forum_Copyright = Setting(3)
Forum_ChanSetting = CacheData(24,0)
Forum_ChanSetting = Split(Forum_ChanSetting,",")
Forum_Version = CacheData(18,0)
BadWords = Split(CacheData(3,0),"|")
rBadWord = Split(CacheData(4,0),"|")
Main_Sid=CacheData(17,0)
Maxonline = CacheData(5,0)
NowUseBBS = CacheData(19,0)
Cookiepath = CacheData(26,0)
'IP鎖定
If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
If Not Page_Admin Then
Response.Redirect "showerr.asp?action=iplock"
Exit Sub
End If
ElseIf Not ( Request.Cookies(Forum_sn & "Kill")("kill") = "0" And Not IsEmpty(Session(CacheName & "UserID")) ) Then
Call ChecKIPlock
If Request.Cookies(Forum_sn & "Kill")("kill") = "1" Then
If Not Page_Admin Then
Response.Redirect "showerr.asp?action=iplock"
Exit Sub
End If
End If
End If
'關閉論壇相關部分
If Forum_Setting(21)="1" And Not Page_Admin Then Response.redirect "showerr.asp?action=stop"
Dim OpenTime,ischeck
'判斷BoardID的值，獲取對應的設置
If BoardID>0 Then
If Not InStr((","&cachedata(27,0)&","),(","&BoardID&","))>0 Then
Response.Write "錯誤的版面參數"
Response.End
End If
Name="BoardInfo_" & BoardID
If ObjIsEmpty() Then ReloadBoardInfo(BoardID)
Board_Data = Value
boarduser = Split(Board_Data(13,0) & "",",")
Board_Ads = Split(Board_Data(17,0),"$")
Board_user = Split(Board_Data(18,0),",")
Forum_user = Board_User
board_Setting = Split(Board_Data(16,0),",")
LastPost = Split(Board_Data(14,0),"$")
BoardType = Board_Data(1,0)
IsGroupSetting = Board_Data(19,0)
BoardMasterList = Board_Data(8,0)
BoardRootID = Board_Data(5,0)
BoardParentID=Board_Data(2,0)
Sid = Board_Data(15,0)
Boardreadme=Board_Data(7,0)
If Len(Board_Setting(22))< 24 Then
Board_Setting(22)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
End If
OpenTime=Split(Board_Setting(22),"|")
setting=Board_Setting(21)
Forum_ads =Board_Ads
ischeck=Clng(Board_Setting(18))
If Board_Setting(50)<>"0" And Board_Setting(50)<>"" Then Response.Redirect Board_Setting(50)
If IsNumeric(Board_Data(21,0)) And CLng(Board_Data(6,0)) > 0 And CInt(Board_Data(4,0))< 2 Then Call LoadBoardList(BoardID,1)
If IsNumeric(Board_Data(26,0)) And CLng(Board_Data(6,0)) > 0 And CInt(Board_Data(4,0))< 2 Then Call LoadBoardList(BoardID,0)
'楊錚注：Board_Data(6,0) 為子論壇個數，當為空值時便會出錯，檢查 Dv_Board 表 Child 字段。
Else
Forum_ads = CacheData(2,0)
Forum_ads = Split(Forum_ads,"$")
If Len(Forum_Setting(70))< 24 Then
Forum_Setting(70)="1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1"
End If
OpenTime=Split(Forum_Setting(70),"|")
setting=Forum_Setting(69)
ischeck=Forum_Setting(26)
If Not IsNumeric(ischeck) Then ischeck=0
ischeck=CLng(ischeck)
End If
'定時開放判斷
If Not Page_Admin And Cint(setting)=1 Then
If OpenTime(Hour(Now))="0" Then
Response.redirect "showerr.asp?action=stop&boardid="&Dvbbs.BoardID&""
End If
End If
'在線人數限制
If ischeck > 0 And Not Page_Admin Then
If MyBoardOnline.Forum_Online > ischeck And BoardID=0 Then
If Not IsONline(Membername,1) Then Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
End If
If BoardID<> 0 Then
If (Not IsONline(Membername,1)) And MyBoardOnline.Board_Online > ischeck Then Response.Redirect "showerr.asp?action=limitedonline&lnum="&ischeck
End If
End If
If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1" Then Get_Chan_Ad
End Sub
Public Function IsReadonly()
IsReadonly=False
Dim TimeSetting
If Forum_Setting(69)="2" Then
TimeSetting=split(Forum_Setting(70),"|")
If TimeSetting(Hour(Now))="0" Then
IsReadonly=True
Exit Function
End If
End If
If boardid<>0 Then
If Board_Setting(21)="2" Then
TimeSetting=split(Board_Setting(22),"|")
If TimeSetting(Hour(Now))="0" Then
IsReadonly=True
End If
End If
End If
End Function
Public Function IsONline(UserName,action)
IsONline=False
If Trim(UserName)="" Then Exit Function
If IsArray(Session(CacheName & "UserID")) And action=1 Then
If Session(CacheName & "UserID")(0)="Dvbbs" Then
IsONline=True:Exit Function
End If
End If
Dim Rs
Set Rs =Execute("Select Count(*) From Dv_Online Where Username='"&UserName&"'")
If Rs(0)<> 0 Then IsONline=True
Set rs=Nothing
End Function
Public Sub ReloadSetup()
Dim SQL,Rs,i
SQL = "Select * from [Dv_setup] "
Set Rs = Execute(SQL)
value = Rs.GetRows(1)
Set Rs = Nothing
End Sub
Public Sub ReloadTemplateslist()
Dim Rs,SQL,tmpdata
SQL = "select ID,StyleName from [Dv_Style]"
Set Rs = Execute(SQL)
tmpdata = Rs.GetString(,,"|||","@@@","")
tmpdata = Left(tmpdata,Len(tmpdata)-3)
Set Rs = Nothing
value=tmpdata
End Sub
Public Sub LoadTemplates(Page_Fields)
Dim Style_Pic,Main_Style,TempStyle
CookiesSid = Request.Cookies("skin")("SkinID_"&BoardID)
If Not IsNumeric(CookiesSid) Or CookiesSid = "" Then
If BoardID = 0 Then
SkinID = Main_Sid
Else
SkinID = sid
End If
Else
SkinID=CookiesSid
End If
SkinID=CLng(SkinID)
Name="StyleName"&SkinID
If ObjIsEmpty() Then TemplatesToCache ("StyleName")
StyleName=value
Name="Forum_CSS"&SkinID
If ObjIsEmpty() Then TemplatesToCache ("Forum_CSS")
'風格換膚修改
CssID=Request.Cookies("skin")("cssid_"&BoardID)
If Not IsNumeric(CssID) OR CssID="" Then
If boardid=0 Then
CssID=CacheData(30,0)
Else
CssID=Board_Data(25,0)
End If
End If
If CssID="" Or Not IsNumeric(CssID) Then CssID=0
CssID=CLng(CssID)
TempStyle = value
TempStyle = Split(TempStyle,"@@@")
If CssID > UBound(Split(TempStyle(1),"|||"))-1 Then
CssID = 0
End If
Forum_CSS = Split(TempStyle(1),"|||")(CssID) '風格內容
Forum_PicUrl = Split(TempStyle(2),"|||")(CssID) '圖片路徑
Name = "Main_Style"&SkinID
If ObjIsEmpty() Then TemplatesToCache ("Main_Style")
Main_Style = Replace(value,"{$PicUrl}",Forum_PicUrl) '風格圖片路徑替換
If Not (Instr(ScriptName,"index")>0 Or Instr(ScriptName,"list")>0 Or Page_Admin) Then
Name = "Style_Pic"&SkinID
If ObjIsEmpty() Then TemplatesToCache ("Style_Pic")
Style_Pic = Replace(value,"{$PicUrl}",Forum_PicUrl) '風格圖片路徑替換
Style_Pic = Split(Style_Pic,"@@@")
Dim TmpArray(10),i
For i=0 to UBound(Style_Pic)
TmpArray(i) = Style_Pic(i)
Next
Forum_UserFace = TmpArray(0)
Forum_PostFace = TmpArray(1)
Forum_Emot = TmpArray(2)
End If
If Page_Fields<>"" Then
Name="page_"&Page_Fields&SkinID
If ObjIsEmpty() Then TemplatesToCache ("page_"&Page_Fields)
Template.value = value
End If
Main_Style = Split(Main_Style,"@@@")
mainhtml = Split(Main_Style(0),"|||")
lanstr = Split(Main_Style(1),"|||")
mainpic = Split(Main_Style(2),"|||")
mainsetting = Split(mainhtml(0),"||")
Forum_CSS = Replace(Forum_CSS,"{$width}",mainsetting(0))
Forum_CSS = Replace(Forum_CSS,"{$PicUrl}",Forum_PicUrl)
End Sub
Public Sub TemplatesToCache(Page_Fields)
Dim Rs,SQL
SQL = "Select "&Page_Fields&" from [Dv_Style] where id = " & SkinID
Set Rs = Execute(SQL)
If Not Rs.EOF Then
value=Rs(0)&""
Else
'處理錯誤
If boardid<>0 Then
If Cint(SkinID)=Cint(sid) Then Fixsid()
Else
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -