📄 dv_clsmain.asp
字号:
<%
'=========================================================
' File: Dv_ClsMain.asp
' Version:8.0.0 sp1
' Date: 2005-8-1
' Script Written by dvbbs.net
'=========================================================
' Copyright (C) 2003,2004 AspSky.Net. All rights reserved.
' Web: http://www.aspsky.net,http://www.dvbbs.net
' Email: eway@aspsky.net
'=========================================================
'是否商业版，非官方SQL版本请在此设置为0以及在Conn中设置论坛为SQL数据库，否则显示不正常
Const IsBuss=1
Const Dvbbs_Server_Url = "http://server.dvbbs.net/"
Const Dvbbs_PayTo_Url = "http://pay.dvbbs.net/"
Dim IP_MAX
Class Cls_Forum
Rem Const
Public DvXmlDom
Public BoardID,SqlQueryNum,Forum_Info,Forum_Setting,Forum_user,Forum_Copyright,Forum_ads,Forum_ChanSetting,Forum_UploadSetting
Public Forum_sn,Forum_Version,Stats,StyleName,ErrCodes,NowUseBBS,Cookiepath,ScriptFolder,BoardInfoData,UserSession
Public lanstr,mainhtml,mainsetting,sysmenu,mainpic,UserToday,BoardJumpList,BoardList,CacheData,Maxonline
Public VipGroupUser,Vipuser,Boardmaster,Superboardmaster,Master,FoundIsChallenge,FoundUser
Public ScriptName,MemberName,MemberWord,MemberClass,UserHidden,UserID,UserTrueIP,UserPermission
Public sendmsgnum,sendmsgid,sendmsguser,Page_Admin
Public BadWords,rBadWord,Forum_emot,Forum_PostFace,Forum_UserFace,SkinID,Forum_PicUrl
Private Forum_CSS,Main_Sid,Nowstats,CssID
Public Reloadtime,CacheName,UserGroupID,Lastlogin,GroupSetting,FoundUserPer,UserGroupParent,UserGroupParentID
Private LocalCacheName,IsTopTable,ShowErrType
Public Board_Setting,LastPost,Board_user,BoardType,Board_Data,Sid,Boardreadme,BoardRootID,BoardParentID
Private Is_Isapi_Rewrite,iArchiverUrl
Public ModHtmlLinked,ArchiverUrl,ArchiverType
Public Browser,version ,platform,IsSearch,Cls_IsSearch
Public IsUserPermissionOnly,IsUserPermissionAll,ShowSQL,actforip
Public GroupName
Rem Sub
Private Sub Class_Initialize()
Forum_sn="DvForum"'如果一个虚拟目录或站点开多个论坛，则每个要错开，不能定义同一个名称
CacheName="DvCache"'如果一个虚拟目录或站点开多个论坛，则每个要错开，不能定义同一个名称
If Not Response.IsClientConnected Then
Session(CacheName & "UserID")=empty
Set Dvbbs=Nothing
Response.End
End If
IsUserPermissionOnly = 0
IsUserPermissionAll = 0
ShowErrType = 0 '错误信息显示模式
SqlQueryNum = 0
Reloadtime=28800
IsTopTable = 0
VipGroupUser = False:IsSearch=False:Cls_IsSearch=False
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 = Trim(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 = getIP()
IP_MAX=0
Dim Tmpstr
Tmpstr = Request.ServerVariables("PATH_INFO")
Tmpstr = Split(Tmpstr,"/")
ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))
ScriptFolder = Lcase(Tmpstr(UBound(Tmpstr)-1)) & "/"
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=""
'模拟HTML部分开始
Is_Isapi_Rewrite = 0
If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "?"
ArchiverType = 0
If InStr(ScriptName,"indexhtml.asp") > 0 Then
iArchiverUrl = Lcase(Request.ServerVariables("QUERY_STRING"))
If iArchiverUrl <> "" Then
ArchiverUrl = iArchiverUrl
iArchiverUrl = Split(iArchiverUrl,"_")
If iArchiverUrl(0) = "list" And Ubound(iArchiverUrl) = 5 Then
If IsNumeric(iArchiverUrl(1)) Then
ArchiverType = 1
BoardID = Clng(iArchiverUrl(1))
End If
End If
End If
End If
End Sub
'isapi_write
Public Function ArchiveHtml(Textstr)
Str=Textstr
If isUrlreWrite = 1 Then
Dim Str,re,Matches,Match
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern = "<a(.[^>]*)index\.asp\?boardid=(\d+)(&|&)action=(.[^&]*)(&|&)topicmode=(\d+)(&|&)page=(\d+)"
str = re.Replace(str,"<a$1index_$2_$4_$6_$8.html")
re.Pattern = "<a(.[^>]*)index\.asp\?boardid=(\d+)(&|&)page=(\d+)(&|&)action=(.[^<>""\'\s]*)"
str = re.Replace(str,"<a$1index_$2_$4_$6.html")
re.Pattern = "<a(.[^>]*)index\.asp\?boardid=(\d+)(&|&)topicmode=(\d+)"
str = re.Replace(str,"<a$1index_$2_$4.html")
re.Pattern = "<a(.[^>]*)index\.asp\?boardid=(\d+)(&|&)page=(\d+)"
str = re.Replace(str,"<a$1index_$2_$4_.html")
re.Pattern = "<a(.[^>]*)index\.asp\?boardid=(\d+)(&|&)page="
str = re.Replace(str,"<a$1index_$2__.html")
re.Pattern = "<a(.[^>]*)index\.asp\?boardid=(\d+)"
str = re.Replace(str,"<a$1index_$2.html")
re.Pattern = "<a(.[^>|_]*)index\.asp"
str = re.Replace(str,"<a$1index.html")
re.Pattern = "<a(.[^>]*)dispbbs\.asp\?boardid=(\d+)(&|&)replyid=(\d+)(&|&)id=(\d+)(&|&)skin=(\d+)(&|&)page=(\d+)(&|&)star=(\d+)"
str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_skin$8_$10_$12.html")
re.Pattern = "<a(.[^>]*)dispbbs\.asp\?boardid=(\d+)(&|&)replyid=(\d+)(&|&)id=(\d+)(&|&)skin=(\d+)(&|&)star=(\d+)"
str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_skin$8_$10.html")
re.Pattern = "<a(.[^>]*)dispbbs\.asp\?boardid=(\d+)(&|&)replyid=(\d+)(&|&)id=(\d+)(&|&)skin=(\d+)"
str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_skin$8.html")
re.Pattern = "<a(.[^>]*)dispbbs\.asp\?boardid=(\d+)(&|&)id=(\d+)(&|&)star=(\d+)(&|&)page=(\d+)"
str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_$8.html")
re.Pattern = "<a(.[^>]*)dispbbs\.asp\?boardid=(\d+)(&|&)id=(\d+)(&|&)page=(\d+)"
str = re.Replace(str,"<a$1dispbbs_$2_$4_$6.html")
re.Pattern = "<a(.[^>]*)dv_rss\.asp\?s=(.[^<|>|""|\'|\s]*)"
str = re.Replace(str,"<a$1dv_rss_$2.html")
re.Pattern = "<a(.[^>]*)dv_rss\.asp"
str = re.Replace(str,"<a$1dv_rss.html")
Set Re=Nothing
End If
ArchiveHtml = Str
End Function
Private Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
actforip=Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
actforip=Request.ServerVariables("REMOTE_ADDR")
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
actforip=Request.ServerVariables("REMOTE_ADDR")
End If
getIP = CheckStr(Trim(Mid(strIPAddr, 1, 30)))
End Function
Private Sub class_terminate()
If EnabledSession Then
If Not UserSession Is Nothing Then Session(CacheName & "UserID")= UserSession.xml
End If
Set UserSession=Nothing
If IsObject(Conn) Then Conn.Close : Set Conn = Nothing
If IsObject(Plus_Conn) Then Plus_Conn.Close : Set Plus_Conn = Nothing
End Sub
Public Sub Sendmessanger(touserid,senduser,messangertext)
Dim Node
If Not IsObject( Application(Dvbbs.CacheName&"_messanger")) Then
Set Application(Dvbbs.CacheName&"_messanger")=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
Application(Dvbbs.CacheName&"_messanger").appendChild( Application(Dvbbs.CacheName&"_messanger").createElement("xml"))
End If
For Each Node in Application(Dvbbs.CacheName&"_messanger").documentElement.SelectNodes("messanger")
If datediff("s",Node.selectSingleNode("@sendtime").text,Now()) > 72000 Then
Application(Dvbbs.CacheName&"_messanger").documentElement.removeChild(Node)
End If
Next
Set Node=Application(Dvbbs.CacheName&"_messanger").documentElement.appendChild(Application(Dvbbs.CacheName&"_messanger").createNode(1,"messanger",""))
Node.attributes.setNamedItem(Application(Dvbbs.CacheName&"_messanger").createNode(2,"sendtime","")).text=Now()
Node.attributes.setNamedItem(Application(Dvbbs.CacheName&"_messanger").createNode(2,"touserid","")).text=touserid
Node.attributes.setNamedItem(Application(Dvbbs.CacheName&"_messanger").createNode(2,"senduser","")).text=senduser
Node.text=messangertext
End Sub
Public Property Let Name(ByVal vNewValue)
LocalCacheName = LCase(vNewValue)
End Property
Public Property Let Value(ByVal vNewValue)
If LocalCacheName<>"" Then
Application.Lock
Application(CacheName & "_" & LocalCacheName &"_-time")=Now()
Application(CacheName & "_" & LocalCacheName) = vNewValue
Application.unLock
End If
End Property
Public Property Get Value()
If LocalCacheName<>"" Then
Value=Application(CacheName & "_" & LocalCacheName)
End If
End Property
Public Function ObjIsEmpty()
ObjIsEmpty=True
If Not IsDate(Application(CacheName & "_" & LocalCacheName &"_-time")) Then Exit Function
If DateDiff("s",CDate(Application(CacheName & "_" & LocalCacheName &"_-time")),Now()) < (60*Reloadtime) Then ObjIsEmpty=False
End Function
'取得基本设置数据
Public Sub loadSetup()
Dim Rs,locklist,ip,ip1,XMLDom,Node,i
Application.Lock
Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
XMLDom.Load Server.MapPath(MyDbPath &"inc\guest.xml")
Set Application(Dvbbs.CacheName&"_info_guest")=XMLDom.cloneNode(True)
Set XMLDom=Nothing
Application.UnLock
Name="setup"
Set Rs = Dvbbs.Execute("Select id, Forum_Setting, Forum_ads, Forum_Badwords, Forum_rBadword, Forum_Maxonline, Forum_MaxonlineDate, Forum_TopicNum, Forum_PostNum, Forum_TodayNum, Forum_UserNum, Forum_YesTerdayNum, Forum_MaxPostNum, Forum_MaxPostDate, Forum_lastUser, Forum_LastPost, Forum_BirthUser, Forum_Sid, Forum_Version, Forum_NowUseBBS, Forum_IsInstall, Forum_challengePassWord, Forum_Ad, Forum_ChanName, Forum_ChanSetting, Forum_LockIP, Forum_Cookiespath, Forum_Boards, Forum_alltopnum, Forum_pack, Forum_Cid, Forum_AvaSiteID, Forum_AvaSign, Forum_AdminFolder, Forum_BoardXML, Forum_Css From [Dv_Setup]")
Value = Rs.GetRows(1)
CacheData=value
Set XMLDom=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
XMLDom.appendChild(XMLDom.createElement("xml"))
locklist=Trim(CacheData(25,0))
locklist=Split(locklist,"|")
For Each Ip in locklist
Ip1=Split(Ip,".")
Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"lockip",""))
For i=0 to UBound(ip1)
Node.attributes.setNamedItem(XMLDom.createNode(2,"number"& (i+1),"")).text=ip1(i)
Next
Next
Application.Lock
Set Application(CacheName & "_forum_lockip")=XMLDom.cloneNode(True)
Application.UnLock
Set XMLDom=Nothing
If Not isobject(Application(CacheName & "_getbrowser")) Then
Dim stylesheet
Set stylesheet=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
stylesheet.load Server.MapPath(MyDbPath &"inc\GetBrowser.xslt")
Application.Lock
Set Application(CacheName & "_getbrowser")=Server.CreateObject("msxml2.XSLTemplate" & MsxmlVersion)
Application(CacheName & "_getbrowser").stylesheet=stylesheet
Application.unLock
End If
Application.Lock
Set Application(CacheName & "_csslist")=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
Application(CacheName & "_csslist").Loadxml CacheData(35,0)
Application.unLock
Application.Lock
Set Application(CacheName & "_accesstopic")=Server.CreateObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
Application(CacheName & "_accesstopic").Loadxml CacheData(34,0)
Application.unLock
End Sub
Public Sub LoadBoardList()
Application.Lock
Dim Rs,boardmaster,master,node,Board_setting
Set Rs=Execute("select boardid,boardtype,ParentID,depth,rootid,Child,indeximg,parentstr,cid as checkout,cid as hidden,cid as nopost,cid as checklock,cid as mode,cid as simplenesscount,readme From Dv_board Order by rootid,Orders")
Set Application(CacheName&"_boardlist")=RecordsetToxml(rs,"board","BoardList")
Rs.Close
Set Rs=Execute("select boardid From Dv_board Order by Orders")
Set Application(CacheName&"_boardmaster")=RecordsetToxml(rs,"boardmaster","masterlist")
Rs.Close
Set Rs=Execute("select boardmaster,boardid,Board_setting From Dv_board Order by Orders")
Do While Not Rs.EOF
boardmaster=split(Rs("boardmaster")&"","|")
Set Node=Application(CacheName&"_boardmaster").documentElement.selectSingleNode("boardmaster[@boardid='"& Rs(1)&"']")
For Each Master In boardmaster
Node.appendChild(Application(CacheName&"_boardmaster").createNode(1,"master","")).text=Master
Next
Board_setting=Split(Rs("Board_setting"),",")
Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@checkout").text=Board_setting(2)
Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@hidden").text=Board_setting(1)
Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@nopost").text=Board_setting(43)
Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@checklock").text=Board_setting(0)
Application(CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@mode").text=Board_setting(39)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -