<!--#include file="Admin_Common.asp"-->
<!--#include file="../Include/PowerEasy.FSO.asp"-->
<%
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2009 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Const NeedCheckComeUrl = True   '是否需要检查外部访问

Const PurviewLevel = 2      '0--不检查，1--超级管理员，2--普通管理员
Const PurviewLevel_Channel = 0   '0--不检查，1--频道管理员，2--栏目总编，3--栏目管理员
Const PurviewLevel_Others = ""   '其他权限

Const SurveyTemplateChannelID = 996
Dim SurveyID, QuestionID, AnswerID, OrderID, Flag
Dim strNavigation
'检查管理员操作权限
If AdminPurview > 1 Then
    arrPurview(0) = CheckPurview_Other(AdminPurview_Others, "ViewSurvey")
    arrPurview(1) = CheckPurview_Other(AdminPurview_Others, "AddSurvey")
    arrPurview(2) = CheckPurview_Other(AdminPurview_Others, "ManageSurvey")
    arrPurview(3) = CheckPurview_Other(AdminPurview_Others, "ShowSurveyCountData")
    arrPurview(4) = CheckPurview_Other(AdminPurview_Others, "ManageSurveyTemplate")
    arrPurview(5) = CheckPurview_Other(AdminPurview_Others, "ImportSurveyQuestion")
    arrPurview(6) = CheckPurview_Other(AdminPurview_Others, "ExportSurveyQuestion")
    arrPurview(7) = CheckPurview_Other(AdminPurview_Others, "ViewListQuestion")
    For PurviewIndex = 0 To 7
        If arrPurview(PurviewIndex) = True Then
            PurviewPassed = True
            Exit For
        End If
    Next
    If PurviewPassed = False Then
        Response.Write "<br><p align='center'><font color='red' style='font-size:9pt'>对不起，你没有此项操作的权限。</font></p>"
        Call WriteEntry(6, AdminName, "越权操作")
        Response.End
    End If
End If



SurveyID = PE_CLng(Trim(Request("SurveyID")))
QuestionID = Trim(Request("QuestionID"))
AnswerID = PE_CLng(Request("AnswerID"))
If IsValidID(QuestionID) = False Then
    QuestionID = ""
End If
strFileName = "Admin_Survey.asp"
                                                    
Response.Write "<html><head><title>问卷调查</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'><link href='Admin_Style.css' rel='stylesheet' type='text/css'><base target='_self'></head>"
Response.Write "<body leftmargin='2' topmargin='0' marginwidth='0' marginheight='0' >" & vbCrLf
If Action <> "ShowReportForm" Then
    Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' Class='border'>" & vbCrLf
    Call ShowPageTitle("问卷调查管理", 10401)

    Response.Write "  <tr class='tdbg'> "
    Response.Write "    <td width='80' height='30'><strong>管理导航：</strong></td>"
    Response.Write "    <td height='30'>"
    Response.Write "  <a href='" & strFileName & "?Action=AddSurvey'>创建问卷</a>&nbsp;|&nbsp;<a href='" & strFileName & "'>问卷管理</a>&nbsp;|&nbsp;<a href='" & strFileName & "?Action=ListQuestion'>题目列表</a></td></tr>" & vbCrLf
    If InStr(Action, "ShowCountData") > 0 Or Action = "UserFormDetail" Or Action = "GetQuestionDetail" Or Action = "ListAnswer" Or Action = "ShowContent" Then
        Response.Write "  <tr class='tdbg'> "
        Response.Write "    <td width='80' height='30'><strong>查看结果：</strong></td>"
        Response.Write "    <td height='30'>"
        Response.Write "<a href='" & strFileName & "?Action=ShowCountData1&SurveyID=" & SurveyID & "'>调查结果分析</a>&nbsp;|&nbsp;<a href='" & strFileName & "?Action=ShowCountData4&SurveyID=" & SurveyID & "'>柱形图显示</a>&nbsp;|&nbsp;<a href='" & strFileName & "?Action=ShowCountData3&SurveyID=" & SurveyID & "'>列表式查看</a>&nbsp;|&nbsp;<a href='" & strFileName & "?Action=ShowCountData2&SurveyID=" & SurveyID & "'>卡片式查看</a>&nbsp;|&nbsp;<a href='" & strFileName & "?Action=GetQuestionDetail&SurveyID=" & SurveyID & "'>查看问题的回答详情</a>"
    End If
    Response.Write "  </td></tr>"
    Response.Write "</table>" & vbCrLf
End If
If Action = "ShowCountData1" Or Action = "ShowCountData4" Then
    Dim SurveyName
    SurveyName = Conn.Execute("select SurveyName from PE_Survey where SurveyID=" & SurveyID)(0)
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;<B>[</B><font color=red>" & SurveyName & "</font><B>]</B>&nbsp;调查结果"
    Response.Write "</td></tr></table>"
End If
Select Case Action
Case "EditSurvey"
    Call EditSurvey
Case "SaveEditHtml"
    Call SaveEditHtml
Case "CreateSurvey"
    Call CreateSurvey
Case "CreateHtml"
    Call CreateHtml
Case "ShowCountData1"
    Call ShowCountData1
Case "ShowCountData2"
    Call ShowCountData2
Case "ShowCountData3"
    Call ShowCountData3
Case "ShowCountData4"
    Call ShowCountData4
Case "UserFormDetail"
    Call UserFormDetail
Case "OpenUse"
    Call OpenUse
Case "AddSurvey"
    Call AddSurvey
Case "AddQuestion"
    Call AddQuestion
Case "ModifySurvey"
    Call ModifySurvey
Case "ModifyQuestion"
    Call ModifyQuestion
Case "SaveAddSurvey", "SaveModifySurvey"
    Call SaveSurvey
Case "SaveAddQuestion", "SaveModifyQuestion"
    Call SaveQuestion
Case "ListQuestion", "ListSurveyQuestion"
    Call QuestionList
Case "DelSurvey"
    Call DelSurvey
Case "DelQuestion"
    Call DelQuestion
Case "DelOption"
    Call DelOption
Case "UserRecordDel"
    Call UserRecordDel
Case "PreviewQuestion"
    Call PreviewQuestion
Case "OrderQuestion"
    Call OrderQuestion
Case "OrderOption"
    Call OrderOption
Case "ListAnswer"
    Call AnswerList
Case "ShowReportForm"
    Call ShowReportForm
Case "GetQuestionDetail"
    Call GetQuestionDetail
Case "SurveyCode"
    Call SurveyCode
Case "ManageTemplate"
    Call ManageTemplate
Case "AddTemplate"
    Call AddTemplate
Case "ModifyTemplate"
    Call ModifyTemplate
Case "DelTemplate"
    Call DelTemplate
Case "SetDefault"
    Call SetDefault
Case "SaveAddTemplate", "SaveModifyTemplate"
    Call SaveTemplate
Case "ExportQuestion"
    Call ExportQuestion
Case "DoExportQuestion"
    Call DoExportQuestion
Case "ImportQuestion"
    Call ImportQuestion
Case "ImportQuestion2"
    Call ImportQuestion2
Case "DoImportQuestion"
    Call DoImportQuestion
Case "ShowContent"
    Call ShowContent
Case Else
    Call Main
End Select
If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If
Response.Write "</body></html>"
Call CloseConn


Sub Main()
    Call ShowJS_Survey
    Dim rsSurvey, sql, Querysql
    sql = "select * from PE_Survey "
    Querysql = " where 1=1 "
    strNavigation = "问卷列表"
    If Keyword <> "" And SearchType <> "" Then
        Select Case SearchType
            Case "SurveyName":
                Querysql = Querysql & " and SurveyName like '%" & Keyword & "%'"
                strNavigation = "名称中含有 <font color='red'>" & Keyword & "</font> 的问卷"
            Case "CreateDate":
                If IsDate(Keyword) = True Then
                    Querysql = Querysql & " and datediff(" & PE_DatePart_D & ",CreateDate,'" & Keyword & "')=0"
                    strNavigation = "创建日期为 " & Keyword & " 的问卷"
                Else
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>查询的创建日期格式不正确！</li>"
                    Exit Sub
                End If
            Case "EndTime":
                If IsDate(Keyword) = True Then
                    Querysql = Querysql & " and datediff(" & PE_DatePart_D & ",EndTime,'" & Keyword & "')=0"
                    strNavigation = "截止日期为 " & Keyword & " 的问卷"
                Else
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>查询的截止日期格式不正确！</li>"
                    Exit Sub
                End If
            Case Else:
        End Select
        strFileName = strFileName & "?KeyWord=" & Keyword & "&SearchType=" & SearchType
    End If

    totalPut = PE_CLng(Conn.Execute("select Count(*) from PE_Survey " & Querysql)(0))
    If CurrentPage < 1 Then
        CurrentPage = 1
    End If
    If (CurrentPage - 1) * MaxPerPage > totalPut Then
        If (totalPut Mod MaxPerPage) = 0 Then
            CurrentPage = totalPut \ MaxPerPage
        Else
            CurrentPage = totalPut \ MaxPerPage + 1
        End If
    End If
    If CurrentPage > 1 Then
        Querysql = Querysql & " and SurveyID < (select min(SurveyID) from (select top " & ((CurrentPage - 1) * MaxPerPage) & " SurveyID from PE_Survey " & Querysql & " order by SurveyID desc) as QuerySurvey) "
    End If
    
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;" & strNavigation
    Response.Write "</td></tr></table>"
    If AdminPurview <> 1 And arrPurview(0) = False Then
        Response.Write "<table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无查看问卷的权限！</td></tr></table>"
        Exit Sub
    End If
    Response.Write "    <table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>" & vbCrLf
    Response.Write "    <form name='myform' method='Post' action='Admin_Survey.asp' onsubmit='return ConfirmDel();'>"
    Response.Write "      <tr class='title'>" & vbCrLf
    If (SearchType = "CreateDate" Or SearchType = "EndTime") And IsDate(Keyword) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>查询的时间格式不正确！</li>"
        Response.Write "</tr></table>"
        Exit Sub
    End If
    Response.Write "        <td width='4%'><div align='center'><b>选中</b> </div></td>" & vbCrLf
    Response.Write "        <td><div align='center'><b>问卷名称</b> </div></td>" & vbCrLf
    Response.Write "        <td width='18%'><div align='center'><b>创建日期/截止日期</b></div></td>" & vbCrLf
    Response.Write "        <td width='12%'><div align='center'><b>文件名</b></div></td>" & vbCrLf
 
    Response.Write "        <td width='23%'><div align='center'><b>常规管理操作</b></div></td>" & vbCrLf
    Response.Write "        <td width='9%'><div align='center'><b>题目操作</b></div></td>" & vbCrLf
    Response.Write "        <td width='14%'><div align='center'><b>HTML页操作</b></div></td>" & vbCrLf
    Response.Write "      </tr>" & vbCrLf

    Set rsSurvey = Server.CreateObject("adodb.recordset")
    rsSurvey.open sql & Querysql & " order by SurveyID desc", Conn, 1, 3

    If rsSurvey.EOF Then
        totalPut = 0
        Response.Write "<tr class='tdbg'><td colspan='8' align='center'>找不到任何问卷！</td><tr>" & vbCrLf
    Else
        Dim SurveyNum
        SurveyNum = 0
        Do While Not rsSurvey.EOF
            Response.Write "    <tr class='tdbg' align='center'>"
            Response.Write "        <td width='30' align='center'><input name='SurveyID' type='checkbox' onclick='unselectall()' id='SurveyID' value='" & rsSurvey("SurveyID") & "'></td>"
            Response.Write "    <td align='left'><a href='Admin_Survey.asp?Action=SurveyCode&SurveyID=" & rsSurvey("SurveyID") & "' title='[" & rsSurvey("SurveyName") & "]调用代码'>" & rsSurvey("SurveyName") & "</a></td>"
            Response.Write "    <td>" & FormatDateTime(rsSurvey("CreateDate"), 2) & "/"
            Response.Write "<font color='"
            If DateDiff("d", rsSurvey("EndTime"), Now()) >= 0 Then Response.Write "red"
            Response.Write "'>"
            Response.Write FormatDateTime(rsSurvey("EndTime"), 2)
            Response.Write "</font></td>"
            If IsNull(rsSurvey("Filename")) Then
                Response.Write "    <td>问卷未创建</td>"
            Else
                Response.Write "    <td><a href='../Survey/" & rsSurvey("Filename") & "' target='_bank'>" & rsSurvey("Filename") & "</a></td>"
            End If
            If rsSurvey("IsOpen") = 1 Then
                Response.Write "    <td><a href=Admin_Survey.asp?Action=ModifySurvey&SurveyID=" & rsSurvey("SurveyID") & ">修改  </a><a href=Admin_Survey.asp?Action=DelSurvey&SurveyID=" & rsSurvey("SurveyID") & " onclick=""return confirm('删除后将删除该问卷页面和所有题目，确定要删除此问卷吗？');"">删除 </a><font color='gray'>启用 </font><a href='" & strFileName & "?Action=ShowCountData1&SurveyID=" & rsSurvey("SurveyID") & "'>调查结果 </a><a href='" & strFileName & "?Action=ShowReportForm&SurveyID=" & rsSurvey("SurveyID") & "'>报表</a></td>"
                Response.Write "    <td><font color='gray'>添加 </font><a href=Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & rsSurvey("SurveyID") & ">列表</a></td>"
            Else
                Response.Write "    <td><a href=Admin_Survey.asp?Action=ModifySurvey&SurveyID=" & rsSurvey("SurveyID") & ">修改  </a><a href=Admin_Survey.asp?Action=DelSurvey&SurveyID=" & rsSurvey("SurveyID") & " onclick=""return confirm('删除后将删除该问卷页面和所有题目，确定要删除此问卷吗？');"">删除 </a><a href='Admin_Survey.asp?Action=OpenUse&SurveyID=" & rsSurvey("SurveyID") & "' onclick=""return confirm('启用后将不允许添加问卷题目了，确定要启用此问卷吗？');"">启用 </a><font color='gray'>调查结果 报表</font></td>"
                Response.Write "    <td><a href=Admin_Survey.asp?Action=AddQuestion&SurveyID=" & rsSurvey("SurveyID") & ">添加 </a><a href=Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & rsSurvey("SurveyID") & ">列表</a></td>"
            End If
            Response.Write "    <td><a href='" & strFileName & "?Action=CreateSurvey&SurveyID=" & rsSurvey("SurveyID") & "'>创建 </a>"
            If IsNull(rsSurvey("Filename")) Then
                Response.Write "    <font color='gray'>编辑 预览</font>"
            Else
                Response.Write "    <a href='" & strFileName & "?Action=EditSurvey&SurveyID=" & rsSurvey("SurveyID") & "'>编辑 </a><a href='../Survey/" & rsSurvey("Filename") & "' target='_bank'>预览</a>"
            End If
            Response.Write " </td>"
            SurveyNum = SurveyNum + 1
            If SurveyNum >= MaxPerPage Then Exit Do
            rsSurvey.MoveNext
        Loop
    End If

    Response.Write "    </table>" & vbCrLf
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'>"
    Response.Write "  <tr>"
    Response.Write "    <td width='200' height='30'><input name='chkAll' type='checkbox' id='chkAll' onclick='CheckAll(this.form)' value='checkbox'>选中本页显示的所有问卷</td><td>"
    Response.Write "<input name='submit1' type='submit' value='删除选定的问卷' onClick=""if (confirm('删除后将删除该问卷页面和所有题目，确定要删除此问卷吗？')==true){document.myform.action.value='DelSurvey';}"">"
    Response.Write "<input name='action' type='hidden' id='action' value=''>"
    Response.Write "  </td></tr></form></table>"
    If totalPut > 0 Then
        Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "篇问卷 ", True)
    End If
    rsSurvey.Close
    Set rsSurvey = Nothing

    Response.Write "<br>"
    Response.Write "<form method='Get' name='SearchForm' action='" & strFileName & "'>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "   <td width='80' align='right'><strong>问卷搜索：</strong></td>"
    Response.Write "     <td>"
    Response.Write "        <select name='SearchType' size='1'>"
    Response.Write "        <option value='SurveyName' selected>问卷名称</option>"
    Response.Write "        <option value='CreateDate'>创建日期</option>"
    Response.Write "        <option value='EndTime'>截止日期</option>"
    Response.Write "        </select>"
    Response.Write "        <input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>"
    Response.Write "        <input type='submit' name='Submit'  value='搜索'>"
    Response.Write "     </td>"
    Response.Write "   </td>"
    Response.Write "   </tr>"
    Response.Write "</table>"
    Response.Write "</form>"
    Response.Write "<br>"
End Sub

Sub ShowJS_Survey()
    Response.Write "<script language=JavaScript>" & vbCrLf
    Response.Write "<!--" & vbCrLf
    Response.Write "function CheckForm()" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "  if(myform.SurveyName.value==''){" & vbCrLf
    Response.Write "    alert('问卷名称不能为空！');" & vbCrLf
    Response.Write "    myform.SurveyName.focus();" & vbCrLf
    Response.Write "    return false;" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "}" & vbCrLf

    Response.Write "function SetProperty(itemvalue)" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "    if(itemvalue=='0'){" & vbCrLf
    Response.Write "        TextType.style.display='';" & vbCrLf
    Response.Write "        RadioType.style.display='';" & vbCrLf
    Response.Write "        myform.InputType[0].disabled='true';" & vbCrLf
    Response.Write "        myform.InputType[1].checked='true';" & vbCrLf
    Response.Write "        OptionItem.style.display='none';" & vbCrLf
    Response.Write "        ContentLength.style.display='';" & vbCrLf
    Response.Write "        InputTypeTitle.style.display='';" & vbCrLf
    Response.Write "        InputTypeTitle2.style.display='none';" & vbCrLf
    'Response.Write "        if(myform.NotEmpty.checked==false){" & vbCrLf
    'Response.Write "        alert('adfa')" & vbCrLf
    'Response.Write "            RadioType.style.display='none';" & vbCrLf
    'Response.Write "         }" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "    else if(itemvalue=='1' || itemvalue=='2' || itemvalue=='3'){" & vbCrLf
    Response.Write "        RadioType.style.display='none';" & vbCrLf
    Response.Write "        TextType.style.display='';" & vbCrLf
    Response.Write "        myform.InputType[0].disabled=false;" & vbCrLf
    Response.Write "        myform.InputType[0].checked='true';" & vbCrLf
    Response.Write "        OptionItem.style.display='';" & vbCrLf
    Response.Write "        ContentLength.style.display='none';" & vbCrLf
    Response.Write "        InputTypeTitle.style.display='none';" & vbCrLf
    Response.Write "        InputTypeTitle2.style.display='';" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "    else if(itemvalue==''){" & vbCrLf
    Response.Write "        RadioType.style.display='none';" & vbCrLf
    Response.Write "        TextType.style.display='none';" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "}" & vbCrLf

    Response.Write "function unselectall(){" & vbCrLf
    Response.Write "    if(document.myform.chkAll.checked){" & vbCrLf
    Response.Write " document.myform.chkAll.checked = document.myform.chkAll.checked&0;" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf
    
    Response.Write "function CheckAll(form){" & vbCrLf
    Response.Write "  for (var i=0;i<form.elements.length;i++){" & vbCrLf
    Response.Write "    var e = form.elements[i];" & vbCrLf
    Response.Write "    if (e.Name != 'chkAll'&&e.disabled!=true)" & vbCrLf
    Response.Write "       e.checked = form.chkAll.checked;" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf

    Response.Write "function ConfirmDel(){" & vbCrLf
    Response.Write "   if(confirm('确定要删除选中的数据吗？'))" & vbCrLf
    Response.Write "     return true;" & vbCrLf
    Response.Write " else" & vbCrLf
    Response.Write "     return false;" & vbCrLf
    Response.Write "}" & vbCrLf

    Response.Write "function ShowIt(itemvalue)" & vbCrLf
    Response.Write "{" & vbCrLf
    Response.Write "    if(itemvalue=='0' || itemvalue=='2'){" & vbCrLf
    Response.Write "        ContentLength.style.display='none';" & vbCrLf
    Response.Write "     }" & vbCrLf
    Response.Write "    else if(itemvalue=='1'){" & vbCrLf
    Response.Write "        ContentLength.style.display='';" & vbCrLf
    Response.Write "     }" & vbCrLf
    Response.Write "  }" & vbCrLf
    Response.Write "//-->" & vbCrLf
    Response.Write "</script>" & vbCrLf
End Sub

Sub AddSurvey()
    Call ShowJS_Survey
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;添加问卷"
    Response.Write "</td></tr></table>"
    If AdminPurview <> 1 And arrPurview(1) = False Then
            Response.Write "<table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
            Response.Write "<tr><td align='center'>您无创建问卷的权限！</td></tr></table>"
            Exit Sub
    End If
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'>"
     Response.Write "<form method='POST' name='myform' onSubmit='return CheckForm();' action='Admin_Survey.asp' target='_self'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>添 加 问 卷</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>问卷名称：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <input name='SurveyName' type='text' id='SurveyName' size='60' maxlength='60' value=''> <font color='red'>*</font>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>问卷描述：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <textarea name='Description' cols='50' rows='5'></textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>同一IP允许重复提交次数：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <input name='IPRepeat' type='text' value='1' size='6' maxlength='4' >&nbsp;"
    Response.Write "           请填写大于0的数字"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>只有登录后才能投票：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <input name='NeedLogin' type='radio' value='1' onclick=""javascript:encourage.style.display='';"">&nbsp;是"
    Response.Write "           <input name='NeedLogin' type='radio' value='0' checked onclick=""javascript:encourage.style.display='none';"">&nbsp;否"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg' id='encourage' style='display:none'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>注册会员参与者奖励点数：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <input name='PresentPoint' type='text' value='0' size='6'>如果点数大于0，则注册会员填写问卷时增加相应点数"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>设置密码限制：</strong><br><font color='blue'>创建问卷后再启用此设置时请重新创建问卷。</font></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <input name='SetPassword' type='password' id='SetPassword' size='20' maxlength='30'> 请输入密码，为空时表示不启用此限制"
    Response.Write "      </td>"
    Response.Write "    </tr>"

    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' class='tdbg5' align='left'><strong>来访限定方式：</strong></td>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='0' checked>  不启用来访限定功能，任何IP都可以访问本问卷。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='1'>  仅仅启用白名单，只允许白名单中的IP访问本问卷。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='2'>  仅仅启用黑名单，只禁止黑名单中的IP访问本问卷。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='3'>  同时启用白名单与黑名单，先判断IP是否在白名单中，如果不在，则禁止访问；如果在则再判断是否在黑名单中，如果IP在黑名单中则禁止访问，否则允许访问。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='4'>  同时启用白名单与黑名单，先判断IP是否在黑名单中，如果不在，则允许访问；如果在则再判断是否在白名单中，如果IP在白名单中则允许访问，否则禁止访问。 " & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf

    Response.Write "   <tr class='tdbg'>     " & vbCrLf
    Response.Write "     <td width='40%' class='tdbg5' align='left'>               <strong>IP段白名单</strong>：<br>" & vbCrLf
    Response.Write "      (注：添加多个限定IP段，请用<font color='red'>回车</font>分隔。 <br>" & vbCrLf
    Response.Write "      限制IP段的书写方式，中间请用英文四个小横杠连接，如 " & vbCrLf
    Response.Write "      <font color='red'>219.100.93.32----219.100.93.255</font> 就限定了IP 219.100.93.32 到IP 219.100.93.255 这个IP段的访问。) </td>      " & vbCrLf
    Response.Write "     <td class='tdbg'>" & vbCrLf

    Response.Write " <textarea name='LockIPWhite' cols='60' rows='8' id='LockIP'>" & vbCrLf
    Response.Write "</textarea>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "   <tr class='tdbg'>     " & vbCrLf
    Response.Write "     <td class='tdbg5' align='left'><strong>IP段黑名单</strong>：<br>" & vbCrLf
    Response.Write "      (注：同上。) <br>" & vbCrLf
    Response.Write "      </td>      " & vbCrLf
    Response.Write "     <td class='tdbg'>" & vbCrLf

    Response.Write " <textarea name='LockIPBlack' cols='60' rows='8' id='LockIP'>" & vbCrLf
    Response.Write "</textarea>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>结束日期：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <input name='EndTime' type='text' id='EndTime' size='30' maxlength='30' value='" & DateAdd("m", 1, Now()) & "'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>问卷模板：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <select name='TemplateID'>"
    Dim rsTemplate
    Set rsTemplate = Conn.Execute("select * from PE_Template where ChannelID=" & SurveyTemplateChannelID & " and TemplateType=99 and Deleted=" & PE_False & " order by IsDefault")
    If rsTemplate.EOF Then
        Response.Write "           <option value='0' selected>暂无模板</option>"
    Else
        Do While Not rsTemplate.EOF
            Response.Write "           <option value=" & rsTemplate("TemplateID") & ">" & rsTemplate("TemplateName") & "</option>"
            rsTemplate.MoveNext
        Loop
    End If
    rsTemplate.Close
    Set rsTemplate = Nothing
    Response.Write "          </select>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
        
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong> 允许提交的表单页面地址列表：</strong><br>"
    Response.Write "      （注：允许所有页面提交，请留空。<br>" & vbCrLf
    Response.Write "      添加多个限定地址，请用<font color='red'>回车</font>分隔。地址书写方式，"
    Response.Write "      如：<font color='blue'>http://www.***.**/Survey/200612080903.html</font> 就允许了这个地址提交的问卷数据。<font color='red'>推荐使用，防止伪造提交！</font>）" & vbCrLf
    Response.Write "      </td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <textarea name='LockUrl' cols='60' rows='8'></textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='40' colspan='2' align='center'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveAddSurvey'>"
    Response.Write "        <input  type='submit' name='Submit' value=' 保 存 '>&nbsp;&nbsp;"
    Response.Write "        <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_Survey.asp'"" style='cursor:hand;'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    </form>" & vbCrLf
    Response.Write "    </table>" & vbCrLf
End Sub

Sub QuestionList()
    Dim rsQuestion, sql, strFileName, rs, IsOpen
    Dim Querysql
    
    If AdminPurview <> 1 And arrPurview(7) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无查看题目列表的权限！</td></tr></table>"
        Exit Sub
    End If

    Call ShowJS_Survey
    If Action = "ListSurveyQuestion" Then
        strFileName = "Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & SurveyID
    Else
        strFileName = "Admin_Survey.asp?Action=ListQuestion"
    End If

    sql = "select Q.QuestionID,Q.OrderID,Q.QuestionContent,Q.QuestionType,S.SurveyID,S.IsOpen,S.SurveyName from PE_SurveyQuestion Q, PE_Survey S where S.SurveyID=Q.SurveyID "
    If Keyword <> "" And SearchType <> "" Then
        Select Case SearchType
            Case "SurveyName":
                Querysql = " and S.SurveyName like '%" & Keyword & "%'"
                strNavigation = "所属问卷名称中含有 <font color=red>" & Keyword & "</font> 的问题"
            Case "QuestionContent":
                Querysql = " and Q.QuestionContent like '%" & Keyword & "%'"
                strNavigation = "名称中含有 <font color=red>" & Keyword & "</font> 的问题"
        End Select
        strFileName = strFileName & "&KeyWord=" & Keyword & "&SearchType=" & SearchType
    End If
    sql = sql & Querysql

    If Action = "ListSurveyQuestion" Then
        sql = sql & " and Q.SurveyID =" & SurveyID
    End If
    If Action = "ListSurveyQuestion" Then
        totalPut = PE_CLng(Conn.Execute("select Count(*) from PE_SurveyQuestion Q, PE_Survey S where S.SurveyID=Q.SurveyID and  Q.SurveyID=" & SurveyID & Querysql)(0))
    Else
        totalPut = PE_CLng(Conn.Execute("select Count(*) from PE_SurveyQuestion Q, PE_Survey S where S.SurveyID=Q.SurveyID  " & Querysql)(0))
    End If

    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp; "
    If Action = "ListSurveyQuestion" Then
        If strNavigation = "" Then
            Set rs = Conn.Execute("select SurveyName,IsOpen from PE_Survey where SurveyID=" & SurveyID)
            Response.Write "<B>[</B><font color=red>" & rs(0) & "</font><B>]</B> "
            IsOpen = rs("IsOpen")
            rs.Close
            Set rs = Nothing
        End If
    End If
    If strNavigation <> "" Then
        Response.Write strNavigation
    Else
        Response.Write "题目列表"
    End If
    If Action = "ListSurveyQuestion" And IsOpen = 0 Then
        Response.Write "</td><td align='right'>[<a href='Admin_Survey.asp?Action=AddQuestion&SurveyID=" & SurveyID & "'>添加此问卷的问题</a>]&nbsp;"
    End If
    Response.Write "</td></tr></table>"
    Response.Write "    <table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>" & vbCrLf
    Response.Write "    <form name='myform' method='Post' action='Admin_Survey.asp'>"
    Response.Write "      <tr class='title'>" & vbCrLf
    If IsOpen = 0 Then
        Response.Write "        <td <div align='center'><b>选中</b></div></td>" & vbCrLf
    End If
    If Action = "ListQuestion" Or (Action = "ListSurveyQuestion" And IsOpen <> 0) Then
        Response.Write "        <td <div align='center'><b>序号</b></div></td>" & vbCrLf
    End If
    Response.Write "        <td width='30%'><div align='center'><b>问题</b> </div></td>" & vbCrLf
    Response.Write "        <td <div align='center'><b>问题类型</b></div></td>" & vbCrLf
    Response.Write "        <td <div align='center'><b>所属问卷</b></div></td>" & vbCrLf
    Response.Write "        <td width='25%'><div align='center'><b>常规管理操作</b></div></td>" & vbCrLf
    If Action = "ListSurveyQuestion" And IsOpen = 0 Then
        Response.Write "        <td width='10%'><div align='center'><b>排序操作</b></div></td>" & vbCrLf
    End If
    Response.Write "      </tr>" & vbCrLf
   
    Set rsQuestion = Server.CreateObject("adodb.recordset")
    rsQuestion.open sql & " order by S.SurveyID asc,Q.OrderID asc", Conn, 1, 3
    If rsQuestion.EOF Then
        totalPut = 0
        Response.Write "<tr class='tdbg'><td colspan='6' align='center'>您还没有添加任何问题记录！</td><tr>" & vbCrLf
    Else
        Dim QuestionNum, i
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If

        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rsQuestion.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        QuestionNum = 0
        Do While Not rsQuestion.EOF
            Response.Write "    <tr class='tdbg' align='center'>"
            If IsOpen = 0 Then
                Response.Write "        <td width='30' align='center'><input name='QuestionID' type='checkbox' onclick='unselectall()' id='QuestionID' value='" & rsQuestion("QuestionID") & "'></td>"
            End If
            If Action = "ListQuestion" Or (Action = "ListSurveyQuestion" And IsOpen <> 0) Then
                Response.Write "    <td width='40' align='center'>" & rsQuestion("OrderID") & "</td>"
            End If
            Response.Write "    <td align='left'>" & rsQuestion("QuestionContent") & "</td>"
            Select Case rsQuestion("QuestionType")
            Case 0
                Response.Write "    <td>填空题</td>"
            Case 1
                Response.Write "    <td>单选题</td>"
            Case 2
                Response.Write "    <td>多选题</td>"
            Case 3
                Response.Write "    <td>下拉选框</td>"
            End Select
            Response.Write "    <td><a href='Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & rsQuestion("SurveyID") & "'>" & rsQuestion("SurveyName") & "</a></td>"
            Response.Write "    <td>"
            If rsQuestion("IsOpen") = 0 Then
                If Action = "ListSurveyQuestion" Then
                    Response.Write "<a href=Admin_Survey.asp?Action=ModifyQuestion&QuestionID=" & rsQuestion("QuestionID") & "&SurveyID=" & SurveyID & "&Flag=1>修改  </a>"
                Else
                    Response.Write "<a href=Admin_Survey.asp?Action=ModifyQuestion&QuestionID=" & rsQuestion("QuestionID") & "&SurveyID=" & rsQuestion("SurveyID") & ">修改  </a>"
                End If
                Response.Write "<a href=Admin_Survey.asp?Action=DelQuestion&QuestionID=" & rsQuestion("QuestionID") & " onclick=""return confirm('确定要删除此问题吗？');"">删除 </a><a href=Admin_Survey.asp?Action=PreviewQuestion&QuestionID=" & rsQuestion("QuestionID") & "&SurveyID=" & rsQuestion("SurveyID") & ">预览</a></td>"
            Else
                Response.Write "<font color=gray>修改  </font><font color=gray>删除 </font><a href=Admin_Survey.asp?Action=PreviewQuestion&QuestionID=" & rsQuestion("QuestionID") & "&SurveyID=" & rsQuestion("SurveyID") & ">预览</a></td>"
            End If
            If Action = "ListSurveyQuestion" And IsOpen = 0 Then
                Response.Write "    <td><input name='OrderID' title='编辑后按回车保存' type='text' size='3' value='" & rsQuestion("OrderID") & "' style='text-align:center' onFocus=""myform.submit.disabled=true;"" onBlur=""myform.submit.disabled=false;""  onKeyPress=""if (event.keyCode==13) window.location='Admin_Survey.asp?Action=OrderQuestion&QuestionID=" & rsQuestion("QuestionID") & "&SurveyID=" & SurveyID & "&OrderID='+this.value;""></td>"
            End If
            Response.Write "  </tr>"
            QuestionNum = QuestionNum + 1
            If QuestionNum >= MaxPerPage Then Exit Do
            rsQuestion.MoveNext
        Loop
    End If
    Response.Write "    </table>" & vbCrLf
    If IsOpen = 0 Then
        Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'>"
        Response.Write "  <tr>"
        Response.Write "    <td width='200' height='30'><input name='chkAll' type='checkbox' id='chkAll' onclick='CheckAll(this.form)' value='checkbox'>选中本页显示的所有问题</td><td>"
        Response.Write "<input name='submit' type='submit' value='删除选定的问题' onClick=""if (confirm('确定要删除选中的问题吗？')==true){document.myform.Action.value='DelQuestion';}"">"
        Response.Write "  </td></tr></table>"
    End If
    Response.Write "<input name='Action' type='hidden' id='Action' value=''>"
    Response.Write " </form>"
    If totalPut > 0 Then
        Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "个问题 ", True)
    End If
    Response.Write "<br>"
    rsQuestion.Close
    Set rsQuestion = Nothing
    Response.Write "<br>"
    Response.Write "<form method='Post' name='SearchForm' action='Admin_Survey.asp?Action="
    If Action = "ListSurveyQuestion" Then
        Response.Write "ListSurveyQuestion&SurveyID=" & SurveyID
    Else
        Response.Write "ListQuestion"
    End If
    Response.Write "'>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "   <td width='80' align='right'><strong>问题搜索：</strong></td>"
    Response.Write "     <td>"
    Response.Write "        <select name='SearchType' size='1'>"
    Response.Write "        <option value='QuestionContent' selected>问题名称</option>"
    Response.Write "        <option value='SurveyName'>所属问卷</option>"
    Response.Write "        </select>"
    Response.Write "        <input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>"
    Response.Write "        <input type='submit' name='Submit'  value='搜索'>"
    Response.Write "     </td>"
    Response.Write "   </td>"
    Response.Write "   </tr>"
    Response.Write "</table>"
    Response.Write "</form>"
    Response.Write "<br>"
End Sub

Sub GetQuestionDetail()
    Dim rsQuestion, sql, strFileName, rs

    Call ShowJS_Survey
    strFileName = "Admin_Survey.asp?Action=GetQuestionDetail&SurveyID=" & SurveyID

    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;"
    Set rs = Conn.Execute("select SurveyName from PE_Survey where SurveyID=" & SurveyID)
    Response.Write "<B>[</B><font color=red>" & rs(0) & "</font><B>]</B>&nbsp;&gt;&gt;&nbsp;"
    rs.Close
    Set rs = Nothing

    Response.Write "问题回答详情"
    Response.Write "</td></tr></table>"
    Response.Write "    <table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>" & vbCrLf
    Response.Write "    <form name='myform' method='Post' action='Admin_Survey.asp'>"
    Response.Write "      <tr class='title'>" & vbCrLf
    Response.Write "        <td <div align='center'><B>序号</B></div></td>" & vbCrLf
    Response.Write "        <td width='30%'><div align='center'><B>问题</B> </div></td>" & vbCrLf
    Response.Write "        <td <div align='center'><B>问题类型</B></div></td>" & vbCrLf
    Response.Write "        <td <div align='center'><B>所属问卷</B></div></td>" & vbCrLf
    Response.Write "        <td width='25%'><div align='center'><B>常规管理操作</B></div></td>" & vbCrLf
    Response.Write "      </tr>" & vbCrLf

    sql = "select Q.QuestionID,Q.OrderID,Q.QuestionContent,Q.QuestionType,S.SurveyID,S.IsOpen,S.SurveyName from PE_SurveyQuestion Q, PE_Survey S where S.SurveyID=Q.SurveyID "
    sql = sql & " and Q.SurveyID =" & SurveyID

    totalPut = PE_CLng(Conn.Execute("select Count(*) from PE_SurveyQuestion where SurveyID=" & SurveyID)(0))

    Set rsQuestion = Server.CreateObject("adodb.recordset")
    rsQuestion.open sql & " order by OrderID asc", Conn, 1, 3
    If rsQuestion.EOF Then
        totalPut = 0
        Response.Write "<tr class='tdbg'><td colspan='6' align='center'>您还没有添加任何问题记录!</td><tr>" & vbCrLf
    Else
        Dim QuestionNum, i
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If

        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rsQuestion.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        QuestionNum = 0
        Do While Not rsQuestion.EOF
            Response.Write "    <tr class='tdbg' align='center'>"
            Response.Write "    <td width='30'>" & rsQuestion("OrderID") & "</td>"
            Response.Write "    <td align='left'><a href=Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rsQuestion("QuestionID") & ">" & rsQuestion("QuestionContent") & "</a></td>"
            Select Case rsQuestion("QuestionType")
            Case 0
                Response.Write "    <td>填空题</td>"
            Case 1
                Response.Write "    <td>单选题</td>"
            Case 2
                Response.Write "    <td>多选题</td>"
            Case 3
                Response.Write "    <td>下拉选框</td>"
            End Select
            Response.Write "    <td>" & rsQuestion("SurveyName") & "</td>"
            Response.Write "    <td>"
            Response.Write "     <a href=Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rsQuestion("QuestionID") & ">查看问题的回答详情</a></td>"
            Response.Write "  </tr>"
            QuestionNum = QuestionNum + 1
            If QuestionNum >= MaxPerPage Then Exit Do
            rsQuestion.MoveNext
        Loop
    End If
    Response.Write "    </table>" & vbCrLf
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'>"
    Response.Write "  <tr>"
    Response.Write "    <td width='200' height='30'>"
    Response.Write "<input name='action' type='hidden' id='action' value=''>"
    Response.Write "  </td></tr></form></table>"
    If totalPut > 0 Then
        Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "个问题 ", True)
    End If
    Response.Write "<br>"
    rsQuestion.Close
    Set rsQuestion = Nothing
End Sub

Sub AddQuestion()
    Call ShowJS_Survey
    Dim rs
    Set rs = Conn.Execute("select SurveyName,IsOpen from PE_Survey Where SurveyID=" & SurveyID)
    If rs.EOF Or rs.BOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>该问卷不存在！！</li>"
        Exit Sub
    End If

    If rs("IsOpen") = 1 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>该问卷已启用，不能添加问题！！</li>"
        Exit Sub
    End If
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;<a href='Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & SurveyID & "'><b>[</b><font color=red>" & rs("SurveyName") & "</font><b>]</b>问卷</a>&nbsp;&gt;&gt;&nbsp;添加问题"
    Response.Write "</td></tr></table>"
    rs.Close
    Set rs = Nothing

    Response.Write "  <table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'>"
    Response.Write "<form method='POST' name='myform' action='Admin_Survey.asp' target='_self' onSubmit=""javascript:if(QuestionContent.value ==''){alert('问题不能为空！');QuestionContent.focus();return false;}if(ContentLength.value ==''){alert('回答的最多字符不能为空！');ContentLength.focus();return false;}"">"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>添 加 问 题</strong></td>"
    Response.Write "    </tr>"
    Response.Write "  <tr>" & vbCrLf
    Response.Write "    <td width='200' align='right'  class='tdbg5'><strong>标题和类型设置：</td></strong>" & vbCrLf
    Response.Write "    <td class='tdbg'>" & vbCrLf
    
    Response.Write "   <table>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>"
    Response.Write "        问题：<br>"
    Response.Write "          &nbsp;&nbsp;&nbsp;<input name='QuestionContent' type='text' id='QuestionContent' size='60' maxlength='255' value=''> <font color='red'>*</font><br>"
    Response.Write "        问题类型：<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio' checked onclick='SetProperty(this.value)' name='QuestionType' value='0'>填空题<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio' onclick='SetProperty(this.value)' name='QuestionType' value='1'>单选题<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio' onclick='SetProperty(this.value)' name='QuestionType' value='2'>多选题<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio' onclick='SetProperty(this.value)' name='QuestionType' value='3'>下拉选框"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "   </table>"
    
    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr>" & vbCrLf
    Response.Write "    <td class='tdbg5' align='right'><strong>属性可选设置：</strong><br><font color='blue'>“其它”输入框，可以紧跟选项后面，也可以独立填写。</font></td>" & vbCrLf
    Response.Write "    <td class='tdbg'>" & vbCrLf
    Response.Write "   <table>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>"
    Response.Write "          <table id='TextType' width='100%' border='0' cellspacing='0' cellpadding='0' style='display:'><tr><td>"
    Response.Write "            是否必填：<br>"
    Response.Write "            &nbsp;&nbsp;<input name='NotEmpty' type='checkbox' value=1 checked onclick=""javascript:if(this.checked==false||myform.QuestionType[0].checked==false){RadioType.style.display='none';}else{RadioType.style.display='';}"">必填<br></td></tr>"
    Response.Write "       </table>"
    Response.Write "        <table id='RadioType' width='100%' border='0' cellspacing='0' cellpadding='0' style='display:'><tr><td>数据验证<br>"
    Response.Write "         &nbsp;&nbsp;<input name='DataRight' type='checkbox' value=1 onclick='javascript:DataRight[1].checked=false;'>必须为数字<br>"
    Response.Write "         &nbsp;&nbsp;<input name='DataRight' type='checkbox' value=2 onclick='javascript:DataRight[0].checked=false;'>Email有效性验证</td></tr>"
    Response.Write "       </table>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr id='OptionItem' style='display:none'  class='tdbg'>"
    Response.Write "          <td>问题选项（<font color='blue'>每一个选项为一行</font>）：<br>"
    Response.Write "             &nbsp;&nbsp;&nbsp;<textarea name='OptionText' rows='10' cols='50' wrap='off' onblur=""javvascript:if(this.value==''){alert('问题选项不能为空！');}""></textarea></td>"
    Response.Write "     </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td id='InputTypeTitle' style='display:' width='600'>回答文本框的类型：<br></td>"
    Response.Write "      <td id='InputTypeTitle2' style='display:none' width='600'>问题中的“其它”选项的类型：<br></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='600'>"
    Response.Write "        &nbsp;&nbsp;<input name='InputType' disabled='false' type='radio' id='InputType' value=0 onclick='ShowIt(this.value)'>无<br>"
    Response.Write "        &nbsp;&nbsp;<input name='InputType' checked type='radio' id='InputType' value=1 onclick='ShowIt(this.value)'>单行<br>"
    Response.Write "        &nbsp;&nbsp;<input name='InputType' type='radio' id='InputType' value=2 onclick='ShowIt(this.value)'>多行<br>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr id='ContentLength' class='tdbg'>"
    Response.Write "          <td>回答的最多字符数：<br>"
    Response.Write "             &nbsp;&nbsp;&nbsp;<Input name='ContentLength' size='10' id=ContentLength' value='20'> <font color='blue'>最大不能超过120</font></td>"
    Response.Write "     </td>"
    Response.Write "    </tr>"
    Response.Write "   </table>"

    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf

    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='40' colspan='2' align='center'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveAddQuestion'>"
    Response.Write "        <input name='Flag' type='hidden' id='Flag' value='1'>"
    Response.Write "        <input name='SurveyID' type='hidden' id='SurveyID' value='" & SurveyID & "'>"
    Response.Write "        <input  type='Submit' name='Submit' value=' 保 存 '>&nbsp;&nbsp;"
    Response.Write "        <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & SurveyID & "'"" style='cursor:hand;'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    </form>" & vbCrLf
    Response.Write "    </table>" & vbCrLf

End Sub

Sub ModifySurvey()
    Dim rsSurvey, sql
    If SurveyID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要修改的问卷ID</li>"
        Exit Sub
    End If
    Set rsSurvey = Server.CreateObject("adodb.recordset")
    sql = "select * from PE_Survey where SurveyID = " & SurveyID & ""
    rsSurvey.open sql, Conn, 1, 3
    If rsSurvey.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到该问卷!</li>"
        rsSurvey.Close
        Set rsSurvey = Nothing
        Exit Sub
    End If

    Call ShowJS_Survey
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;修改问卷"
    Response.Write "</td></tr></table>"
    
    If AdminPurview <> 1 And arrPurview(2) = False Then
            Response.Write "<table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
            Response.Write "<tr><td align='center'>您无修改问卷的权限！</td></tr></table>"
            Exit Sub
    End If
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'>"
    Response.Write "<form method='POST' name='myform' onSubmit='return CheckForm();' action='Admin_Survey.asp' target='_self'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>修 改 问 卷</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>问卷名称：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <input name='SurveyName' type='text' id='SurveyName' size='60' maxlength='60' value='" & rsSurvey("SurveyName") & "'> <font color='red'>*</font>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>问卷描述：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <textarea name='Description' cols='50' rows='5'>" & rsSurvey("Description") & "</textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>同一IP允许重复提交次数：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <input name='IPRepeat' type='text' size='6' maxlength='4' value='" & rsSurvey("IPRepeat") & "'"
    Response.Write ">&nbsp;请填写大于0的数字"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>只有登录后才能投票：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <input name='NeedLogin' type='radio' onclick=""javascript:encourage.style.display='';"" value='1'"
    If rsSurvey("NeedLogin") = 1 Then Response.Write " Checked"
    Response.Write ">&nbsp;是"
    Response.Write "           <input name='NeedLogin' type='radio' onclick=""javascript:encourage.style.display='none';"" value='0'"
    If rsSurvey("NeedLogin") = 0 Then Response.Write " Checked"
    Response.Write ">&nbsp;否"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    
    Response.Write "    <tr class='tdbg' id='encourage' style='display:"
    If rsSurvey("NeedLogin") = 0 Then Response.Write "none"
    Response.Write "'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>注册会员参与者奖励点数：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <input name='PresentPoint' type='text' value='" & rsSurvey("PresentPoint") & "' size='6'>如果点数大于0，则注册会员填写问卷时增加相应点数"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>设置密码限制：</strong><br><font color='blue'>创建问卷后再启用此设置时请重新创建问卷。</font></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <input name='SetPassword' type='Password' id='SetPassword' size='20' maxlength='30' value='" & rsSurvey("SetPassword") & "'> 请输入密码，为空时表示不启用此限制"
    Response.Write "      </td>"
    Response.Write "    </tr>"

    Response.Write "    <tr class='tdbg'>" & vbCrLf
    Response.Write "      <td width='40%' class='tdbg5' align='left'><strong>来访限定方式：</strong></td>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='0' " & IsRadioChecked(rsSurvey("LockIPType"), 0) & ">  不启用来访限定功能，任何IP都可以访问本问卷。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='1' " & IsRadioChecked(rsSurvey("LockIPType"), 1) & ">  仅仅启用白名单，只允许白名单中的IP访问本问卷。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='2' " & IsRadioChecked(rsSurvey("LockIPType"), 2) & ">  仅仅启用黑名单，只禁止黑名单中的IP访问本问卷。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='3' " & IsRadioChecked(rsSurvey("LockIPType"), 3) & ">  同时启用白名单与黑名单，先判断IP是否在白名单中，如果不在，则禁止访问；如果在则再判断是否在黑名单中，如果IP在黑名单中则禁止访问，否则允许访问。<br>" & vbCrLf
    Response.Write "        <input name='LockIPType' type='radio' value='4' " & IsRadioChecked(rsSurvey("LockIPType"), 4) & ">  同时启用白名单与黑名单，先判断IP是否在黑名单中，如果不在，则允许访问；如果在则再判断是否在白名单中，如果IP在白名单中则允许访问，否则禁止访问。 " & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "   <tr class='tdbg'>     " & vbCrLf
    Response.Write "     <td width='40%' class='tdbg5' align='left'>               <strong>IP段白名单</strong>：<br>" & vbCrLf
    Response.Write "      (注：添加多个限定IP段，请用<font color='red'>回车</font>分隔。 <br>" & vbCrLf
    Response.Write "      限制IP段的书写方式，中间请用英文四个小横杠连接，如 " & vbCrLf
    Response.Write "      <font color='red'>219.100.93.32----219.100.93.255</font> 就限定了IP 219.100.93.32 到IP 219.100.93.255 这个IP段的访问。) </td>      " & vbCrLf
    Response.Write "     <td class='tdbg'>" & vbCrLf

    Response.Write " <textarea name='LockIPWhite' cols='60' rows='8' id='LockIP'>" & vbCrLf
    Dim rsLockIP, arrLockIP, i, arrLockIPCut
    If InStr(rsSurvey("SetIPLock"), "|||") > 0 Then
        rsLockIP = Split(rsSurvey("SetIPLock"), "|||")
        If InStr(rsLockIP(0), "$$$") > 0 Then
            arrLockIP = Split(Trim(rsLockIP(0)), "$$$")
            For i = 0 To UBound(arrLockIP)
                arrLockIPCut = Split(Trim(arrLockIP(i)), "----")
                Response.Write DecodeIP(arrLockIPCut(0)) & "----" & DecodeIP(arrLockIPCut(1))
                If i < UBound(arrLockIP) Then Response.Write Chr(10)
            Next
        ElseIf rsLockIP(0) <> "" Then
            arrLockIPCut = Split(Trim(rsLockIP(0)), "----")
            Response.Write DecodeIP(arrLockIPCut(0)) & "----" & DecodeIP(arrLockIPCut(1))
        End If
    End If
    Response.Write "</textarea>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "   <tr class='tdbg'>     " & vbCrLf
    Response.Write "     <td class='tdbg5' align='left'><strong>IP段黑名单</strong>：<br>" & vbCrLf
    Response.Write "      (注：同上。) <br>" & vbCrLf
    Response.Write "      </td>      " & vbCrLf
    Response.Write "     <td class='tdbg'>" & vbCrLf

    Response.Write " <textarea name='LockIPBlack' cols='60' rows='8' id='LockIP'>" & vbCrLf

    If InStr(rsSurvey("SetIPLock"), "|||") > 0 Then
        rsLockIP = Split(rsSurvey("SetIPLock"), "|||")
        If InStr(rsLockIP(1), "$$$") > 0 Then
            arrLockIP = Split(Trim(rsLockIP(1)), "$$$")
            For i = 0 To UBound(arrLockIP)
                arrLockIPCut = Split(Trim(arrLockIP(i)), "----")
                Response.Write DecodeIP(arrLockIPCut(0)) & "----" & DecodeIP(arrLockIPCut(1))
                If i < UBound(arrLockIP) Then Response.Write Chr(10)
            Next
        ElseIf rsLockIP(1) <> "" Then
            arrLockIPCut = Split(Trim(rsLockIP(1)), "----")
            Response.Write DecodeIP(arrLockIPCut(0)) & "----" & DecodeIP(arrLockIPCut(1))
        End If
    End If
    Response.Write "</textarea>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>结束日期：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <input name='EndTime' type='text' id='EndTime' size='60' maxlength='60' value='" & rsSurvey("EndTime") & "'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong>问卷模板：</strong></td>"
    Response.Write "      <td width='600'>"
    Response.Write "          <select name='TemplateID'>"
    Dim rsTemplate
    Set rsTemplate = Conn.Execute("select * from PE_Template where ChannelID=" & SurveyTemplateChannelID & " and TemplateType=99 and Deleted=" & PE_False & " order by IsDefault")
    If rsTemplate.EOF Then
        Response.Write "           <option value='0' selected>暂无模板</option>"
    Else
        Do While Not rsTemplate.EOF
            Response.Write "           <option value=" & rsTemplate("TemplateID")
            If rsSurvey("TemplateID") = rsTemplate("TemplateID") Then
                Response.Write " Selected"
            End If
            Response.Write ">" & rsTemplate("TemplateName") & "</option>"
            rsTemplate.MoveNext
        Loop
    End If
    rsTemplate.Close
    Set rsTemplate = Nothing
    Response.Write "          </select>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td align='left' class='tdbg5'><strong> 允许提交的表单页面地址列表：</strong><br>"
    Response.Write "      （注：允许所有页面提交，请留空。<br>" & vbCrLf
    Response.Write "      添加多个限定地址，请用<font color='red'>回车</font>分隔。地址书写方式，"
    Response.Write "      如：<font color='blue'>http://www.***.**/Survey/200612080903.html</font> 就允许了这个地址提交的问卷数据。<font color='red'>推荐使用，防止伪造提交！</font>）" & vbCrLf
    Response.Write "      </td>"
    Response.Write "      <td width='600'>"
    Response.Write "        <textarea name='LockUrl' cols='60' rows='8'>" & rsSurvey("LockUrl") & "</textarea>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='40' colspan='2' align='center'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveModifySurvey'>"
    Response.Write "        <input name='SurveyID' type='hidden' id='SurveyID' value='" & SurveyID & "'>"
    Response.Write "        <input  type='submit' name='Submit' value=' 保 存 '>&nbsp;&nbsp;"
    Response.Write "        <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_Survey.asp'"" style='cursor:hand;'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    </table>" & vbCrLf
    Response.Write "    </form>" & vbCrLf
    rsSurvey.Close
    Set rsSurvey = Nothing
End Sub

Sub ModifyQuestion()
    Dim rsQuestion, sql
    If QuestionID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要修改的问题ID</li>"
        Exit Sub
    End If
    Flag = PE_CLng(Request("Flag"))
    Set rsQuestion = Server.CreateObject("adodb.recordset")
    sql = "select * from PE_SurveyQuestion where QuestionID = " & QuestionID & ""
    rsQuestion.open sql, Conn, 1, 3
    If rsQuestion.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>找不到该问题!</li>"
        rsQuestion.Close
        Set rsQuestion = Nothing
        Exit Sub
    End If

    Call ShowJS_Survey

    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;修改问题"
    Response.Write "</td></tr></table>"
  
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'>"
    Response.Write "<form method='POST' name='myform' action='Admin_Survey.asp' target='_self' onSubmit=""javascript:if(QuestionContent.value ==''){alert('问题不能为空！');return false;}"">"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>修 改 问 题</strong></td>"
    Response.Write "    </tr>"
    Response.Write "  <tr>" & vbCrLf
    Response.Write "    <td width='200' align='right'  class='tdbg5'><strong>标题和类型设置：</td></strong>" & vbCrLf
    Response.Write "    <td class='tdbg'>" & vbCrLf
    
    Response.Write "   <table>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>"
    Response.Write "        问题：<br>"
    Response.Write "          &nbsp;&nbsp;&nbsp;<input name='QuestionContent' type='text' id='QuestionContent' size='60' maxlength='255'   value='" & rsQuestion("QuestionContent") & "' onBlur=""javascript:if(this.value ==''){alert('问题不能为空！');}""> <font color='red'>*</font><br>"
    Response.Write "        问题类型：<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio'"
    If rsQuestion("QuestionType") = 0 Then Response.Write " checked"
    Response.Write "  onclick='SetProperty(this.value)' name='QuestionType' value='0'>填空题<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio'"
    If rsQuestion("QuestionType") = 1 Then Response.Write " checked"
    Response.Write "  onclick='SetProperty(this.value)' name='QuestionType' value='1'>单选题<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio'"
    If rsQuestion("QuestionType") = 2 Then Response.Write " checked"
    Response.Write "  onclick='SetProperty(this.value)' name='QuestionType' value='2'>多选题<br>"
    Response.Write "         &nbsp;&nbsp;<input type='radio'"
    If rsQuestion("QuestionType") = 3 Then Response.Write " checked"
    Response.Write "  onclick='SetProperty(this.value)' name='QuestionType' value='3'>下拉选框<br>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "   </table>"
    
    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    Response.Write "  <tr>" & vbCrLf
    Response.Write "    <td class='tdbg5' align='right'><strong>属性可选设置：</strong><br><font color='blue'>“其它”输入框，可以紧跟选项后面，也可以独立填写。</font></td>" & vbCrLf
    Response.Write "    <td class='tdbg'>" & vbCrLf
    Response.Write "   <table>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>"

    Response.Write "        <table id='TextType' width='100%' border='0' cellspacing='0' cellpadding='0'><tr><td>是否必填(必选)：<br>"
    Response.Write "          &nbsp;&nbsp;<input name='NotEmpty'  type='checkbox' value=1"
    If rsQuestion("NotEmpty") = 1 Then Response.Write " checked"
    Response.Write "              onclick=""javvascript:if(this.checked==false||myform.QuestionType[0].checked==false){RadioType.style.display='none';}else{RadioType.style.display='';}"">必填(必选)<br></td></tr>"
    Response.Write "       </table>"
    Response.Write "        <table id='RadioType' width='100%' border='0' cellspacing='0' cellpadding='0' style='display:"
    If rsQuestion("QuestionType") <> 0 Or rsQuestion("NotEmpty") <> 1 Then Response.Write "none"
    Response.Write "'><tr><td>数据验证：<br>"
    Response.Write "          &nbsp;&nbsp;<input name='DataRight' type='checkbox' value=1 onclick='javascript:DataRight[1].checked=false;'"
    If rsQuestion("DataRight") = 1 Then Response.Write " checked"
    Response.Write ">必须为数字<br>"
    Response.Write "          &nbsp;&nbsp;<input name='DataRight' type='checkbox' value=2 onclick='javascript:DataRight[0].checked=false;'"
    If rsQuestion("DataRight") = 2 Then Response.Write " checked"
    Response.Write "           >Email有效性验证</td></tr>"
    Response.Write "       </table>"

    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr id='OptionItem' style='display:"
    If rsQuestion("QuestionType") = 0 Then Response.Write "none"
    Response.Write "'  class='tdbg'>"
    Response.Write "          <td width='600'>问题选项（<font color='blue'>每一个选项为一行</font>）：<br>"
    Response.Write "             &nbsp;&nbsp&nbsp;<textarea name='OptionText' wrap='off' rows='10' cols='50'>"
    If rsQuestion("QuestionType") <> 0 Then
        Dim rsOptionItem, iCount
        Set rsOptionItem = Conn.Execute("select AnswerContent from PE_SurveyAnswer where QuestionID = " & QuestionID & " Order By OrderID Asc")
        iCount = 0
        Do While Not rsOptionItem.EOF
            If iCount <> 0 Then Response.Write vbCrLf
            Response.Write rsOptionItem("AnswerContent")
            rsOptionItem.MoveNext
            iCount = 1
        Loop
    End If
    Response.Write "</textarea></td>"
    Response.Write "     </td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td id='InputTypeTitle' style='display:"
    If rsQuestion("QuestionType") <> 0 Then Response.Write "none"
    Response.Write "' width='600'>回答文本框的类型：<br></td>"
    Response.Write "      <td id='InputTypeTitle2' style='display:"
    If rsQuestion("QuestionType") = 0 Then Response.Write "none"
    Response.Write "' width='600'>问题中的“其它”选项的类型：<br></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td width='600'>"
    Response.Write "        &nbsp;&nbsp;<input name='InputType' type='radio'  onclick='ShowIt(this.value)'"
    If rsQuestion("InputType") = 0 Then Response.Write " checked"
    If rsQuestion("QuestionType") = 0 Then Response.Write " disabled"
    Response.Write "          id='InputType' value=0 >无<br>"
    Response.Write "        &nbsp;&nbsp;<input name='InputType' type='radio'  onclick='ShowIt(this.value)'"
    If rsQuestion("InputType") = 1 Then Response.Write " checked"
    Response.Write "          id='InputType' value=1 >单行<br>"
    Response.Write "        &nbsp;&nbsp;<input name='InputType' type='radio'  onclick='ShowIt(this.value)'"
    If rsQuestion("InputType") = 2 Then Response.Write " checked"
    Response.Write "          id='InputType' value=2 >多行<br>"
    Response.Write "      </td>"
    Response.Write "    </tr>"

    Response.Write "    <tr id='ContentLength' style='display:"
    If rsQuestion("InputType") <> 1 Then Response.Write "none"
    Response.Write "'  class='tdbg'>"
    Response.Write "          <td width='600'>回答的最多字符数<br>"
    Response.Write "             &nbsp;&nbsp;&nbsp;<Input name='ContentLength' size='10' id=ContentLength' Value=" & rsQuestion("ContentLength") & "><font color='blue'>最大不能超过120</font></td>"
    Response.Write "     </td>"
    Response.Write "    </tr>"
    Response.Write "   </table>"

    Response.Write "    </td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf

    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='40' colspan='2' align='center'>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='SaveModifyQuestion'>"
    Response.Write "        <input name='QuestionID' type='hidden' id='QuestionID' value='" & QuestionID & "'>"
    Response.Write "        <input name='Flag' type='hidden' id='Flag' value='" & Flag & "'>"
    Response.Write "        <input name='SurveyID' type='hidden' id='SurveyID' value='" & SurveyID & "'>"
    Response.Write "        <input  type='submit' name='Submit' value='  保 存 '>&nbsp;&nbsp;"
    Response.Write "        <input name='Cancel' type='button' id='Cancel' value=' 取 消 ' onClick=""window.location.href='Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & SurveyID & "'"" style='cursor:hand;'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "    </form>" & vbCrLf
    Response.Write "    </table>" & vbCrLf
    rsQuestion.Close
    Set rsQuestion = Nothing
End Sub

Sub SaveSurvey()
    Dim SurveyName, Description, IPRepeat, EndTime, NeedLogin, Password, LockIPType, PresentPoint
    Dim rsSurvey, sql, TemplateID, LockUrl

    SurveyName = ReplaceBadChar(Trim(Request.Form("SurveyName")))
    If SurveyName = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "问卷名称不能为空！"
    End If
    Description = ReplaceBadChar(Trim(Request.Form("Description")))
    NeedLogin = ReplaceBadChar(Trim(Request.Form("NeedLogin")))
    Password = ReplaceBadChar(Trim(Request.Form("SetPassword")))
    IPRepeat = PE_CLng1(Trim(Request.Form("IPRepeat")))
    PresentPoint = PE_CLng(Request.Form("PresentPoint"))
    LockIPType = PE_CLng(Request.Form("LockIPType"))
    EndTime = Trim(Request.Form("EndTime"))
    TemplateID = PE_CLng(Trim(Request.Form("TemplateID")))
    LockUrl = Trim(Request.Form("LockUrl"))

    If Not IsDate(EndTime) Then
        EndTime = DateAdd("m", 1, Now())
    ElseIf Now() > CDate(EndTime) Then
        FoundErr = True
        ErrMsg = ErrMsg & "问卷结束时间早于创建时间！"
    End If
    Dim arrLockIP, arrIpW, arrIpB, i, arrLockIPCut
    arrLockIP = Split(Trim(Request("LockIPWhite")), vbCrLf)
    For i = 0 To UBound(arrLockIP)
        If Not (arrLockIP(i) = "" Or IsNull(arrLockIP(i))) And InStr(Trim(arrLockIP(i)), "----") > 0 Then
                arrLockIPCut = Split(Trim(arrLockIP(i)), "----")
                If Not isIP(Trim(arrLockIPCut(0))) Or Not isIP(Trim(arrLockIPCut(1))) Then
                    FoundErr = True
                    ErrMsg = ErrMsg & "请填写正确网站黑白名单中的IP地址！"
                    Exit For
                End If
                If i = 0 Then
                    arrIpW = EncodeIP(Trim(arrLockIPCut(0))) & "----" & EncodeIP(Trim(arrLockIPCut(1)))
                Else
                    arrIpW = arrIpW & "$$$" & EncodeIP(Trim(arrLockIPCut(0))) & "----" & EncodeIP(Trim(arrLockIPCut(1)))
                End If
        End If
    Next
    arrLockIP = Split(Trim(Request("LockIPBlack")), vbCrLf)
    For i = 0 To UBound(arrLockIP)
        If Not (arrLockIP(i) = "" Or IsNull(arrLockIP(i))) And InStr(Trim(arrLockIP(i)), "----") > 0 Then
            arrLockIPCut = Split(Trim(arrLockIP(i)), "----")
            If Not isIP(Trim(arrLockIPCut(0))) Or Not isIP(Trim(arrLockIPCut(1))) Then
                FoundErr = True
                ErrMsg = ErrMsg & "请填写正确网站黑白名单中的IP地址！"
                Exit For
            End If
            If i = 0 Then
                arrIpB = EncodeIP(Trim(arrLockIPCut(0))) & "----" & EncodeIP(Trim(arrLockIPCut(1)))
            Else
                arrIpB = arrIpB & "$$$" & EncodeIP(Trim(arrLockIPCut(0))) & "----" & EncodeIP(Trim(arrLockIPCut(1)))
            End If
        End If
    Next
    If FoundErr = True Then Exit Sub
    Set rsSurvey = Server.CreateObject("adodb.recordset")
    If Action = "SaveAddSurvey" Then
        sql = "select Top 1 * from PE_Survey"
        rsSurvey.open sql, Conn, 1, 3
        rsSurvey.AddNew
    Else
        sql = "select * from PE_Survey where SurveyID = " & SurveyID & ""
        rsSurvey.open sql, Conn, 1, 3
    End If
    rsSurvey("SurveyName") = SurveyName
    rsSurvey("Description") = Description
    rsSurvey("IPRepeat") = IPRepeat
    rsSurvey("NeedLogin") = NeedLogin
    If Action = "SaveAddSurvey" Then
        rsSurvey("CreateDate") = Now()
    End If
    rsSurvey("EndTime") = EndTime
    rsSurvey("PresentPoint") = PresentPoint
    rsSurvey("SetPassword") = Password
    rsSurvey("LockIPType") = LockIPType
    rsSurvey("SetIPLock") = arrIpW & "|||" & arrIpB
    rsSurvey("LockUrl") = LockUrl
    rsSurvey("TemplateID") = TemplateID
    rsSurvey.Update
    rsSurvey.Close
    Set rsSurvey = Nothing
    SurveyID = Conn.Execute("select max(SurveyID) from PE_Survey")(0)
    Call WriteSuccessMsg("<li>保存问卷成功！</li>", "Admin_Survey.asp")
    
End Sub

Sub SaveQuestion()
    Dim QuestionContent, QuestionType, InputType, NotEmpty, DataRight, ContentLength
    Dim rsQuestion, sql
    Dim OptionText, arrOption, i, j

    Flag = PE_CLng(Request.Form("Flag"))
    QuestionContent = Trim(Request.Form("QuestionContent"))
    QuestionType = PE_CLng(Trim(Request.Form("QuestionType")))
    InputType = PE_CLng(Trim(Request.Form("InputType")))
    NotEmpty = PE_CLng(Trim(Request.Form("NotEmpty")))
    DataRight = PE_CLng(Trim(Request.Form("DataRight")))
    OptionText = ReplaceBadChar(Trim(Request.Form("OptionText")))
    arrOption = Split(OptionText, vbCrLf)
    ContentLength = PE_CLng(Trim(Request.Form("ContentLength")))
    If ContentLength > 120 Then ContentLength = 120

    If QuestionContent = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>您还没有填写问题！</li>"
    End If
    If OptionText = "" And QuestionType <> 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>您还没有填写问题选项！</li>"
    End If

    If QuestionType <> 0 And OptionText <> "" Then
        i = 0
        Do While i <= UBound(arrOption)
            If Len(arrOption(i)) > 255 Then
                FoundErr = True
                ErrMsg = ErrMsg & "<li>问题选项长度大于255字符！</li>"
                Exit Do
            End If
            i = i + 1
        Loop
    End If
        
    If FoundErr = True Then Exit Sub

    Set rsQuestion = Server.CreateObject("adodb.recordset")
    If Action = "SaveAddQuestion" Then
        Dim rs, QuestionOrderID
        Set rs = Conn.Execute("Select Max(OrderID) from PE_SurveyQuestion where SurveyID=" & SurveyID)
        If IsNull(rs(0)) Then
            QuestionOrderID = 1
        Else
            QuestionOrderID = rs(0) + 1
        End If
        rs.Close
        Set rs = Nothing
        sql = "select Top 1 * from PE_SurveyQuestion"
        rsQuestion.open sql, Conn, 1, 3
        rsQuestion.AddNew
        rsQuestion("SurveyID") = SurveyID
        rsQuestion("OrderID") = QuestionOrderID
    Else
        sql = "select * from PE_SurveyQuestion where QuestionID = " & QuestionID & ""
        rsQuestion.open sql, Conn, 1, 3
        Conn.Execute ("delete from PE_SurveyAnswer Where QuestionID = " & QuestionID & "")
    End If

    rsQuestion("QuestionContent") = QuestionContent
    rsQuestion("QuestionType") = QuestionType
    rsQuestion("InputType") = InputType
    rsQuestion("NotEmpty") = NotEmpty
    rsQuestion("DataRight") = DataRight
    rsQuestion("ContentLength") = ContentLength
    rsQuestion.Update
    If Action = "SaveAddQuestion" Then
        QuestionID = Conn.Execute("select Max(QuestionID) from PE_SurveyQuestion where SurveyID=" & SurveyID)(0)
    Else
        QuestionID = rsQuestion("QuestionID")
    End If
    rsQuestion.Close
    Set rsQuestion = Nothing

    If QuestionType <> 0 And OptionText <> "" Then
        i = 0
        j = 1
        Do While i <= UBound(arrOption)
            If arrOption(i) <> "" Then
                Conn.Execute ("insert into PE_SurveyAnswer (QuestionID,AnswerContent,OrderID) values (" & QuestionID & ",'" & arrOption(i) & "'," & j & ")")
                j = j + 1
            End If
            i = i + 1
        Loop
    End If

    If Flag = 1 Then
        Call WriteSuccessMsg("<li>保存问题成功！</li>", "Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & SurveyID)
    Else
        Call WriteSuccessMsg("<li>保存问题成功！</li>", "Admin_Survey.asp?Action=ListQuestion&QuestionType=" & QuestionType)
    End If
End Sub

Sub DelSurvey()
    If AdminPurview <> 1 And arrPurview(2) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无删除问卷的权限！</td></tr></table>"
        Exit Sub
    End If
    Dim SurveyID
    SurveyID = Trim(Request("SurveyID"))
    If IsValidID(SurveyID) = False Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的问卷ID</li>"
        Exit Sub
    End If


    Dim rs, rsAnswer, rsSurvey
    Set rs = Conn.Execute("select QuestionID from PE_SurveyQuestion where SurveyID in (" & SurveyID & ")")
    Do While Not rs.EOF
        Set rsAnswer = Conn.Execute("select AnswerID from PE_SurveyAnswer where QuestionID=" & rs("QuestionID"))
        If Not rsAnswer.EOF Then
            Conn.Execute ("delete from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & "")
        End If
        rsAnswer.Close
        Set rsAnswer = Nothing
        rs.MoveNext
    Loop
    Conn.Execute ("delete from PE_SurveyQuestion where SurveyID in ( " & SurveyID & ")")
    Set rsSurvey = Conn.Execute("select * from PE_Survey where SurveyID in ( " & SurveyID & ")")
    Dim FileName, myFile
    Do While Not rsSurvey.EOF
        FileName = "../Survey/" & rsSurvey("FileName")
        myFile = Server.MapPath(FileName)
        If fso.FileExists(myFile) Then
           fso.DeleteFile myFile
        End If
        rsSurvey.MoveNext
    Loop
    Conn.Execute ("delete from PE_Survey where SurveyID in ( " & SurveyID & ")")
    rs.Close
    Set rs = Nothing

    Call WriteSuccessMsg("<li>删除问卷成功！</li>", ComeUrl)
End Sub

Sub DelQuestion()
    If QuestionID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的问题ID</li>"
        Exit Sub
    End If
    Dim rs
    Set rs = Conn.Execute("select Distinct(Q.SurveyID), S.IsOpen from PE_SurveyQuestion Q inner join PE_Survey S on Q.SurveyID=S.SurveyID where Q.QuestionID in (" & QuestionID & ")")
    Do While Not rs.EOF
        If rs("IsOpen") = 1 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>已启用的问卷中的题目不能删除！</li>"
            Exit Sub
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Conn.Execute ("delete from PE_SurveyAnswer where QuestionID in (" & QuestionID & ")")
    Conn.Execute ("delete from PE_SurveyQuestion where QuestionID in (" & QuestionID & ")")
    Call WriteSuccessMsg("<li>删除问题成功！</li>", ComeUrl)
End Sub

Sub DelOption()
    If AnswerID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的选项ID</li>"
        Exit Sub
    End If
    Conn.Execute ("delete from PE_SurveyAnswer where AnswerID=" & AnswerID)
    Call WriteSuccessMsg("<li>删除选项成功！</li>", ComeUrl)
End Sub

Sub UserRecordDel()
    Dim RecordID
    SurveyID = PE_CLng(Trim(Request("SurveyID")))
    RecordID = PE_CLng(Trim(Request("RecordID")))
    If RecordID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的记录ID</li>"
        Exit Sub
    End If
    If SurveyID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的问卷ID</li>"
        Exit Sub
    End If
    Conn.Execute ("delete from PE_SurveyRecord" & SurveyID & " where SurveyID=" & SurveyID & " and RecordID=" & RecordID)
    Call WriteSuccessMsg("<li>删除记录成功！</li>", "Admin_Survey.asp?Action=ShowCountData3&SurveyID=" & SurveyID)
End Sub

Sub PreviewQuestion()
    Dim rsQuestion, rsAnswer, sql
    Set rsQuestion = Conn.Execute("select * from PE_SurveyQuestion where QuestionID=" & QuestionID)
    Response.Write "<br><br>  <table width='100%' border='0' align='center' cellpadding='5' cellspacing='1' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>预 览 问 题</strong></td>"
    Response.Write "    </tr>"
    If rsQuestion("QuestionType") > 0 Then
        Set rsAnswer = Conn.Execute("select * from PE_SurveyAnswer where QuestionID=" & QuestionID)
        If rsAnswer.EOF Then
            Response.Write " <tr class='tdbg'><td height='22' colspan='2' align='center'>该问题还没有添加选项</td></tr>"
        Else
            Response.Write "<tr class='tdbg'><td align='left'>"
            Select Case rsQuestion("QuestionType")
            Case 1
                Response.Write rsQuestion("QuestionContent") & "<br>"
                Do While Not rsAnswer.EOF
                    Response.Write "<input name=radio1 type='radio'>" & rsAnswer("AnswerContent") & "<br>"
                    rsAnswer.MoveNext
                Loop
            Case 2
                Response.Write rsQuestion("QuestionContent") & "<br>"
                Do While Not rsAnswer.EOF
                    Response.Write "<input name='checkbox1' type='checkbox'>" & rsAnswer("AnswerContent") & "<br>"
                    rsAnswer.MoveNext
                Loop
            Case 3
                Response.Write rsQuestion("QuestionContent")
                Response.Write "<select name='select1'>"
                Do While Not rsAnswer.EOF
                    Response.Write "<option value=''>" & rsAnswer("AnswerContent") & "</option>"
                    rsAnswer.MoveNext
                Loop
                Response.Write "</select><br>"
            End Select
            If rsQuestion("InputType") = 1 Then
                Response.Write "<input name='text1' type='text'>"
            End If
            If rsQuestion("InputType") = 2 Then
                Response.Write "<textarea name='Description' cols='30' rows='3'></textarea>"
            End If
            Response.Write "</td></tr>"
        End If
        rsAnswer.Close
        Set rsAnswer = Nothing
    Else
        Response.Write "<tr class='tdbg'><td align='left'>"
        If rsQuestion("InputType") = 1 Then
            Response.Write rsQuestion("QuestionContent") & "<input name='text1' type='text'></td></tr>"
        Else
            Response.Write rsQuestion("QuestionContent") & "<textarea name='Description' cols='30' rows='3'></textarea></td></tr>"
        End If
    End If
    Dim rsSurvey
    Set rsSurvey = Conn.Execute("select isopen from PE_Survey where SurveyID=" & SurveyID)

    Response.Write "<tr class='tdbg'><td align='center'>"
    If rsSurvey(0) = 0 Then
        Response.Write "<a href=Admin_Survey.asp?Action=ModifyQuestion&QuestionID=" & rsQuestion("QuestionID") & "&SurveyID=" & SurveyID & "&Flag=1>修改&nbsp;&nbsp;&nbsp;&nbsp;</a>"
    End If
    Response.Write "<a href=" & ComeUrl & ">返回上一页</a></td></tr></table>"
    rsQuestion.Close
    Set rsQuestion = Nothing
End Sub

Sub OrderQuestion()
    OrderID = PE_CLng(Request("OrderID"))
    Conn.Execute ("Update PE_SurveyQuestion set OrderID=" & OrderID & " where QuestionID=" & PE_CLng(QuestionID))
    Response.Redirect "Admin_Survey.asp?Action=ListSurveyQuestion&SurveyID=" & PE_CLng(SurveyID)
End Sub

Sub OrderOption()
    OrderID = PE_CLng(Request("OrderID"))
    Conn.Execute ("Update PE_SurveyAnswer set OrderID=" & OrderID & " where AnswerID=" & AnswerID)
    Response.Redirect "Admin_Survey.asp?Action=AddOption&AnswerID=" & AnswerID & "&QuestionID=" & PE_CLng(QuestionID)
End Sub

Sub OpenUse()
    Dim FileName, sql, rs
    SurveyID = PE_CLng(SurveyID)
    FileName = Conn.Execute("select FileName from PE_Survey where SurveyID= " & SurveyID & "")(0)
    If IsNull(FileName) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>数据库无对应的文件名！！</li>"
        ErrMsg = ErrMsg & "<li>启用前请先创建问卷表单文件！</li>"
        Exit Sub
    End If
    If Not fso.FileExists(Server.MapPath("../Survey/" & FileName)) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>不存在文件文件：../Survey/" & FileName & "！！</li>"
        ErrMsg = ErrMsg & "<li>启用前请先创建问卷表单文件！</li>"
        Exit Sub
    End If
    Conn.Execute ("Update PE_Survey set IsOpen=1 where SurveyID=" & SurveyID)
    sql = "Create table PE_SurveyRecord" & SurveyID & " ("
    sql = sql & " RecordID Int IDENTITY(1,1),"
    sql = sql & " SurveyID Int,"
    If SystemDatabaseType = "SQL" Then
        sql = sql & " UserName [nvarchar](50),"
        sql = sql & " IP [nvarchar](20),"
    Else
        sql = sql & " UserName text(50),"
        sql = sql & " IP text(20),"
    End If
    Set rs = Conn.Execute("select QuestionID, QuestionType, ContentLength, InputType from PE_SurveyQuestion where SurveyID=" & SurveyID)
    Dim ItemWidth
    Do While Not rs.EOF
        If rs("QuestionType") <> 0 And rs("InputType") = 0 Then '没有“其它”选项的
            ItemWidth = 150
        ElseIf rs("QuestionType") <> 0 And rs("InputType") = 1 Then
            ItemWidth = 255
        ElseIf rs("QuestionType") = 0 Then
            ItemWidth = rs("ContentLength")
        End If
        If SystemDatabaseType = "SQL" Then
            If rs("InputType") = 2 Then
                sql = sql & " Q" & rs(0) & " ntext,"
            Else
                sql = sql & " Q" & rs(0) & " [nvarchar](" & ItemWidth & "),"
            End If
        Else
            If rs("InputType") = 2 Then
                sql = sql & " Q" & rs(0) & " Memo,"
            Else
                sql = sql & " Q" & rs(0) & " text(" & ItemWidth & "),"
            End If
        End If
        rs.MoveNext
    Loop
    sql = sql & " SubmitTime DateTime,"
    sql = sql & " Primary Key (RecordID)"
    sql = sql & " )"

    Conn.Execute (sql)

    If Err.Number <> 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>创建表失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
    End If

    Response.Redirect ("Admin_Survey.asp")
End Sub

Sub CreateSurvey()
    Dim SurveyHtml, FirstQID, sql, rs, i, j, rs1, Itemstr, strJS
    Dim HtmlTop, HtmlBottom, SurveyName, FileName, SurveyPassword
    SurveyID = PE_CLng(SurveyID)
    j = 1
    SurveyPassword = Conn.Execute("select SetPassword from PE_Survey where SurveyID=" & SurveyID)(0)

    If SurveyPassword <> "" Then
        SurveyHtml = "请输入问卷密码：<input type='password' name='SurveyPassword'><br><br>"
    End If

    'sql="select Q.QuestionID,Q.QuestionContent,Q.QuestionType,Q.InputType,A.AnswerID,A.AnswerContent from PE_SurveyQuestion Q left join PE_SurveyAnswer A on Q.QuestionID=A.QuestionID where Q.SurveyID=1 order by Q.QuestionID asc"
    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select QuestionID,QuestionContent,QuestionType,InputType,ContentLength from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
    rs.open sql, Conn, 1, 1
    Do While Not rs.EOF
        Itemstr = ""
        Select Case rs("QuestionType")
        Case 0
            If rs("InputType") = 1 Then
                SurveyHtml = SurveyHtml & j & "、" & rs("QuestionContent") & "<input type='text' MaxLength='" & rs("ContentLength") & "' name='Q" & rs("QuestionID") & "'><br><br>"
            Else
                SurveyHtml = SurveyHtml & j & "、" & rs("QuestionContent") & "<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<textarea name='Q" & rs("QuestionID") & "' cols='50' rows='5'></textarea><br><br>"
            End If
        Case 1
            SurveyHtml = SurveyHtml & j & "、" & rs("QuestionContent") & "<br>"
            i = 0
            Set rs1 = Server.CreateObject("adodb.recordset")
            rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            Do While Not rs1.EOF
                If i = 0 Then
                    Itemstr = "&nbsp;&nbsp;&nbsp;&nbsp;<input name='Q" & rs("QuestionID") & "' type='radio' value='" & rs1("AnswerID") & "'>" & rs1("AnswerContent") & "<br>"
                Else
                    Itemstr = Itemstr & "&nbsp;&nbsp;&nbsp;&nbsp;<input name='Q" & rs("QuestionID") & "' type='radio' value='" & rs1("AnswerID") & "'>" & rs1("AnswerContent") & "<br>"
                End If
                i = i + 1
                rs1.MoveNext
            Loop
            SurveyHtml = SurveyHtml & Itemstr & "<br>"
            Select Case rs("InputType")
            Case 0
            Case 1
                SurveyHtml = SurveyHtml & "<input type='text' name='QInput" & rs("QuestionID") & "' MaxLength='" & rs("ContentLength") & "'><br><br>"
            Case 2
                SurveyHtml = SurveyHtml & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<textarea name='QInput" & rs("QuestionID") & "' cols='50' rows='5'></textarea><br><br>"
            End Select
        Case 2
            SurveyHtml = SurveyHtml & j & "、" & rs("QuestionContent") & "<br>"
            i = 0
            Set rs1 = Server.CreateObject("adodb.recordset")
            rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            Do While Not rs1.EOF
                If i = 0 Then
                    Itemstr = "&nbsp;&nbsp;&nbsp;&nbsp;<input name='Q" & rs("QuestionID") & "' type='checkbox' value='" & rs1("AnswerID") & "'>" & rs1("AnswerContent") & "<br>"
                Else
                    Itemstr = Itemstr & "&nbsp;&nbsp;&nbsp;&nbsp;<input name='Q" & rs("QuestionID") & "' type='checkbox' value='" & rs1("AnswerID") & "'>" & rs1("AnswerContent") & "<br>"
                End If
                i = i + 1
                rs1.MoveNext
            Loop
            SurveyHtml = SurveyHtml & Itemstr & "<br>"
            Select Case rs("InputType")
            Case 0
            Case 1
                SurveyHtml = SurveyHtml & "<input type='text' name='QInput" & rs("QuestionID") & "' MaxLength='" & rs("ContentLength") & "'><br><br>"
            Case 2
                SurveyHtml = SurveyHtml & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<textarea name='QInput" & rs("QuestionID") & "' cols='50' rows='5'></textarea><br><br>"
            End Select
        Case 3
            SurveyHtml = SurveyHtml & j & "、" & rs("QuestionContent") & ":"
            i = 0
            Set rs1 = Server.CreateObject("adodb.recordset")
            rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            Do While Not rs1.EOF
                If i = 0 Then
                    Itemstr = "&nbsp;&nbsp;&nbsp;&nbsp;<option value='" & rs1("AnswerID") & "'>" & rs1("AnswerContent") & "</option>"
                Else
                    Itemstr = Itemstr & "&nbsp;&nbsp;&nbsp;&nbsp;<option value='" & rs1("AnswerID") & "'>" & rs1("AnswerContent") & "</option>"
                End If
                i = i + 1
                rs1.MoveNext
            Loop
            SurveyHtml = SurveyHtml & "<select name='Q" & rs("QuestionID") & "'>" & Itemstr & "</select><br><br>"
            Select Case rs("InputType")
            Case 0
            Case 1
                SurveyHtml = SurveyHtml & "<input type='text' name='QInput" & rs("QuestionID") & "' MaxLength='" & rs("ContentLength") & "'><br><br>"
            Case 2
                SurveyHtml = SurveyHtml & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<textarea name='QInput" & rs("QuestionID") & "' cols='50' rows='5'></textarea><br><br>"
            End Select
        End Select
        j = j + 1
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    SurveyName = Conn.Execute("select SurveyName from PE_Survey where SurveyID=" & SurveyID & "")(0)
    HtmlTop = ""
    HtmlTop = HtmlTop & "<form name='myform' method='post' action='../Survey/SaveSurvey.asp' onSubmit='return CheckForm();'>"
    HtmlTop = HtmlTop & "<DIV align=center>" & vbCrLf
    HtmlTop = HtmlTop & "<TABLE cellSpacing=0 cellPadding=0 width=100% border=0> " & vbCrLf
    HtmlTop = HtmlTop & "<TBODY> " & vbCrLf
    HtmlTop = HtmlTop & "<TR>   " & vbCrLf
    HtmlTop = HtmlTop & "<TD vAlign=top height=500>" & vbCrLf
    HtmlTop = HtmlTop & "<P align=center>" & SurveyName & "</P>" & vbCrLf
    HtmlBottom = ""
    HtmlBottom = HtmlBottom & "<input name='SurveyID' type='hidden' id='SurveyID' value='" & SurveyID & "'>" & vbCrLf
    HtmlBottom = HtmlBottom & "</TD></TR>" & vbCrLf
    HtmlBottom = HtmlBottom & "</TBODY></TABLE>" & vbCrLf
    HtmlBottom = HtmlBottom & "</DIV>    " & vbCrLf
    HtmlBottom = HtmlBottom & "<P align=center>" & vbCrLf
    If 1 = 0 Then
        HtmlBottom = HtmlBottom & "问卷密码" & vbCrLf
        HtmlBottom = HtmlBottom & "<INPUT type=password maxLength=20 size=12 name=surveypsw>" & vbCrLf
    End If
    HtmlBottom = HtmlBottom & " <INPUT type=submit value=提交问卷 name=Submit> " & vbCrLf
    HtmlBottom = HtmlBottom & "</P></form>" & vbCrLf
    SurveyHtml = HtmlTop & vbCrLf & SurveyHtml & vbCrLf & HtmlBottom
    SurveyHtml = Server.HTMLEncode(SurveyHtml)

    Dim TemplateID, TemplateHtml
    TemplateID = Conn.Execute("select TemplateID from PE_Survey Where SurveyID=" & SurveyID)(0)

    TemplateHtml = Conn.Execute("select TemplateContent from PE_Template where TemplateID=" & TemplateID)(0)

    TemplateHtml = Replace(TemplateHtml, "{$SurveyName}", SurveyName)
    TemplateHtml = Replace(TemplateHtml, "{$GetSurveyForm}", SurveyHtml)

    '客户端代码校正，同步
    Call Resumeblank

    Response.Write "<br>"
    Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' Class='border'>"
    Response.Write "<form name='form1' method='post' onSubmit='return CheckForm();' action='" & strFileName & "?Action=CreateHtml'>"
    Response.Write "  <tr class='title'>"
    Response.Write "    <td height='22' class='title' align=center><b>创 建 问 卷</b></td>"
    Response.Write "  </tr>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td>"
    Response.Write "    <tr class='tdbg' id=showAlgebra>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "       <table>" & vbCrLf
    Response.Write "        <tr>" & vbCrLf
    Response.Write "          <td>" & vbCrLf
    Response.Write "           <table width='100%'>" & vbCrLf
    Response.Write "            <tr><td width='20'></td>" & vbCrLf
    Response.Write "             <td>" & vbCrLf
    Response.Write "             <textarea name='SurveyContent' id='SurveyContent' style='display:' ROWS='30' COLS='117'  class='txt_main'>" & TemplateHtml & "</textarea>"
    Response.Write "            </td></tr>" & vbCrLf
    Response.Write "           </table>" & vbCrLf
    Response.Write "          </td>" & vbCrLf
    Response.Write "       </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' id=showeditor style='display:none'>" & vbCrLf
    Response.Write "      <td valign='top'>" & vbCrLf
    Response.Write "        <table >" & vbCrLf
    Response.Write "         <tr>" & vbCrLf
    Response.Write "          <td width='20'></td>" & vbCrLf
    Response.Write "           <td>" & vbCrLf
    Response.Write "            <textarea name='SurveyEditContent' id='SurveyEditContent' style='display:none'>" & TemplateHtml & "</textarea>"
    Response.Write "            <iframe ID='editor' src='../editor.asp?ChannelID=" & SurveyTemplateChannelID & "&ShowType=1&TemplateType=1&ShowTypeVote=1&tContentid=SurveyEditContent' frameborder='1' scrolling='no' width='790' height='400'></iframe>" & vbCrLf
    Response.Write "           </td>" & vbCrLf
    Response.Write "         </tr>" & vbCrLf
    Response.Write "        </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' >"
    Response.Write "     <td>"
    Response.Write "      <table>"
    Response.Write "        <tr>"
    Response.Write "          <td width='95%'>&nbsp;&nbsp;&nbsp;&nbsp;"
    Response.Write "            <input name='EditorAlgebra' type='button' id='EditorAlgebra' value=' 代码模式 '  onclick='LoadEditorAlgebra();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input name='EditorEdit' type='button' id='EditorEdit' value=' 编辑模式 ' disabled onclick='LoadEditorEdit();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input TYPE='hidden' Name='EditorMix' id='EditorMix' value=''>"
    Response.Write "          </td>"
    Response.Write "         </tr>"
    Response.Write "      </table>"
    Response.Write "    </td>"
    Response.Write "  </tr>"
    Dim ExeFileName, ShortFileName
    FileName = Conn.Execute("select FileName from PE_Survey where SurveyID= " & SurveyID & "")(0)
    If IsNull(FileName) Then
        FileName = Year(Now()) & Right("0" & Month(Now()), 2) & Right("0" & Day(Now()), 2) & Right("0" & Minute(Now()), 2) & Right("0" & Second(Now()), 2) & ".html"
    End If
    ShortFileName = Left(FileName, InStr(FileName, ".") - 1)
    ExeFileName = Right(FileName, Len(FileName) - InStr(FileName, "."))
    Response.Write "        <tr class='tdbg'>"
    Response.Write "          <td width='95%'>&nbsp;&nbsp;&nbsp;&nbsp;"
    Response.Write "            页面类型：  <input name='FileType' type='radio' id='FileType' value=0 onclick=""FileName.value='" & ShortFileName & ".html';"""
    If ExeFileName = "html" Then Response.Write " Checked"
    Response.Write ">静态页&nbsp;&nbsp;"
    Response.Write "            <input name='FileType' type='radio' id='FileType' value=1  onclick=""FileName.value='" & ShortFileName & ".asp';"""
    If ExeFileName = "asp" Then Response.Write " Checked"
    Response.Write ">动态页"
    Response.Write "          </td>"
    Response.Write "         </tr>"
    
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td height='22' align='left'>"

    Response.Write "       &nbsp;&nbsp;&nbsp;&nbsp; 问卷文件名：&nbsp;&nbsp;&nbsp;&nbsp;<input name='FileName' id='FileName' value='" & FileName & "'>"
    Response.Write "  </td></tr>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td height='22' align=center>"
    Response.Write "        <input name='SurveyID' type='hidden' id='SurveyID' value='" & SurveyID & "'><input name='Create' type='submit'  id='Create' value='创建问卷文件' onClick='return CheckForm();' style='cursor:hand;'>"
    Response.Write "  </td></tr>"
    Response.Write "</form></table>"
End Sub

Sub EditSurvey()
    Dim SurveyHtml, strJS
    Dim HtmlTop, HtmlBottom, SurveyName, FileName, FileContent
    SurveyID = PE_CLng(SurveyID)

    SurveyHtml = ""
    FileName = Conn.Execute("select FileName from PE_Survey where SurveyID= " & SurveyID & "")(0)
    If IsNull(FileName) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>数据库无对应的文件名！！</li>"
        Exit Sub
    End If
    If Not fso.FileExists(Server.MapPath("../Survey/" & FileName)) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>不存在文件文件：../Survey/" & FileName & "！！</li>"
        Exit Sub
    Else
       SurveyHtml = ReadFileContent("../Survey/" & FileName)
    End If


    SurveyHtml = PE_ConvertBR(PE_HTMLEncode(SurveyHtml))

    '客户端代码校正，同步
    Call Resumeblank

    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' Class='border'>"
    Response.Write "  <form name='form1' method='post' onSubmit='return CheckForm();' action='" & strFileName & "?Action=SaveEditHtml'>"
    Response.Write "  <tr class='title'>"
    Response.Write "    <td height='22' class='title' align=center><b>编 辑 页 面</b></td>"
    Response.Write "  </tr>"
    Response.Write "    <tr class='tdbg' id=showAlgebra>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "       <table>" & vbCrLf
    Response.Write "        <tr>" & vbCrLf
    Response.Write "          <td>" & vbCrLf
    Response.Write "           <table width='100%'>" & vbCrLf
    Response.Write "            <tr><td width='20'></td>" & vbCrLf
    Response.Write "             <td>" & vbCrLf
    Response.Write "             <textarea name='SurveyContent' id='SurveyContent' style='display:' ROWS='30' COLS='117'  class='txt_main'>" & SurveyHtml & "</textarea>"
    Response.Write "            </td></tr>" & vbCrLf
    Response.Write "           </table>" & vbCrLf
    Response.Write "          </td>" & vbCrLf
    Response.Write "       </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' id=showeditor style='display:none'>" & vbCrLf
    Response.Write "      <td valign='top'>" & vbCrLf
    Response.Write "        <table >" & vbCrLf
    Response.Write "         <tr>" & vbCrLf
    Response.Write "          <td width='20'></td>" & vbCrLf
    Response.Write "           <td>" & vbCrLf
    Response.Write "            <textarea name='SurveyEditContent' id='SurveyEditContent' style='display:none'>" & SurveyHtml & "</textarea>"
    Response.Write "            <iframe ID='editor' src='../editor.asp?ChannelID=" & SurveyTemplateChannelID & "&ShowType=1&TemplateType=1&ShowTypeVote=1&tContentid=SurveyEditContent' frameborder='1' scrolling='no' width='790' height='400'></iframe>" & vbCrLf
    Response.Write "           </td>" & vbCrLf
    Response.Write "         </tr>" & vbCrLf
    Response.Write "        </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' >"
    Response.Write "     <td>"
    Response.Write "      <table>"
    Response.Write "        <tr>"
    Response.Write "          <td width='95%'>&nbsp;&nbsp;&nbsp;&nbsp;"
    Response.Write "            <input name='EditorAlgebra' type='button' id='EditorAlgebra' value=' 代码模式 '  onclick='LoadEditorAlgebra();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input name='EditorEdit' type='button' id='EditorEdit' value=' 编辑模式 ' disabled onclick='LoadEditorEdit();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input TYPE='hidden' Name='EditorMix' id='EditorMix' value=''>"
    Response.Write "          </td>"
    Response.Write "         </tr>"
    Response.Write "      </table>"
    Response.Write "    </td>"
    Response.Write "  </tr>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td height='22' align='left'>"

    Response.Write "       &nbsp;&nbsp;&nbsp;&nbsp; 问卷文件名：&nbsp;&nbsp;&nbsp;&nbsp;" & FileName
    Response.Write "  <input name='FileName' type='hidden'  id='FileName' value='" & FileName & "'></td></tr>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td height='22' align=center>"
    Response.Write "        <input name='Create' type='submit'  id='Create' value='保存修改'  onClick='return CheckForm();' style='cursor:hand;'>"
    Response.Write "  </td></tr>"
    Response.Write "</form></table>"
End Sub

Sub SaveEditHtml()
    Dim SurveyContent, FileName, DelFile
    FileName = ReplaceBadChar(Trim(Request.Form("FileName")))
    SurveyContent = PE_HtmlDecode(Request.Form("SurveyContent"))
    If fso.FileExists(Server.MapPath("../Survey/" & FileName)) Then
        Set DelFile = fso.GetFile(Server.MapPath("../Survey/" & FileName))
        DelFile.Delete
    End If
    Call WriteToFile("../Survey/" & FileName, SurveyContent)
    Call WriteSuccessMsg("编辑页面成功!保存在../Survey/" & FileName, ComeUrl)
End Sub

Sub CreateHtml()
    Dim SurveyContent, FileName, SurveyID, FileJs, CheckCode
    Dim rs, sql, Num
    SurveyID = PE_Clng(Request.Form("SurveyID"))
    FileName = ReplaceBadChar(Trim(Request.Form("FileName")))
    FileJs = ""
    Num = Conn.Execute("select Count(*) from PE_Survey where FileName='" & FileName & "'")(0)
    If Num > 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>已存在相同的问卷名！请指定另外的文件名。</li>"
        Exit Sub
    End If
    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select QuestionID,QuestionContent,QuestionType,InputType,NotEmpty,ContentLength,DataRight from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
    rs.open sql, Conn, 1, 1
    Do While Not rs.EOF
        FileJs = FileJs & GetFormJs(rs("QuestionID"), rs("QuestionContent"), rs("QuestionType"), rs("NotEmpty"), rs("DataRight"), rs("InputType"))
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    If Trim(Request.Form("FileType")) = 1 Then
        CheckCode = CheckCode & "<!--#include file=""../Start.asp""-->" & vbCrLf
        CheckCode = CheckCode & "<" & "%" & vbCrLf
        CheckCode = CheckCode & "    Dim ExitIP, SurveyPassword, rsSurvey" & vbCrLf
        CheckCode = CheckCode & "    Call IsSurveyIPlock " & vbCrLf
        CheckCode = CheckCode & "    SurveyPassword = ReplaceBadChar(Trim(Request.form(""SurveyPassword"")))" & vbCrLf
        CheckCode = CheckCode & "    Set rsSurvey = Conn.Execute(""select IsOpen, EndTime, IPRepeat, SetPassword from PE_Survey where SurveyID=" & SurveyID & """)" & vbCrLf
        CheckCode = CheckCode & "    If rsSurvey(0) = 0 Then" & vbCrLf
        CheckCode = CheckCode & "        FoundErr = True" & vbCrLf
        CheckCode = CheckCode & "        ErrMsg = ErrMsg & ""<br><li>问卷调查尚未启用！！！</li>""" & vbCrLf
        CheckCode = CheckCode & "    End If" & vbCrLf
        CheckCode = CheckCode & "    If IsDate(rsSurvey(1)) And rsSurvey(1) < Now() Then" & vbCrLf
        CheckCode = CheckCode & "        FoundErr = True" & vbCrLf
        CheckCode = CheckCode & "        ErrMsg = ErrMsg & ""<br><li>问卷调查已经结束！！！</li>""" & vbCrLf
        CheckCode = CheckCode & "    End If" & vbCrLf
        CheckCode = CheckCode & "    If rsSurvey(2) <= Conn.Execute(""select count(IP) from PE_SurveyRecord" & SurveyID & " where IP='"" & UserTrueIP & ""' and SurveyID=" & SurveyID & """)(0) Then" & vbCrLf
        CheckCode = CheckCode & "        FoundErr = True" & vbCrLf
        CheckCode = CheckCode & "        ErrMsg = ErrMsg & ""<br><li>同一用户不允许填写问卷调查超过"" & rsSurvey(2) & ""次！！！</li>""" & vbCrLf
        CheckCode = CheckCode & "    End If" & vbCrLf
        CheckCode = CheckCode & "    Set rsSurvey = Nothing" & vbCrLf
        CheckCode = CheckCode & "    If FoundErr = True Then" & vbCrLf
        CheckCode = CheckCode & "        Response.Write ErrMsg" & vbCrLf
        CheckCode = CheckCode & "        Response.End" & vbCrLf
        CheckCode = CheckCode & "    End If" & vbCrLf

        CheckCode = CheckCode & "Sub IsSurveyIPlock()" & vbCrLf
        CheckCode = CheckCode & "    Dim LockIP, LockIPType, rs" & vbCrLf
        CheckCode = CheckCode & "    Set rs=conn.execute(""select * from PE_Survey where SurveyID=" & SurveyID & """)" & vbCrLf
        CheckCode = CheckCode & "    LockIPType = rs(""LockIPType"")" & vbCrLf
        CheckCode = CheckCode & "    LockIP = rs(""SetIPLock"")" & vbCrLf
        CheckCode = CheckCode & "" & vbCrLf
        CheckCode = CheckCode & "    UserTrueIP = Request.ServerVariables(""HTTP_X_FORWARDED_FOR"")" & vbCrLf
        CheckCode = CheckCode & "    If UserTrueIP = """" Then UserTrueIP = Request.ServerVariables(""REMOTE_ADDR"")" & vbCrLf
        CheckCode = CheckCode & "    If session(""SurveyIPlock"") = """" Then" & vbCrLf
        CheckCode = CheckCode & "        session(""SurveyIPlock"") = ChecKIPlock(LockIPType, LockIP, UserTrueIP)" & vbCrLf
        CheckCode = CheckCode & "    End If" & vbCrLf
        CheckCode = CheckCode & "    If session(""SurveyIPlock"") = True Then" & vbCrLf
        CheckCode = CheckCode & "        Response.Write ""对不起！您的IP（"" & UserTrueIP & ""）被系统限定。您可以和站长联系。""" & vbCrLf
        CheckCode = CheckCode & "        Response.End" & vbCrLf
        CheckCode = CheckCode & "    End If" & vbCrLf
        CheckCode = CheckCode & "End Sub" & vbCrLf

        CheckCode = CheckCode & " %" & ">" & vbCrLf

        SurveyContent = SurveyContent & CheckCode
    End If

    FileJs = "<script language='javascript'>" & vbCrLf & "function CheckForm(){" & vbCrLf & "flag=true;" & vbCrLf & FileJs & vbCrLf & "return flag }</script>"
    SurveyContent = SurveyContent & Replace(Request("SurveyContent"), "{$SurveyJS}", FileJs)
    If Not fso.FolderExists(Server.MapPath("../Survey")) Then
        fso.CreateFolder Server.MapPath("../Survey")
    End If

    Call WriteToFile("../Survey/" & FileName, SurveyContent)
    Conn.Execute ("update PE_Survey Set FileName='" & FileName & "' where SurveyID= " & SurveyID & "")
    Call WriteSuccessMsg("创建页面成功!保存在../Survey/" & FileName, ComeUrl)
End Sub
 

Function WriteSuccessMsg(sSuccessMsg, sComeUrl)
    Dim QuestionType
    QuestionType = PE_CLng(Request("QuestionType"))
    Response.Write "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    Response.Write "<link href='images/Style.css' rel='stylesheet' type='text/css'></head><body><br><br>" & vbCrLf
    Response.Write "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    Response.Write "  <tr align='center' class='title'><td height='22'><strong>恭喜你！</strong></td></tr>" & vbCrLf
    Response.Write "  <tr class='tdbg'><td height='100' valign='top'><br>" & sSuccessMsg & "</td></tr>" & vbCrLf
    Response.Write "  <tr align='center' class='tdbg'><td>"
    If sComeUrl <> "" Then
        Select Case Action
        Case "SaveAddSurvey"
            Response.Write "<a href='" & sComeUrl & "'>&lt;&lt; 返回问卷列表</a>"
        Case "SaveAddQuestion"
            Response.Write "<a href='" & sComeUrl & "'>&lt;&lt; 返回题目列表</a>"
        Case "SaveAddTemplate", "SaveModifyTemplate"
            Response.Write "<a href='" & sComeUrl & "'>&lt;&lt; 返回问卷模板管理</a>"
        Case Else
            Response.Write "<a href='" & sComeUrl & "'>&lt;&lt; 返回上一页</a>"
        End Select
    Else
        Response.Write "<a href='javascript:window.close();'>【关闭】</a>"
    End If
    If Action = "SaveAddSurvey" Then
        Response.Write "<a href=Admin_Survey.asp?Action=AddQuestion&SurveyID=" & SurveyID & "> &nbsp;&nbsp;&nbsp;&nbsp;添加题目</a>"
    End If
    Response.Write "</td></tr>" & vbCrLf
    Response.Write "</table>" & vbCrLf
    Response.Write "</body></html>" & vbCrLf
End Function

Function GetFormJs(QuestionID, QuestionContent, QuestionType, NotEmpty, DataRight, InputType)
    Dim tempFormJs, ProblemName, OtherName
    tempFormJs = ""
    ProblemName = "Q" & QuestionID
    OtherName = "QInput" & QuestionID
    If NotEmpty = 1 Then
        Select Case QuestionType
        Case 0
            tempFormJs = tempFormJs & "if (document.myform." & ProblemName & ".value=='')" & vbCrLf
            tempFormJs = tempFormJs & "{flag=false;" & vbCrLf
            tempFormJs = tempFormJs & "alert('" & QuestionContent & "不能为空');" & vbCrLf
            tempFormJs = tempFormJs & "document.myform." & ProblemName & ".focus();" & vbCrLf
            tempFormJs = tempFormJs & "return flag}" & vbCrLf
        Case 1
            tempFormJs = tempFormJs & "var Input1=false" & vbCrLf
            tempFormJs = tempFormJs & "for (i=0;i<document.myform." & ProblemName & ".length;i++) " & vbCrLf
            tempFormJs = tempFormJs & "{Input1=Input1||document.myform." & ProblemName & "[i].checked;} " & vbCrLf
            tempFormJs = tempFormJs & "if (Input1==false){alert('请选择" & QuestionContent & "');" & vbCrLf
            tempFormJs = tempFormJs & "document.myform." & ProblemName & "[0].focus();" & vbCrLf
            tempFormJs = tempFormJs & "return Input1};" & vbCrLf
        Case 2
            tempFormJs = tempFormJs & "var Input2=false" & vbCrLf
            tempFormJs = tempFormJs & "for (i=0;i<document.myform." & ProblemName & ".length;i++) " & vbCrLf
            tempFormJs = tempFormJs & "{Input2=Input2||document.myform." & ProblemName & "[i].checked;} " & vbCrLf
            tempFormJs = tempFormJs & "document.myform." & ProblemName & "[0].focus();" & vbCrLf
            tempFormJs = tempFormJs & "if (Input2==false){alert('请选择" & QuestionContent & "');" & vbCrLf
            tempFormJs = tempFormJs & "return Input2};" & vbCrLf
        Case 3
            tempFormJs = tempFormJs & "if (document.myform." & ProblemName & ".selectedIndex==-1)" & vbCrLf
            tempFormJs = tempFormJs & "{flag=false;alert('请选择" & QuestionContent & "');" & vbCrLf
            tempFormJs = tempFormJs & "document.myform." & ProblemName & ".focus();return flag}" & vbCrLf
        End Select
        If InputType = 2 Then
            tempFormJs = tempFormJs & "if (document.myform." & OtherName & ".value.length>100)" & vbCrLf
            tempFormJs = tempFormJs & "{flag=false;alert('填写的内容过长');" & vbCrLf
            tempFormJs = tempFormJs & "document.myform." & OtherName & ".focus();return flag}" & vbCrLf
        End If
    End If
    If DataRight = 1 Then
        tempFormJs = tempFormJs & "if (isNaN(myform." & ProblemName & ".value))" & vbCrLf
        tempFormJs = tempFormJs & "{alert('请用数字填写" & QuestionContent & "');" & vbCrLf
        tempFormJs = tempFormJs & "flag=false;" & vbCrLf
        tempFormJs = tempFormJs & "document.myform." & ProblemName & ".focus();" & vbCrLf
        tempFormJs = tempFormJs & "return flag}" & vbCrLf
    End If
    If DataRight = 2 Then
        tempFormJs = tempFormJs & "if (myform." & ProblemName & ".value!='')  " & vbCrLf
        tempFormJs = tempFormJs & "{if (myform." & ProblemName & ".value.length<6)  {" & vbCrLf
        tempFormJs = tempFormJs & "flag=false;" & vbCrLf
        tempFormJs = tempFormJs & "alert('您所填的Email太短！');" & vbCrLf
        tempFormJs = tempFormJs & "document.myform." & ProblemName & ".focus();" & vbCrLf
        tempFormJs = tempFormJs & "return flag}" & vbCrLf
        tempFormJs = tempFormJs & "if (myform." & ProblemName & ".value.indexOf('@')==-1||myform." & ProblemName & ".value.indexOf('.')==-1)" & vbCrLf
        tempFormJs = tempFormJs & "{flag=false;" & vbCrLf
        tempFormJs = tempFormJs & "alert('Email格式有问题,是否包含了@和.');" & vbCrLf
        tempFormJs = tempFormJs & "document.myform." & ProblemName & ".focus();" & vbCrLf
        tempFormJs = tempFormJs & "return flag}}" & vbCrLf
    End If

    GetFormJs = tempFormJs
End Function

Sub ShowCountData1()
    Dim SurveyID, rs, sql, Rs2, TotalNum, rs1, j, IsOpen, SurveyName
    SurveyID = PE_CLng(Trim(Request("SurveyID")))
    If SurveyID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>请指定问卷ID！！！</li>"
        Exit Sub
    End If

    If AdminPurview <> 1 And arrPurview(3) = False Then
            Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
            Response.Write "<tr><td align='center'>您无查看调查结果的权限！</td></tr></table>"
            Exit Sub
    End If

    Set IsOpen = Conn.Execute("select IsOpen,SurveyName From PE_Survey where SurveyID=" & SurveyID & "")
    If IsOpen.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在！！！</li>"
        Exit Sub
    ElseIf IsOpen(0) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷未启用，无统计数据！！！</li>"
        Exit Sub
    Else
        SurveyName = IsOpen(1)
    End If
    j = 1
    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select QuestionID,QuestionContent,QuestionType,InputType from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
    rs.open sql, Conn, 1, 1
    If rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在题目！！！</li>"
        Exit Sub
    End If

    Do While Not rs.EOF
        Select Case rs("QuestionType")
        Case 0
            Response.Write "<table width='100%'>"
            Response.Write "  <tr>"
            If rs("InputType") = 1 Then
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（单行输入）<a title='[" & rs("QuestionContent") & "]的回答详情' href='Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rs("QuestionID") & "'>" & rs("QuestionContent") & "</a></td>"
            Else
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（多行输入）<a title='[" & rs("QuestionContent") & "]的回答详情' href='Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rs("QuestionID") & "'>" & rs("QuestionContent") & "</a></td>"
            End If
            
            Response.Write "  </tr>"
            Response.Write "</table>"
            Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
            Select Case rs("InputType")
            Case 0
            Case 1, 2
                Set Rs2 = Server.CreateObject("adodb.recordset")
                Rs2.open "Select InputContent From PE_SurveyInput Where QuestionID=" & rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
                If Rs2.EOF Or Rs2.BOF Then
                Else
                    Response.Write "  <tr class='tdbg'>"
                    Response.Write "    <td>"
                    Response.Write "<a href='Admin_Survey.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "'>内容</a>"
                    Response.Write "    </td>"
                    Response.Write "  </tr>"
                End If
                Rs2.Close
                Set Rs2 = Nothing
            End Select
            Response.Write "</table><br>"
        Case 1, 2, 3
            TotalNum = 0
            Set rs1 = Server.CreateObject("adodb.recordset")
            rs1.open "select VoteAmount from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            Do While Not rs1.EOF
                TotalNum = TotalNum + rs1(0)
                rs1.MoveNext
            Loop
            rs1.Close
            Response.Write "<table width='100%'>"
            Response.Write "  <tr>"
            Select Case rs("QuestionType")
            Case 1
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（单选）<a title='[" & rs("QuestionContent") & "]的回答详情' href='Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rs("QuestionID") & "'>" & rs("QuestionContent") & "</a></td>"
            Case 2
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（多选）<a title='[" & rs("QuestionContent") & "]的回答详情' href='Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rs("QuestionID") & "'>" & rs("QuestionContent") & "</a></td>"
            Case 3
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（下拉选框）<a title='[" & rs("QuestionContent") & "]的回答详情' href='Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & rs("QuestionID") & "'>" & rs("QuestionContent") & "</a></td>"
            End Select
            Response.Write "  </tr>"
            Response.Write "</table>"
            Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
            rs1.open "select AnswerContent,VoteAmount from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            If rs1.BOF And rs1.EOF Then
                Response.Write "  <tr class=title>"
                Response.Write "    <td nowrap>"
                Response.Write "<li>系统中无数据！"
                Response.Write "    </td>"
                Response.Write "  </tr>"
            Else
                Response.Write "  <tr class=title>"
                Response.Write "    <td align=center width='45%' nowrap>选项</td>"
                Response.Write "    <td align=left width='10%' nowrap>票数</td>"
                Response.Write "    <td align=left width='15%' nowrap>百分比</td>"
                Response.Write "    <td align=left width='30%' nowrap>图示</td>"
                Response.Write "  </tr>"
                Do While Not rs1.EOF
                    Response.Write "  <tr class='tdbg'>"
                    Response.Write "    <td align=left nowrap>"
                    Response.Write Left(rs1(0), 40)
                    Response.Write "    </td>"
                    If rs1(1) = 0 Then
                        Response.Write "    <td align=left >" & rs1(1) & "</td>"
                        Response.Write "    <td align=left >0</td>"
                        Response.Write "    <td align=left ></td>"
                    Else
                        Response.Write "    <td align=left >" & rs1(1) & "</td>"
                        Response.Write "    <td align=left >" & FormatNumber(Int(rs1(1) / TotalNum * 10000) / 100, 2, -1) & "%</td>"
                        Response.Write "    <td align=left ><img src='../Images/bar.gif' width='" & rs1(1) / TotalNum * 220 & "' height='12'></td>"
                    End If

                    Response.Write "  </tr>"
                    rs1.MoveNext
                Loop
            End If
            rs1.Close
            Set rs1 = Nothing

            Select Case rs("InputType")
            Case 0
            Case 1, 2
                Set Rs2 = Server.CreateObject("adodb.recordset")
                Rs2.open "Select InputContent From PE_SurveyInput Where QuestionID=" & rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
                If Rs2.EOF Or Rs2.BOF Then
                Else
                    Response.Write "  <tr>"
                    Response.Write "    <td class='tdbg' colspan='4'>"
                    If rs("InputType") = 1 Then
                        Response.Write "<a href='Admin_Survey.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "'>"
                        Response.Write " （单行输入）内容</a></td>"
                    Else
                        Response.Write "<a href='Admin_Survey.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "'>"
                        Response.Write " （多行输入）内容</a></td>"
                    End If
                    Response.Write "    </td>"
                    'Response.Write "    <td colspan='3'>"
                    'Response.Write Rs2(0)
                    'Response.Write "    </td>"
                    Response.Write "  </tr>"
                End If
                Rs2.Close
                Set Rs2 = Nothing
            End Select
            Response.Write "</table><br>"
        End Select
        j = j + 1
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Response.Write "<br>"
End Sub

Sub ShowCountData2()
    Dim SurveyID, rs, sql, Rs2, sql2, TotalNum, rs1, j, IsOpen, IP, Answer, SubmitTime
    Dim SurveyHtml, Itemstr, m, SurveyName
    MaxPerPage = 1
    SurveyID = PE_CLng(Trim(Request("SurveyID")))
    'If RecordID=0 Then
    'response.write "select min(RecordID) from PE_SurveyRecord SurveyID=" & SurveyID
    'response.end
        'Set RecordIDMin=Conn.Execute("select min(RecordID) from PE_SurveyRecord where SurveyID=" & SurveyID & "")
        'If RecordIDMin.Eof Then
            'FoundErr = True
            'ErrMsg = ErrMsg & "<br><li>指定的问卷无统计数据！！！</li>"
            'Exit Sub
        'Else
            'RecordID=RecordIDMin(0)
        'End If
        'Set RecordIDMin=Nothing
    'End If
    If SurveyID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>请指定问卷ID！！！</li>"
        Exit Sub
    End If

    If AdminPurview <> 1 And arrPurview(3) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无查看调查结果的权限！</td></tr></table>"
        Exit Sub
    End If

    Set IsOpen = Conn.Execute("select IsOpen,SurveyName From PE_Survey where SurveyID=" & SurveyID & "")
    If IsOpen.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在！！！</li>"
        Exit Sub
    ElseIf IsOpen(0) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷未启用，无统计数据！！！</li>"
        Exit Sub
    Else
        SurveyName = IsOpen(1)
    End If
    j = 1
    Set Rs2 = Server.CreateObject("adodb.recordset")
    sql2 = "select * from PE_SurveyRecord" & SurveyID & " order by RecordID asc"
    Rs2.open sql2, Conn, 1, 1
    If Rs2.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷无统计数据！！！</li>"
        Exit Sub
    Else
        Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;<B>[</B><font color=red>" & SurveyName & "</font><B>]</B>&nbsp;调查结果"
        Response.Write "</td></tr></table>"
        Dim totalPut, VisitorNum
        totalPut = Rs2.RecordCount
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                Rs2.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        VisitorNum = 0
        Do While Not Rs2.EOF
            IP = Rs2("IP")
            SubmitTime = Rs2("SubmitTime")
            Dim counta, countb, countc
            j = 1
            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' colspan='2' align='center'><strong>卡片式查看</strong></td>"
            Response.Write "    </tr>"
            Response.Write "<tr class='tdbg'><td width='250' align='right' class='tdbg5'>IP：</td><td>" & IP & "</td></tr>"
            Response.Write "<tr class='tdbg'><td width='250' align='right' class='tdbg5'>提交时间：</td><td>" & SubmitTime & "</td></tr>"
            Set rs = Server.CreateObject("adodb.recordset")
            sql = "select QuestionID,QuestionContent,QuestionType,InputType from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
            rs.open sql, Conn, 1, 1
            Do While Not rs.EOF
                Itemstr = ""
                Select Case rs("QuestionType")
                Case 0
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td><td>" & Rs2("Q" & rs("QuestionID")) & "</td></tr>"
                Case 1
                    Answer = Split(Rs2("Q" & rs("QuestionID")), "$$")
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td>"
                    Set rs1 = Server.CreateObject("adodb.recordset")
                    rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " and AnswerID=" & Answer(0), Conn, 1, 1
                    If Not rs1.EOF Then
                        Response.Write "<td>" & rs1("AnswerContent") & "</td></tr>"
                    Else
                        Response.Write "<td></td></tr>"
                    End If

                    Select Case rs("InputType")
                    Case 0

                    Case 1, 2
                        Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'>填空：</td><td>" & Answer(1) & "</td></tr>"
                    End Select
                Case 2
                    m = 0
                    Answer = Split(Rs2("Q" & rs("QuestionID")) & "$$", "$$")
					If IsValidID(Answer(0)) = False Then
						Answer(0) = ""
					End If
                    If Answer(0) = "" Then Answer(0) = "0"
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td><td>"
                    Set rs1 = Server.CreateObject("adodb.recordset")
                    rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " and AnswerID in (" & Answer(0) & ") order by OrderID asc", Conn, 1, 1
                    Do While Not rs1.EOF
                        If m = 0 Then
                            Itemstr = rs1("AnswerContent")
                        Else
                            Itemstr = Itemstr & "&nbsp;&nbsp;&nbsp;&nbsp;" & rs1("AnswerContent")
                        End If
                        m = m + 1
                        rs1.MoveNext
                    Loop
                    Response.Write Itemstr & "</td></tr>"
                    Select Case rs("InputType")
                    Case 0
                    Case 1, 2
                        Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'>填空：</td><td>" & Answer(1) & "</td></tr>"
                    End Select
                Case 3
                    Answer = Split(Rs2("Q" & rs("QuestionID")), "$$")
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td>"
                    Set rs1 = Server.CreateObject("adodb.recordset")

                    rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " and AnswerID=" & Answer(0), Conn, 1, 1
                    If Not rs1.EOF Then
                        Response.Write "<td>" & rs1("AnswerContent") & "</td></tr>"
                    Else
                        Response.Write "<td></td></tr>"
                    End If
                    Select Case rs("InputType")
                    Case 0
                    Case 1, 2
                        Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'>填空：</td><td>" & Answer(1) & "</td></tr>"
                    End Select
                End Select
                j = j + 1
                rs.MoveNext
            Loop
            rs.Close
            Set rs = Nothing
            VisitorNum = VisitorNum + 1
            If VisitorNum >= 1 Then Exit Do
            Rs2.MoveNext
        Loop
    End If
    Rs2.Close
    Set Rs2 = Nothing
    Response.Write SurveyHtml & "</table><br>"
    If totalPut > 0 Then
        Response.Write ShowPagevote("Admin_Survey.asp?Action=ShowCountData2&SurveyID=" & SurveyID, totalPut, 1, CurrentPage, True, "条记录")
    End If
End Sub

Sub ShowCountData3()
    Dim SurveyID, rs, sql, Rs2, sql2, TotalNum, rs1, j, IsOpen, IP, Answer, SubmitTime
    Dim SurveyHtml, Itemstr, i, m, SurveyName
    If MaxPerPage < 90 Then MaxPerPage = 90
    SurveyID = PE_CLng(Trim(Request("SurveyID")))

    If SurveyID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>请指定问卷ID！！！</li>"
        Exit Sub
    End If

    If AdminPurview <> 1 And arrPurview(3) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无查看调查结果的权限！</td></tr></table>"
        Exit Sub
    End If

    Set IsOpen = Conn.Execute("select IsOpen,SurveyName From PE_Survey where SurveyID=" & SurveyID & "")
    If IsOpen.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在！！！</li>"
        Exit Sub
    ElseIf IsOpen(0) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷未启用，无统计数据！！！</li>"
        Exit Sub
    Else
        SurveyName = IsOpen(1)
    End If
    j = 1
    Set Rs2 = Server.CreateObject("adodb.recordset")
    sql2 = "select RecordID, IP from PE_SurveyRecord" & SurveyID & " order by RecordID asc"
    Rs2.open sql2, Conn, 1, 1
    If Rs2.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷无统计数据！！！</li>"
        Exit Sub
    Else
        Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;<B>[</B><font color=red>" & SurveyName & "</font><B>]</B>&nbsp;列表查看"
        Response.Write "</td></tr></table>"
        Dim totalPut, VisitorNum
        totalPut = Rs2.RecordCount
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                Rs2.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        VisitorNum = 1
        Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border' align='center'><tr>"
        Do While Not Rs2.EOF
            Response.Write "<td><a href='Admin_Survey.asp?Action=UserFormDetail&SurveyID=" & SurveyID & "&RecordID=" & Rs2("RecordID") & "'>"
            Response.Write Rs2("IP")
            Response.Write "</a></td>"
            If j Mod 6 = 0 Then Response.Write "</tr><tr>"
            j = j + 1
            If VisitorNum >= MaxPerPage Then Exit Do
            VisitorNum = VisitorNum + 1
            Rs2.MoveNext
        Loop
    End If
    Rs2.Close
    Set Rs2 = Nothing
    Response.Write SurveyHtml & "</tr></table><br>"
    If totalPut > 0 Then
        Response.Write ShowPage("Admin_Survey.asp?Action=ShowCountData3&SurveyID=" & SurveyID, totalPut, MaxPerPage, CurrentPage, True, True, "条记录", True)
    End If
End Sub

Sub ShowCountData4()
     Dim SurveyID, rs, sql, Rs2, TotalNum, rs1, j, IsOpen, SurveyName
    SurveyID = PE_CLng(Trim(Request("SurveyID")))
    If SurveyID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>请指定问卷ID！！！</li>" & vbCrLf
        Exit Sub
    End If

    If AdminPurview <> 1 And arrPurview(3) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无查看调查结果的权限！</td></tr></table>"
        Exit Sub
    End If

    Set IsOpen = Conn.Execute("select IsOpen,SurveyName From PE_Survey where SurveyID=" & SurveyID & "")
    If IsOpen.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在！！！</li>" & vbCrLf
        Exit Sub
    ElseIf IsOpen(0) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷未启用，无统计数据！！！</li>" & vbCrLf
        Exit Sub
    Else
        SurveyName = IsOpen(1)
    End If
    j = 1
    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select QuestionID,QuestionContent,QuestionType,InputType from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
    rs.open sql, Conn, 1, 1
    If rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在题目！！！</li>" & vbCrLf
        Exit Sub
    End If

    Do While Not rs.EOF
        Select Case rs("QuestionType")
        Case 0
            Response.Write "<table width='100%'>" & vbCrLf
            Response.Write "  <tr>" & vbCrLf
            If rs("InputType") = 1 Then
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（单行输入）" & rs("QuestionContent") & "</td>"
            Else
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（多行输入）" & rs("QuestionContent") & "</td>" & vbCrLf
            End If
            
            Response.Write "  </tr>" & vbCrLf
            Response.Write "</table>" & vbCrLf
            Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>" & vbCrLf
            Select Case rs("InputType")
            Case 0
            Case 1, 2
                Set Rs2 = Server.CreateObject("adodb.recordset")
                Rs2.open "Select InputContent From PE_SurveyInput Where QuestionID=" & rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
                If Rs2.EOF Or Rs2.BOF Then
                Else
                    Response.Write "  <tr class='tdbg'>" & vbCrLf
                    Response.Write "    <td>" & vbCrLf
                    Response.Write "<a href='Admin_Survey.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "'>内容</a>"
                    Response.Write "    </td>" & vbCrLf
                    Response.Write "  </tr>" & vbCrLf
                End If
                Rs2.Close
                Set Rs2 = Nothing
            End Select
            Response.Write "</table><br>" & vbCrLf
        Case 1, 2, 3
            TotalNum = 0
            Set rs1 = Server.CreateObject("adodb.recordset")
            rs1.open "select VoteAmount from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            Do While Not rs1.EOF
                TotalNum = TotalNum + rs1(0)
                rs1.MoveNext
            Loop
            rs1.Close
            Response.Write "<table width='100%'>" & vbCrLf
            Response.Write "  <tr>" & vbCrLf
            Select Case rs("QuestionType")
            Case 1
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（单选）" & rs("QuestionContent") & "</td>" & vbCrLf
            Case 2
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（多选）" & rs("QuestionContent") & "</td>" & vbCrLf
            Case 3
                Response.Write "    <td align=left clospan='1' nowrap>" & j & "、（下拉选框）" & rs("QuestionContent") & "</td>" & vbCrLf
            End Select
            Response.Write "  </tr>" & vbCrLf
            Response.Write "</table>" & vbCrLf
            Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>" & vbCrLf
            rs1.open "select AnswerContent,VoteAmount from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " order by OrderID asc", Conn, 1, 1
            If rs1.BOF And rs1.EOF Then
                Response.Write "  <tr class=title>" & vbCrLf
                Response.Write "    <td nowrap>" & vbCrLf
                Response.Write "<li>系统中无数据！" & vbCrLf
                Response.Write "    </td>" & vbCrLf
                Response.Write "  </tr>" & vbCrLf
            Else
                Response.Write "  <tr class=tdbg>" & vbCrLf
                Response.Write "    <td>" & vbCrLf
               
                Response.Write "       <table width='100%' cellpadding='0' cellspacing='0'>" & vbCrLf
                Response.Write "         <tr>" & vbCrLf
                Response.Write "           <td width='10%'>" & vbCrLf
                Response.Write "             <table width='100%'>" & vbCrLf
                If TotalNum = 1 Then
                    Response.Write "                <tr>" & vbCrLf
                    Response.Write "                  <td height='20'></td>" & vbCrLf
                    Response.Write "                </tr>" & vbCrLf
                End If
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td align='right'>100</td>" & vbCrLf
                Response.Write "                </tr>" & vbCrLf
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td align='right'>80</td>" & vbCrLf
                Response.Write "                </tr>" & vbCrLf
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td align='right'>60</td>" & vbCrLf
                Response.Write "                </tr>" & vbCrLf
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td align='right'>40</td>" & vbCrLf
                Response.Write "                </tr>" & vbCrLf
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td align='right'>20</td>" & vbCrLf
                Response.Write "                </tr>" & vbCrLf
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td align='right'>0</td>" & vbCrLf
                Response.Write "                </tr>" & vbCrLf
                Response.Write "              </table>" & vbCrLf
                Response.Write "            </td>" & vbCrLf
                Response.Write "            <td>" & vbCrLf
                Response.Write "              <table width='100%' >" & vbCrLf
                Response.Write "                <tr>" & vbCrLf
                Response.Write "                  <td valign='bottom'>" & vbCrLf
                Response.Write "                     <table cellpadding='0' cellspacing='0' bgcolor='#CCCCCC' height='120'><tr>" & vbCrLf
                Dim ImgSerial
                ImgSerial = 1
                Do While Not rs1.EOF
                    Response.Write "                   <td align='center' width='40' valign='bottom'>"
                    If TotalNum = 0 Or rs1(1) = 0 Then
                        Response.Write "0.00%<img  src='../Survey/Images/Survey" & ImgSerial & ".gif' height='1' width='15'></td>" & vbCrLf
                    Else
                        Response.Write FormatNumber(Int(rs1(1) / TotalNum * 10000) / 100, 2, -1) & "%<img  src='../Survey/Images/Survey" & ImgSerial & ".gif' height='" & Int(rs1(1) / TotalNum * 120) & "' width='15'></td>" & vbCrLf
                    End If
                    rs1.MoveNext
                    ImgSerial = ImgSerial + 1
                    If ImgSerial > 9 Then ImgSerial = 1
                Loop
                Response.Write "                        <td width='20'></td>" & vbCrLf
                Response.Write "                        <td>" & vbCrLf
                Response.Write "                          <table  cellpadding='1' cellspacing='1' class='border'>" & vbCrLf
                rs1.MoveFirst
                ImgSerial = 1
                Dim RowsCount
                RowsCount = 1
                Do While Not rs1.EOF
                    Response.Write "                         <tr>" & vbCrLf
                    Response.Write "                            <td>" & vbCrLf
                    Response.Write "                              <img  src='../Survey/Images/Survey" & ImgSerial & ".gif' height='8' width='10'> " & rs1("AnswerContent")
                    Response.Write "                         </tr>" & vbCrLf
                    If RowsCount Mod 6 = 0 Then
                        Response.Write "</table>" & vbCrLf
                        Response.Write "<td width='10'></td>" & vbCrLf
                        Response.Write "<td>" & vbCrLf
                        Response.Write "  <table  cellpadding='1' cellspacing='1' class='border'>" & vbCrLf
                    End If
                    rs1.MoveNext
                    ImgSerial = ImgSerial + 1
                    If ImgSerial > 9 Then ImgSerial = 1
                    RowsCount = RowsCount + 1
                Loop
                Response.Write "                           </table>" & vbCrLf

                Response.Write "                         </td>" & vbCrLf
                Response.Write "                        <td width='10'></td>" & vbCrLf
                Response.Write "                      </tr></table>" & vbCrLf
                Response.Write "                    </td>" & vbCrLf
                Response.Write "                  </tr>" & vbCrLf
                Response.Write "                </table></td>" & vbCrLf
                Response.Write "               </tr>" & vbCrLf
                Response.Write "            </table>" & vbCrLf
                Response.Write "          </td>" & vbCrLf
                Response.Write "        </tr>" & vbCrLf
            End If
            rs1.Close
            Set rs1 = Nothing

            Select Case rs("InputType")
            Case 0
            Case 1, 2
                Set Rs2 = Server.CreateObject("adodb.recordset")
                Rs2.open "Select InputContent From PE_SurveyInput Where QuestionID=" & rs("QuestionID") & " And SurveyID=" & SurveyID, Conn, 1, 3
                If Rs2.EOF Or Rs2.BOF Then
                Else
                    Response.Write "  <tr>"
                    Response.Write "    <td class='tdbg' colspan='4'>"
                    If rs("InputType") = 1 Then
                        Response.Write "<a href='Admin_Survey.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "'>"
                        Response.Write " （单行输入）内容</a></td>"
                    Else
                        Response.Write "<a href='Admin_Survey.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "'>"
                        Response.Write " （多行输入）内容</a></td>"
                    End If
                    Response.Write "    </td>"
                    'Response.Write "    <td colspan='3'>"
                    'Response.Write Rs2(0)
                    'Response.Write "    </td>"
                    Response.Write "  </tr>"
                End If
                Rs2.Close
                Set Rs2 = Nothing
            End Select
            Response.Write "</table><br>"
        End Select
        j = j + 1
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Response.Write "<br>"
End Sub

Sub UserFormDetail()
    Dim SurveyID, rs, sql, Rs2, sql2, TotalNum, rs1, j, IsOpen, IP, Answer, SubmitTime
    Dim SurveyHtml, Itemstr, m, SurveyName, RecordID
    SurveyID = PE_CLng(Trim(Request("SurveyID")))
    RecordID = PE_CLng(Trim(Request("RecordID")))
    If SurveyID = 0 Or RecordID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>记录ID或问卷ID错误！！！</li>"
        Exit Sub
    End If
    Set IsOpen = Conn.Execute("select IsOpen,SurveyName From PE_Survey where SurveyID=" & SurveyID & "")
    If IsOpen.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷不存在！！！</li>"
        Exit Sub
    ElseIf IsOpen(0) = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷未启用，无统计数据！！！</li>"
        Exit Sub
    Else
        SurveyName = IsOpen(1)
    End If
    j = 1
    Set Rs2 = Server.CreateObject("adodb.recordset")
    sql2 = "select * from PE_SurveyRecord" & SurveyID & " Where RecordID =" & RecordID
    Rs2.open sql2, Conn, 1, 1
    If Rs2.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>指定的问卷无统计数据！！！</li>"
        Exit Sub
    Else
        'Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;<B>[</B><font color=red>" & SurveyName & "</font><B>]</B>&nbsp;详情显示"
        'Response.Write "</td></tr></table>"
        Response.Write "<br>"
        IP = Rs2("IP")
        'Answer=Split(rs2("Answer"),"$$")
        SubmitTime = Rs2("SubmitTime")
        j = 1
        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' colspan='2' align='center'><strong>用户填写问卷详情显示</strong></td>"
        Response.Write "    </tr>"
        Response.Write "<tr class='tdbg'><td width='250' align='right' class='tdbg5'>IP：</td><td>" & IP & "</td></tr>"
        Response.Write "<tr class='tdbg'><td width='250' align='right' class='tdbg5'>提交时间：</td><td>" & SubmitTime & "</td></tr>"
        'sql="select Q.QuestionID,Q.QuestionContent,Q.QuestionType,Q.InputType,A.AnswerID,A.AnswerContent from PE_SurveyQuestion Q left join PE_SurveyAnswer A on Q.QuestionID=A.QuestionID where Q.SurveyID=1 order by Q.QuestionID asc"
        Set rs = Server.CreateObject("adodb.recordset")
        sql = "select QuestionID,QuestionContent,QuestionType,InputType from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID asc"
        rs.open sql, Conn, 1, 1
        Do While Not rs.EOF
            Itemstr = ""
            Select Case rs("QuestionType")
            Case 0
                Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td><td>" & Rs2("Q" & rs("QuestionID")) & "</td></tr>"
            Case 1
                Answer = Split(Rs2("Q" & rs("QuestionID")), "$$")
                Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td>"
                Set rs1 = Server.CreateObject("adodb.recordset")
                rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " and AnswerID=" & Answer(0), Conn, 1, 1
                If Not rs1.EOF Then
                    Response.Write "<td>" & rs1("AnswerContent") & "</td></tr>"
                Else
                    Response.Write "<td></td></tr>"
                End If

                Select Case rs("InputType")
                Case 0

                Case 1, 2
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'>填空：</td><td>" & Answer(1) & "</td></tr>"
                End Select
            Case 2
                m = 0
                Answer = Split(Rs2("Q" & rs("QuestionID")) & "$$", "$$")
				If IsValidID(Answer(0)) = False Then
					Answer(0) = ""
				End If

                If Answer(0) = "" Then Answer(0) = "0"
                Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td><td>"
                Set rs1 = Server.CreateObject("adodb.recordset")
                rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " and AnswerID in(" & Answer(0) & ") order by OrderID asc", Conn, 1, 1
                Do While Not rs1.EOF
                    If m = 0 Then
                        Itemstr = rs1("AnswerContent")
                    Else
                        Itemstr = Itemstr & "&nbsp;&nbsp;&nbsp;&nbsp;" & rs1("AnswerContent")
                    End If
                    m = m + 1
                    rs1.MoveNext
                Loop
                Response.Write Itemstr & "</td></tr>"
                Select Case rs("InputType")
                Case 0
                Case 1, 2
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'>填空：</td><td>" & Answer(1) & "</td></tr>"
                End Select
            Case 3
                Answer = Split(Rs2("Q" & rs("QuestionID")), "$$")
                Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'> " & j & "、" & rs("QuestionContent") & "</td>"
                Set rs1 = Server.CreateObject("adodb.recordset")

                rs1.open "select AnswerID,AnswerContent from PE_SurveyAnswer where QuestionID=" & rs("QuestionID") & " and AnswerID=" & Answer(0), Conn, 1, 1
                If Not rs1.EOF Then
                    Response.Write "<td>" & rs1("AnswerContent") & "</td></tr>"
                Else
                    Response.Write "<td></td></tr>"
                End If
                Select Case rs("InputType")
                Case 0
                Case 1, 2
                    Response.Write " <tr class='tdbg'><td width='250' align='right' class='tdbg5'>填空：</td><td>" & Answer(1) & "</td></tr>"
                End Select
            End Select
            j = j + 1
            rs.MoveNext
        Loop
        rs.Close
        Set rs = Nothing
    End If
    Rs2.Close
    Set Rs2 = Nothing
    Response.Write "      <tr class='tdbg'> " & vbCrLf
    Response.Write "        <td colspan='2' nowrap> " & vbCrLf
    Response.Write "          <div align='center'>" & vbCrLf
    Response.Write "    <form name='myform' method='Post' action='Admin_Survey.asp' onsubmit='return ConfirmDel();'>"
    Response.Write "<input type='hidden' name='Action' value='UserRecordDel'>" & vbCrLf
    Response.Write "<input type='hidden' name='SurveyID' value='" & SurveyID & "'>" & vbCrLf
    Response.Write "<input type='hidden' name='RecordID' value='" & RecordID & "'>" & vbCrLf
    Response.Write "            <input type='button' name='Submit2' value='返回列表' onClick='javascript:history.go(-1);'>" & vbCrLf
    Response.Write "<input name='submit' type='submit' value='删除记录'>" & vbCrLf
    Response.Write "</from>" & vbCrLf
    Response.Write "          </div>" & vbCrLf
    Response.Write "<script language=JavaScript>" & vbCrLf
    Response.Write "<!--" & vbCrLf
    Response.Write "function ConfirmDel(){" & vbCrLf
    Response.Write "   if(confirm('确定要删除此用户问卷的详情数据吗？'))" & vbCrLf
    Response.Write "     return true;" & vbCrLf
    Response.Write " else" & vbCrLf
    Response.Write "     return false;" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "//-->" & vbCrLf
    Response.Write "</script>" & vbCrLf
    Response.Write "        </td>" & vbCrLf
    Response.Write "      </tr>" & vbCrLf
    Response.Write SurveyHtml & "</table><br>"

End Sub

Function ShowPagevote(sfilename, totalnumber, MaxPerPage, CurrentPage, ShowTotal, strUnit)
    Dim TotalPage, strTemp, strUrl, i

    If totalnumber = 0 Or MaxPerPage = 0 Or IsNull(MaxPerPage) Then
        ShowPagevote = ""
        Exit Function
    End If
    If totalnumber Mod MaxPerPage = 0 Then
        TotalPage = totalnumber \ MaxPerPage
    Else
        TotalPage = totalnumber \ MaxPerPage + 1
    End If
    If CurrentPage > TotalPage Then CurrentPage = TotalPage
        
    strTemp = "<table align='center'><tr><td>"
    If ShowTotal = True Then
        strTemp = strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
    End If

    strUrl = JoinChar(sfilename)
 
    If CurrentPage = 1 Then
        strTemp = strTemp & "首条 上一条&nbsp;"
    Else
        strTemp = strTemp & "<a href='" & strUrl & "page=1'>首条</a>&nbsp;"
        strTemp = strTemp & "<a href='" & strUrl & "page=" & (CurrentPage - 1) & "'>上一条</a>&nbsp;"
    End If

    If CurrentPage >= TotalPage Then
        strTemp = strTemp & "下一条 尾条"
    Else
        strTemp = strTemp & "<a href='" & strUrl & "page=" & (CurrentPage + 1) & "'>下一条</a>&nbsp;"
        strTemp = strTemp & "<a href='" & strUrl & "page=" & TotalPage & "'>尾条</a>"
    End If
    strTemp = strTemp & "&nbsp;&nbsp;<strong><font color=red>" & CurrentPage & "</font>/" & TotalPage & "</strong>条 "

    strTemp = strTemp & "</td></tr></table>"
    ShowPagevote = strTemp
End Function

'=================================================
'过程名：Resumeblank
'作  用：代码校正，同步。
'=================================================
Sub Resumeblank()

    Response.Write "<script language = 'JavaScript'>" & vbCrLf
    Response.Write "var Strsave = ""A"" " & vbCrLf
                    '表单验证
    Response.Write "function CheckForm(){" & vbCrLf
    Response.Write "    if (document.form1.SurveyContent.value==''){" & vbCrLf
    Response.Write "        alert('问卷内容不能为空！');" & vbCrLf
    Response.Write "        document.form1.SurveyContent.focus();" & vbCrLf
    Response.Write "        return false;" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "    if (document.form1.FileName.value==''){" & vbCrLf
    Response.Write "        alert('创建的文件名不能为空！');" & vbCrLf
    Response.Write "        document.form1.FileName.focus();" & vbCrLf
    Response.Write "        return false;" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "    if (Strsave==""B"") { document.form1.SurveyContent.value=Resumeblank(editor.HtmlEdit.document.documentElement.outerHTML)};" & vbCrLf
    Response.Write "    return true;  " & vbCrLf
    Response.Write "}" & vbCrLf
                    '模式切换
    Response.Write "function LoadEditorAlgebra(){" & vbCrLf
    Response.Write "    if (Strsave!=""A""){" & vbCrLf
    Response.Write "        Strsave=""A""" & vbCrLf
    Response.Write "        showAlgebra.style.display="""";" & vbCrLf
    Response.Write "        showeditor.style.display=""none"";" & vbCrLf
    Response.Write "        document.form1.SurveyContent.value=Resumeblank(editor.HtmlEdit.document.documentElement.outerHTML)" & vbCrLf
    Response.Write "        editor.yToolbarsCss();" & vbCrLf
    Response.Write "        editor.showBorders();" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function LoadEditorEdit(){" & vbCrLf
    Response.Write "    if (Strsave!=""B""){" & vbCrLf
    Response.Write "        Strsave=""B""" & vbCrLf
                            '处理FSO 读入字符问题
    Response.Write "        document.form1.SurveyContent.select();" & vbCrLf
    Response.Write "        textRange = document.form1.SurveyContent.createTextRange();" & vbCrLf
    Response.Write "        textRange.execCommand(""Copy"");" & vbCrLf
    Response.Write "        document.form1.SurveyContent.value = """";" & vbCrLf
    Response.Write "        setTimeout('aaa()',500);" & vbCrLf
    Response.Write "    }" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function aaa(){" & vbCrLf
    Response.Write "    textRange.execCommand(""paste"");" & vbCrLf
    Response.Write "    showAlgebra.style.display=""none"";" & vbCrLf
    Response.Write "    showeditor.style.display="""";" & vbCrLf
    Response.Write "    editor.HtmlEdit.document.designMode=""on"";" & vbCrLf
    Response.Write "    editor.HtmlEdit.document.open();" & vbCrLf
    Response.Write "    editor.HtmlEdit.document.write(document.form1.SurveyContent.value);" & vbCrLf
    Response.Write "    editor.HtmlEdit.document.close();" & vbCrLf
    Response.Write "    editor.yToolbarsCss();" & vbCrLf
    Response.Write "    editor.showBorders();" & vbCrLf
    Response.Write "}" & vbCrLf
                    '兼容模板触发事件
    Response.Write "function setContent(Type,TemplateType){" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</script>" & vbCrLf
                    '返回值代码校正
    Response.Write "<script language=""VBScript"">" & vbCrLf
    Response.Write "Function  Resumeblank(byval Content)" & vbCrLf
    Response.Write "    Dim strHtml,strHtml2,Num,Numtemp,Strtemp" & vbCrLf
    Response.Write "    strHtml=Replace(Content, ""<DIV"", ""<div"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</DIV>"", vbCrLf & ""</div>""& vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<DD>"", vbCrLf & ""<dd>"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<DT>"", vbCrLf & ""<dt>"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<DL>"", vbCrLf & ""<dl>"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</DD>"", vbCrLf & ""</dd>""& vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</DT>"", vbCrLf & ""</dt>""& vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</DL>"", vbCrLf & ""</dl>""& vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<TABLE"", ""<table"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</TABLE>"", vbCrLf & ""</table>""& vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<TBODY>"", """")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</TBODY>"","""" & vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<TR"", ""<tr"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</TR>"", vbCrLf & ""</tr>""& vbCrLf)" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<TD"", ""<td"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</TD>"", ""</td>"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<!--"", vbCrLf & ""<!--"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<SELECT"",vbCrLf & ""<Select"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</SELECT>"",vbCrLf & ""</Select>"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<OPTION"",vbCrLf & ""  <Option"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""</OPTION>"",""</Option>"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<INPUT"",vbCrLf & ""  <Input"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""<script"",vbCrLf & ""<script"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""&amp;"",""&"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""{$--"",vbCrLf & ""<!--$"")" & vbCrLf
    Response.Write "    strHtml=Replace(strHtml, ""--}"",""$-->"")" & vbCrLf
    Response.Write "    arrContent = Split(strHtml,vbCrLf)" & vbCrLf
    Response.Write "    For i = 0 To UBound(arrContent)" & vbCrLf
    Response.Write "        Numtemp=false" & vbCrLf
    Response.Write "        if Instr(arrContent(i),""<table"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "            if Strtemp<>""<table"" and Strtemp <>""</table>"" then" & vbCrLf
    Response.Write "              Num=Num+2" & vbCrLf
    Response.Write "            End if " & vbCrLf
    Response.Write "            Strtemp=""<table""" & vbCrLf
    Response.Write "        elseif Instr(arrContent(i),""<tr"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "            if Strtemp<>""<tr"" and Strtemp<>""</tr>"" then" & vbCrLf
    Response.Write "              Num=Num+2" & vbCrLf
    Response.Write "            End if " & vbCrLf
    Response.Write "            Strtemp=""<tr""" & vbCrLf
    Response.Write "        elseif Instr(arrContent(i),""<td"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "            if Strtemp<>""<td"" and Strtemp<>""</td>"" then" & vbCrLf
    Response.Write "              Num=Num+2" & vbCrLf
    Response.Write "            End if " & vbCrLf
    Response.Write "            Strtemp=""<td""" & vbCrLf
    Response.Write "        elseif Instr(arrContent(i),""</table>"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "            if Strtemp<>""</table>"" and Strtemp<>""<table"" then" & vbCrLf
    Response.Write "              Num=Num-2" & vbCrLf
    Response.Write "            End if " & vbCrLf
    Response.Write "            Strtemp=""</table>""" & vbCrLf
    Response.Write "        elseif Instr(arrContent(i),""</tr>"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "            if Strtemp<>""</tr>"" and Strtemp<>""<tr"" then" & vbCrLf
    Response.Write "              Num=Num-2" & vbCrLf
    Response.Write "            End if " & vbCrLf
    Response.Write "            Strtemp=""</tr>""" & vbCrLf
    Response.Write "        elseif Instr(arrContent(i),""</td>"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "            if Strtemp<>""</td>"" and Strtemp<>""<td"" then" & vbCrLf
    Response.Write "              Num=Num-2" & vbCrLf
    Response.Write "            End if " & vbCrLf
    Response.Write "            Strtemp=""</td>""" & vbCrLf
    Response.Write "        elseif Instr(arrContent(i),""<!--"")>0 then" & vbCrLf
    Response.Write "            Numtemp=True" & vbCrLf
    Response.Write "        End if" & vbCrLf
    Response.Write "        if Num< 0 then Num = 0" & vbCrLf
    Response.Write "        if trim(arrContent(i))<>"""" then" & vbCrLf
    Response.Write "            if i=0 then" & vbCrLf
    Response.Write "                strHtml2= string(Num,"" "") & arrContent(i) " & vbCrLf
    Response.Write "            elseif Numtemp=True then" & vbCrLf
    Response.Write "                strHtml2= strHtml2 & vbCrLf & string(Num,"" "") & arrContent(i) " & vbCrLf
    Response.Write "            else" & vbCrLf
    Response.Write "                strHtml2= strHtml2 & vbCrLf & arrContent(i) " & vbCrLf
    Response.Write "            end if" & vbCrLf
    Response.Write "        end if" & vbCrLf
    Response.Write "    Next" & vbCrLf
    Response.Write "    Resumeblank=strHtml2" & vbCrLf
    Response.Write "End function" & vbCrLf
    Response.Write "</script>" & vbCrLf

End Sub

Sub AnswerList()
    Dim rs, sql, rsQuestion, SurveyName
    Set rsQuestion = Conn.Execute("select QuestionType,InputType,QuestionContent from PE_SurveyQuestion where QuestionID=" & QuestionID)
    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select IP,Q" & QuestionID & " from PE_SurveyRecord" & SurveyID
    rs.open sql, Conn, 1, 1
    SurveyName = Conn.Execute("select SurveyName from PE_Survey where SurveyID=" & SurveyID)(0)
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;<B>[</B><a href='Admin_Survey.asp?Action=ShowCountData1&SurveyID=" & SurveyID & "'>" & SurveyName & "</a><B>]</B>&nbsp;&gt;&gt;&nbsp;"
    Response.Write "问题<B>[</B><font color=red>" & rsQuestion("QuestionContent") & "</font><B>]</B>的回答详情"

    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' Class='border'>"

    Response.Write "<tr class='title' align='center'><td><b>IP</b></td><td><b>回答</b></td>"
    If rsQuestion("QuestionType") <> 0 And rsQuestion("InputType") <> 0 Then Response.Write "<td><b>其它</b></td>"
    Response.Write "</tr>"
    Dim totalPut, AnswerNum
    totalPut = rs.RecordCount
    If CurrentPage < 1 Then
        CurrentPage = 1
    End If
    If (CurrentPage - 1) * MaxPerPage > totalPut Then
        If (totalPut Mod MaxPerPage) = 0 Then
            CurrentPage = totalPut \ MaxPerPage
        Else
            CurrentPage = totalPut \ MaxPerPage + 1
        End If
    End If
    If CurrentPage > 1 Then
        If (CurrentPage - 1) * MaxPerPage < totalPut Then
            rs.Move (CurrentPage - 1) * MaxPerPage
        Else
            CurrentPage = 1
        End If
    End If
    AnswerNum = 1
    Do While Not rs.EOF
        Select Case rsQuestion("QuestionType")
        Case 0
            Response.Write "<tr class='tdbg'><td>" & rs("IP") & "</td><td>" & rs(1) & "</td></tr>"
        Case 1, 2, 3
            Dim Itemstr, rsAnswer
            AnswerID = Split(rs(1), "$$")
			If IsValidID(AnswerID(0)) = False Then
				AnswerID(0) = ""
			End If
            Itemstr = ""
            If InStr(rs(1), "$$") > 0 Then
                If AnswerID(1) = "" Then
                    AnswerID(1) = "未填写"
                End If
            End If
            Set rsAnswer = Conn.Execute("select AnswerContent from PE_SurveyAnswer where AnswerID in (" & AnswerID(0) & ")")
            Do While Not rsAnswer.EOF
                Itemstr = Itemstr & "&nbsp;&nbsp;&nbsp;&nbsp;" & rsAnswer("AnswerContent")
                rsAnswer.MoveNext
            Loop

            rsAnswer.Close
            Set rsAnswer = Nothing
            Select Case rsQuestion("InputType")
            Case 0
                Response.Write "<tr class='tdbg'><td>" & rs("IP") & "</td><td>" & Itemstr & "</td></tr>"
            Case 1, 2
                Response.Write "<tr class='tdbg'><td>" & rs("IP") & "</td><td>" & Itemstr & "</td><td>" & AnswerID(1) & "</td></tr>"
            End Select
        End Select
        If AnswerNum >= MaxPerPage Then Exit Do
        AnswerNum = AnswerNum + 1
        rs.MoveNext
    Loop
    rs.Close
    rsQuestion.Close
    Set rsQuestion = Nothing
    Set rs = Nothing
    Response.Write "</table><br>"
    If totalPut > 0 Then
        Response.Write ShowPage("Admin_Survey.asp?Action=ListAnswer&SurveyID=" & SurveyID & "&QuestionID=" & QuestionID, totalPut, MaxPerPage, CurrentPage, True, True, "条记录", True)
    End If

End Sub

Sub ShowReportForm()
    Dim rs, SurveyNum
    SurveyNum = Conn.Execute("select Count(*) from PE_SurveyRecord" & SurveyID)(0)
    Set rs = Conn.Execute("select * from PE_Survey where SurveyID=" & SurveyID)
    If rs.EOF Then
        FoundErr = True
        ErrMsg = ErrMsg & "<br><li>不存在此问卷！！</li>"
        Exit Sub
    End If
    Response.Write "<br><table width='100%'><tr align='center'><td> <h3>[" & rs("SurveyName") & "]问卷报表</td></tr></table>"
    Response.Write "<br><table width='90%' border='0' align='center' cellpadding='2' cellspacing='1' Class='border'>"

    Response.Write "<tr class='tdbg' align='left'><td>问卷名</td><td>" & rs("SurveyName") & "</td></tr>"
    Response.Write "<tr class='tdbg' align='left'><td>问卷说明</td><td>" & rs("Description") & "</td></tr>"
    Response.Write "<tr class='tdbg' align='left'><td>创建日期/结束日期</td><td>" & rs("CreateDate") & "/" & rs("EndTime") & "</td></tr>"
    Response.Write "<tr class='tdbg' align='left'><td>问卷数</td><td>" & SurveyNum & "</td></tr>"
    Response.Write "<tr class='tdbg' align='left'><td>问卷题目</td><td>"
    Dim rsQuestion, rsAnswer, Answer, i
    i = 1
    Response.Write "<br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1'>"
    Set rsQuestion = Conn.Execute("select QuestionID, QuestionContent from PE_SurveyQuestion where SurveyID=" & SurveyID)
    If rsQuestion.EOF Then
        Response.Write "<tr><td>此问卷还没有问题</td></tr>"
    Else
        Do While Not rsQuestion.EOF
            Answer = ""
            Response.Write "<tr><td>" & i & "、" & rsQuestion("QuestionContent") & "</td></tr>"
            Set rsAnswer = Conn.Execute("select AnswerContent from PE_SurveyAnswer where QuestionId=" & rsQuestion("QuestionID"))
            If rsAnswer.EOF Then
                Answer = "此题为填空题"
            Else
                Do While Not rsAnswer.EOF
                    Answer = Answer & rsAnswer("AnswerContent") & "&nbsp;&nbsp;"
                    rsAnswer.MoveNext
                Loop
            End If
            rsAnswer.Close
            Set rsAnswer = Nothing
            Response.Write "<tr><td>&nbsp;&nbsp;" & Answer & "</td></tr>"
            i = i + 1
            rsQuestion.MoveNext
        Loop
    End If
    rsQuestion.Close
    Set rsQuestion = Nothing
    Response.Write "</table>"
    Response.Write "</td></tr>"
    Response.Write "<tr class='tdbg'><td>数据统计</td><td>"
    Call ShowCountData1
    Response.Write "</td></tr>"
    Response.Write "</table>"
    Response.Write "<br><br><table width='90%' id='Panel'><tr><td align='center'><input type='button' name='Print' value=' 打 印… ' onClick=""Panel.style.display='none';window.print()""></td></tr></table>"
End Sub

Sub SurveyCode()
    Dim rsSurvey, sql, Querysql
    sql = "select * from PE_Survey "
    Querysql = " where 1=1 "
    strNavigation = "所有问卷"
    strFileName = strFileName & "?Action=SurveyCode"
    If Keyword <> "" And SearchType <> "" Then
        Select Case SearchType
            Case "SurveyName":
                Querysql = Querysql & " and SurveyName like '%" & Keyword & "%'"
                strNavigation = "名称中含有 <font color='red'>" & Keyword & "</font> 的问卷"
            Case "CreateDate":
                If IsDate(Keyword) = True Then
                    Querysql = Querysql & " and datediff(" & PE_DatePart_D & ",CreateDate,'" & Keyword & "')=0"
                    strNavigation = "创建日期为 " & Keyword & " 的问卷"
                Else
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>查询的创建日期格式不正确！</li>"
                    Exit Sub
                End If
            Case "EndTime":
                If IsDate(Keyword) = True Then
                    Querysql = Querysql & " and datediff(" & PE_DatePart_D & ",EndTime,'" & Keyword & "')=0"
                    strNavigation = "截止日期为 " & Keyword & " 的问卷"
                Else
                    FoundErr = True
                    ErrMsg = ErrMsg & "<li>查询的截止日期格式不正确！</li>"
                    Exit Sub
                End If
        End Select
        strFileName = strFileName & "&KeyWord=" & Keyword & "&SearchType=" & SearchType
    End If
    If SurveyID > 0 Then
        Querysql = Querysql & " and SurveyId = " & SurveyID & ""
    End If
    totalPut = PE_CLng(Conn.Execute("select Count(*) from PE_Survey " & Querysql)(0))
    If CurrentPage < 1 Then
        CurrentPage = 1
    End If
    If (CurrentPage - 1) * MaxPerPage > totalPut Then
        If (totalPut Mod MaxPerPage) = 0 Then
            CurrentPage = totalPut \ MaxPerPage
        Else
            CurrentPage = totalPut \ MaxPerPage + 1
        End If
    End If
    If CurrentPage > 1 Then
        Querysql = Querysql & " and SurveyID < (select min(SurveyID) from (select top " & ((CurrentPage - 1) * MaxPerPage) & " SurveyID from PE_Survey " & Querysql & " order by SurveyID desc) as QuerySurvey) "
    End If
    Set rsSurvey = Server.CreateObject("adodb.recordset")
    rsSurvey.open sql & Querysql & " order by SurveyID desc", Conn, 1, 3
    If SurveyID > 0 And Not rsSurvey.EOF Then
        strNavigation = "[<font color='red'>" & rsSurvey("SurveyName") & "</font>] 调用代码"
    End If

    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;" & strNavigation
    Response.Write "</td></tr></table>"
    Response.Write "    <table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>" & vbCrLf
    Response.Write "      <tr class='title'>" & vbCrLf
    Response.Write "        <td width='25%'><div align='center'><b>问卷名称</b> </div></td>" & vbCrLf
    Response.Write "        <td width='25%'><div align='center'><b>问卷页面调用代码</b></div></td>" & vbCrLf
    Response.Write "        <td width='25%'><div align='center'><b>问卷页面链接调用代码</b></div></td>" & vbCrLf
    Response.Write "        <td width='25%'><div align='center'><b>问卷结果调用代码</b></div></td>" & vbCrLf
    Response.Write "      </tr>" & vbCrLf

    If rsSurvey.EOF Then
        totalPut = 0
        Response.Write "<tr class='tdbg'><td colspan='8' align='center'>没有任何问卷!</td><tr>" & vbCrLf
    Else
        Dim SurveyNum
        SurveyNum = 0
        Do While Not rsSurvey.EOF
            Response.Write "  <tr class='tdbg' align='center'>"
            Response.Write "    <td align='left'>" & rsSurvey("SurveyName") & "</td>"
            Response.Write "    <td align='center'><textarea name='selectKey' cols='28' rows='3' onmouseover='this.select();' id='selectKey'>"
            If IsNull(rsSurvey("Filename")) Then
                Response.Write "问卷未完成"
            Else
                Response.Write "<IFRAME id=SurveyItem src='{$InstallDir}Survey/" & rsSurvey("Filename") & "' frameBorder=0 scrolling=no></IFRAME>"
            End If
            Response.Write "</textarea></td>"

            Response.Write "    <td align='center'><textarea name='selectKey' cols='28' rows='3' onmouseover='this.select();' id='selectKey'>"
            If IsNull(rsSurvey("Filename")) Then
                Response.Write "问卷未完成"
            Else
                Response.Write "<a href='{$InstallDir}Survey/" & rsSurvey("Filename") & "' target='_blank'>" & rsSurvey("SurveyName") & "</a>"
            End If
            Response.Write "</textarea></td>"

            Response.Write "    <td align='center'><textarea name='selectKey' cols='28' rows='3' onmouseover='this.select();' id='selectKey'>"
            If rsSurvey("IsOpen") = 0 Then
                Response.Write "指定的问卷未启用，无统计数据"
            Else
                Response.Write "<a href='{$InstallDir}Survey/ListReport.asp?SurveyID=" & rsSurvey("SurveyID") & "' target='_blank'>" & rsSurvey("SurveyName") & "调查结果</a>"
            End If
            Response.Write "</textarea></td>"
            Response.Write "  </tr>"
            SurveyNum = SurveyNum + 1
            If SurveyNum >= MaxPerPage Then Exit Do
            rsSurvey.MoveNext
        Loop
    End If

    Response.Write "    </table><br>" & vbCrLf
    If totalPut > 0 Then
        Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "篇问卷 ", True)
    End If
    rsSurvey.Close
    Set rsSurvey = Nothing

    Response.Write "<br>"
    Response.Write "<form method='Post' name='SearchForm' action='" & strFileName & "'>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "   <td width='80' align='right'><strong>问卷搜索：</strong></td>"
    Response.Write "     <td>"
    Response.Write "        <select name='SearchType' size='1'>"
    Response.Write "        <option value='SurveyName' selected>问卷名称</option>"
    Response.Write "        <option value='CreateDate'>创建日期</option>"
    Response.Write "        <option value='EndTime'>截止日期</option>"
    Response.Write "        </select>"
    Response.Write "        <input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>"
    Response.Write "        <input type='submit' name='Submit'  value='搜索'>"
    Response.Write "     </td>"
    Response.Write "   </td>"
    Response.Write "   </tr>"
    Response.Write "</table>"
    Response.Write "</form>"
    Response.Write "<br>"

End Sub

Sub ManageTemplate()
    Dim rs, sql
    Call ShowJS_Survey

    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;问卷模板管理"
    Response.Write "</td></tr></table>"

    If AdminPurview <> 1 And arrPurview(4) = False Then
        Response.Write "<table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无问卷模板管理的权限！</td></tr></table>"
        Exit Sub
    End If

    Set rs = Server.CreateObject("adodb.recordset")
    sql = "select * from PE_Template where Deleted=" & PE_False & " and ChannelID=" & SurveyTemplateChannelID
    rs.open sql, Conn, 1, 1
    Response.Write "<table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>"
    Response.Write "<form name='form1' method='post' action='Admin_Survey.asp'>"
    Response.Write "     <tr class='title' height='22'>"
    Response.Write "      <td width='30' align='center'><strong>选择</strong></td>"
    Response.Write "      <td width='60' align='center'><strong>ID</strong></td>"
    Response.Write "      <td width='200' align='center'><strong>模板名称</strong></td>"
    Response.Write "      <td width='120' align='center'><strong>系统默认</strong></td>"
    Response.Write "      <td height='22' align='center'><strong>操作</strong></td>"
    Response.Write "     </tr>"
    Do While Not rs.EOF
        Response.Write "<tr class='tdbg' align='center'>"
        Response.Write "<td>"
        Response.Write "    <input type=""checkbox"" value=" & rs("TemplateID") & " name=""TemplateID"""

        If rs("IsDefault") = True Then Response.Write "disabled"
        Response.Write "> "
        Response.Write "  </td>"
        Response.Write "      <td width='30' align='center'>" & rs("TemplateID") & "</td>"
        Response.Write "      <td width='100' align='center'>" & rs("TemplateName") & "</td>"
        Response.Write "      <td width='60' align='center'><b>"

        If rs("IsDefault") = True Then
            Response.Write "<FONT style='font-size:12px' color='#008000'>√</FONT><td>"
        Else
            Response.Write "<td>"
        End If

        If rs("IsDefault") = False Then
            Response.Write "<a href='Admin_Survey.asp?Action=SetDefault&TemplateID=" & rs("TemplateID")

            Response.Write "'>&nbsp;设为系统默认</a>&nbsp;&nbsp;"
        Else
            Response.Write "<font color='gray'>&nbsp;设为系统默认&nbsp;&nbsp;</font>"
        End If

        Response.Write "<a href='Admin_Survey.asp?Action=ModifyTemplate&TemplateID=" & rs("TemplateID")
        Response.Write "'>修改模板</a>&nbsp;&nbsp;"
        If rs("IsDefault") = False Then
            Response.Write "<a href='Admin_Survey.asp?Action=DelTemplate&TemplateID=" & rs("TemplateID")
            Response.Write "' onClick=""return confirm('确定要删除此版面设计模板吗？删除后模板将无法恢复。');"">删除模板</a>"
        Else
            Response.Write "<font color='gray'>删除模板</font>"
        End If
        Response.Write "</td></tr>"
        rs.MoveNext
    Loop
    Response.Write "</table><br>"
    Response.Write "        <input name=""chkAll"" type=""checkbox"" id=""chkAll"" onclick=CheckAll(this.form) value=""checkbox"" >选中所有模板" & vbCrLf
    Response.Write "        &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
    Response.Write "        <input type=""submit"" value="" 批量删除 "" name=""Del"" onclick='return confirm(""确定要删除选中的模板吗？"");' >&nbsp;&nbsp;" & vbCrLf
    Response.Write "        <input type='hidden' value='DelTemplate' name='Action'  id='Action'>&nbsp;&nbsp;" & vbCrLf
    Response.Write "<input type='button' name='buttonm' value='添加模板' onclick=""window.location.href='Admin_Survey.asp?Action=AddTemplate'"">"
    Response.Write "</form>"
    rs.Close
    Set rs = Nothing

End Sub

Sub AddTemplate()
    If AdminPurview <> 1 And arrPurview(4) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无问卷模板管理的权限！</td></tr></table>"
        Exit Sub
    End If
    
    Call Resumeblank
    Dim strHTML

    strHTML = strHTML & "<html>" & vbCrLf
    strHTML = strHTML & "<head>" & vbCrLf
    strHTML = strHTML & "<title>新模板标题</title>" & vbCrLf
    strHTML = strHTML & "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    strHTML = strHTML & "</head>" & vbCrLf
    strHTML = strHTML & "<body>" & vbCrLf
    strHTML = strHTML & "" & vbCrLf
    strHTML = strHTML & "</body>" & vbCrLf
    strHTML = strHTML & "</html>" & vbCrLf
    strHTML = strHTML & "" & vbCrLf

    Response.Write "<form name='form1' method='post' action='Admin_Survey.asp' onsubmit=""Javascript:if(TemplateName.value==''){alert('模板名称不能为空！');return false;}else{return true;}"" >"
    Response.Write "  <table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>添 加 新 模 板</strong></td>"
    Response.Write "    </tr>"

    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>&nbsp;&nbsp;<strong> 模板名称： </strong><input name='TemplateName' type='text' id='TemplateName' value='' size='50' maxlength='50'></td>"
    Response.Write "    </tr>"
    Response.Write "    <a name='#TemplateStart1'></a>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td valign='top'align=center id='Navigation1' style='display:'>"
    
    Response.Write "<b> 模 板 内 容 ↓</b>"

    Response.Write "    </td></tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>"
    Response.Write "        <table align='left' width='200'>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td>"
    Response.Write "    <tr class='tdbg' id=showAlgebra>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "       <table>" & vbCrLf
    Response.Write "        <tr>" & vbCrLf
    Response.Write "          <td>" & vbCrLf
    Response.Write "           <table width='100%'>" & vbCrLf
    Response.Write "            <tr><td width='20'></td>" & vbCrLf
    Response.Write "             <td>" & vbCrLf
    Response.Write "             <textarea name='SurveyContent' id='SurveyContent' style='display:' ROWS='30' COLS='117'  class='txt_main'>" & strHTML & "</textarea>"
    Response.Write "            </td></tr>" & vbCrLf
    Response.Write "           </table>" & vbCrLf
    Response.Write "          </td>" & vbCrLf
    Response.Write "       </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' id=showeditor style='display:none'>" & vbCrLf
    Response.Write "      <td valign='top'>" & vbCrLf
    Response.Write "        <table >" & vbCrLf
    Response.Write "         <tr>" & vbCrLf
    Response.Write "          <td width='20'></td>" & vbCrLf
    Response.Write "           <td>" & vbCrLf
    Response.Write "            <textarea name='SurveyEditContent' id='SurveyEditContent' style='display:none'></textarea>"
    Response.Write "            <iframe ID='editor' src='../editor.asp?ChannelID=" & SurveyTemplateChannelID & "&ShowType=1&TemplateType=1&ShowTypeVote=1&tContentid=SurveyEditContent' frameborder='1' scrolling='no' width='790' height='400'></iframe>" & vbCrLf
    Response.Write "           </td>" & vbCrLf
    Response.Write "         </tr>" & vbCrLf
    Response.Write "        </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' >"
    Response.Write "     <td>"
    Response.Write "      <table>"
    Response.Write "        <tr>"
    Response.Write "          <td width='95%'>&nbsp;&nbsp;&nbsp;&nbsp;"
    Response.Write "            <input name='EditorAlgebra' type='button' id='EditorAlgebra' value=' 代码模式 '  onclick='LoadEditorAlgebra();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input name='EditorEdit' type='button' id='EditorEdit' value=' 编辑模式 ' disabled onclick='LoadEditorEdit();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input TYPE='hidden' Name='EditorMix' id='EditorMix' value=''>"
    Response.Write "          </td>"
    Response.Write "         </tr>"
    Response.Write "      </table>"
    Response.Write "    </td>"
    Response.Write "  </tr>"

    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td valign='top'>&nbsp;&nbsp;<input name='IsDefault' type='checkbox' id='IsDefault' value='Yes'> 将此模板设为"
    Response.Write "默认模板</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='50'  align='center'>"
    Response.Write "       <input name='Action' type='hidden' id='Action' value='SaveAddTemplate'><input type='Submit' name='Submit' value=' 添 加 '>"
    Response.Write "     </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write " </td>"
    Response.Write "</tr>"
    Response.Write "</table>"
    Response.Write "</form>"
End Sub

Sub DelTemplate()
    If AdminPurview <> 1 And arrPurview(4) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无问卷模板管理的权限！</td></tr></table>"
        Exit Sub
    End If
    Dim rs, sql, TemplateID
    TemplateID = Trim(Request("TemplateID"))
    If IsValidID(TemplateID) = False Then
        TemplateID = ""
    End If
    If TemplateID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要删除的模板ID!</li>"
    End If
    
    If FoundErr = True Then
        Exit Sub
    End If

    sql = "select * from PE_Template where TemplateID in (" & TemplateID & ")"
    Set rs = Server.CreateObject("adodb.recordset")
    rs.open sql, Conn, 1, 3
    If rs.EOF Then
        Response.Write "模板不存在！"
        Exit Sub
    End If
    Do While Not rs.EOF
        rs("Deleted") = True
        rs.Update
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Call WriteSuccessMsg("删除模板成功！", ComeUrl)

End Sub

Sub ModifyTemplate()
    If AdminPurview <> 1 And arrPurview(4) = False Then
        Response.Write "<br><table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无问卷模板管理的权限！</td></tr></table>"
        Exit Sub
    End If
    Dim rs
    Set rs = Conn.Execute("select * from PE_Template where TemplateID=" & Request("TemplateID"))
    If rs.EOF Then
        Response.Write "该模板不存在！"
        Exit Sub
    End If

    Call Resumeblank
    Response.Write "<form name='form1' method='post' action='Admin_Survey.asp' onsubmit=""Javascript:if(TemplateName.value==''){alert('模板名称不能为空！');return false;}else{return true;}"">"
    Response.Write "  <table width='100%' border='0' cellspacing='1' cellpadding='2' class='border'>"
    Response.Write "    <tr class='title'>"
    Response.Write "      <td height='22' colspan='2' align='center'><strong>修 改 模 板</strong></td>"
    Response.Write "    </tr>"

    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td>&nbsp;&nbsp;<strong> 模板名称： </strong><input name='TemplateName' type='text' id='TemplateName' value='" & rs("TemplateName") & "' size='50' maxlength='50'></td>"
    Response.Write "    </tr>"
    Response.Write "    <a name='#TemplateStart1'></a>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td valign='top'align=center id='Navigation1' style='display:'>"
    
    Response.Write "<b> 模 板 内 容 ↓</b>"

    Response.Write "    </td></tr>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "    <td>"
    Response.Write "    <tr class='tdbg' id=showAlgebra>" & vbCrLf
    Response.Write "      <td>" & vbCrLf
    Response.Write "       <table>" & vbCrLf
    Response.Write "        <tr>" & vbCrLf
    Response.Write "          <td>" & vbCrLf
    Response.Write "           <table width='100%'>" & vbCrLf
    Response.Write "            <tr><td width='20'></td>" & vbCrLf
    Response.Write "             <td>" & vbCrLf
    Response.Write "             <textarea name='SurveyContent' id='SurveyContent' style='display:' ROWS='30' COLS='117'  class='txt_main'>" & rs("TemplateContent") & "</textarea>"
    Response.Write "            </td></tr>" & vbCrLf
    Response.Write "           </table>" & vbCrLf
    Response.Write "          </td>" & vbCrLf
    Response.Write "       </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' id=showeditor style='display:none'>" & vbCrLf
    Response.Write "      <td valign='top'>" & vbCrLf
    Response.Write "        <table >" & vbCrLf
    Response.Write "         <tr>" & vbCrLf
    Response.Write "          <td width='20'></td>" & vbCrLf
    Response.Write "           <td>" & vbCrLf
    Response.Write "            <textarea name='SurveyEditContent' id='SurveyEditContent' style='display:none'>" & rs("TemplateContent") & "</textarea>"
    Response.Write "            <iframe ID='editor' src='../editor.asp?ChannelID=" & SurveyTemplateChannelID & "&ShowType=1&TemplateType=1&ShowTypeVote=1&tContentid=SurveyEditContent' frameborder='1' scrolling='no' width='790' height='400'></iframe>" & vbCrLf
    Response.Write "           </td>" & vbCrLf
    Response.Write "         </tr>" & vbCrLf
    Response.Write "        </table>" & vbCrLf
    Response.Write "      </td>" & vbCrLf
    Response.Write "    </tr>" & vbCrLf
    Response.Write "    <tr class='tdbg' >"
    Response.Write "     <td>"
    Response.Write "      <table>"
    Response.Write "        <tr>"
    Response.Write "          <td width='95%'>&nbsp;&nbsp;&nbsp;&nbsp;"
    Response.Write "            <input name='EditorAlgebra' type='button' id='EditorAlgebra' value=' 代码模式 '  onclick='LoadEditorAlgebra();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input name='EditorEdit' type='button' id='EditorEdit' value=' 编辑模式 ' disabled onclick='LoadEditorEdit();' onmouseover=""this.style.backgroundColor='#BFDFFF'"" onmouseout=""this.style.backgroundColor=''"">"
    Response.Write "            <input TYPE='hidden' Name='EditorMix' id='EditorMix' value=''>"
    Response.Write "          </td>"
    Response.Write "         </tr>"
    Response.Write "      </table>"
    Response.Write "    </td>"
    Response.Write "  </tr>"

    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td valign='top'>&nbsp;&nbsp;<input name='IsDefault' type='checkbox' id='IsDefault' "
    If rs("IsDefault") Then Response.Write "checked"
    Response.Write " value='Yes'> 将此模板设为"
    Response.Write "默认模板</td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='50'  align='center'><input name='TemplateID' type='hidden' id='TemplateID' value='" & rs("TemplateID") & "'>"

    Response.Write "       <input name='Action' type='hidden' id='Action' value='SaveModifyTemplate'><input type='Submit' name='Submit' value=' 修 改 '>"
    Response.Write "     </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write " </td>"
    Response.Write "</tr>"
    Response.Write "</table>"
    Response.Write "</form>"

    rs.Close
    Set rs = Nothing
End Sub

Sub SetDefault()
    Dim rs, sql
    Conn.Execute ("update PE_Template set IsDefault= " & PE_False & " where ChannelID=" & SurveyTemplateChannelID & " and  IsDefault=" & PE_True)
    sql = "select * from PE_Template where TemplateID=" & PE_Clng(Request("TemplateID"))
    Set rs = Server.CreateObject("adodb.recordset")
    rs.open sql, Conn, 1, 3
    If rs.EOF Then
        Response.Write "该模板不存在！"
        Exit Sub
    End If
    rs("IsDefault") = True
    rs.Update
    rs.Close
    Set rs = Nothing
    Response.Redirect "Admin_Survey.asp?Action=ManageTemplate"

End Sub

Sub SaveTemplate()
    Dim TemplateContent, TemplateName, IsDefault, sql, rs
    TemplateContent = Trim(Request.Form("SurveyContent"))
    TemplateName = Trim(Request.Form("TemplateName"))
    IsDefault = Trim(Request.Form("IsDefault"))
    If IsDefault = "Yes" Then
        IsDefault = True
        Conn.Execute ("update PE_Template set IsDefault= " & PE_False & " where ChannelID=" & SurveyTemplateChannelID & " and  IsDefault=" & PE_True)
    Else
        IsDefault = False
    End If

    If Action = "SaveAddTemplate" Then
        sql = "select top 1 * from PE_Template"
        Set rs = Server.CreateObject("Adodb.RecordSet")
        rs.open sql, Conn, 1, 3
        rs.AddNew
    Else
        sql = "select top 1 * from PE_Template where TemplateID=" & PE_CLng(Request("TemplateID"))
        Set rs = Server.CreateObject("Adodb.RecordSet")
        rs.open sql, Conn, 1, 3
    End If
    rs("ChannelID") = SurveyTemplateChannelID
    rs("Templatetype") = 99
    rs("ProjectName") = "动易2006海蓝方案"
    rs("TemplateName") = TemplateName
    rs("TemplateContent") = TemplateContent
    rs("IsDefault") = IsDefault
    rs.Update
    Call WriteSuccessMsg("保存模板成功！", "Admin_Survey.asp?Action=ManageTemplate")

    rs.Close
    Set rs = Nothing

End Sub

Sub ExportQuestion()
    
    Dim rs, sql
    Dim trs, iCount, ModuleType, ProjectName
    
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;问卷题目导出"
    Response.Write "</td></tr></table>"

    If AdminPurview <> 1 And arrPurview(6) = False Then
        Response.Write "<table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无问卷题目导出的权限！</td></tr></table>"
        Exit Sub
    End If

    Response.Write "<form name='myform' method='post' action='Admin_Survey.asp'>"
    Response.Write "  <table width='100%' border='0' align='center' cellpadding='2' cellspacing='0' class='border'>"
    Response.Write "    <tr class='title'> "
    Response.Write "      <td height='22' align='center' colspan='2'><strong>导出问卷题目</strong></td>"
    Response.Write "    </tr>"
    Response.Write "          <tr>"
    Response.Write "           <td align='center'>"
    Response.Write "            <select name='SurveyID' size='2' multiple style='height:300px;width:450px;'>"

    sql = "select * from PE_Survey"

    Set rs = Server.CreateObject("Adodb.RecordSet")
    rs.open sql, Conn, 1, 1

    If rs.BOF And rs.EOF Then
        Response.Write "         <option value=''>没有任何问卷</option>"
        '关闭提交按钮
        iCount = 0
    Else
        iCount = rs.RecordCount

        Do While Not rs.EOF
            Response.Write "     <option value='" & rs("SurveyID") & "'>" & rs("SurveyName") & "</option>"
            rs.MoveNext
        Loop

    End If

    rs.Close
    Set rs = Nothing
    Response.Write "         </select>"
    Response.Write "       </td>"
    Response.Write "       <td align='left'>&nbsp;&nbsp;&nbsp;&nbsp;<input type='button' name='Submit' value=' 选定所有 ' onclick='SelectAll()'>"
    Response.Write "       <br><br>&nbsp;&nbsp;&nbsp;&nbsp;<input type='button' name='Submit' value=' 取消选定 ' onclick='UnSelectAll()'><br><br><br><b>&nbsp;提示：按住“Ctrl”或“Shift”键可以多选</b></td>"
    Response.Write "      </tr>"
    Response.Write "      <tr height='30'>"
    Response.Write "        <td colspan='2'>目标数据库：<input name='TemplateMdb' type='text' id='TemplateMdb' value='../temp/PE_Survey.mdb' size='20' maxlength='50'>&nbsp;&nbsp;<INPUT TYPE='checkbox' NAME='FormatConn' value='yes' id='id' checked> 先清空目标数据库</td>"
    Response.Write "      </tr>"
    Response.Write "      <tr height='50'>"
    Response.Write "         <td colspan='2' align='center'><input type='submit' name='Submit' value='执行导出操作'>"

    Response.Write "                  <input name='Action' type='hidden' id='Action' value='DoExportQuestion'>"
    Response.Write "         </td>"
    Response.Write "        </tr>"
    Response.Write "    </table>"
    Response.Write "</form>"
    Response.Write "<script language='javascript'>" & vbCrLf
    Response.Write "function SelectAll(){" & vbCrLf
    Response.Write "  for(var i=0;i<document.myform.SurveyID.length;i++){" & vbCrLf
    Response.Write "    document.myform.SurveyID.options[i].selected=true;}" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "function UnSelectAll(){" & vbCrLf
    Response.Write "  for(var i=0;i<document.myform.SurveyID.length;i++){" & vbCrLf
    Response.Write "    document.myform.SurveyID.options[i].selected=false;}" & vbCrLf
    Response.Write "}" & vbCrLf
    Response.Write "</script>" & vbCrLf

End Sub

Sub DoExportQuestion()
    On Error Resume Next
    Dim mdbname, tconn, trs, strSql, Table_PE_lable
    Dim SurveyID, rs, sql, FormatConn, TemplateChannelID, rsLabel
    SurveyID = Trim(Request("SurveyID"))
    If IsValidID(SurveyID) = False Then
        SurveyID = ""
    End If
    

    FormatConn = Request.Form("FormatConn")
    'TemplateChannelID = Request.Form("TemplateChannelID")
    mdbname = Replace(Trim(Request.Form("Templatemdb")), "'", "")

    If SurveyID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定要导出题目所属的问卷！</li>"
    End If

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请填写导出模板数据库名"
    End If
        
    Set tconn = Server.CreateObject("ADODB.Connection")
    tconn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)

    If Err.Number <> 0 Then
        FoundErr = True
        Set tconn = Nothing
        ErrMsg = ErrMsg & "<li>数据库操作失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
    End If

    If FoundErr = True Then
        Exit Sub
    End If


    If FormatConn <> "" Then
        tconn.Execute ("delete from PE_SurveyQuestion")
        tconn.Execute ("delete from PE_SurveyAnswer")
        tconn.Execute ("delete from PE_Survey")
    End If

    Set rs = Conn.Execute("select * from PE_SurveyQuestion where SurveyID in (" & SurveyID & ")  order by OrderID")
 
    Set trs = Server.CreateObject("adodb.recordset")
    trs.open "select * from PE_SurveyQuestion", tconn, 1, 3
    Dim trsAnswer, rsAnswer
    Set trsAnswer = Server.CreateObject("adodb.recordset")
    trsAnswer.open "Select * from PE_SurveyAnswer", tconn, 1, 3
    
    Dim QuestionID
    Do While Not rs.EOF
        trs.AddNew
        trs("QuestionContent") = rs("QuestionContent")
        trs("SurveyID") = rs("SurveyID")
        trs("QuestionID") = rs("QuestionID")
        trs("QuestionType") = rs("QuestionType")
        trs("InputType") = rs("InputType")
        trs("NotEmpty") = rs("NotEmpty")
        trs("IsDefault") = rs("IsDefault")
        trs("DataRight") = rs("DataRight")
        trs("OrderID") = rs("OrderID")
        trs("ContentLength") = rs("ContentLength")
        If rs("QuestionType") <> 0 Then
            If QuestionID = "" Then
                QuestionID = rs("QuestionID")
            Else
                QuestionID = QuestionID & "," & rs("QuestionID")
            End If
        End If
        trs.Update
        rs.MoveNext
    Loop

    trs.Close
    Set trs = Nothing
    rs.Close
    Set rs = Nothing

    If QuestionID <> "" Then
        Set rsAnswer = Conn.Execute("select * from PE_SurveyAnswer where QuestionID in (" & QuestionID & ")")
        Do While Not rsAnswer.EOF
            trsAnswer.AddNew
            trsAnswer("QuestionID") = rsAnswer("QuestionID")
            trsAnswer("AnswerContent") = rsAnswer("AnswerContent")
            trsAnswer("VoteAmount") = 0
            trsAnswer("OrderID") = rsAnswer("OrderID")
            trsAnswer.Update
            rsAnswer.MoveNext
        Loop
        trsAnswer.Close
        Set trsAnswer = Nothing
        rsAnswer.Close
        Set rsAnswer = Nothing
    End If

    Dim rsSurvey, trsSurvey
    Set rsSurvey = Conn.Execute("select * from PE_Survey where SurveyID in (" & SurveyID & ")")
    
    Set trsSurvey = Server.CreateObject("adodb.recordset")
    trsSurvey.open "Select * from PE_Survey", tconn, 1, 3

    Do While Not rsSurvey.EOF

        trsSurvey.AddNew
        trsSurvey("SurveyID") = rsSurvey("SurveyID")
        trsSurvey("SurveyName") = rsSurvey("SurveyName")
        trsSurvey.Update
        rsSurvey.MoveNext
    Loop
    
    trsSurvey.Close
    Set trsSurvey = Nothing
    rsSurvey.Close
    Set rsSurvey = Nothing
    tconn.Close
    Set tconn = Nothing
    Call WriteSuccessMsg("已经成功将所选中的问卷题目导出到指定的数据库中！", ComeUrl)
End Sub

Sub ImportQuestion()
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;问卷题目导入"
    Response.Write "</td></tr></table>"

    If AdminPurview <> 1 And arrPurview(5) = False Then
        Response.Write "<table width='100%' class='border' border='0' cellspacing='1' cellpadding='1' align='center'>"
        Response.Write "<tr><td align='center'>您无问卷题目导入的权限！</td></tr></table>"
        Exit Sub
    End If

    Response.Write "<form name='myform' method='post' action='Admin_Survey.asp'>"
    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' align='center'><strong>问卷题目导入（第一步）</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'>"
    Response.Write "      <td height='100'>&nbsp;&nbsp;&nbsp;&nbsp;请输入要导入的数据库的文件名： "
    Response.Write "        <input name='SurveyMdb' type='text' id='SurveyMdb' value='../temp/PE_Survey.mdb' size='20' maxlength='50'>"
    Response.Write "        <input name='Submit' type='submit' id='Submit' value=' 下一步 '>"
    Response.Write "        <input name='Action' type='hidden' id='Action' value='ImportQuestion2'>"
    Response.Write "      </td>"
    Response.Write "    </tr>"
    Response.Write "  </table>"
    Response.Write "</form>"
End Sub

Sub ImportQuestion2()
    On Error Resume Next

    Dim rs, sql
    Dim mdbname, tconn, trs, iCount
    Dim ModuleType, ChannelName
    
    Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理 &nbsp;&gt;&gt;&nbsp;问卷题目导入"
    Response.Write "</td></tr></table>"
    mdbname = Replace(Trim(Request.Form("SurveyMdb")), "'", "")

    If mdbname = "" Then
        mdbname = Replace(Trim(Request.QueryString("SurveyMdb")), "'", "")
    End If

    mdbname = Replace(mdbname, "＄", "/") '防止外部链接安全问题

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请填写导入的数据库名"
        Exit Sub
    End If

 
    Set tconn = Server.CreateObject("ADODB.Connection")
    tconn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)

    If Err.Number <> 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>数据库操作失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
        Exit Sub
    End If

  
    Response.Write "<form name='myform' method='post' action='Admin_Survey.asp'>"
    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' align='center'><strong>问卷题目导入（第二步）</strong></td>"
    Response.Write "    </tr>"
    Response.Write "    <tr class='tdbg'> "
    Response.Write "      <td height='100' align='center'>"
    Response.Write "        <br>"
    Response.Write "        <table border='0' cellspacing='0' cellpadding='0'>"
    Response.Write "          <tr align='center'>"
    Response.Write "            <td><strong>源问卷</strong></td>"
    Response.Write "            <td></td>"
    Response.Write "            <td><strong>目标问卷</strong></td>"
    Response.Write "          </tr>"
    Response.Write "           <tr>"
    Response.Write "            <td>"
    
    Response.Write "              <select name='SurveyID' size='2' style='height:300px;width:250px;'>"

    sql = "select * from PE_Survey"

    Set rs = Server.CreateObject("Adodb.RecordSet")
    rs.open sql, tconn, 1, 1

    If rs.BOF And rs.EOF Then
        Response.Write "                <option value='0'>没有任何问卷</option>"
        iCount = 0
    Else
        iCount = rs.RecordCount
        Do While Not rs.EOF
            Response.Write "            <option value='" & rs("SurveyID") & "'>" & rs("SurveyName") & "</option>"
            rs.MoveNext
        Loop
    End If

    rs.Close
    Set rs = Nothing
    Response.Write "                   </select>"
    Response.Write "                  </td>"
    Response.Write "                  <td width='80'>&nbsp;&nbsp;导入到&gt;&gt;</td>"
    Response.Write "                  <td>"
    Response.Write "                    <select name='TargetSurveyID' size='2' style='height:300px;width:250px;'"

    If iCount = 0 Then Response.Write " disabled"
    Response.Write "                             >"
    

    sql = "select * from PE_Survey"


    Set rs = Conn.Execute(sql)

    If rs.BOF And rs.EOF Then
        Response.Write "              <option value='0'>没有任何问卷</option>"
    Else
        Do While Not rs.EOF
            Response.Write "           <option value='" & rs("SurveyID") & "'>" & rs("SurveyName") & "</option>"
            rs.MoveNext
        Loop
    End If

    rs.Close
    Set rs = Nothing
    
    Response.Write "                    </select>"
    Response.Write "                   </td>"
    Response.Write "                  </tr>"
    Response.Write "                  <tr><td colspan='3' height='10'></td></tr>"
    'Response.Write "                  <tr>"
    'Response.Write "                    <td height='25' align='center'><b> 提示：按住“Ctrl”或“Shift”键可以多选</b></td>"
    'Response.Write "                    <td height='25' align='center'></td>"
    'Response.Write "                    <td height='25' align='center'><b> 提示：按住“Ctrl”或“Shift”键可以多选</b></td>"
    'Response.Write "                  </tr>"
    Response.Write "                  <tr><td colspan='3' height='20'></td></tr>"
    Response.Write "                  <tr><td colspan='3' height='25' align='center'><input type='submit' name='Submit' value=' 导入问卷题目 '"

    If iCount = 0 Then Response.Write " disabled"
    Response.Write "                      ></td>"
    Response.Write "                 </tr>"
    Response.Write "               </table>"
    Response.Write "               <input name='TemplateMdb' type='hidden' id='TemplateMdb' value='" & mdbname & "'>"
    Response.Write "               <input name='Action' type='hidden' id='Action' value='DoImportQuestion'>"
    Response.Write "               <br>"
    Response.Write "            </td>"
    Response.Write "          </tr>"
    Response.Write "       </table>"
    Response.Write "</form>"
End Sub

Sub DoImportQuestion()
    On Error Resume Next
    
    Dim trs, mdbname, tconn
    Dim SurveyID, TargetSurveyID, rs, sql, QuestionID
    SurveyID = ReplaceBadChar(Trim(Request("SurveyID")))
    TargetSurveyID = ReplaceBadChar(Trim(Request("TargetSurveyID")))
    mdbname = Replace(Trim(Request.Form("Templatemdb")), "'", "")

    If SurveyID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定源问卷！</li>"
    End If

    If TargetSurveyID = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请指定目标问卷！</li>"
    End If

    If mdbname = "" Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>请填写源问卷所在的数据库名"
    End If
    
    If FoundErr = True Then
        Exit Sub
    End If
        
    Set tconn = Server.CreateObject("ADODB.Connection")
    tconn.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(mdbname)

    If Err.Number <> 0 Then
        ErrMsg = ErrMsg & "<li>数据库操作失败，请以后再试，错误原因：" & Err.Description
        Err.Clear
        Exit Sub
    End If

    'If FoundInArr(TargetSurveyID, 0, ",") = True Then

    Set trs = tconn.Execute(" select * from PE_SurveyQuestion where SurveyID=" & SurveyID & " order by OrderID")
    Set rs = Server.CreateObject("adodb.recordset")
    rs.open "select top 1 * from PE_SurveyQuestion", Conn, 1, 3

    Dim QuestionIDDic, OldQuestionID, NewQuestionID, MaxOrderID
    MaxOrderID = PE_CLng(Conn.Execute("select Max(OrderID) from PE_SurveyQuestion where SurveyID=" & TargetSurveyID)(0))

    Set QuestionIDDic = Server.CreateObject("Scripting.Dictionary")
    Do While Not trs.EOF
        rs.AddNew
        MaxOrderID = MaxOrderID + 1
        rs("QuestionContent") = trs("QuestionContent")
        rs("SurveyID") = TargetSurveyID
        rs("InputType") = trs("InputType")
        rs("QuestionType") = trs("QuestionType")
        rs("NotEmpty") = trs("NotEmpty")
        rs("IsDefault") = trs("IsDefault")
        rs("DataRight") = trs("DataRight")
        rs("ContentLength") = trs("ContentLength")
        rs("OrderID") = MaxOrderID
        If trs("QuestionType") <> 0 Then
            If QuestionID = "" Then
                QuestionID = trs("QuestionID")
            Else
                QuestionID = QuestionID & "," & trs("QuestionID")
            End If
        End If
        rs.Update
        NewQuestionID = Conn.Execute("select Max(QuestionID) from PE_SurveyQuestion")(0)
        OldQuestionID = trs("QuestionID")
        QuestionIDDic.Add CStr(OldQuestionID), CStr(NewQuestionID)
        trs.MoveNext
    Loop
    Set trs = Nothing
    rs.Close
    Set rs = Nothing
    
    Dim rsAnswer, trsAnswer
    Set rsAnswer = Server.CreateObject("Adodb.recordset")
    rsAnswer.open "Select * from PE_SurveyAnswer", Conn, 1, 3

    If QuestionID <> "" Then
        Set trsAnswer = tconn.Execute("select * from PE_SurveyAnswer where QuestionID in (" & QuestionID & ")")

        Do While Not trsAnswer.EOF
            rsAnswer.AddNew
            rsAnswer("QuestionID") = QuestionIDDic.Item(CStr(trsAnswer("QuestionID")))
            rsAnswer("AnswerContent") = trsAnswer("AnswerContent")
            rsAnswer("VoteAmount") = trsAnswer("VoteAmount")
            rsAnswer("OrderID") = trsAnswer("OrderID")
            rsAnswer.Update
            trsAnswer.MoveNext
        Loop
        trsAnswer.Close
        Set trsAnswer = Nothing
        rsAnswer.Close
        Set rsAnswer = Nothing
    End If
    tconn.Close
    Set tconn = Nothing

    Call WriteSuccessMsg("已经成功将所选中的问卷题目导入到指定的数据库中！", ComeUrl)

End Sub

Sub ShowContent()
    Dim rs, arrContent, i, j, sql, Other, Answer, Querysql, QuestionContent
    sql = "select * from PE_SurveyRecord" & SurveyID
    Querysql = " where 1=1"
    If SearchType <> "" And Keyword <> "" Then
        If SearchType = "QuestionContent" Then
            Querysql = Querysql & " and Q" & QuestionID & " like '%" & Keyword & "%'"
            strNavigation = "&nbsp;&gt;&gt;&nbsp;内容中含有 <font color='red'>" & Keyword & "</font> 的数据"
        End If
    End If
    strFileName = strFileName & "?Action=ShowContent&SurveyID=" & SurveyID & "&QuestionID=" & QuestionID & "&SearchType=" & SearchType & "&KeyWord=" & Keyword & ""
    sql = sql & Querysql
    Set rs = Server.CreateObject("adodb.recordset")
    rs.open sql, Conn, 1, 1
    If rs.BOF And rs.EOF Then
        totalPut = 0
        Response.Write "<li>没有任何内容</li>"
    Else
        totalPut = rs.RecordCount
        If CurrentPage < 1 Then
            CurrentPage = 1
        End If
        If (CurrentPage - 1) * MaxPerPage > totalPut Then
            If (totalPut Mod MaxPerPage) = 0 Then
                CurrentPage = totalPut \ MaxPerPage
            Else
                CurrentPage = totalPut \ MaxPerPage + 1
            End If
        End If
        If CurrentPage > 1 Then
            If (CurrentPage - 1) * MaxPerPage < totalPut Then
                rs.Move (CurrentPage - 1) * MaxPerPage
            Else
                CurrentPage = 1
            End If
        End If
        QuestionContent = Conn.Execute("select QuestionContent from PE_SurveyQuestion where QuestionID=" & QuestionID)(0)
        Response.Write "<br><table width='100%'><tr><td align='left'>您现在的位置：问卷调查管理&nbsp;&gt;&gt;&nbsp;<B>[</B><a href='Admin_Survey.asp?Action=ShowCountData1&SurveyID=" & SurveyID & "'>" & Conn.Execute("select SurveyName from PE_Survey where SurveyID=" & SurveyID)(0) & "</a><B>]</B>&nbsp;&gt;&gt;&nbsp;问题<B>[</B><font color=red>" & QuestionContent & "</font><B>]</B>&nbsp;调查结果" & strNavigation
        Response.Write "</td></tr></table>"
        Response.Write "<table width='100%' class='border' align='center' border='0' cellspacing='1' cellpadding='1'>"
        Response.Write "      <tr class='title'>" & vbCrLf
        Response.Write "        <td width='100%'><div align='left'>调查结果 </div></td>" & vbCrLf
        Do While Not rs.EOF
            If InStr(rs("Q" & QuestionID), "$$") > 0 Then
                Answer = Split(rs("Q" & QuestionID), "$$")
                Other = Answer(1)
            Else
                Other = rs("Q" & QuestionID)
            End If
            If Other = "" Then Other = "未填写"
            Response.Write "<tr class='tdbg'><td align='left'>" & Other & "</td></tr>"
            i = i + 1
            If i >= MaxPerPage Then Exit Do
            'If (i Mod 8) = 0 And i > 1 Then Response.Write "</tr><tr>"
            rs.MoveNext
        Loop
        Response.Write "</table><br>"
    End If
    Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "个", True)
    rs.Close
    Set rs = Nothing

    Response.Write "<br>"
    Response.Write "<form method='Post' name='SearchForm' action='Admin_Survey.asp'>"
    Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0' class='border'>"
    Response.Write "  <tr class='tdbg'>"
    Response.Write "   <td width='80' align='right'><strong>问题搜索：</strong></td>"
    Response.Write "     <td>"
    Response.Write "        <select name='SearchType' size='1'>"
    Response.Write "        <option value='QuestionContent' selected>调查结果</option>"
    Response.Write "        </select>"
    Response.Write "        <input type='text' name='keyword'  size='20' value='关键字' maxlength='50' onFocus='this.select();'>"
    Response.Write "        <input type='submit' name='Submit'  value='搜索'>"
    Response.Write "        <input type='hidden' name='Action'  value='ShowContent'>"
    Response.Write "        <input type='hidden' name='SurveyID'  value='" & SurveyID & "'>"
    Response.Write "        <input type='hidden' name='QuestionID'  value='" & QuestionID & "'>"
    Response.Write "     </td>"
    Response.Write "   </td>"
    Response.Write "   </tr>"
    Response.Write "</table>"
    Response.Write "</form>"
    Response.Write "<br>"
End Sub

Function IsRadioChecked(Compare1, Compare2)
    If Compare1 = Compare2 Then
        IsRadioChecked = " checked"
    Else
        IsRadioChecked = ""
    End If
End Function

%>
