admin_vote.asp

个人网站比较简短

        ErrMsg = ErrMsg & "<li>找不到指定的调查！</li>"
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If

    Call ShowJS_AddModify
    Response.Write "<form method='POST' name='myform' onSubmit='return CheckForm();' action='Admin_Vote.asp' target='_self'>"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' class='title' colspan=4 align=center><b>修 改 调 查</b></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='right'>所属频道：</td>"
    Response.Write "      <td colspan='3'>"
    Response.Write "        <select name='ChannelID' id='ChannelID'>" & GetChannel_Option(rs("ChannelID")) & "</select>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='right'>调查主题：</td>"
    Response.Write "      <td colspan='3'>"
    Response.Write "        <textarea name='Title' cols='60' rows='4'>" & PE_ConvertBR(rs("Title")) & "</textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    For i = 1 To 8
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='20%' align='right'>选项" & i & "：</td>"
    Response.Write "      <td width='35%' >"
    Response.Write "        <input type='text' name='select" & i & "' value='" & rs("select" & i) & "' size='36'>"
    Response.Write "      </td>"
    Response.Write "      <td width='10%' align='right'>票数：</td>"
    Response.Write "      <td width='35%'>"
    Response.Write "        <input type='text' name='answer" & i & "' value='" & rs("answer" & i) & "' size='10'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Next
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='right'>调查类型：</td>"
    Response.Write "      <td colspan='3'>"
    Response.Write "        <select name='VoteType' id='VoteType'>"
    Response.Write "          <option value='Single' "
    If rs("VoteType") = "Single" Then Response.Write " selected"
    Response.Write "          >单选</option>"
    Response.Write "          <option value='Multi' "
    If rs("VoteType") = "Multi" Then Response.Write " selected"
    Response.Write "          >多选</option>"
    Response.Write "        </select>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='right'>发布时间：</td>"
    Response.Write "      <td colspan='3'>"
    Response.Write "        <input name='VoteTime' type='text' id='VoteTime' value='" & rs("VoteTime") & "' size='20' maxlength='20'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='right'>终止时间：</td>"
    Response.Write "      <td colspan='3'>"
    Response.Write "        <input name='EndTime' type='text' id='EndTime' value='" & rs("EndTime") & "' size='20' maxlength='20'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='right'>&nbsp;</td>"
    Response.Write "      <td colspan='3'>"
    Response.Write "        <input name='IsSelected' type='checkbox' id='IsSelected' value='yes' "
    If rs("IsSelected") = True Then Response.Write " checked"
    Response.Write "        >启用本调查</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='40' colspan=4 align=center>"
    Response.Write "        <input name='ID' type='hidden' id='ID' value='" & ID & "'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveModify'>"
    Response.Write "        <input name='Submit' type='submit' id='Submit' value=' 保 存 '>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
    rs.Close
    Set rs = Nothing
End Sub

Sub SaveVote()
    Dim Title, VoteTime, EndTime, VoteType, IsSelected
    Dim rs, sql
    Dim i
    ChannelID = PE_CLng(Request("ChannelID"))
    Title = Trim(Request("Title"))
    VoteTime = PE_CDate(Trim(Request("VoteTime")))
    EndTime = Trim(Request("EndTime"))
    VoteType = Trim(Request("VoteType"))
    IsSelected = Trim(Request("IsSelected"))
    If Title = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>调查主题不能为空！</li>"
    End If
    If FoundErr = True Then
        Exit Sub
    End If

    Title = PE_HTMLEncode(Title)
    If IsSelected = "yes" Then
        IsSelected = True
        '只有一个有效的调查
        'Conn.Execute("update PE_Vote set IsSelected=False Where ChannelID=" & ChannelID)
    Else
        IsSelected = False
    End If

    Set rs = Server.CreateObject("adodb.recordset")
    If Action = "SaveAdd" Then
        sql = "select top 1 * from PE_Vote"
        rs.Open sql, Conn, 1, 3
        rs.addnew
    ElseIf Action = "SaveModify" Then
        If ID = "" Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>不能确定调查ID</li>"
            Exit Sub
        Else
            sql = "select * from PE_Vote where ID=" & PE_CLng(ID)
            Set rs = Server.CreateObject("adodb.recordset")
            rs.Open sql, Conn, 1, 3
            If rs.BOF And rs.EOF Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>找不到指定的调查！</li>"
                rs.Close
                Set rs = Nothing
                Exit Sub
            End If
        End If
    End If

    rs("ChannelID") = ChannelID
    rs("Title") = Title
    For i = 1 To 8
        rs("select" & i) = Trim(Request("select" & i))
        If Request("answer" & i) = "" Then
            rs("answer" & i) = 0
        Else
            rs("answer" & i) = PE_CLng(Request("answer" & i))
        End If
    Next
    rs("VoteTime") = VoteTime
    If EndTime <> "" And IsDate(EndTime) Then
        rs("EndTime") = EndTime
    End If
    rs("VoteType") = VoteType
    rs("IsSelected") = IsSelected
    rs("IsItem") = False
    rs.Update
    rs.Close
    Set rs = Nothing
    
    If IsSelected = "yes" Then
        PE_Cache.DelCache (ChannelID & "_Site_Vote")
    End If
    Call CreateJS_Vote
    Call CloseConn
    Response.Redirect "admin_Vote.asp?ChannelID=" & ChannelID
End Sub

Sub SetProperty()
    Dim sqlProperty, rsProperty
    Dim MoveChannelID
    If ID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定调查ID</li>"
    End If
    If Action = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>参数不足！</li>"
    End If
    If FoundErr = True Then
        Exit Sub
    End If
    If InStr(ID, ",") > 0 Then
        sqlProperty = "select * from PE_Vote where ID in (" & ID & ")"
    Else
        sqlProperty = "select * from PE_Vote where ID=" & ID
    End If
    Set rsProperty = Server.CreateObject("ADODB.Recordset")
    rsProperty.Open sqlProperty, Conn, 1, 3
    Do While Not rsProperty.EOF
        Select Case Action
        Case "SetNew"
            rsProperty("IsSelected") = True
            PE_Cache.DelCache (rsProperty("ChannelID") & "_Site_Vote")
        Case "CancelNew"
            rsProperty("IsSelected") = False
            PE_Cache.DelCache (rsProperty("ChannelID") & "_Site_Vote")
        Case "Move"
            MoveChannelID = PE_CLng(Trim(Request("ChannelID")))
            PE_Cache.DelCache (rsProperty("ChannelID") & "_Site_Vote")
            PE_Cache.DelCache (MoveChannelID & "_Site_Vote")
            rsProperty("ChannelID") = MoveChannelID
        Case "Del"
            PE_Cache.DelCache (rsProperty("ChannelID") & "_Site_Vote")
            rsProperty.Delete
        End Select
        rsProperty.Update
        rsProperty.MoveNext
    Loop
    rsProperty.Close
    Set rsProperty = Nothing
    Call CreateJS_Vote
    Call CloseConn
    Response.Redirect ComeUrl
End Sub

Sub CreateJS_Vote()
    If ObjInstalled_FSO = False Then
        Exit Sub
    End If
    Dim sqlVote, rsVote, i, strVote
    sqlVote = "select * from PE_Vote where IsSelected=" & PE_True & " and (ChannelID=-1 or ChannelID=" & ChannelID & ") and IsItem=" & PE_False & " order by ID Desc"
    Set rsVote = Conn.Execute(sqlVote)
    If rsVote.BOF And rsVote.EOF Then
        strVote = "&nbsp;没有任何调查"
    Else
        Do While Not rsVote.EOF
            strVote = strVote & "<form name='VoteForm' method='post' action='" & InstallDir & "vote.asp' target='_blank'>"
            strVote = strVote & "&nbsp;&nbsp;&nbsp;&nbsp;" & rsVote("Title") & "<br>"
            If rsVote("VoteType") = "Single" Then
                For i = 1 To 8
                    If Trim(rsVote("Select" & i) & "") = "" Then Exit For
                    strVote = strVote & "<input type='radio' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
                Next
            Else
                For i = 1 To 8
                    If Trim(rsVote("Select" & i) & "") = "" Then Exit For
                    strVote = strVote & "<input type='checkbox' name='VoteOption' value='" & i & "' style='border:0'>" & rsVote("Select" & i) & "<br>"
                Next
            End If
            strVote = strVote & "<br><input name='VoteType' type='hidden'value='" & rsVote("VoteType") & "'>"
            strVote = strVote & "<input name='Action' type='hidden' value='Vote'>"
            strVote = strVote & "<input name='ID' type='hidden' value='" & rsVote("ID") & "'>"
            strVote = strVote & "<div align='center'>"
            strVote = strVote & "<a href='javascript:VoteForm.submit();'><img src='" & InstallDir & "images/voteSubmit.gif' width='52' height='18' border='0'></a>&nbsp;&nbsp;"
            strVote = strVote & "<a href='" & InstallDir & "Vote.asp?ID=" & rsVote("ID") & "&Action=Show' target='_blank'><img src='" & InstallDir & "images/voteView.gif' width='52' height='18' border='0'></a>"
            strVote = strVote & "</div></form>"
            rsVote.MoveNext
        Loop
    End If
    rsVote.Close
    Set rsVote = Nothing

    Dim JSPath
    If ChannelDir <> "" Then
        JSPath = InstallDir & ChannelDir & "/js"
    Else
        JSPath = InstallDir & "js"
    End If
    If Not fso.FolderExists(Server.MapPath(JSPath)) Then
        fso.CreateFolder (Server.MapPath(JSPath))
    End If
    Call WriteToFile(JSPath & "/ShowVote.js", "document.write(""" & strVote & """);")
End Sub

%>