<!--#include file="../Start.asp"-->
<!--#include file="../Include/PowerEasy.Common.Manage.asp"-->
<!--#include file="../Include/PowerEasy.ConsumeLog.asp"-->

<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2009 佛山市动易网络科技有限公司 版权所有
'**************************************************************


'问卷所用变量
Private Rs, Sql, NeedLogin, SurveyID


SurveyID = PE_CLng(Request.Form("SurveyID"))

Call IsSurveyIPlock
Call Main
If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If
Call CloseConn

Sub Main()
    Dim Rs2, Rs3, AnwserDetail, Question, rsSurvey, SurveyPassword
    AnwserDetail = ""
    SurveyPassword = ReplaceBadChar(Trim(Request.Form("SurveyPassword")))
    Set rsSurvey = Conn.Execute("select IsOpen, EndTime, LockUrl, IPRepeat, SetPassword, NeedLogin, PresentPoint, SurveyName from PE_Survey where SurveyID=" & SurveyID & "")
    If rsSurvey(0) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>问卷调查尚未启用！！！</li>"
        rsSurvey.Close
        Set rsSurvey = Nothing
        Exit Sub
    End If
    If IsDate(rsSurvey(1)) And rsSurvey(1) < Now() Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>问卷调查已经结束！！！</li>"
        rsSurvey.Close
        Set rsSurvey = Nothing
        Exit Sub
    End If
    If Not (IsNull(rsSurvey(2)) Or Trim(rsSurvey(2)) = "") And FoundInArr(rsSurvey(2), ComeUrl, vbCrLf) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>不允许从外部链接地址提交！！！</li>"
        rsSurvey.Close
        Set rsSurvey = Nothing
        Exit Sub
    End If
    If rsSurvey(3) <= Conn.Execute("select count(IP) from PE_SurveyRecord" & SurveyID & " where IP='" & UserTrueIP & "' and SurveyID=" & SurveyID & "")(0) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>同一用户不允许填写问卷调查超过" & rsSurvey(3) & "次！！！</li>"
        rsSurvey.Close
        Set rsSurvey = Nothing
        Exit Sub
    End If
    If rsSurvey(4) <> SurveyPassword Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>问卷密码错误！！！</li>"
        rsSurvey.Close
        Set rsSurvey = Nothing
        Exit Sub
    End If
    If rsSurvey(5) = 1 Then
        If Not CheckUserLogined() Then
            rsSurvey.Close
            Set rsSurvey = Nothing
            Call CloseConn
            Response.Redirect "../User/User_Login.asp"
            Exit Sub
        Else
            If rsSurvey(6) <> 0 Then
                Conn.Execute ("update PE_User set UserPoint=UserPoint+" & rsSurvey(6) & " where UserName='" & UserName & "'")
                Call AddConsumeLog("System", 0, UserName, 0, rsSurvey(6), 1, "参与“" & rsSurvey(7) & "”--问卷调查获得奖励点数")
            End If
        End If
    End If
    Set rsSurvey = Nothing

    Set Rs = Server.CreateObject("adodb.recordset")
    Sql = "select QuestionID,QuestionContent,QuestionType,InputType,NotEmpty,DataRight from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
    Rs.Open Sql, Conn, 1, 1
    Do While Not Rs.EOF
        Question = Trim(Request.Form("Q" & Rs("QuestionID")))
        Select Case Rs("QuestionType")
        Case 0
            Question = FilterJS(Question)
            If Rs("NotEmpty") = 1 And Question = "" Then
                FoundErr = True
                ErrMsg = ErrMsg & "<br><li>" & Rs("QuestionContent") & "不能为空或非法输入！！！</li>"
                Exit Sub
            ElseIf Rs("DataRight") = 1 And IsTrueCode(Question) = False Then
                FoundErr = True
                ErrMsg = ErrMsg & "<br><li>" & Rs("QuestionContent") & "不是有效数字！！！</li>"
                Exit Sub
            ElseIf Rs("DataRight") = 2 And IsValidEmail(Question) = False Then
                FoundErr = True
                ErrMsg = ErrMsg & "<br><li>" & Rs("QuestionContent") & "不是有效Email！！！</li>"
                Exit Sub
            End If
        Case 1, 3
            Question = PE_CLng(Question)
            If Rs("NotEmpty") = 1 And Question = 0 Then
                FoundErr = True
                ErrMsg = ErrMsg & "<br><li>" & Rs("QuestionContent") & "必选！！！</li>"
                Exit Sub
            End If
        Case 2
            If Rs("NotEmpty") = 1 And Question = "" Then
                FoundErr = True
                ErrMsg = ErrMsg & "<br><li>" & Rs("QuestionContent") & "必选！！！</li>"
                Exit Sub
            ElseIf Question <> "" And IsValidID(Question) = False Then
                FoundErr = True
                ErrMsg = ErrMsg & "<br><li>" & Rs("QuestionContent") & "非法数据！！！</li>"
                Exit Sub
            End If
        End Select
        Rs.Movenext
    Loop
    Rs.Close
    Set Rs = Nothing

    Set Rs = Server.CreateObject("adodb.recordset")
    Set Rs2 = Server.CreateObject("adodb.recordset")
    Set Rs3 = Server.CreateObject("adodb.recordset")
    Dim sqlRecord, Record
    Dim InputContent
    sqlRecord = "select top 1 * from PE_SurveyRecord" & SurveyID
    Rs3.Open sqlRecord, Conn, 1, 3
    Rs3.addnew
    Rs3("SurveyID") = SurveyID
    Rs3("UserName") = UserName
    Rs3("IP") = UserTrueIP
    Rs3("SubmitTime") = Now()

    Sql = "select QuestionID,QuestionContent,QuestionType,InputType,NotEmpty,DataRight from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
    Rs.Open Sql, Conn, 1, 1


    Do While Not Rs.EOF

        Question = Trim(Request.Form("Q" & Rs("QuestionID")))

        Select Case Rs("QuestionType")
        Case 0 '真空题
            Question = FilterJS(PE_HTMLEncode(Question))
            Rs2.Open "Select * From PE_SurveyInput Where QuestionID=" & Rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
            If Rs2.EOF Or Rs2.BOF Then
                Rs2.addnew
                Rs2("QuestionID") = Rs("QuestionID")
                Rs2("SurveyID") = SurveyID
                Rs2("InputContent") = Question
            Else
                Rs2("InputContent") = Rs2("InputContent") & "$$" & Question
            End If
            Rs2.Update
            Rs2.Close
        Case 1, 3 '单选或下拉列表
            Question = PE_CLng(Question)
            If Question <> 0 Then
                Conn.Execute ("update PE_SurveyAnswer Set VoteAmount=VoteAmount+1 where AnswerID=" & Question)
            End If
            Select Case Rs("InputType")
            Case 0
            Case 1, 2 '有其它选项，可能是单行或多行
                InputContent = FilterJS(PE_HTMLEncode(Trim(Request.Form("QInput" & Rs("QuestionID")))))
                Rs2.Open "Select * From PE_SurveyInput Where QuestionID=" & Rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
                If Rs2.EOF Or Rs2.BOF Then
                    Rs2.addnew
                    Rs2("QuestionID") = Rs("QuestionID")
                    Rs2("SurveyID") = SurveyID
                    Rs2("InputContent") = InputContent
                Else
                    Rs2("InputContent") = Rs2("InputContent") & "$$" & InputContent
                End If
                Rs2.Update
                Rs2.Close
                Question = Question & "$$" & InputContent
            End Select
        Case 2 '多选题
            If IsValidID(Question) = False Then
                Question = ""
            End If
            If Question <> "" Then
                Conn.Execute ("update PE_SurveyAnswer Set VoteAmount=VoteAmount+1 where AnswerID in (" & Question & ")")
            End If
            Select Case Rs("InputType")
            Case 0
            Case 1, 2
                InputContent = FilterJS(PE_HTMLEncode(Trim(Request.Form("QInput" & Rs("QuestionID")))))
                Rs2.Open "Select * From PE_SurveyInput Where QuestionID=" & Rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
                If Rs2.EOF Or Rs2.BOF Then
                    Rs2.addnew
                    Rs2("QuestionID") = Rs("QuestionID")
                    Rs2("SurveyID") = SurveyID
                    Rs2("InputContent") = InputContent
                Else
                    Rs2("InputContent") = Rs2("InputContent") & "$$" & InputContent
                End If
                Rs2.Update
                Rs2.Close
                Question = Question & "$$" & InputContent
            End Select
        End Select
        Rs3("Q" & Rs("QuestionID")) = Question
        Rs.Movenext
    Loop
    Rs3.Update
    Rs3.Close
    Rs.Close
    Set Rs = Nothing
    Set Rs2 = Nothing
    Set Rs3 = Nothing
    Dim RecordID
    RecordID = Conn.Execute("select Max(RecordID) from PE_SurveyRecord" & SurveyID)(0)
        
    Call WriteSuccessMsg("提交成功，非常感谢您的参与！", "")
End Sub


Function IsTrueCode(thisCode)
    regEx.Pattern = "^\d+$"
    IsTrueCode = regEx.Test(thisCode)
End Function

Sub IsSurveyIPlock()
    Dim LockIP, LockIPType, Rs
    Set Rs = Conn.Execute("select * from PE_Survey where SurveyID=" & SurveyID)
    LockIPType = Rs("LockIPType")
    LockIP = Rs("SetIPLock")

    If ChecKIPlock(LockIPType, LockIP, UserTrueIP) = True Then
        FoundErr = True
        ErrMsg = ErrMsg & "对不起！您的IP（" & UserTrueIP & "）被系统限定。您可以和站长联系。"
    End If
End Sub

%>
