[动网]同一IP20分钟内不允许重复投票

一、论坛版本: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字段增加完成!"
%>


上一篇: 服务器组件检测
下一篇: ASP中Cache技术的应用
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
最新日志:
评论: 0 | 引用: 0 | 查看次数: 6250
发表评论
登录后再发表评论!