📄 dv_clsmain.asp
字号:
BoardReadme = Replace(BoardReadme,"{$smsid}",sendmsgid)
BoardReadme = Replace(BoardReadme,"{$sender}",sendmsguser)
BoardReadme = Replace(BoardReadme,"{$newmsgnum}",sendmsgnum)
NavStr = Replace(NavStr,"{$umsg}",BoardReadme)
Else
NavStr = Replace(NavStr,"{$umsg}",IsBoard(3))
End If
Else
NavStr = Replace(NavStr,"{$umsg}","")
End If
NavStr = Replace(NavStr,"{$alertcolor}",mainsetting(1))
NavStr = Replace(NavStr,"{$showstr}","")
Response.Write NavStr
End Sub
Private Function LoadBoardJumpList(Act)'参数，1读全部，0读非隐藏
Dim Forum_Boards,i,ii,Depth,Board_Datas,b_setting
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
BoardJumpList = BoardJumpList & "<option value=""list.asp?boardid="&Forum_Boards(i)&""" {BoardID="&Forum_Boards(i)&"}>"
Depth=Board_Datas(4,0)
Select Case Depth
Case 0
BoardJumpList = BoardJumpList & "╋"
Case 1
BoardJumpList = BoardJumpList & " ├"
End Select
If Depth>1 Then
For ii=2 To Depth
BoardJumpList = BoardJumpList & " │"
Next
BoardJumpList = BoardJumpList & " ├"
End If
BoardJumpList = BoardJumpList & Replace(Replace(Board_Datas(1,0),Chr(39),"'"),Chr(34), """) &"</option>"
End If
Next
If Act=1 Then
Name="BoardJumpList"
Else
Name="BoardJumpList_g"
End If
value=BoardJumpList
Forum_Boards=Null
Board_Datas=Null
End Function
Private Function LoadAllBoardList(Act)'参数，1读全部，0读非隐藏
Dim Forum_Boards,MyAllBoardList,i,ii,Depth,Board_Datas,b_setting
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)
MyAllBoardList = MyAllBoardList & "<a href=list.asp?boardid="&Forum_Boards(i)&">"
Select Case Depth
Case 0
MyAllBoardList = MyAllBoardList & "╋"
Case 1
MyAllBoardList = MyAllBoardList & " ├"
End Select
If Depth>1 Then
For ii=2 To Depth
MyAllBoardList = MyAllBoardList & " │"
Next
MyAllBoardList = MyAllBoardList & " ├"
End If
MyAllBoardList = MyAllBoardList & Server.htmlencode(Board_Datas(1,0)) & "</a><br>"
End If
Next
If Act=1 Then
Name="MyAllBoardList"
Else
Name="MyAllBoardList_g"
End If
value=Replace(Replace(MyAllBoardList,"'","\'"),Chr(34), """)
Forum_Boards=Null
Board_Datas=Null
End Function
Public Sub AddErrCode(ErrCode)
If ErrCodes = "" Then
ErrCodes = ErrCode
Else
ErrCodes = ErrCodes & "," & ErrCode
End If
End Sub
Public Sub Showerr()
If ErrCodes<>"" Then Response.redirect "showerr.asp?BoardID="&boardid&"&ErrCodes="&ErrCodes&"&action="&server.URLEncode(Stats)
End Sub
Public Sub Footer()
Dim Tmp,CaCheInfo
'CaCheInfo = "<li>"
'CaCheInfo = CaCheInfo & "共使用了" & Application.Contents.Count & "个缓存对象。"
Tmp = mainhtml(8)
If Forum_Setting(30) = "1" Then
Dim Endtime
Endtime = Timer()
Tmp = Replace(Tmp,"{$runtime}","<br>执行时间：" & FormatNumber((Endtime-Startime)*1000,5) & "毫秒。查询数据库" & SqlQueryNum & "次。"& CaCheInfo)
Else
Tmp = Replace(Tmp,"{$runtime}","")
End If
Tmp = Replace(Tmp,"{$color}",mainsetting(1))
Tmp = Replace(Tmp,"{$width}",mainsetting(0))
Tmp = Replace(Tmp,"{$powered}","Powered By ：<a href = ""http://www.dvbbs.net/download.asp"" target = ""_blank"">Dvbbs Version " & Forum_Version & "</a> Sp2")
Tmp = Replace(Tmp,"{$Footer_ads}",Forum_ads(1))
If Forum_ChanSetting(0)="1" And Forum_ChanSetting(1)="1" And Forum_ChanSetting(4)="1" And IsTopTable=1 Then
Tmp = Replace(Tmp,"{$ad}","<BR>" & adcode_2)
Else
Tmp = Replace(Tmp,"{$ad}","")
End If
Tmp = Replace(Tmp,"{$copyright}",Forum_Copyright)
Tmp = Replace(Tmp,"{$StyleName}",StyleName)
If Forum_ChanSetting(0)="1" Then
Tmp = Replace(Tmp,"{$server}","<td align = right><a href = ""http://www.ray5198.com"" target = _blank title = ""本论坛所提供的互动服务由北京阳光加信科技有限公司提供""><img src = ""images/rayslogo.GIF"" border = 0></a></td>")
Else
Tmp = Replace(Tmp,"{$server}","")
End If
'Response.Write CaCheInfo
'//------------------------------------------------------------------------------
'//论坛访问量统系
If ScriptName="list.asp" or ScriptName="index.asp" Then
Dim RayPostAct,RayUpCount,RayMaxCount,Forum_url,RaySubjection,Board_Datas,FrameBody
Dim PostStr
RayMaxCount=100 '定义更新概率
RaySubjection=False
Forum_url=Get_ScriptNameUrl
If ScriptName="index.asp" Then
Name="RayUpCount"
If Dvbbs.ObjIsEmpty() Then
Value=1
Else
RayUpCount=Value
If Not IsNumeric(RayUpCount) Then
Value=1
Else
Value=RayUpCount+1
End If
End If
RayUpCount=Value
If RayUpCount >= RayMaxCount Then
RaySubjection=True
RayUpCount=1
Value=1
FrameBody="?PostType=0&forumname="&Server.htmlencode(Forum_Info(0))
FrameBody=FrameBody+"&forumurl="&Forum_url
FrameBody=FrameBody+"&forumlogincount="&Dvbbs.CacheData(10,0)
FrameBody=FrameBody+"&foruminlinecount="&MyBoardOnline.Forum_Online
FrameBody=FrameBody+"&forumtitlecount="&CacheData(8,0)
FrameBody=FrameBody+"&forumvisitprob=1"
FrameBody=FrameBody+"&forumemail="&Forum_Info(5)
FrameBody=FrameBody+"&forumtag=host"
End If
ElseIf ScriptName="list.asp" Then
Name="BoardInfo_" & Boardid
Board_Datas=Value
If Not IsNumeric(Board_Data(24,0)) Then
Board_Datas(24,0)=1
Else
Board_Datas(24,0)=Board_Datas(24,0)+1
End If
If Board_Datas(24,0) >= RayMaxCount Then
RaySubjection=True
Board_Datas(24,0)=1
FrameBody="?PostType=1&forumchildname="&Boardtype
FrameBody=FrameBody+"&forumchildurl="&Forum_url&"list.asp?boardid="&Boardid
FrameBody=FrameBody+"&forumchildtitlecount="&Board_Datas(9,0)
FrameBody=FrameBody+"&foruminlinecount="&MyBoardOnline.Forum_Online
FrameBody=FrameBody+"&forumlogincount="&Dvbbs.CacheData(10,0)
FrameBody=FrameBody+"&Forumvisitprob=1"
FrameBody=FrameBody+"&forumchildtag=subjection"
End If
Value=Board_Datas
End If
If RaySubjection Then
Response.Write "<iframe id=""RayCount"" src=""RayPost.asp"&FrameBody&""" width=0 height=0></iframe>"
End If
End If
Response.Write Tmp
'//------------------------------------------------------------------------------
End Sub
Public Function Dvbbs_Suc(sucmsg)
Dim TempStr
TempStr = mainhtml(13)
TempStr = Replace(TempStr,"{$sucmsg}",sucmsg)
TempStr = Replace(TempStr,"{$returnurl}",Request.ServerVariables("HTTP_REFERER"))
Response.Write TempStr
TempStr = ""
End Function
Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
'检查权限,防止注入攻击。
If InStr(LCase(Command),"dv_admin")>0 And Left(ScriptName,6)<> "admin_" Then
If savelog=1 Then
Response.Write SaveSQLLOG(Command,"")
End If
Command=Replace(LCase(Command),"dv_admin","dv<i>"&Chr(95)&"</i>admin")
End If
If IsDeBug = 0 Then
On Error Resume Next
Set Execute = Conn.Execute(Command)
If Err Then
err.Clear
Set Conn = Nothing
If savelog=1 Then
Response.Write SaveSQLLOG(Command,"查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为：""Const IsDeBug = 1""")
Else
Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
End If
Response.End
End If
Else
'Response.Write command & "<br>"
Set Execute = Conn.Execute(Command)
End If
SqlQueryNum = SqlQueryNum+1
End Function
'记录查询错误事件
Public Function SaveSQLLOG(sCommand,message)
Dim lConnStr,lConn,ldb,SQL,RS
ldb = "data/DvSQLLOG.mdb"
lConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
Set lConn = Server.CreateObject("ADODB.Connection")
lConn.Open lConnStr
Set Rs = Server.CreateObject("adodb.recordset")
Sql="select * from dv_sql_log"
Rs.open sql,lconn,1,3
Rs.addnew
Rs("ScriptName")=ScriptName
Rs("S_Info")=Left(sCommand,255)
Rs("ip")=UserTrueIP
Rs.update
Rs.close
lConn.Execute(SQL)
lConn.Close
Set lConn = Nothing
SaveSQLLOG = message
End Function
Public Sub ChecKIPlock()
Dim IPlock
IPlock = False
Dim locklist
locklist=Trim(CacheData(25,0))
If locklist="" Then Exit Sub
Dim i,StrUserIP,StrKillIP
StrUserIP=UserTrueIP
locklist=Split(locklist,"|")
If StrUserIP="" Then Exit Sub
StrUserIP=Split(UserTrueIP,".")
If Ubound(StrUserIP)<>3 Then Exit Sub
For i= 0 to UBound(locklist)
locklist(i)=Trim(locklist(i))
If locklist(i)<>"" Then
StrKillIP = Split(locklist(i),".")
If Ubound(StrKillIP)<>3 Then Exit For
IPlock = True
If (StrUserIP(0) <> StrKillIP(0)) And Instr(StrKillIP(0),"*")=0 Then IPlock=False
If (StrUserIP(1) <> StrKillIP(1)) And Instr(StrKillIP(1),"*")=0 Then IPlock=False
If (StrUserIP(2) <> StrKillIP(2)) And Instr(StrKillIP(2),"*")=0 Then IPlock=False
If (StrUserIP(3) <> StrKillIP(3)) And Instr(StrKillIP(3),"*")=0 Then IPlock=False
If IPlock Then Exit For
End If
Next
Response.Cookies(Forum_sn & "Kill").Expires = DateAdd("s", 360, Now())
Response.Cookies(Forum_sn & "Kill").Path = Cookiepath
If IPlock Then
Response.Cookies(Forum_sn & "Kill")("kill") = "1"
Else
Response.Cookies(Forum_sn & "Kill")("kill") = "0"
End If
End Sub
'IP/来源
Public Function address(sip)
Dim aConnStr,aConn,adb
Dim str1,str2,str3,str4
Dim num
Dim country,city
Dim irs,SQL
If IsNumeric(Left(sip,2)) Then
If sip="127.0.0.1" Then sip="192.168.0.1"
str1=Left(sip,InStr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=Left(sip,instr(sip,".")-1)
sip=Mid(sip,InStr(sip,".")+1)
str3=Left(sip,instr(sip,".")-1)
str4=Mid(sip,instr(sip,".")+1)
If isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 Then
Else
num=CLng(str1)*16777216+CLng(str2)*65536+CLng(str3)*256+CLng(str4)-1
adb = "data/ipaddress.mdb"
aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
Set AConn = Server.CreateObject("ADODB.Connection")
aConn.Open aConnStr
sql="select top 1 country,city from dv_address where ip1 <="&num&" and ip2 >="&num&""
Set irs=aConn.execute(sql)
If irs.EOF And irs.bof Then
country="亚洲"
city=""
Else
country=irs(0)
city=irs(1)
End If
Set irs=Nothing
Set aConn = Nothing
SqlQueryNum = SqlQueryNum+1
End If
address=country&city
Else
address="未知"
End If
End Function
'显示验证码
Public Function GetCode()
Dim test
On Error Resume Next
Set test=Server.CreateObject("Adodb.Stream")
Set test=Nothing
If Err Then
Dim zNum
Randomize timer
zNum = cint(8999*Rnd+1000)
Session("GetCode") = zNum
GetCode=Dvbbs.mainhtml(15)& Session("GetCode")
Else
GetCode= Dvbbs.mainhtml(15)&"<img src=""DV_getcode.asp"">"
End If
End Function
'检查验证码是否正确
Public Function CodeIsTrue()
Dim CodeStr
CodeStr=Trim(Request("CodeStr"))
If CStr(Session("GetCode"))=CStr(CodeStr) And CodeStr<>"" Then
CodeIsTrue=True
Session("GetCode")=empty
Else
CodeIsTrue=False
Session("GetCode")=empty
End If
End Function
'用于用户发布的各种信息过滤，带脏话过滤
Public Function HTMLEncode(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), """)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -