现在的位置: 首页 > 综合 > 正文

动网论坛核心类源码注释

2013年09月18日 ⁄ 综合 ⁄ 共 22661字 ⁄ 字号 评论关闭

<object runat="server" id="DvStream" progid="ADODB.Stream"></object>
<%
'=========================================================
' File: Dv_ClsMain.asp
' Version:8.2.0
' Date: 2007-3-10
' 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 '定义变量,初始值为1
Const Dvbbs_Server_Url = "http://server.dvbbs.net/" '定义动网服务器地址http://server.dvbbs.net
Const Dvbbs_PayTo_Url = "http://pay.dvbbs.net/" '定义动网http://pay.dvbbs.net/
Const fversion="8.2.0" '定义版本号
Dim IP_MAX
Const guestxml="<?xml version=""1.0"" encoding=""gb2312""?><xml><userinfo statuserid=""0"" userid=""0"" username=""客人"" userclass=""客人"" usergroupid=""7"" cometime="""" boardid=""0"" activetime="""" statusstr=""""/></xml>"'定义一个xml文件,主要是做中间缓存作用,防止频繁读写数据库,值得借鉴
Class Cls_Forum
 Rem 对各字段的解释,StyleName和NowUseBBS两变量没有用到
 'BoardID 论坛ID,SqlQueryNum 数据库查询次数,Forum_Info 论坛基本信息,Forum_Setting 论坛设置信息,Forum_user 论坛用户,Forum_Copyright 论坛版权,Forum_ads 论坛广告,
 'Forum_ChanSetting 论坛栏目基本设置,Forum_UploadSetting 论坛上传设置,Forum_sn 论坛名称,Forum_Version 论坛版本号,Stats 网页的标题信息,
 'StyleName 论坛使用的样式名称,Cookiepath Cookie路径,ScriptFolder 暂放 ,BoardInfoData 论坛信息基本数据,UserSession 用户Session信息
 'MainSetting 论坛的基本设置信息(字体大小,颜色等),sysmenu 系统菜单,UserToday 存储的是0|0|0|0|0,还不知道是干吗用的,BoardJumpList 论坛跳转菜单,BoardList 论坛列表,
 'CacheData 论坛缓存数据,Maxonline 最大在线人数,VipGroupUser Vip用户组,Vipuser vip用户,Boardmaster 论坛版主,Superboardmaster 论坛超级版主,Master 管理员,
 'FoundIsChallenge 暂放,FoundUser 暂放,ScriptName 文件名的前缀,MemberName 用户名,MemberWord 用户密码,MemberClass 用户头衔,UserHidden 是否隐身,UserID 用户ID,
 'UserTrueIP 论坛用户真实IP, UserPermission 用户访问权限设置字段,sendmsgnum 发送短消息数目,sendmsgid 短消息ID,sendmsguser 发送短消息用户,Page_Admin 判断用的
 'BadWords 需要过滤的词汇,rBadWord 过滤后的显示的词汇,Forum_emot 论坛心情图标,Forum_UserFace 论坛用户图象,SkinID 主题样式ID,Forum_PicUrl 论坛图片路径
 'Forum_CSS 论坛样式,Main_Sid 暂放,Nowstats 暂放,CssID 样式表ID,ReloadTime 缓存有效时间,CacheName 缓存名称,UserGroupID 用户所在组ID,Lastlogin 最后登陆,
 'GroupSetting 圈子设置,FoundUserPer 布尔值,UserGroupParent 用户所在圈子,UserGroupParentID 用户所在圈子ID
 'LocalCacheName 本地缓存名,IsTopTable 一常量(0和1),ShowErrType 错误信息显示模式,Board_Setting 分论坛设置信息,LastPost 最后注销时间,Board_User 暂放,
 'BoardType 论坛类型,Board_Data 论坛缓存数据,sid 暂放,Boardreadme 论坛帮助,BoardRootID 论坛根ID,BoardParentID 论坛父ID,Is_Isapi_Rewrite 是否重写, iArchiverUrl 暂放
 'Browser 浏览器,version 版本号,platform 操作系统,IsSearch 布尔值,Cls_IsSearch 暂放,IsUserPermissionAll 是否允许所有用户,ShowSQL 显示SQL,GroupName 圈子名称
 'ScriptPath 模板路径,Forum_apis 论坛插件
 
 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 MainSetting,sysmenu,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,DvRegExp,DvRegExp1
 Public GroupName,ScriptPath,Forum_apis
 Rem Const
 Function iCreateObject(str)
  'iis5创建对象方法Server.CreateObject(ObjectName);
  'iis6创建对象方法CreateObject(ObjectName);
  '默认为iis6,如果在iis5中使用,需要改为Server.CreateObject(str);
  Set iCreateObject=CreateObject(str)'创建一个对象
 End Function

 Function CreateXmlDoc(str)
  Set CreateXmlDoc = iCreateObject(str)'创建一个xml对象
  CreateXmlDoc.async=false
 End Function
 

 Public Function ReadTextFile(fileName)'读取文本函数
  On Error Resume Next
   'Response.Write Server.MapPath(ScriptPath&fileName)
   DvStream.charset="gb2312"'字符编码,gb2312表示简体中文
   DvStream.Mode = 3'对数据的修改权限,3表示可读写
   DvStream.open()'打开流模式
   DvStream.LoadFromFile(Server.MapPath(ScriptPath&fileName))'调入文件路径
   ReadTextFile=DvStream.ReadText'读取文件内容
   DvStream.close()'关闭流模式
  If Err Then
   err.Clear
   PageEnd()
   Response.Clear
   Response.Write ScriptPath&fileName & "文件不存在!请检查,或者恢复官方模板数据!"
   Response.End
  End If
 End Function

 Function writeToFile(fileName,Text)'写入文本函数
  DvStream.charset="gb2312"'字符编码简体中文
  DvStream.Mode = 3'表示可读写
  DvStream.open()'打开流模式
  DvStream.WriteText(Text)'写入文件内容
  DvStream.SaveToFile Server.MapPath(ScriptPath&fileName),2'保存指定路径
  DvStream.close()'关闭流模式
 End Function

 Private Sub Class_Initialize()  
 End Sub

 public Sub PageInit()'论坛函数初始化
  ScriptPath="./"
  Forum_sn="DvForum 8.2"'如果一个虚拟目录或站点开多个论坛,则每个要错开,不能定义同一个名称
  Forum_sn=Forum_sn & "_" & Request.servervariables("SERVER_NAME") 'Request.servervariables("SERVER_NAME")-服务器的主机名、DNS地址或IP地址
  CacheName="DvCache 8.2"'如果一个虚拟目录或站点开多个论坛,则每个要错开,不能定义同一个名称
  IsUserPermissionOnly = 0 '仅允许当前用户访问模式
  IsUserPermissionAll = 0 '允许所有用户访问模式
  ShowErrType = 0 '错误信息显示模式
  SqlQueryNum = 0 '数据库查询次数
  Reloadtime=600 '缓存时间
  IsTopTable = 0
  VipGroupUser = False:IsSearch=False:Cls_IsSearch=False'版主,超级版主,管理员,vip用户默认初始化
  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是否为数字,空值
  BoardID = Clng(BoardID)
  '以下是用cookies来保存用户信息,而不是用session,因为大量的session占用大量资源,cookies存在客户端,减轻服务器的负载,值得推荐
  MemberName = checkStr(Trim(Request.Cookies(Forum_sn)("username")))'用cookies保存用户名,checkStr是一个过滤函数,防止拼接字符串进行SQL注入,这里是防止cookies注入
  MemberWord = checkStr(Trim(Request.Cookies(Forum_sn)("password")))'用cookies保存用户密码,防止Cookies注入
  UserHidden = Trim(Request.Cookies(Forum_sn)("userhidden"))'用cookies来保存用户是否隐身,trim是去掉空格
  UserID = Trim(Request.Cookies(Forum_sn)("UserID"))'以cookies保存用户ID
  If IsNumeric(UserHidden) = 0 or Userhidden = "" Then UserHidden = 2'UserHidden数值判断初始化,IsNumeric判断是否为数字,返回的结果为True或False
  If IsNumeric(UserID) = 0 Or UserID="" Then UserID=0'UserID数值判断初始化
  UserID = Clng(UserID)'clng将数字转换成Long格式的数字类型
  UserTrueIP = getIP()'调用getIP函数,此函数主要是获取用户的IP地址
  IP_MAX=0
  Dim Tmpstr
  Tmpstr = Request.ServerVariables("PATH_INFO")'返回客户端提供的路径信息
  Tmpstr = Split(Tmpstr,"/")'split数组分割
  ScriptName = Lcase(Tmpstr(UBound(Tmpstr)))'取得访问的文件名
  ScriptFolder = Lcase(Tmpstr(UBound(Tmpstr)-1)) & "/"
  MemberClass = checkStr(Request.Cookies(Forum_sn)("userclass"))'将用户头衔用cookie保存起来
  Page_Admin=False 'Page_Admin初始化,主要为后面页面判断,判断是否指定的当前页面,主要是为安全性考虑,只有从指定页面跳转过来的,才是安全的,防止跨站
  If InStr(ScriptName,"showerr")>0 Or InStr(ScriptName,"login")>0 Or InStr(ScriptName,"admin_")>0 Or InStr(ScriptName,"ajax")>0 Then Page_Admin=True
  '依次与指定的页面比较,看是否是指定的页面,Instr用法是从字符串中搜索指定的字符串,如果搜索到了,其InStr值大于0,这时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"))'接受Get变量传递的参数
   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)'URL重写函数,主要是用正则处理,具体请大家参考正则的详细用法,这里不详细阐述
  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+)(&|&amp;)topicmode=(/d+)?(&|&amp;)list_type=([/d,]+)?(&|&amp;)page=(/d+)?"
   str = re.Replace(str,"<a$1index_$2_$4_$6_$8.html")
   re.Pattern = "<a(.[^>]*)index/.asp/?boardid=(/d+)(&|&amp;)action=(.[^&]*)?(&|&amp;)topicmode=(/d+)?(&|&amp;)list_type=([/d,]+)?(&|&amp;)page=(/d+)?"
   str = re.Replace(str,"<a$1index_$2_$4_$6_$8_$10.html")
   re.Pattern = "<a(.[^>]*)index/.asp/?boardid=(/d+)(&|&amp;)page=(/d+)?(&|&amp;)action=(.[^<>""/'/s]*)?"
   str = re.Replace(str,"<a$1index_$2_$4_$6.html")
   re.Pattern = "<a(.[^>]*)index/.asp/?boardid=(/d+)(&|&amp;)topicmode=(/d+)?"
   str = re.Replace(str,"<a$1index_$2_$4.html")
   re.Pattern = "<a(.[^>]*)index/.asp/?boardid=(/d+)(&|&amp;)page=(/d+)?"
   str = re.Replace(str,"<a$1index_$2_$4_.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+)(&|&amp;)replyid=(/d+)?(&|&amp;)id=(/d+)?(&|&amp;)skin=(/d+)?(&|&amp;)page=(/d+)?(&|&amp;)star=(/d+)?"
   str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_skin$8_$10_$12.html")
   re.Pattern = "<a(.[^>]*)dispbbs/.asp/?boardid=(/d+)(&|&amp;)replyid=(/d+)?(&|&amp;)id=(/d+)?(&|&amp;)skin=(/d+)?(&|&amp;)star=(/d+)?"
   str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_skin$8_$10.html")
   re.Pattern = "<a(.[^>]*)dispbbs/.asp/?boardid=(/d+)(&|&amp;)replyid=(/d+)?(&|&amp;)id=(/d+)?(&|&amp;)skin=(/d+)?"
   str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_skin$8.html")
   re.Pattern = "<a(.[^>]*)dispbbs/.asp/?boardid=(/d+)(&|&amp;)id=(/d+)?(&|&amp;)page=(/d+)?(&|&amp;)(star|move)=([/w/d]+)?"
   str = re.Replace(str,"<a$1dispbbs_$2_$4_$6_$9.html")
   re.Pattern = "<a(.[^>]*)dispbbs/.asp/?boardid=(/d+)(&|&amp;)id=(/d+)?(&|&amp;)page=(/d+)?"
   str = re.Replace(str,"<a$1dispbbs_$2_$4_$6.html")
   re.Pattern = "<a(.[^>]*)dispbbs/.asp/?boardid=(/d+)(&|&amp;)id=(/d+)?"
   str = re.Replace(str,"<a$1dispbbs_$2_$4.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() '获取IP地址函数
  Dim strIPAddr '定义IP地址字符串
  '如果客户端使用了代理服务器,使用Request.ServerVariables("HTTP_X_FORWARDED_FOR")得到IP地址,如果没用使用代理服务器,得到的是"",则用Request.ServerVariables("REMOTE_ADDR") 得到IP地址.
  If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
   strIPAddr = Request.ServerVariables("REMOTE_ADDR") '取得本机IP地址
  '如果取得多个代理IP地址,且ip地址以逗号分隔,那么就取第一个ip地址
  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")
  '如果取得多个代理IP地址,且ip地址以分号分隔,那么就取第一个ip地址
  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)))'mid函数是从从字符串中返回指定数目的字符,这里是从strIPAddr第一位开始,取后面的30位字符
 End Function

 Private Sub class_terminate()  
 End Sub

 Public Sub PageEnd()
  If EnabledSession Then 'EnabledSession这个变量没有定义,可能是判断是否是session,暂放一下
   If Not UserSession Is Nothing  Then Session(CacheName & "UserID")= UserSession.xml'判断UserSession是否为空,将UserSession.xml置于session中
  End If
  Set UserSession=Nothing '释放UserSession
  If IsObject(Conn) Then Conn.Close : Set Conn = Nothing'判断Conn是否为一个对象 变量,是的话释放Conn
  If IsObject(Plus_Conn) Then Plus_Conn.Close : Set Plus_Conn = Nothing'判断Plus_Conn是否是一个对象变量,是的话释放Plus_Conn
  '以下是释放各变量的值,释放后内存能被其他代码使用,优化了代码运行速度
  Set DvRegExp= Nothing'释放正则
  Set DvRegExp1= Nothing
  CacheData=Null'释放缓存数据
  Forum_Setting = Null'释放论坛设置数据
  Forum_UploadSetting = Null'释放上传设置数据
  Forum_user =Null'释放论坛用户数据
  Forum_ChanSetting =Null'释放论坛栏目基本设置数据
  BadWords = Null'释放过滤的词汇数据
  rBadWord = Null'释放过滤后替换的词汇数据
  Forum_ads=Null'释放论坛广告数据
 End Sub

 Public Sub Sendmessanger(touserid,senduser,messangertext)'发送短消息函数,touserid--发送信息到指定用户的ID号,senduser--发送信息的用户,messangertext--发送信息文本内容
  Dim Node'定义Node变量
  If Not IsObject( Application(Dvbbs.CacheName&"_messanger")) Then'判断Application(Dvbbs.CacheName&"_messanger")是否为一对象,这里将Dvbbs.CacheName&"_messanger"用Application进行缓存,Dvbbs.CacheName是缓存名称,默认定义为dvbbs,后面的_messanger是自定义的,是为了和其他缓存对象相区别.这个If语句表示:如果Application(Dvbbs.CacheName&"_messanger")不是一个对象,则执行如下语句
   Set  Application(Dvbbs.CacheName&"_messanger")=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)'创建自由线程XMlDOM对象
    Application(Dvbbs.CacheName&"_messanger").appendChild( Application(Dvbbs.CacheName&"_messanger").createElement("xml"))'添加xml节点,将其作为Application(Dvbbs.CacheName&"_messanger")的子节点
  End If
  For Each Node in Application(Dvbbs.CacheName&"_messanger").documentElement.SelectNodes("messanger")'对根节点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'创建节点,对节点进行赋值--发送到指定用户ID
  Node.attributes.setNamedItem(Application(Dvbbs.CacheName&"_messanger").createNode(2,"senduser","")).text=senduser'创建节点,对节点进行赋值--发送用户
  Node.text=messangertext'文本内容赋值
 End Sub
    '下面是dvbbs缓存模块,从dvbbs7.0开始,动网开始使用缓存机制,到SQL8.2版本,动网缓存机制使用更上一层楼,结合Application,采用xml缓存.个人认为,动网的缓存机制值得学习
 Public Property Let Name(ByVal vNewValue)'定义Name属性,此处Name属性主要是缓存Name,不同的缓存有不同的Name,此Name是自定义的.个人认为,Name主要起一个标记作用,因为缓存数量过多的话,主要是靠Name来识别.Name就像房间号一样,对号入座.
  LocalCacheName = LCase(vNewValue)'将传递参数转换成小写
 End Property

 Public Property Let Value(ByVal vNewValue)'定义Value属性,此处Value属性是指写入缓存的Value,后面着重介绍
  If LocalCacheName<>"" Then'LocalCacheName不为空
   Application.Lock'锁定,其他人无法写入
   Application(CacheName & "_" & LocalCacheName &"_-time")=Now()'将now函数写入Application中
   Application(CacheName & "_" & LocalCacheName) = vNewValue'将参数vNewValue写入Application中
   Application.unLock'解锁,共享缓存
  End If
 End Property

 Public Property Get Value()'定义一个类的属性,该属性返回Value的值
  If LocalCacheName<>"" Then  '判断条件,也就是缓存名不为空,每一个缓存有一个Name值,才能执行下面语句
    Value=Application(CacheName & "_" & LocalCacheName)'将缓存的内容赋给Value
  End If
 End Property

 Public Function ObjIsEmpty()'此函数是判断缓存对象是否过期,有一个返回值ObjIsEmpty,初始值为False
  'Response.Write DateDiff("s",CDate(Application(CacheName & "_" & LocalCacheName &"_-time")),Now())&"秒"
  ObjIsEmpty=False'返回值初始化
  If  IsDate(Application(CacheName & "_" & LocalCacheName &"_-time")) Then'用IsDate函数判断缓存中的now()是否转换成日期
   If DateDiff("s",CDate(Application(CacheName & "_" & LocalCacheName &"_-time")),Now()) > (60*Reloadtime) Then ObjIsEmpty=True'缓存是否过期判断,主要是和Now进行比较,得到一个返回值
  Else
   ObjIsEmpty=True
  End If
  If ObjIsEmpty Then RemoveCache()'过期了,是否缓存
 End Function

 Public Sub RemoveCache()'是否缓存对象
  Application.Lock'锁定
  Application.Contents.Remove(CacheName & "_" & LocalCacheName)'释放缓存数据
  Application.Contents.Remove(CacheName & "_" & LocalCacheName &"_-time")'释放缓存的时间
  Application.unLock'解锁
 End Sub
 '取得基本设置数据
 Public Sub loadSetup()
  Dim Rs,locklist,ip,ip1,XMLDom,Node,i'定义各种变量
  Name="setup"'此处命名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, Forum_apis From [Dv_Setup]")'用Execute执行这个SQL语句,该方法在后面介绍
  Value = Rs.GetRows(1)'取得检索一行数据,置入一个二维数组之中.赋给Value,该Value就是缓存值.dvbbs非常注重缓存机制,尽可能减轻服务器的访问压力
  CacheData=value'将Value赋给CacheData,可以通过CacheData(1,0)来访问数据
  Set XMLDom=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)'建立xmldom对象
   XMLDom.appendChild(XMLDom.createElement("xml"))'建立xml节点
   locklist=Trim(CacheData(25,0))'这里取得缓存值,注意这里不是从硬盘中读取,而是从内存中读取的,这个CacheDate(25,0)究竟是什么值,看上面的SQL语句,从id数起,也就是从0开始,数到25个,可见是Forum_LockIP,锁定IP
   locklist=Split(locklist,"|")'数组分割,取得单个IP地址
   For Each Ip in locklist'取得值后遍历IP地址
    Ip1=Split(Ip,".")'对IP地址分割,此处是一个数组下标
    Set Node=XMLDom.documentElement.appendChild(XMLDom.createNode(1,"lockip",""))'建立lockip节点
    For i=0 to UBound(ip1)'通过数组下标访问
     Node.attributes.setNamedItem(XMLDom.createNode(2,"number"& (i+1),"")).text=ip1(i)'批量建立锁定的ip地址节点
    Next
   Next
   Application.Lock
   Set Application(CacheName & "_forum_lockip")=XMLDom'这里相当于Set Application(CacheName & "_forum_lockip")=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion),作用还是建立xmldom对象,只不过分了两步
   Application.UnLock
  Set XMLDom=Nothing'释放对象
  If Not isobject(Application(CacheName & "_getbrowser")) Then'对返回的浏览器类型进行缓存,判断Application(CacheName & "_getbrowser")是否一个对象
   Dim stylesheet
   Set stylesheet=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)'建立自由多线程xmldom对象
   stylesheet.load Server.MapPath(MyDbPath &"inc/GetBrowser.xslt")'调入xslt文件
   Application.Lock'锁定
   Set Application(CacheName & "_getbrowser")=Dvbbs.iCreateObject("msxml2.XSLTemplate" & MsxmlVersion)'创建一个新的 XSLTemplate 对象并设置样式表
   Application(CacheName & "_getbrowser").stylesheet=stylesheet
   Application.unLock'解锁
  End If
  Application.Lock
  Set Application(CacheName & "_accesstopic")=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
  Application(CacheName & "_accesstopic").Loadxml Replace(Replace(CacheData(34,0),Chr(10),""),Chr(13),"")'对Forum_BoardXML进行替换危险字符,防止注入chr(10)表示换行,chr(13)表示回车
  Application.unLock
 End Sub

 Public Sub LoadBbsBoard()  
 End Sub

 Public Sub LoadBoardList()'调入论坛列表函数
  Dim TempXmlDoc,TempMasterDoc,ChildNode'定义各种变量
  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,boardmaster From Dv_board Order by rootid,Orders")'执行SQL语句
  Set TempXmlDoc = RecordsetToxml(rs,"board","BoardList")'这里用到后面封装的一个函数RecordsetToxml,后面详细介绍,作用是建立根节点和行节点,BoardList是根节点,board是行节点,rs是建立的记录集
  Rs.Close'关闭
  Set TempMasterDoc = Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)'建立xmldom对象
  TempMasterDoc.documentElement = TempMasterDoc.createElement("masterlist")'创建masterlist节点,并将此节点作根节点
  Set Rs=Execute("select boardmaster,boardid,Board_setting From Dv_board Order by Orders")
  Do While Not Rs.EOF'循环
   Set Node = TempMasterDoc.documentElement.appendChild(TempMasterDoc.createNode(1,"boardmaster",""))'建立boardmaster节点,将此节点放在masterlist之后
   Node.setAttribute "boardid",Rs(1)'对节点对象的属性进行赋值,这里将rs(1)赋给boardid,rs(1)=上面sql语句中boardid值
   boardmaster=split(Rs("boardmaster")&"","|")'对Rs("boardmaster")进行数组分割
   For Each Master In boardmaster'节点遍历
    Node.appendChild(TempMasterDoc.createNode(1,"master","")).text=Master'将Master赋值给已经创建的节点master,
   Next
   Board_setting=Split(Rs("Board_setting"),",")'论坛设置数组分割
   '先看Rs("Board_setting")的值,是以逗号分隔的字符串,Board_Setting,如下:
'0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,16240,3,0,gif|jpg|jpeg|bmp|png|rar|txt|zip|mid,0,0,1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1|1,0,1,100,20,10,9,normal,1,10,10,0,0,0,0,1,0,0,1,4,0,1,0,200,0,0,,$$,0,0,0,1,0|0|0|0|0|0|0|0|0,0|0|0|0|0|0|0|0|0|0|0|0|0,0,0,0,0,0,0,0,0,0,灌水|广告|奖励|惩罚|好文章|内容不符|重复发帖,0,1,0,24,0,0,这里面的0和1代表着是和否,默认的后台预留开关,下面语句赋值可以用xml解释:<xml><board boardid=""0"" checkout=""0"" hidden="" nopost=""1"" checklock=""1"" mode=""0"" simplenesscount=""0""/></xml>
   TempXmlDoc.documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@checkout").text=Board_setting(2)
   TempXmlDoc.documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@hidden").text=Board_setting(1)
   TempXmlDoc.documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@nopost").text=Board_setting(43)
   TempXmlDoc.documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@checklock").text=Board_setting(0)
   TempXmlDoc.documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@mode").text=Board_setting(39)
   TempXmlDoc.documentElement.selectSingleNode("board[@boardid='"& Rs("Boardid")&"']/@simplenesscount").text=Board_setting(41)
  Rs.MoveNext'循环
  Loop
  Rs.Close'释放对象
  Set Rs= Nothing
  Application.Lock'锁定,将论坛列表和论坛设置进入缓存
  Set Application(CacheName&"_boardmaster") = TempMasterDoc
  Set Application(CacheName&"_boardlist") = TempXmlDoc
  Application(CacheName&"_boardmaster_xml") = TempMasterDoc.xml
  Application(CacheName&"_boardlist_xml") = TempXmlDoc.xml
  Application.unLock
 End Sub

 Public Sub LoadPlusMenu()'论坛副菜单函数
  Name = "ForumPlusMenu"'每一个函数都可以置入缓存中,因此没一个函数都有一个Name
  Dim Rs,XMLDom,Node,plus_setting,stylesheet,XMLStyle,proc
  Set Rs=Execute("Select id,plus_type,plus_name,mainpage,plus_copyright,plus_setting,isshowmenu as width,isshowmenu as height From Dv_Plus Where  Isuse=1 Order By ID")
  Set XMLDom=RecordsetToxml(rs,"plus","")'建立xml对象
  Rs.close()
  Set Rs=Nothing
  For Each Node In XMLDom.documentElement.selectNodes("plus")'节点遍历
   plus_setting=Split(Split(node.selectSingleNode("@plus_setting").text,"|||")(0),"|")'多重数组分割,分割后进行赋值
   node.selectSingleNode("@plus_setting").text=plus_setting(0)
   node.selectSingleNode("@width").text=plus_setting(1)
   node.selectSingleNode("@height").text=plus_setting(2)
  Next
  Set XMLStyle=Dvbbs.iCreateObject("msxml2.XSLTemplate" & MsxmlVersion)'创建一个新的 XSLTemplate 对象并设置样式表

  Set stylesheet=Dvbbs.CreateXmlDoc("msxml2.FreeThreadedDOMDocument"& MsxmlVersion)'创建多线程文件对象
  
  stylesheet.load Server.MapPath(MyDbPath &"inc/Templates/plusmenu.xslt")'调入菜单文件
  XMLStyle.stylesheet=stylesheet
  Set proc=XMLStyle.createProcessor()
  proc.input = XMLDom
    proc.transform()
    value=proc.output
 End Sub

 Public Sub LoadBoardData(bid)'调入论坛板块数据
  Dim Rs
  Set Rs=Execute("select boardid,boarduser,board_ads,board_user,isgroupsetting,rootid,board_setting,sid,cid,Rules From Dv_board Where Boardid="&bid)
  Set Application(CacheName &"_boarddata_" & bid)=RecordsetToxml(rs,"boarddata","")'该类中反复使用这一个语句,值得注意
  Rs.Close
  Set Rs= Nothing
 End Sub

 Public Sub LoadBoardinformation(bid)'加载动态板面信息数据
  Dim Rs,lastpost,i
  Set Rs=Execute("select boardid,boardtopstr,postnum,topicnum,todaynum,lastpost as lastpost_0 From Dv_board Where Boardid="&bid)
  Set Application(CacheName &"_information_" & bid)=RecordsetToxml(rs,"information","")
  lastpost=Split(Application(CacheName &"_information_" & bid).documentElement.selectSingleNode("information/@lastpost_0").text,"$")'对information属性节点lastpost进行分割,这里information是根节点
  For i=0 to UBound(lastpost)'数组下标遍历
   Application(CacheName &"_information_" & bid).documentElement.firstChild.setAttribute "lastpost_"& i,lastpost(i)'遍历后对第一个孩子节点赋值
   If i = 7 Then Exit For'下标超过7就退出
  Next
  Rs.Close'每一个函数内部都释放了对象
  Set Rs= Nothing
 End Sub

-----------------------未完待续

抱歉!评论已关闭.