📄 listreport.asp
字号:
<%Option Explicit%>
<!--#include file="../conn.asp"-->
<!--#include file="../inc/function.asp"-->
<html>
<head>
<title>问卷调查</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link href="../Admin/Admin_Style.css" rel="stylesheet" type="text/css">
</head>
<body bgcolor="#FFFFFF" leftmargin="0" topmargin="0" marginwidth="0" marginheight="0">
<table width="600" border="0" align="center" cellpadding="0" cellspacing="0">
<tr>
<td><img src="../Survey/images/top.jpg" width="600" height="95"></td>
</tr>
<tr>
<td style="padding:8px; border-left:#999999 solid 1px;border-right:#999999 solid 1px;"><table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td>
<%
If Action = "ShowContent" Then
Call ShowContent
Else
Call ListReport
End If
%>
</td>
</tr>
<tr>
<td bgcolor="#0149a8"> </td>
</tr>
</table>
</body>
</html>
<%
Private Sub ListReport()
Dim SurveyID, rs, sql, Rs2, TotalNum, rs1, j, IsOpen, SurveyName
SurveyID = PE_CLng(Trim(Request("SurveyID")))
If SurveyID = 0 Then
Response.Write "<br><li>请指定问卷ID！！！</li>"
Exit Sub
End If
Set IsOpen = conn.execute("select IsOpen,SurveyName From PE_Survey where SurveyID=" & SurveyID & "")
If IsOpen.EOF Then
Response.Write "<br><li>指定的问卷不存在！！！</li>"
Exit Sub
ElseIf IsOpen(0) = 0 Then
Response.Write "<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
Response.Write "<br><li>指定的问卷不存在题目！！！</li>"
Exit Sub
End If
Response.Write "<br><div style='font-size:18pt' align='center'><b>《" & SurveyName & "》问卷调查结果</div><br>"
Do While Not rs.EOF
Select Case rs("QuestionType")
Case 0
Response.Write "<table width='100%' align='center'>"
Response.Write " <tr>"
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>"
End If
Response.Write " </tr>"
Response.Write "</table>"
Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border' align='center'>"
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='ListReport.asp?Action=ShowContent&QuestionID=" & rs("QuestionID") & "&SurveyID=" & SurveyID & "' target='_blank'>内容</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%' align='center'>"
Response.Write " <tr>"
Select Case rs("QuestionType")
Case 1
Response.Write " <td align=left clospan='1' nowrap>" & j & "、（单选）" & rs("QuestionContent") & "</td>"
Case 2
Response.Write " <td align=left clospan='1' nowrap>" & j & "、（多选）" & rs("QuestionContent") & "</td>"
Case 3
Response.Write " <td align=left clospan='1' nowrap>" & j & "、（下拉选框）" & rs("QuestionContent") & "</td>"
End Select
Response.Write " </tr>"
Response.Write "</table>"
Response.Write "<table width='100%' border='0' cellspacing='1' cellpadding='2' class='border' align='center'>"
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=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='Images/Survey" & ImgSerial & ".gif' height='1' width='15'></td>" & vbCrLf
Else
Response.Write FormatNumber(Int(rs1(1) / TotalNum * 10000) / 100, 2, -1) & "%<img src='Images/Survey" & ImgSerial & ".gif' height='" & Int(rs1(1) / TotalNum * 120) & "' width='15'></td>" & vbCrLf
End If
rs1.MoveNext
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -