topicother.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

<!--#include file="Conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/chkinput.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/dv_ubbcode.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<%
'go/look_ip/pag/postagree/postvote/printpage/report/sendpage
'Dvbbs.ErrType=1
Dim ErrCodes,Rs,SQL,i
Dim abgcolor,dv_ubb
Dim announceid,replyid,username,rootid,topic,postbuyuser,bgcolor,EmotPath
Dim MailBody,Email,TotalUseTable
Dim T_GetMoneyType,replyid_a,AnnounceID_a,RootID_a
Select Case Request("t")
Case "1"
	'look_ip
	Dim canlookip,canlockip,lockid
	Look_Ip_Main()
Case "2"
	'pag
	'Dim AnnounceID,UserName,RootID,Topic,UserEmail,TotalUseTable,PostBuyUser,ReplyID,EmotPath
	'Pag_Main()
Case "3"
	'postagree
	'PostAgree_Main()
Case "4"
	'postvote
	PostVote_Main()
Case "5"
	'printpage
	PrintPage_Main()
Case "6"
	'report
	Report_Main()
Case "7"
	'sendpage
	SendPage_Main()
Case "8"
	SaveFav_boards()

Case Else
	'go.asp
	Go_Main()
End Select
Sub Go_Main()

End Sub


Sub SaveFav_boards()
	Dvbbs.LoadTemplates("")
	If Dvbbs.Userid=0 Then
		Dvbbs.AddErrCode(34)
		Dvbbs.ShowErr()
	End If
	If Dvbbs.Boardid=0 Then
		Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>请选取要收藏的版面&action=OtherErr"
	End If
	Dim Rs,Sql,Fav_boards
	Set Rs = Dvbbs.Execute("Select Fav_boards From Dv_user Where userid="&Dvbbs.UserID)
	If Not Rs.Eof Then
		Fav_boards = Trim(Rs(0))
	Else
		Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>用户数据不存在。&action=OtherErr"
	End If
	Rs.Close
	Set Rs = Nothing
	If Instr(","&Fav_boards&",",","&Dvbbs.Boardid&",") Then
		Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>该版面已经添加到收藏。&action=OtherErr"
	Else
		If Fav_boards="" or IsNull(Fav_boards) Then
			Fav_boards = Fav_boards & Dvbbs.Boardid
		Else
			Fav_boards = Fav_boards &","& Dvbbs.Boardid
		End If
	End If
	If Len(Fav_boards)<250 Then
		Dvbbs.stats="收藏版块操作"
		Dvbbs.Nav()
		Dvbbs.Execute("update dv_user Set Fav_boards='"&Dvbbs.Checkstr(Fav_boards)&"' Where Userid="&Dvbbs.UserID)
		Dvbbs.Dvbbs_Suc("<li>该版块收藏成功！")
	Else
		Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>你收藏的版块过多超出限制。&action=OtherErr"
	End If
End Sub

'================查看用户来源信息===================
Sub Look_Ip_Main()
	Dvbbs.LoadTemplates("dispuser")
	CanLookIP=False 
	CanLockIP=False 
	If (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster) And Cint(Dvbbs.GroupSetting(30))=1 Then
		CanLookIP=True
	Else
		CanLookIP=False
	End If
	If Dvbbs.UserGroupID>3 And CInt(Dvbbs.GroupSetting(30))=1 Then
		CanLookIP=True
	End If
	If Dvbbs.FoundUserPer And  Cint(Dvbbs.GroupSetting(30))=1 Then
		CanLookIP=True
	ElseIf Dvbbs.FoundUserPer And  CInt(Dvbbs.GroupSetting(30))=0 Then
		CanLookIP=False
	End If

	If (Dvbbs.Master or Dvbbs.SuperBoardMaster or Dvbbs.BoardMaster) and Cint(Dvbbs.GroupSetting(31))=1 Then 
		CanLockIP=True 
	Else
		CanLockIP=False 
	End If
	If Dvbbs.UserGroupID>3 And  Cint(Dvbbs.GroupSetting(31))=1 Then
		CanLockIP=True 
	End If 
	If Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(31))=1 Then
		CanLockIP=True 
	ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(31))=0 Then
		CanLockIP=False 
	End If 
	Dvbbs.stats=template.Strings(13)
	Dvbbs.Nav()
	Dvbbs.Head_var 0,0,Replace(template.Strings(0),"{$MemberName}",""),"dispuser.asp"
	If Not Dvbbs.ChkPost() And Request("action") <> "" Then
		Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>您不要从外部提交数据&action=OtherErr"
	End If
	If Request("action")="setlockip" Then
		Call Setlockip()
	ElseIf Request("action")="unlock" Then
		Call unlock()
	Else
		Call lookip()
	End If
	Showerr()
	Dvbbs.Showerr()
	Dvbbs.ActiveOnline()
	Dvbbs.footer()
End Sub
Sub lookip()
	If Not CanLookIP Then
		ErrCodes=ErrCodes+"<li>"+template.Strings(7)
		Exit sub
	End If

	Dim ip,useraddress,iGetLockIP
	ip=Request("ip")
	useraddress=lookaddress(replace(ip,"'",""))
	iGetLockIP=GetLockIP(replace(ip,"'",""))
	LockID=LockID
%>
<table class=tableborder1 cellspacing="1" cellpadding="3" align="center">
<tr align=center>
<th height=25>查看 <%=IP%>的来源</th>
</tr>
<tr><td height=25 class=tablebody1><blockquote><%=useraddress%></blockquote></td></tr>
<%If CanLookIP Then%>
	<tr><td height=25 class=tablebody2 align=center><B>管理操作</B>：
	<%If iGetLockIP Then%>
		<a href="?t=1&action=unlock&boardid=<%=Dvbbs.BoardID%>&id=<%=LockID%>">该用户IP已被锁定，解除锁定
	<%Else%>
		<a href="?t=1&action=setlockip&ip=<%=IP%>&boardid=<%=Dvbbs.BoardID%>">限制该IP不允许访问</a>
	<%End If%>
	</td></tr>
<%End If%>
</table>
<%
End Sub 

Sub Setlockip()
	If Not CanLockIP then
		ErrCodes=ErrCodes+"<li>"+template.Strings(8)
		Exit sub
	End If
	If request("reaction")="yes" Then
		Dim sip
		sip=cstr(request.form("ip1"))
		If sip<>"" Then
			If Instr(sip,"*.")>0 Then
				ErrCodes=ErrCodes+"<li>前台最多只能限制四类IP，如218.1.2.*"
				Exit Sub
			End If
			If Instr(sip,"*.*.")>0 Then
				ErrCodes=ErrCodes+"<li>前台最多只能限制四类IP，如218.1.2.*"
				Exit Sub
			End If
			If Instr(sip,"*.*.*.")>0 Then
				ErrCodes=ErrCodes+"<li>前台最多只能限制四类IP，如218.1.2.*"
				Exit Sub
			End If
			If Trim(Dvbbs.CacheData(25,0))<>"" Then
				sip=Trim(Dvbbs.CacheData(25,0)) & "|" & Replace(sip,"|","")
			End If
		End If
		If sip<>"" Then
			dvbbs.execute("update dv_setup set Forum_LockIP='"&replace(sip,"'","''")&"'")
			Dvbbs.loadSetup
		End If
		sql="insert into dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('-','"&Dvbbs.membername&"','用户操作：限制IP"&Dvbbs.checkstr(Request.Form("ip1"))&"-"&Dvbbs.checkstr(Request.Form("ip2"))&"','"&Dvbbs.UserTrueIP&"',6)"
		dvbbs.Execute(SQL)
		Dvbbs.Dvbbs_Suc("<li>"+template.Strings(9))
	Else
		Dim userip,ips,GetIp1,useraddress,ip
		If request("ip")<>"" then
			userip=request("ip")
			ips=Split(userIP,".")
			GetIp1=ips(0)&"."&ips(1)&"."&ips(2)&".*"
		Else  
			userip=""
			GetIp1=""
			GetIp2=""
		End If
		ip=Request("ip")
		useraddress=lookaddress(replace(request("ip"),"'",""))
%>
<table class=tableborder1 cellspacing="1" cellpadding="3" align="center">
<tr align=center>
<th height=25>锁定 <%=IP%> 的来源</th>
</tr>
<tr><td height=25 class=tablebody1><blockquote><%=useraddress%></blockquote></td></tr>
<FORM METHOD=POST ACTION="?t=1&action=setlockip&boardid=<%=Dvbbs.BoardID%>">
<input type=hidden name="reaction" value="yes">
<tr><td height=40 class=tablebody1>
<B>说明</B>：您可以添加多个限制IP，每个IP用|号分隔，限制IP的书写方式如202.152.12.1就限制了202.152.12.1这个IP的访问，如202.152.12.*就限制了以202.152.12开头的IP访问，同理*.*.*.*则限制了所有IP的访问。在添加多个IP的时候，请注意最后一个IP的后面不要加|这个符号，<b>在前台只能做一个星号的四类IP限制</b>
</td></tr>
<tr><td height=40 class=tablebody1>
<B>限制I&nbsp;P</B>：<input type="text" name="ip1" size="30" value="<%=GetIp1%>">&nbsp;&nbsp;<input type="submit" name="Submit" value="提 交">
</td></tr>
</FORM>
</table>
<%
	End If 
End Sub 

sub unlock()
	If Not CanLockIP Then
		ErrCodes=ErrCodes+"<li>"+template.Strings(8)
		Exit sub
	End If
	Dim locklist,unlockip
	locklist=Trim(Dvbbs.CacheData(25,0))
	If locklist<>"" Then
		If Trim(request("id"))="" Then
			ErrCodes=ErrCodes+"<li>"+template.Strings(10)
			Exit sub
		End If
		locklist = "|" & locklist & "|"
		unlockip = Replace(Replace(request("id"),"|",""),"'","")
		unlockip = "|" & unlockip
		locklist = Replace(locklist,unlockip,"")
		unlockip = Split(request("id"),".")
		If Ubound(unlockip)<>3 Then
			ErrCodes=ErrCodes+"<li>"+template.Strings(10)
			Exit sub
		End If
		locklist = Split(locklist,"|")
		Dim i,ilocklist
		For i = 1 To Ubound(locklist)-1
			If i = 1 Then
				ilocklist = locklist(i)
			Else
				ilocklist = ilocklist & "|" & locklist(i)
			End If
		Next
		dvbbs.execute("update dv_setup set Forum_LockIP='"&replace(Trim(ilocklist),"'","")&"'")
		Dvbbs.loadSetup
	End If

	sql="insert into dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('-','"&Dvbbs.membername&"','用户操作：解除IP限制','"&Dvbbs.UserTrueIP&"',6)"
	Dvbbs.Execute(SQL)
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(11))
End Sub

Function lookaddress(sip)
	Dim str1,str2,str3,str4
	Dim num
	Dim irs
	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=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
			Dim adb,aConnStr,AConn
			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 country,city from dv_address where ip1 <="&num&" and ip2 >="&num
			Set irs=AConn.Execute(sql)
			If irs.eof And irs.bof Then 
				lookaddress=template.Strings(12)
			Else
				Do While Not irs.eof
					lookaddress=lookaddress & "<br>" &irs(0) & irs(1)
				irs.movenext
				Loop
			End If
			irs.close
			Set irs=nothing
			AConn.Close
			Set AConn=Nothing
		End If
	Else
		lookaddress=template.Strings(12)
	End If
End Function

Function getLockIP(sip)
	getLockIP=False 
	Dim locklist
	locklist=Trim(dvbbs.CacheData(25,0))
	If locklist="" Then Exit Function
	Dim i,StrUserIP,StrKillIP
	StrUserIP=sip
	locklist=Split(locklist,"|")
	If StrUserIP="" Then Exit Function
	StrUserIP=Split(StrUserIP,".")
	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
			getLockIP = True
			If (StrUserIP(0) <> StrKillIP(0)) And Instr(StrKillIP(0),"*")=0 Then getLockIP=False
			If (StrUserIP(1) <> StrKillIP(1)) And Instr(StrKillIP(1),"*")=0 Then getLockIP=False
			If (StrUserIP(2) <> StrKillIP(2)) And Instr(StrKillIP(2),"*")=0 Then getLockIP=False
			If (StrUserIP(3) <> StrKillIP(3)) And Instr(StrKillIP(3),"*")=0 Then getLockIP=False
			If getLockIP Then
				LockID=locklist(i)
				Exit For
			End If
		End If
	Next
End Function

'显示错误信息
Sub Showerr()
	Dim Show_Errmsg
	If ErrCodes<>"" Then 
		Show_Errmsg=Dvbbs.mainhtml(14)
		ErrCodes=Replace(ErrCodes,"{$color}",Dvbbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$color}",Dvbbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$errtitle}",Dvbbs.Forum_Info(0)&"-"&Dvbbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$action}",Dvbbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$ErrString}",ErrCodes)
	End If
	Response.write Show_Errmsg
End Sub
'================查看用户来源信息===================
'================帖子投票===========================
Sub PostVote_Main()
	Dvbbs.Stats="参与投票"
	Dim voteid
	Dim announceid
	If Dvbbs.IsReadonly() And Not Dvbbs.Master Then Response.Redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&action=readonly&boardid="&dvbbs.boardID 
	Dim action
	Dim vote,votenum
	Dim postvote(200)
	Dim postvote1
	Dim j,votenum_1,votenumlen
	Dim vrs
	Dim postnum,postoption

	If Dvbbs.UserID=0 Then Dvbbs.AddErrCode(34)
	
	If Request("id")="" Then
		Dvbbs.AddErrCode(35)
	ElseIf Not IsNumeric(Request("id")) Then
		Dvbbs.AddErrCode(35)
	Else
		AnnounceID=Request("id")
	End If
	If Request("voteid")="" Then
		Dvbbs.AddErrCode(35)
	ElseIf not IsNumeric(Request("voteid")) Then
		Dvbbs.AddErrCode(35)
	Else
		voteID=Request("voteid")
	End If
	
	If CInt(Dvbbs.GroupSetting(9))=0 then Dvbbs.AddErrCode(56)
	Dvbbs.ShowErr
	'主题已锁定，不能参与投票
	Set Rs=Dvbbs.Execute("select locktopic from dv_topic where topicid="&AnnounceID)
	If Not (Rs.Eof And Rs.Bof) then
		If Rs(0)=1 Then
			Dvbbs.AddErrCode(57)
			Dvbbs.ShowErr
			Exit Sub
		End If
	End If
	'已投票用户不允许再次投票
	Set Rs = Dvbbs.Execute("select userid from dv_voteuser where voteid="&voteID&" and userid="&Dvbbs.userid)
	If Not(Rs.Eof And Rs.Bof) Then
		Dvbbs.AddErrCode(58)
		Dvbbs.ShowErr
		Exit Sub
	End If

	Dim Votes,VoteChilds,VoteChildsEP_Item,VoteChildsType
	Dim VoteForm,VoteForm_chkbox,VoteForm_Tempstr
	Set Rs=Server.Createobject("Adodb.Recordset")
	Sql="select * from dv_vote where voteid="&voteid
	Rs.Open Sql,Conn,1,3
	If Rs.Eof And Rs.Bof Then
		Dvbbs.AddErrCode(32)
		Dvbbs.ShowErr
		Exit Sub
	Else
		'管理员，超版，版主不受投票限制
		If Not (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster) Then
		'文章
		If Clng(Rs("UArticle"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本投票设置了用户发贴最少为 <B>"&Rs("UArticle")&"</B> 才能投票&action=OtherErr"
		'金钱
		If Clng(Rs("UWealth"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本投票设置了用户金钱最少为 <B>"&Rs("UWealth")&"</B> 才能投票&action=OtherErr"
		'经验
		If Clng(Rs("UEP"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本投票设置了用户积分最少为 <B>"&Rs("UEP")&"</B> 才能投票&action=OtherErr"
		'魅力
		If Clng(Rs("UCP"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本投票设置了用户魅力最少为 <B>"&Rs("UCP")&"</B> 才能投票&action=OtherErr"
		'威望
		If Clng(Rs("UPower"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>本投票设置了用户威望最少为 <B>"&Rs("UPower")&"</B> 才能投票&action=OtherErr"
		End If
		Dim votenum_temp,n,num_tempstr
		If Rs("votetype")=2 Then
			'调查投票
			Votes = Split(Rs("vote"),"|")
			votenum=Split(rs("votenum"),"|")
			For i = 0 To Ubound(Votes)
				VoteChilds  = Split(Votes(i),"@@")
				VoteChildsType = VoteChilds(1)	'类型：0=单选，1=多选，2=文本
				
				If VoteChildsType = "2" Then
					'文本问答型式
					VoteForm = Replace(Request.Form("postvote_"&i),"|","")
					If Trim(VoteForm)="" Then
					Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=<li>请检查是否有答案未填写？</li>&action=OtherErr"