用ASP开发试题库与在线考试系统(8)


七、附录:源程序列表

  由于源代码繁多,限于篇幅,无法一一列举,现只公布部分代码,具体以系统实物为准。下面是录入试题.asp文件:

<script language="VBScript">
<!-- 'Written by HeKai 2001
Function datacheck()'确保前台输入数据合法
 dim errflag, msg
 errflag = True
 if Len(Trim(luru.xzsj.value)) = 0 Then
  focusto(1); errflag = false; msg="请输入 '选自书籍名称'"
 ElseIf Len(Trim(luru.stnr.value)) = 0 Then
  focusto(9); errflag = false; msg=" '试题内容' 呢"
 ElseIf Len(Trim(luru.A.value)) = 0 Then
  focusto(10); errflag = false; msg=" '答案_A' 呢"
   ┋ ┋ ┋
 ElseIf Len(Trim(luru.F.value)) = 0 Then
  focusto(15); errflag = false; msg="请还原成默认值"
 End if
 If (errflag = false) then
  msg = msg & vbCRLF
  MsgBox msg, 64, "提示"
  Exit Function
 End if
  datacheck = errflag; luru.Submit
End Function

Sub focusto(x)'将鼠标定位在出错处
document.luru.elements(x).focus()
End Sub
--></script>

  以下是录入试题.inc文件:

<script Language="VBScript" RunAt="Server">
 Function check_Pass()'检查库中是否已有此数据
  kmxxmc = Request.Form("kmxxmc")
  stbh = Request.Form("stbh") stnr = Request.Form("stnr")
  SQLstr = "select * from " & kmxxmc & " where stbh=" & "'" & stbh & "'"
  SQLstr = SQLstr & " or tmnr=" & "'" & stnr & "'"
  set adocon=Server.CreateObject("ADODB.Connection")
  adocon.Open "zxtest"
  set sa1=adocon.Execute(SQLstr)
  If sa1.EOF Then
   check_Pass = False
  Else
   check_Pass = True
  End If
  sa1.Close adocon.Close
End Function

Sub Add_Comment()'开始插入数据并显示出来
 Dim kmxxmc,xzsj,tmlx,nycd,jxyq,stbh,stnr
 Dim A,B,C,D,E,F,bzda,lrz,Picstr,SQLstr,lr_date,zhang,jie
 kmxxmc = Request.Form("kmxxmc") xzsj = Request.Form("xzsj")
  ┋ ┋ ┋
 bzda = Request.Form("bzda") zhang = Request.form("zhang")
 set adocon=Server.CreateObject("ADODB.Connection")
 adocon.Open "zxtest"
 SQLstr = "insert into " & kmxxmc & " (xzsj,tmlx,tmnd,jxyq,stbh,tmnr,  bxda_a,"
 SQLstr = SQLstr & ",jie,lrz) values (" & "'" & xzsj & "'," & "'" & tmlx & "',"
  ┋ ┋ ┋
 SQLstr = SQLstr & "'," & "'" & date & "'," & "'" & zhang & "'," & "'" & jie & "'," SQLstr = SQLstr & "'" & lrz & "')"
 set sa1 = adocon.Execute(SQLstr)
 Picstr="<img src='/images/hekai.jpg'>"
 Response.Write "恭喜!此为<i> " & lrz & "</i> 刚才录入的试题"
 Response.Write Picstr & " 试题编号:" & stbh
 Response.Write "试题内容:" & stnr & "<br>"
 Response.Write "答案_A:" & A & "<br>"
  ┋ ┋ ┋
 adocon.Close
End Sub

Sub Register()
 If check_Pass() Then '如果库中已有的话,则给出提示信息
  Show_Warning()
 Else '否则添加进去
  Add_Comment()
 End If
End Sub

Sub Show_Warning()'给出提示信息的函数
 Response.Write("<p>")
 Response.Write("<center>很抱歉<p>")
 Response.Write("库中已有此试题编号或试题内容,请返回前页修改!")
 Response.Write("</center>")
 Response.Write("Made by hekai himself in 2001")
End Sub
</script>

此为"检索试题"的程序代码:
<script Language="VBScript" RunAt="Server">
Function adjust_sql(adj_str)
 '目的---转换查询字符串中的特殊字符至SQL指令
 Dim final_str, i 'WRITE BY HEKAI2001
 adj_str = Trim(adj_str)
 final_str = "" '每次从传进来的字符串中取出一个字符,并判断是否为下述三个字符之一: DOS的Filter符号"|"、左中括号"["以及单引号"'"
 If Len(adj_str) > 0 Then
  For i = 1 To Len(adj_str)
   Select Case Mid(adj_str, i, 1)
     Case "[": final_str = final_str & "[[]"
     Case "|": final_str = final_str & "[{-}]"
     Case "'": final_str = final_str & "[&-()"
     Case Else: '以上皆非则什么事都不做!
     final_str = final_str & Mid(adj_str, i, 1)
   End Select
  Next
 End If
 adjust_sql = final_str
End Function

Sub Output_shiti()
 Dim kmxxmc,xzsj,stbh,zhang,jie,tmlx,nycd,jxyq,lrz,stnr,cond_count, Picstr
 Dim SQLstr,mf,zhangfw,jiefw,stbhfw,nycdfw,lr_datefw,lr_date
 '记录指定条件的栏位总数
 cond_count = 10; mf = "%"
 Picstr="<img src='/images/hk.gif'>"
 '取得表单栏位内容
 kmxxmc = Request.Form("kmxxmc")
 stbh = Request.Form("stbh")
  ┋ ┋ ┋
 stnr = Request.Form("stnr")
 '调整SQL指令中的特定字元
 kmxxmc = adjust_sql(kmxxmc)
 stbh = adjust_sql(stbh)
  ┋ ┋ ┋
 stnr = adjust_sql(stnr)
 If Len(xzsj) = 0 Then cond_count = cond_count - 1
  If Len(stbh) = 0 Then cond_count = cond_count - 1
  ┋ ┋ ┋
  If Len(stnr) = 0 Then cond_count = cond_count - 1
   SQLstr = "select * from " & kmxxmc & " where "
  If Len(stbh) > 0 Then
   SQLstr = SQLstr & " stbh " & stbhfw & "'" & stbh & "'"
  If cond_count > 1 Then
   SQLstr = SQLstr & " and "
   cond_count = cond_count - 1
  End If
 End If
  ┋ ┋ ┋
 If Len(stnr) > 0 Then
  SQLstr = SQLstr & " tmnr like " & "'" & mf & stnr & mf & "'"
  If cond_count > 1 Then
   SQLstr = SQLstr & " and "
   cond_count = cond_count - 1
  End If
 End If
 SQLstr = SQLstr & " order by lr_date DESC "
 set adocon=Server.CreateObject("ADODB.Connection")
 adocon.Open "zxtest"
 set sa1 = adocon.Execute(SQLstr)
 If sa1.EOF Then
  Response.Write "<br><center><h1>"
  Response.Write "Sorry!<p>"
  Response.Write "没有找到试题,"
  esponse.Write "请重试一次!</center><p>"
  Response.Write "<hr></h1>"
 Else
  i = 0
  Response.Write "<h2>"
  Response.Write "符合条件的试题相关内容如下:"
  Response.Write "</h2>"
  While Not sa1.EOF
   i = i + 1
   Response.Write "第 <i>" & i & "</i>题 题编号:<i>" & sa1("stbh") & "</i><br>"
   Response.Write "试题内容:" & sa1("tmnr") & "<br>"
    ┋ ┋ ┋
  Response.Write "答案A:" & sa1("bxda_a") & "<br>"
  sa1.MoveNext
  WEnd
  adocon.Close
 End If
End Sub
</script>

<% '"检索试卷"的查询方式源代码
 mf="%"
 select case request("findfs")
  case "sjbh"
   sqlstr="SELECT * FROM tbsjxx WHERE " & " sjbh LIKE"
   sqlstr=sqlstr & "'" & mf & request("findfsz") & mf & "'order by ksrq DESC"
   ┋ ┋ ┋
  case "lr_date"
   sqlstr="SELECT * FROM tbsjxx WHERE " & " lr_date LIKE"
   sqlstr=sqlstr & "'" & mf & request("findfsz") & mf & "'order by ksrq DESC"
  case else
   sqlstr="SELECT * FROM tbsjxx order by ksrq DESC"
end select %>

  下面是考试的时间自动控制程序(便于演示只设了60秒钟,实际应用应以系统调出试卷的考试时间为准!):

<SCRIPT language=JavaScript>
<!-- Write by HEKAI for TestTimeContorl
var timerID = null;var timerRunning = false
var stardate = new Date();var startime = gettotalsecond(stardate)
var totaltime = 60; var lasttime;var facetime
function Stepclock(){
// hk made by himself
if(timerRunning)
clearTimeout(timerID)
timerRunning = false }
function startclock(){
Stepclock();showtime() }
function gettotalsecond(getdate){
var hours = getdate.getHours()
var minutes = getdate.getMinutes();var seconds = getdate.getSeconds()
var gettotalsecond = seconds + minutes * 60 + hours * 3600
return(gettotalsecond) }
function showtime(){
var now = new Date();var timeValue = gettotalsecond(now)
document.clock.face.value = timeValue - startime
facetime = document.clock.face.value;lasttime = totaltime - facetime
document.clock.sytime.value = lasttime
timerID = setTimeout("showtime()",1000)
timerRunning = true
if (lasttime == 20){
for(i=1;i<=3;i++){
alert('考试时间只剩下最后20秒!')}}
if (lasttime == 0){
for(i=1;i<=5;i++){
alert('时间完毕!请迅速交卷!!')}}
if (lasttime == -10){
for(i=1;i<=10;i++){
alert('考试时间超过10秒,关闭此窗口!')}}
}//-->
</SCRIPT> 

  八、后记

  此系统从研究设计到投入实际应用历时4个月之余,通过多次细致的测试及鉴定,证明系统完全具有可行性与可扩充性,就最近传来的消息,该系统获得了湖南省科技厅的普遍好评。另外,系统还有待于进一步升级,并将实现试卷的主观题部分和多媒体试卷。因此,仍有大量的工作需要开展。若有不详或不妥之处,请您以应用程序为准以及提出良好的意见与建议。

本文作者:

七、附录:源程序列表

  由于源代码繁多,限于篇幅,无法一一列举,现只公布部分代码,具体以系统实物为准。下面是录入试题.asp文件:

<script language="VBScript">
<!-- 'Written by HeKai 2001
Function datacheck()'确保前台输入数据合法
 dim errflag, msg
 errflag = True
 if Len(Trim(luru.xzsj.value)) = 0 Then
  focusto(1); errflag = false; msg="请输入 '选自书籍名称'"
 ElseIf Len(Trim(luru.stnr.value)) = 0 Then
  focusto(9); errflag = false; msg=" '试题内容' 呢"
 ElseIf Len(Trim(luru.A.value)) = 0 Then
  focusto(10); errflag = false; msg=" '答案_A' 呢"
   ┋ ┋ ┋
 ElseIf Len(Trim(luru.F.value)) = 0 Then
  focusto(15); errflag = false; msg="请还原成默认值"
 End if
 If (errflag = false) then
  msg = msg & vbCRLF
  MsgBox msg, 64, "提示"
  Exit Function
 End if
  datacheck = errflag; luru.Submit
End Function

Sub focusto(x)'将鼠标定位在出错处
document.luru.elements(x).focus()
End Sub
--></script>

  以下是录入试题.inc文件:

<script Language="VBScript" RunAt="Server">
 Function check_Pass()'检查库中是否已有此数据
  kmxxmc = Request.Form("kmxxmc")
  stbh = Request.Form("stbh") stnr = Request.Form("stnr")
  SQLstr = "select * from " & kmxxmc & " where stbh=" & "'" & stbh & "'"
  SQLstr = SQLstr & " or tmnr=" & "'" & stnr & "'"
  set adocon=Server.CreateObject("ADODB.Connection")
  adocon.Open "zxtest"
  set sa1=adocon.Execute(SQLstr)
  If sa1.EOF Then
   check_Pass = False
  Else
   check_Pass = True
  End If
  sa1.Close adocon.Close
End Function

Sub Add_Comment()'开始插入数据并显示出来
 Dim kmxxmc,xzsj,tmlx,nycd,jxyq,stbh,stnr
 Dim A,B,C,D,E,F,bzda,lrz,Picstr,SQLstr,lr_date,zhang,jie
 kmxxmc = Request.Form("kmxxmc") xzsj = Request.Form("xzsj")
  ┋ ┋ ┋
 bzda = Request.Form("bzda") zhang = Request.form("zhang")
 set adocon=Server.CreateObject("ADODB.Connection")
 adocon.Open "zxtest"
 SQLstr = "insert into " & kmxxmc & " (xzsj,tmlx,tmnd,jxyq,stbh,tmnr,  bxda_a,"
 SQLstr = SQLstr & ",jie,lrz) values (" & "'" & xzsj & "'," & "'" & tmlx & "',"
  ┋ ┋ ┋
 SQLstr = SQLstr & "'," & "'" & date & "'," & "'" & zhang & "'," & "'" & jie & "'," SQLstr = SQLstr & "'" & lrz & "')"
 set sa1 = adocon.Execute(SQLstr)
 Picstr="<img src='/images/hekai.jpg'>"
 Response.Write "恭喜!此为<i> " & lrz & "</i> 刚才录入的试题"
 Response.Write Picstr & " 试题编号:" & stbh
 Response.Write "试题内容:" & stnr & "<br>"
 Response.Write "答案_A:" & A & "<br>"
  ┋ ┋ ┋
 adocon.Close
End Sub

Sub Register()
 If check_Pass() Then '如果库中已有的话,则给出提示信息
  Show_Warning()
 Else '否则添加进去
  Add_Comment()
 End If
End Sub

Sub Show_Warning()'给出提示信息的函数
 Response.Write("<p>")
 Response.Write("<center>很抱歉<p>")
 Response.Write("库中已有此试题编号或试题内容,请返回前页修改!")
 Response.Write("</center>")
 Response.Write("Made by hekai himself in 2001")
End Sub
</script>

此为"检索试题"的程序代码:
<script Language="VBScript" RunAt="Server">
Function adjust_sql(adj_str)
 '目的---转换查询字符串中的特殊字符至SQL指令
 Dim final_str, i 'WRITE BY HEKAI2001
 adj_str = Trim(adj_str)
 final_str = "" '每次从传进来的字符串中取出一个字符,并判断是否为下述三个字符之一: DOS的Filter符号"|"、左中括号"["以及单引号"'"
 If Len(adj_str) > 0 Then
  For i = 1 To Len(adj_str)
   Select Case Mid(adj_str, i, 1)
     Case "[": final_str = final_str & "[[]"
     Case "|": final_str = final_str & "[{-}]"
     Case "'": final_str = final_str & "[&-()"
     Case Else: '以上皆非则什么事都不做!
     final_str = final_str & Mid(adj_str, i, 1)
   End Select
  Next
 End If
 adjust_sql = final_str
End Function

Sub Output_shiti()
 Dim kmxxmc,xzsj,stbh,zhang,jie,tmlx,nycd,jxyq,lrz,stnr,cond_count, Picstr
 Dim SQLstr,mf,zhangfw,jiefw,stbhfw,nycdfw,lr_datefw,lr_date
 '记录指定条件的栏位总数
 cond_count = 10; mf = "%"
 Picstr="<img src='/images/hk.gif'>"
 '取得表单栏位内容
 kmxxmc = Request.Form("kmxxmc")
 stbh = Request.Form("stbh")
  ┋ ┋ ┋
 stnr = Request.Form("stnr")
 '调整SQL指令中的特定字元
 kmxxmc = adjust_sql(kmxxmc)
 stbh = adjust_sql(stbh)
  ┋ ┋ ┋
 stnr = adjust_sql(stnr)
 If Len(xzsj) = 0 Then cond_count = cond_count - 1
  If Len(stbh) = 0 Then cond_count = cond_count - 1
  ┋ ┋ ┋
  If Len(stnr) = 0 Then cond_count = cond_count - 1
   SQLstr = "select * from " & kmxxmc & " where "
  If Len(stbh) > 0 Then
   SQLstr = SQLstr & " stbh " & stbhfw & "'" & stbh & "'"
  If cond_count > 1 Then
   SQLstr = SQLstr & " and "
   cond_count = cond_count - 1
  End If
 End If
  ┋ ┋ ┋
 If Len(stnr) > 0 Then
  SQLstr = SQLstr & " tmnr like " & "'" & mf & stnr & mf & "'"
  If cond_count > 1 Then
   SQLstr = SQLstr & " and "
   cond_count = cond_count - 1
  End If
 End If
 SQLstr = SQLstr & " order by lr_date DESC "
 set adocon=Server.CreateObject("ADODB.Connection")
 adocon.Open "zxtest"
 set sa1 = adocon.Execute(SQLstr)
 If sa1.EOF Then
  Response.Write "<br><center><h1>"
  Response.Write "Sorry!<p>"
  Response.Write "没有找到试题,"
  esponse.Write "请重试一次!</center><p>"
  Response.Write "<hr></h1>"
 Else
  i = 0
  Response.Write "<h2>"
  Response.Write "符合条件的试题相关内容如下:"
  Response.Write "</h2>"
  While Not sa1.EOF
   i = i + 1
   Response.Write "第 <i>" & i & "</i>题 题编号:<i>" & sa1("stbh") & "</i><br>"
   Response.Write "试题内容:" & sa1("tmnr") & "<br>"
    ┋ ┋ ┋
  Response.Write "答案A:" & sa1("bxda_a") & "<br>"
  sa1.MoveNext
  WEnd
  adocon.Close
 End If
End Sub
</script>

<% '"检索试卷"的查询方式源代码
 mf="%"
 select case request("findfs")
  case "sjbh"
   sqlstr="SELECT * FROM tbsjxx WHERE " & " sjbh LIKE"
   sqlstr=sqlstr & "'" & mf & request("findfsz") & mf & "'order by ksrq DESC"
   ┋ ┋ ┋
  case "lr_date"
   sqlstr="SELECT * FROM tbsjxx WHERE " & " lr_date LIKE"
   sqlstr=sqlstr & "'" & mf & request("findfsz") & mf & "'order by ksrq DESC"
  case else
   sqlstr="SELECT * FROM tbsjxx order by ksrq DESC"
end select %>

  下面是考试的时间自动控制程序(便于演示只设了60秒钟,实际应用应以系统调出试卷的考试时间为准!):

<SCRIPT language=JavaScript>
<!-- Write by HEKAI for TestTimeContorl
var timerID = null;var timerRunning = false
var stardate = new Date();var startime = gettotalsecond(stardate)
var totaltime = 60; var lasttime;var facetime
function Stepclock(){
// hk made by himself
if(timerRunning)
clearTimeout(timerID)
timerRunning = false }
function startclock(){
Stepclock();showtime() }
function gettotalsecond(getdate){
var hours = getdate.getHours()
var minutes = getdate.getMinutes();var seconds = getdate.getSeconds()
var gettotalsecond = seconds + minutes * 60 + hours * 3600
return(gettotalsecond) }
function showtime(){
var now = new Date();var timeValue = gettotalsecond(now)
document.clock.face.value = timeValue - startime
facetime = document.clock.face.value;lasttime = totaltime - facetime
document.clock.sytime.value = lasttime
timerID = setTimeout("showtime()",1000)
timerRunning = true
if (lasttime == 20){
for(i=1;i<=3;i++){
alert('考试时间只剩下最后20秒!')}}
if (lasttime == 0){
for(i=1;i<=5;i++){
alert('时间完毕!请迅速交卷!!')}}
if (lasttime == -10){
for(i=1;i<=10;i++){
alert('考试时间超过10秒,关闭此窗口!')}}
}//-->
</SCRIPT> 

  八、后记

  此系统从研究设计到投入实际应用历时4个月之余,通过多次细致的测试及鉴定,证明系统完全具有可行性与可扩充性,就最近传来的消息,该系统获得了湖南省科技厅的普遍好评。另外,系统还有待于进一步升级,并将实现试卷的主观题部分和多媒体试卷。因此,仍有大量的工作需要开展。若有不详或不妥之处,请您以应用程序为准以及提出良好的意见与建议。

本文作者:
« 
» 
快速导航

Copyright © 2016 phpStudy | 豫ICP备2021030365号-3