标题: [动网]同一IP20分钟内不允许重复投票
作者: dnawo
日期: 2007-05-10 08:43 AM
分类: 程序修改
内容: 一、论坛版本：Dvbbs Version 7.1.0 Sp1
二、修改方法：
1.在Dv_Vote中新增一备注型字段LimitIP(附1)
2.打开TopicOther.asp修改其中的PostVote_Main子过程(红色部分为新增)：
复制内容到剪贴板 程序代码Sub PostVote_Main()
Dvbbs.Stats="参与投票"
Dim voteid
Dim announceid
If Dvbbs.IsReadonly() And Not Dvbbs.Master Then Response.Redirect "showerr.asp?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=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?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?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?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?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?ErrCodes=<li>本投票设置了用户威望最少为 <B>"&Rs("UPower")&"</B> 才能投票&action=OtherErr"
End If
Set vrs=Dvbbs.Execute("select userid from dv_voteuser where voteid="&voteID&" and userid="&Dvbbs.userid)
If Not(vRs.Eof And vRs.Bof) Then
Dvbbs.AddErrCode(58)
Dvbbs.ShowErr
Exit Sub
Else
Dim arrContent,arrTemp,strContent
strContent = ""
If isNull(Rs("LimitIP")) or isEmpty(Rs("LimitIP")) Then
Rs("LimitIP") = Dvbbs.UserTrueIP & "|" & now() & "@@"
Else
arrContent = Split(Rs("LimitIP"),"@@")
For i=0 to UBound(arrContent)
If arrContent(i)<>"" Then
arrTemp = Split(arrContent(i),"|")
If DateDiff("n",CDate(arrTemp(1)),now())<=20 Then
If Instr(arrTemp(0),Dvbbs.UserTrueIP)<>0 Then
Response.redirect "showerr.asp?ErrCodes=<li>同一IP20分钟内只能投一票&action=OtherErr"
Else
strContent = strContent & arrContent(i) & "@@"
End if
End if
End if
Next
strContent = strContent & Dvbbs.UserTrueIP & "|" & now() & "@@"
Rs("LimitIP") = strContent
End if
votenum=split(rs("votenum"),"|")
If Rs("votetype")=1 Then
For i = 0 to UBound(votenum)
postvote(i)=request("postvote_"&i&"")
Next
End If
For j = 0 to UBound(votenum)
If rs("votetype")=0 Then
if cint(request("postvote"))=j Then
votenum(j)=votenum(j)+1
postoption=j
End If
votenum_1=""&votenum_1&""&votenum(j)&"|"
postnum=1
Else
If postvote(j)<>"" Then
If cint(postvote(j))=j Then
votenum(j)=votenum(j)+1
postnum=postnum+1
postoption=postoption & j & ","
End If
End If
votenum_1=""&votenum_1&""&votenum(j)&"|"
End If
Next
If postnum="" or isnull(postnum) then
Dvbbs.AddErrCode(59)
Dvbbs.ShowErr
Exit Sub
End If
votenumlen=len(votenum_1)
votenum_1=left(votenum_1,votenumlen-1)
rs("votenum")=votenum_1
rs("voters")=rs("voters")+1
rs.update
Dvbbs.Execute("update dv_Topic set VoteTotal=voteTotal+"&postnum&" where topicid="&Announceid)
Dvbbs.Execute("insert into dv_voteuser (voteid,userid,voteoption) values ("&voteid&","&Dvbbs.userid&",'"&postoption&"')")
End If
End If
Rs.Close
Set Rs=Nothing
If Dvbbs.Board_Setting(53)<>"0" Then
SQL="update dv_topic set LastPostTime="&SqlNowString&" where Topicid="&announceid&" and istop=0"
Dvbbs.Execute(SQL)
End If
Response.Redirect Request.ServerVariables("HTTP_REFERER")
Dvbbs.ShowErr
End Sub
三、附录
1.数据库比较大时下载增加字段再上传比较麻烦，可直接将下边代码保存为论坛根目录下的add.asp然后运行。
复制内容到剪贴板 程序代码<!--#include file="conn.asp"-->
<!--#include file="inc/Dv_ClsMain.asp"-->
<%
Call ConnectionDatabase
Dim strsql
strsql = "Alter table DV_Vote add column LimitIP memo"
conn.execute(strsql)
conn.close
Set conn = nothing
Response.write "LimitIP字段增加完成！"
%>
+ 查看当前日志评论 (0)
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.078 ms
你没有权限发表评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.078 ms
暂无评论
────────────
PJBlog3 v3.2.9.518 Inside.
Processed In 0.078 ms