📄 dv_clsmain.asp
字号:
Name="BoardInfo_" & Forum_Boards(i)
If ObjIsEmpty() Then ReloadBoardInfo(Forum_Boards(i))
Board_Datas = Value
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 & Board_Datas(1,0)&"</option>"
Next
Name="BoardJumpList"
value=BoardJumpList
Forum_Boards=Null
Board_Datas=Null
End Function
Private Function LoadAllBoardList()
Dim Forum_Boards,MyAllBoardList,i,ii,Depth,Board_Datas
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
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 & Board_Datas(1,0) & "</a><br>"
Next
Name="MyAllBoardList"
value=MyAllBoardList
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>")
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
dim Rs,SQL
SQL="select payuser from [VIP]"
Set Rs=Dvbbs.Execute(SQL)
If Not Rs.EOF Then
Tmp = Replace(Tmp,"{$payuser}",""&rs("payuser")&"")
End If
set rs=nothing
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 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
Rem Function
Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
'检查权限,防止注入攻击。
If InStr(LCase(Command),"dv_admin")>0 And Left(ScriptName,6)<> "admin_" Then
Response.Write SaveSQLLOG(Command,"非法的访问请求。")'翻译成英文
Response.End
End If
If IsDeBug = 0 Then
On Error Resume Next
Set Execute = Conn.Execute(Command)
If Err Then
err.Clear
Set Conn = Nothing
'以下信息要翻译成英文
Response.Write SaveSQLLOG(Command,"查询数据的时候发现错误，请检查您的查询代码是否正确。<br>基于安全的理由，只显示本信息，要查看详细的错误信息，请修改您的程序文件conn.asp。把""Const IsDeBug = 0""改为：""Const IsDeBug = 1""")
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
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
lConn.Execute("insert into [dv_sql_log](ScriptName,S_Info,IP)Values('" & ScriptName & "','" & sCommand & "','" & UserTrueIP & "')")
lConn.Close
Set lConn = Nothing
SaveSQLLOG = message
End Function
Public Function IPlock()
IPlock=False
If IsArray(Session("UserID")) Then Exit Function
Dim locklist
locklist=Trim(CacheData(25,0))
If locklist="" Then Exit Function
Dim i,StrUserIP,StrKillIP
StrUserIP=UserTrueIP
locklist=Split(locklist,"|")
If StrUserIP="" Then Exit Function
StrUserIP=Split(UserTrueIP,".")
If Ubound(StrUserIP)<>3 Then Exit Function
For i= 0 to UBound(locklist)
If locklist(i)<>"" Then
StrKillIP = Split(locklist(i),".")
If Ubound(StrKillIP)<>3 Then Exit For
IPlock = True
If (StrUserIP(0) <> StrKillIP(0)) And (StrKillIP(0) <> "*") Then IPlock=False
If (StrUserIP(1) <> StrKillIP(1)) And (StrKillIP(1) <> "*") Then IPlock=False
If (StrUserIP(2) <> StrKillIP(2)) And (StrKillIP(2) <> "*") Then IPlock=False
If (StrUserIP(3) <> StrKillIP(3)) And (StrKillIP(3) <> "*") Then IPlock=False
If IPlock Then Exit For
End If
Next
If IPlock Then Response.Redirect "showerr.asp?action=iplock"
End Function
'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 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), """)
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
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -