日期:2011-02-20  浏览次数:21199 次

七、附录:源程序列表

  由于源代码繁多,限于篇幅,无法一一列举,现只公布部分代码,具体以系统实物为准。下面是录入试题.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='http://edu.cnzz.cn/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='http://edu.cnzz.cn/images/hk.gif'>"
 '取得表单栏位内容
 kmxxmc = Request.Form("km