scorequery.asp

一本关于大学的书

					%>
				</tr>
				<% 
				While NOT rsScore.EOF 
					ScoreCount=0
					strName=trim(rsScore.Fields.Item("Name").Value)
					if strName="" then strName="&nbsp;"%>
					<tr class="tdbg" onmouseout=this.style.backgroundColor="" onmouseover=this.style.backgroundColor="#BFDFFF">   
					  <td height="20" align="center" nowrap><font color="#000000"><%=(rsScore.Fields.Item("StudentNum").Value)%></font></td>
					  <td height="20" align="center" nowrap><font color="#000000"><%=strName%></font></td>
					  <%
						  For i = LBound(ArrSubject) To UBound(ArrSubject)
							  strSubject=trim(ReplaceBadChar(ArrSubject(i)))
							  if strSubject="总分" then
								  strScore=ScoreCount
								  if strScore<60*SubjectCount then
									  strScore = "<font color='#ff0000'>" & strScore & "</font>"
								  elseif strScore>=60*SubjectCount and strScore<80*SubjectCount then
									  strScore = "<font color='#0000ff'>" & strScore & "</font>"
								  elseif strScore>=80*SubjectCount then
									  strScore = "<font color='#009900'>" & strScore & "</font>"
								  end if
							  elseif strSubject="全级排名" or strSubject="班级排名"	then
								  strScore=rsScore.Fields.Item(strSubject).Value
								  if IsNull(strScore) then strScore=0
							  else
								  if strSubject="平均分" then
									  strScore=Round(ScoreCount/SubjectCount,1)
								  else
									  strScore=rsScore.Fields.Item(strSubject).Value
									  if IsNull(strScore) then strScore=0
									  ScoreCount=ScoreCount+strScore
								  end if
								  if strScore<60 then
									  strScore = "<font color='#ff0000'>" & strScore & "</font>"
								  elseif strScore>=60 and strScore<80 then
									  strScore = "<font color='#0000ff'>" & strScore & "</font>"
								  elseif strScore>=80 then
									  strScore = "<font color='#009900'>" & strScore & "</font>"
								  end if
							  end if
							  response.write "<td height='20' align='center'>" & strScore & "</td>"
						  next						  
						  response.write "</tr>"
						  rsScore.MoveNext()
					  Wend
				  rsScore.Close()
				  Set rsScore = Nothing
				  Call CloseSdmsConn
				  %>
			  </table><% 
		  Else 
			  FoundErr = True
			  ErrMsg=ErrMsg&"<br><li>找不到符合条件的记录！！！</li>"
			  rsScore.Close()
			  Set rsScore = Nothing
			  Call CloseSdmsConn
			  Exit Sub
		  End If 
			%><br><br><br><div align=center><a href="javascript:window.close();">【关闭】</a></div>			
		</TD>
	  </TR>
	</TABLE><%
End Sub

Sub ShowSearchResult2()
	Dim strSubjects
	StudentNum=Trim(Request("StudentNum"))
	StudentName=Trim(Request("StudentName"))
	Birthday=Trim(Request("Birthday"))
	strSubject=Trim(Request("Subject"))
	If strSubject="" Then
		FoundErr = True
		ErrMsg=ErrMsg&"<br><li>所选科目不能为空！！！</li>"
		Exit Sub
	End If
	If StudentNum="" Then
		FoundErr = True
		ErrMsg=ErrMsg&"<br><li>学生学号不能为空！！！</li>"
		Exit Sub
	End If
	If Birthday="" Then
		FoundErr = True
		ErrMsg=ErrMsg&"<br><li>学生生日不能为空！！！</li>"
		Exit Sub
	End If
	If StudentName="" Then
		FoundErr = True
		ErrMsg=ErrMsg&"<br><li>学生姓名不能为空！！！</li>"
		Exit Sub
	End If
	If Birthday<>"" And IsDate(Birthday) = False Then
		FoundErr = True
		ErrMsg=ErrMsg&"<br><li>输入的生日不是规则日期！！！</li>"
		Exit Sub
	End If
	%>
	<TABLE cellSpacing=0 cellPadding=0 width=700 align=center border=0>
	  <TR> 
		<TD valign="top" ><font size="5">&nbsp;</font><br>
		  <b>
		  <font color="#FF0000">科目名称：</font></b>&nbsp;<%=strSubject%><font color="#FF0000"><b><font color="#0066cc">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</font></b></font><font color="#FF0000"><b>&nbsp;查询条件：</b></font> 
            学号（<%If StudentNum<>"" Then 
	  		Response.write StudentNum
			Else
				Response.write "不指定"
			End If%>） 姓名（<%If StudentName<>"" Then 
				Response.write StudentName
			Else
				Response.write "不指定"
			End If%>） 生日（<%If Birthday<>"" Then 
				Response.write Birthday
			Else
				Response.write "不指定"
			End If%>）<br><br><%
			Dim Sql,Recordset1
			Call OpenSdmsConn
			set Recordset1 = Server.CreateObject("ADODB.Recordset")
			Sql = "SELECT StudentNum,Name FROM StudentInfo WHERE 1=1"
			Sql =Sql& " And StudentNum ='" & ReplaceBadChar(StudentNum) & "'"
			Sql =Sql& " And Name ='" & ReplaceBadChar(StudentName) & "'"
			Sql =Sql& " And Birthday =#" & ReplaceBadChar(Birthday) & "#"

			'Sql =Sql& " ORDER BY StudentNum Asc"
			Recordset1.Open Sql, conn_Sdms, 1, 1

			If Not Recordset1.EOF Or Not Recordset1.BOF Then %>
				<table class='border' border='0' cellspacing='1' cellpadding='4' align='center'>
				  <tr valign="middle" class="title"> 		   
					<td width="60" rowspan="2" align="center">学 号</td>
					<td width="50" rowspan="2" align="center">姓 名</td>
					<%
					Dim strTemp,arrSheetName,strSheetName
					Dim rsSubjects()

					strTemp = Trim(Request("SheetName"))
					arrSheetName = split(strTemp,",")

					Redim rsSubjects(Ubound(arrSheetName)+1)
		  
					For i = LBound(arrSheetName) To UBound(arrSheetName)
						strSheetName=trim(ReplaceBadChar(arrSheetName(i)))
						Dim rsTestName__MMColParam,strTestName
						rsTestName__MMColParam=strSheetName
						Dim rsTestName,sqlTestName
						set rsTestName = Server.CreateObject("ADODB.Recordset")
						sqlTestName = "SELECT SheetName, TestName FROM TestName WHERE SheetName = '" + Replace(rsTestName__MMColParam, "'", "''") + "'"
						rsTestName.Open sqlTestName,conn_Sdms, 1, 1
						strTestName=rsTestName.Fields.Item("TestName")
						rsTestName.close
						set rsTestName = Nothing
						
						strTestName=left(strTestName,len(strTestName)\2) & "<br>" & mid(strTestName,len(strTestName)\2+1,len(strTestName))
						response.write "<td height='20' align='center'>" & strTestName & "</td>"
					next
					%>
				  </tr>
				  <tr align="center" valign="middle" class="tdbg1"> 
					<%
					For i = LBound(arrSheetName) To UBound(arrSheetName)
						if strSubject<>"全级排名" and strSubject<>"班级排名" then
							response.write "<td height='20' align='center'>"&strSubject&"成绩</td>"
						else
							response.write "<td height='20' align='center'>名次</td>"
						end if	
					next
				  %>
				  </tr>
				  <% 
					While NOT Recordset1.EOF 
						For i = LBound(arrSheetName) To UBound(arrSheetName)
							strSheetName=trim(ReplaceBadChar(arrSheetName(i)))
							set rsSubjects(i) = Server.CreateObject("ADODB.Recordset")
							rsSubjects__MMColParam =ReplaceBadChar(Recordset1.Fields.Item("StudentNum"))
							sqlSubjects = "SELECT " & ReplaceBadChar(strSubject) & " FROM " & strSheetName & " WHERE StudentNum = '" + Replace(rsSubjects__MMColParam,"'","''") + "'"
							rsSubjects(i).Open sqlSubjects,conn_Sdms,1,1
						next
						%>
						<tr class="tdbg" onmouseout=this.style.backgroundColor="" onmouseover=this.style.backgroundColor="#BFDFFF">  
						  <td height="20" nowrap align="center"><%=(Recordset1.Fields.Item("StudentNum").Value)%></td>
						  <td height="20" nowrap align="center"><%=(Recordset1.Fields.Item("Name").Value)%></td>
							<%
							For i = LBound(arrSheetName) To UBound(arrSheetName)
								if rsSubjects(i).bof or  rsSubjects(i).eof then
									strScore=0
								else
									strScore=rsSubjects(i).Fields.Item(strSubject).Value
									if IsNull(strScore) then strScore=0
								end if
								rsSubjects(i).Close
								set rsSubjects(i) = Nothing
								
								strScore = "<font color='#009900'>" & strScore & "</font>"

								response.write "<td height='20' align='center'>" & strScore & "</td>"
							next%>
						</tr>
						<% 
						Recordset1.MoveNext()
					Wend
					Recordset1.Close()
				    Set Recordset1 = Nothing
				    Call CloseSdmsConn%>
				</table><%
		    Else 
			    FoundErr = True
			    ErrMsg=ErrMsg&"<br><li>找不到符合条件的记录！！！</li>"
				Recordset1.Close()
				Set Recordset1 = Nothing
				Call CloseSdmsConn
			    Exit Sub
		    End If%><br><br><br><div align=center><a href="javascript:window.close();">【关闭】</a></div>		
	    </TD>
	  </TR>
	</TABLE><%
End Sub

Function WriteErrMsg(sErrMsg, sComeUrl)
    Dim strMsg
    strMsg = strMsg & "<html><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
    strMsg = strMsg & "</head><body><br><br>" & vbCrLf
    strMsg = strMsg & "<table cellpadding=2 cellspacing=1 border=0 width=400 class='border' align=center>" & vbCrLf
    strMsg = strMsg & "  <tr align='center' class='title'><td height='22'><strong>错误信息</strong></td></tr>" & vbCrLf
    strMsg = strMsg & "  <tr class='tdbg'><td height='100' valign='top'><b>产生错误的可能原因：</b>" & sErrMsg & "</td></tr>" & vbCrLf
    strMsg = strMsg & "  <tr align='center' class='tdbg'><td>"
    If sComeUrl <> "" Then
        strMsg = strMsg & "<a href='javascript:history.go(-1)'>&lt;&lt; 返回上一页</a>"
    Else
        strMsg = strMsg & "<a href='javascript:window.close();'>【关闭】</a>"
    End If
    strMsg = strMsg & "</td></tr>" & vbCrLf
    strMsg = strMsg & "</table>" & vbCrLf
    strMsg = strMsg & "</body></html>" & vbCrLf
    WriteErrMsg = strMsg
End Function

Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',--,%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceBadChar = tempChar
End Function

Sub OpenSdmsConn()
    On Error Resume Next
    Dim ConnStr
	'当放置网站其它位置时，请相应修改此处数据库参数设置
	ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("database/Data_Sdms.mdb")
    Set conn_Sdms = Server.CreateObject("ADODB.Connection")
    conn_Sdms.open ConnStr
    If Err Then
        Err.Clear
        Set conn_Sdms = Nothing
        Response.Write "数据库连接出错，请检查ScoreQuery.asp文件中的数据库参数设置。"
        Response.End
    End If
End Sub

Sub CloseSdmsConn()
    On Error Resume Next
    If IsObject(conn_Sdms) Then
        conn_Sdms.Close
        Set conn_Sdms = Nothing
    End If
End Sub
%>