dv_clsmain.asp

现在好了

		NavStr = Replace(NavStr,"{$showstr}","")
		Response.Write vbNewLine & NavStr
	End Sub
	Public Sub AddErrCode(ErrCode)
		If ErrCodes = "" Then
			ErrCodes = ErrCode
		Else
			ErrCodes = ErrCodes & "," & ErrCode
		End If
	End Sub
	Public Property Let ErrType(ByVal Value)
		ShowErrType = Value
	End Property
	Public Sub Showerr()
		If ErrCodes<>"" Then
			If ShowErrType = 1 Then
				Response.redirect "showerr.asp?BoardID="&Boardid&"&ErrCodes="&ErrCodes&"&action="&server.URLEncode(Stats)&"&ShowErrType=1"
			Else
				Response.redirect "showerr.asp?BoardID="&Boardid&"&ErrCodes="&ErrCodes&"&action="&server.URLEncode(Stats)
			End If
		End If
	End Sub 
	Public Sub Footer()
		Dim Tmp,CaCheInfo
		'CaCheInfo =  "<li>"
		'CaCheInfo = CaCheInfo & "共使用了" & Application.Contents.Count & "个缓存对象。"
		'CaCheInfo=result
		Tmp = mainhtml(18)
		Tmp = Replace(Tmp,"{$boardid}",boardid)
		If (Dvbbs.Forum_ChanSetting(13)="1" And Dvbbs.Forum_ChanSetting(0)="1") Or Dvbbs.Forum_ChanSetting(3)="0" Then
			Tmp = Replace(Tmp,"{$UserTicket}","<BR>" & lanstr(11))
		Else
			Tmp = Replace(Tmp,"{$UserTicket}","")
		End If
		Response.Write Tmp
		Tmp = mainhtml(8)
		If Forum_Setting(30) = "1" Then 
			Dim Endtime
			Endtime = Timer()
			Tmp = Replace(Tmp,"{$runtime}","<br />页面执行时间 0"&FormatNumber((Endtime-Startime),5)&" 秒, "&SqlQueryNum&" 次数据查询<br />"& CaCheInfo)
		End If
		Tmp = Replace(Tmp,"{$runtime}","")
		Dim Alibaba_Ad
		If IsSqlDataBase = 0 Or (IsBuss = 0 And IsSqlDataBase = 1) Or Forum_Info(0)="动网先锋论坛" Then
			Alibaba_Ad = "网上贸易 创造奇迹! <a href = ""http://china.alibaba.com"" title = ""从网民、网友时代进入“网商”时代"" target=_blank>阿里巴巴</a> <a href = ""http://www.alibaba.com"" title= ""Online Marketplace of Manufacturers & Wholesalers"" target = ""_blank"">Alibaba</a><BR><BR>"
		End If
		Tmp = Replace(Tmp,"{$powered}",Alibaba_Ad & "Powered By <a href = ""http://www.dvbbs.net/"" target = ""_blank"">Dvbbs</a>  <a href = ""http://www.dvbbs.net/download.asp"" target = ""_blank"">Version " & Forum_Version & "</a>")
		If Dvbbs.Forum_ChanSetting(3)="0" Then
			Tmp = Replace(Tmp,"{$alipaymsg}","<td width=""2%""></td><td align=right valign=bottom><a href=""https://www.alipay.com"" target=_blank><img src="""&Dvbbs_Server_Url&"dvbbs/alipay_icon2.gif"" border=0 alt=""本论坛采用阿里巴巴支付宝网上银行支付系统，安全、可靠、便捷""></a></td>")
		Else
			Tmp = Replace(Tmp,"{$alipaymsg}","")
		End If
		Tmp = Replace(Tmp,"{$Footer_ads}",Forum_ads(1))
		Tmp = Replace(Tmp,"{$copyright}",Forum_Copyright)
		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 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 Plus_Execute(Command)
		If Cint(Forum_Setting(92))=1 Then
			If Not IsObject(Plus_Conn) Then Plus_ConnectionDatabase
		Else
			If Not IsObject(Conn) Then ConnectionDatabase
		End IF
		'检查权限,防止注入攻击。
		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
			If Cint(Forum_Setting(92))=1 Then
				Set Plus_Execute = Plus_Conn.Execute(Command)
			Else
				Set Plus_Execute = Conn.Execute(Command)
			End If
			If Err Then
				err.Clear
				If Cint(Forum_Setting(92))=1 Then
					Set Plus_Conn = Nothing
				Else
					Set Conn = Nothing
				End If
				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>"
			If Cint(Forum_Setting(92))=1 Then
				Set Plus_Execute = Plus_Conn.Execute(Command)
			Else
				Set Plus_Execute = Conn.Execute(Command)
			End If
		End If	
		SqlQueryNum = SqlQueryNum+1
	End Function
	'-----------------------------------------------------------------------------------------------------

	'记录查询错误事件
	Public Function SaveSQLLOG(sCommand,message)
		Dim lConnStr,lConn,ldb
		ldb = MyDbPath & "data/DvSQLLOG.mdb"
		'Response.Write ldb
		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&"','"&Replace(Left(sCommand,255),"'","''")&"','"&UserTrueIP&"')")
		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
		address="未知"
		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
				country="亚洲"
				city=""
				sql="select top 1 country,city from dv_address where ip1 <="&num&" and ip2 >="&num&""
				Set irs=aConn.execute(sql)
				If Not(irs.EOF And irs.bof) Then
					country=irs(0)
					city=irs(1)
				End If
				Set irs=Nothing
				Set aConn = Nothing 
				SqlQueryNum = SqlQueryNum+1
			End If
			address=country&city
		End If
	End Function
	'显示验证码
	Public Function GetCode()
			GetCode= Dvbbs.mainhtml(15)&"<img src=""DV_getcode.asp"">"
	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, ">", "&gt;")
			fString = replace(fString, "<", "&lt;")
			fString = Replace(fString, CHR(32), " ")		'&nbsp;
			fString = Replace(fString, CHR(9), " ")			'&nbsp;
			fString = Replace(fString, CHR(34), "&quot;")
			'fString = Replace(fString, CHR(39), "&#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, ">", "&gt;")
			fString = replace(fString, "<", "&lt;")
			fString = Replace(fString, CHR(32), " ")
			fString = Replace(fString, CHR(9), " ")
			fString = Replace(fString, CHR(34), "&quot;")
			'fString = Replace(fString, CHR(39), "&#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 CheckNumeric(Byval CHECK_ID)
		If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _
			CHECK_ID = cCur(CHECK_ID) _
		Else _
			CHECK_ID = 0
		CheckNumeric = CHECK_ID
	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 InStr(Str,BadWords(i))>0 Then
				If i > UBound(rBadWord) Then
					Str = Replace(Str,BadWords(i),"*")
				Else
					Str = Replace(Str,BadWords(i),rBadWord(i))
				End If
			End If
		Next
		ChkBadWords = Str
	End Function
	Public Function Checkstr(Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Replace(Str,"'","''")
	End Function

	Public Sub ReloadBoardInfo(lboardid)
		NodeUpdate=True
		'Response.Write "ReloadBoardInfo="&lboardid &"<br>"
		Dim Rs,Node,i,BoardPath,BoardMasterList,BoardMaster,CNode
		Set Rs=Execute("Select boardid,BoardType,ParentID,ParentStr,Depth,RootID,Child,readme,BoardMaster,PostNum,TopicNum,indexIMG,todayNum,boarduser,LastPost,Sid,Board_Setting,Board_Ads,Board_user,IsGroupSetting,BoardTopStr,cid,Rules From Dv_Board where boardid in ("& lboardid &") Order By RootID,orders")
		Dim Board_setting,lastpost
		Do while Not Rs.EOF
			Board_setting=Split(Rs("Board_setting")&"",",")
			BoardPath = "board"
			For i=1 To Rs("Depth")