一、需求分析
计算机技术没有应用到考试上时，组织一次考试只是要经过五步：人工出
题，考生考试，人工阅卷，成绩评估和试卷分析，这是一项十分繁琐和容易出错的工作，教师的工作量非常的大。很明显，传统的考试方式已经不再适应现代考试的需要。如今，信息技术的迅猛发展，应用不断扩大，教学和虚拟大学等相继出现，这些应用正逐步深入到千家万户，人们迫切要求利用这些技术来进行在线考试，以减少教师的工作负担并提高工作效率，同时提高考试的质量，从而使考试更趋于公正，客观，更加激发学生的兴趣。例如，目前许多国际著名的计算机公司所举办的各种认证考试绝大部分是采用这种形式。
二、数据库设计
1， 概念模型设计（E —R 图）
2、E-R 图转为逻辑模型的方法及过程
在sql 中创建一个新的数据库CET6，以E —R 图中的实体的名称创建表。设计表时，以该E —R 图中的属性为列名，根据实际情况确定其数据类型和长度，在必须唯一的列名处设计主键。在sql 中一共建立七个表来实现CET6模拟考试系统应用程序数据的连接。其中，UserType 表示数据类型，0表示学生，1表示管理员。UserId 表示用户账号，UserName 表示用户姓名，UserPsw 表示用户密码。HaveIn ，HaveTest 分别表示用户是否登录和参加考试。TypeId ，TypeName 分别表示试题类型和试题类型名。XZT_BL，XZT_FZ分别表示选择题的分值和比例。判断题和填空题类推。StudentId 表示考生考号，TopicId 、PaperTopId 分别表示试题在题库和试卷中的编号。TopicName 、TopicAnswer 表示试题题目和答案。
3、逻辑模型
TB_User（用户信息表）
TB_TestType（试题类型表）
TB_Param(系统参数表
)
TB_StuTest(学生考试试卷表
)
TB_Grade(学生分数表
)
TB_Test(试题安排
)
TB_StuTest(学生考试试卷表
)
4、数据库评价
首先，用
sql 设计数据库比较稳定，对数据的要求也比较严格。这样在
编码阶段数据这一块就基本没有不合理的数据出现在应用程序上。减少了运行会出现的错误。但是sql 与应用程序的链接有时比较繁琐而且不易成功。
三、编码实现
1， 登录模块
1）
用户的不同类型进入到不同的界面，主要有一个combox 控件，用于选择用户类型。两个TextBox 控件，Txt_id用于输入账号，Txt_Pse用于输入密码。三个commandButton 控件：cmd_In用于登录系统，Cmd_Again用于清空用户信息重新输入，Cmd_Quit用于退出系统。 程序流程图
2）
3） 登录模块代码
Option Explicit
Public B As Boolean '用户的登录信息是否正确
Private Sub PD()'判断用户登录信息是否正确, 正确B=true,否则B=false Dim rs As New ADODB.Recordset '声明rs 为记录集对象 If Trim(Txt_Id.Text) = "" Then '如果没有输入帐号
MsgBox "没有输入用户账号，请您正确填写！", vbOKCancel + vbCritical Txt_Id.SetFocus '设置焦点在问本框Txt_Id上 ElseIf Trim(Txt_Psw.Text) = "" Then '如果密码为空 MsgBox "没有输入密码，请您正确填写！", vbOKCancel + vbCritical Txt_Psw.SetFocus '设置焦点在问本框Txt_Psw上 Else '
Cmd_In.Default = True '设置Cmd_In按Enter 键触发Click 事件
Sql = "select * from TB_User where UserId='" & Trim(Txt_Id.Text) & "'" & _"and UserType='" & Cbx_UserType.ListIndex & "' " & _"and UserPsw='" & Trim(Txt_Psw.Text) & "' " '把查询用户信息的SQL 语句赋给变量Sql
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '以只读的方式静态的打开Sql 执行的结果的记录集
If Not rs.RecordCount > 0 Then '如果记录集为空 Select Case MsgBox("用户账号或密码不正确，请您正确填写！", vbOKCancel + vbCritical) '显示提示信息
Case vbOK '如果选择了是 B = False
Txt_Id.Text = "" '帐号清空
Txt_Psw.Text = "" '密码清空
Txt_Id.SetFocus '是输入帐号的文本框获得焦点 Case Else '选择了取消 End '结束程序 End Select
Cmd_In.Default = False '设置Cmd_In不是Enter 的默认按钮
ElseIf rs.Fields("HaveIn") = 0 Then '如果记录集不为空且此帐号没被其他用户使用
B = True '用户的登录信息正确 cnn.Execute "update TB_User set HaveIn=1 " & _"where UserId='" & Trim(Txt_Id.Text) & "'" & _"and UserType='" & Cbx_UserType.ListIndex & "'" '设置HaveIn 字段为1，限制其他用户用此帐户登录 UsId = Trim(Txt_Id.Text) '记录用户的帐号 Else '如果记录集不为空但此帐号正在被其他用户使用 MsgBox "用户已经登录！", vbOKOnly + vbCritical '显示提示信息 B = False '用户的登录信息错误 Txt_Id.Text = "" '帐号清空 Txt_Psw.Text = "" '密码清空
Txt_Id.SetFocus '是输入帐号的文本框获得焦点
Cmd_In.Default = False '设置Cmd_In不是Enter 的默认按钮 End If
rs.Close '关闭记录集 End If End Sub
Private Sub Cbx_UserType_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then '如果输入的字符是Enter 键 Txt_Id.SetFocus '设置输入帐号的文本框获得焦点 Else '如果输入的是其它字符
KeyAscii = 0 '返回值为空即不输入任何字符 End If End Sub
Private Sub Cmd_Again_Click() '用户信息输入错误，选择了“重输”按钮，开始重新输入。 Call Form_Load End Sub
Private Sub Cmd_In_Click() '用户填写信息完毕，单击“确定”按钮，开始登录
On Error GoTo Err1 '出现错误转向错误处理
Dim rs As New ADODB.Recordset '声明rs 为记录集对象
Select Case Cbx_UserType.ListIndex 'Select 语句的条件是Cbx_UserType的ListIndex 属性
Case 0 '如果选中的是第一条记录即考生
Call PD '判断考生的帐号和密码是否正确
If B = True Then '如果考生的帐号和密码正确
Sql = "select HaveTest from TB_User where UserType=0" & _
"and UserId='" & Trim(Txt_Id.Text) & "'" '判断考生是否参加过考试
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '执行SQL 语句
If rs.Fields("HaveTest") = False Then '如果考生没有参加过考试
Sql = "delete from TB_Grade where StuId=" & _ "'" & Trim(Txt_Id.Text) & "'" '删除成绩表中考生原有的记录
cnn.Execute Sql '执行SQL 语句
Sql = "insert into TB_Grade(StuId) values" & _
"('" & Trim(Txt_Id.Text) & "')" '把考生的帐号插入到成绩表中
cnn.Execute Sql '执行SQL 语句 End If
frm_Stu.Show '显示考生窗口 Unload Me '卸载本窗体 End If Case 1
If Txt_Id.Text = "admin" And Txt_Psw = "admin" Then '设置超级用户
Unload Me '卸载本窗体
frm_Manager.Show '显示管理员窗体 Else '如果不是超级用户
Call PD '判断管理员的帐号和密码是否正确 If B = True Then '如果帐号和密码正确 Unload Me '卸载本窗体
frm_Manager.Show '显示管理员窗体 End If End If
Case Else '不过没有选择用户的身份 MsgBox " 您没有选择身份，请选择！", vbOKCancel + vbCritical ' 提示选择身份
Cbx_UserType.SetFocus '组合框Cbx_UserType获得焦点 End Select
Exit Sub '跳出Sub 过程 Err1:
ErrMessageBox "打开窗口失败" '显示出错信息 frm_Login.Show '显示登录窗体 End Sub
Private Sub Cmd_Quit_Click()
If MsgBox("真的要退出 " & Me.Caption & " 吗？", vbYesNo + vbInformation) = vbNo Then Exit Sub
End If '弹出对话框询问是否退出系统 End '退出系统 End Sub
Private Sub Form_Load()
Cbx_UserType.Text = "请选择身份" Txt_Id.Text = "" Txt_Psw.Text = "" End Sub
Private Sub Txt_Id_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then '判断如果用户输入的是Enter 键
Txt_Psw.SetFocus '设置Txt_Psw获得焦点 End If End Sub
Private Sub Txt_Psw_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call Cmd_In_Click End If End Sub
2、管理员模块
1）在窗体上添加一个SSTab 控件，上面添加三个commandButton 控件，分别为选择题，填空题，判断题。添加一个DataGrid 控件显示试题，添加一个Ado 控件链接数据库。编写菜单实现各种管理的功能。
2）
3） 代码
Option Explicit
Dim Sql As String '声明模块级变量
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As Long, ByVal lpDirectory As Long, ByVal nShowCmd As Long) As Long Private Function FunAdo(ByVal str As String) '构造连接ADO 的函数 On Error GoTo Err1 '执行过程中如果发生错误转向错误处理 With Ado1 '使用With 结构 .Visible = False 'Ado不可见
.ConnectionString = cnn.ConnectionString '设置Ado 的连接字符串 .CommandType = adCmdText '设置Ado 的命令类型 .RecordSource = str '设置Ado 的记录源 .Refresh '刷新Ado 的记录集 End With '结束With 结构 Exit Function '结束函数 Err1:
ErrMessageBox "与数据库连接失败！" '显示错误信息 Me.Show '显示窗口 End Function
Private Sub Cmd_Cancel_Click() Call Form_Unload(1) End Sub
Private Sub Cmd_PDT_Click()
Sql = "select 类型号=tb_testtype.Typeid,题号=(tb_topicstor.topicid)," & _ "题目名称=topicname,答案=topicanswer " & _ "from tb_topicstor,tb_testtype where tb_testtype.typeid=tb_topicstor.typeid and typename='判断题'" Call FunAdo(Sql)
DG.Columns(0).Width = 700 DG.Columns(1).Width = 500 DG.Columns(2).Width = 4000 DG.Columns(3).Width = 500 End Sub
Private Sub Cmd_TKT_Click()
Sql = "select 类型号=tb_testtype.Typeid,题号=(tb_topicstor.topicid)," & _ "题目名称=topicname,答案=topicanswer " & _ "from tb_topicstor,tb_testtype where tb_testtype.typeid=tb_topicstor.typeid and typename='填空题'" Call FunAdo(Sql)
DG.Columns(0).Width = 700 DG.Columns(1).Width = 500 DG.Columns(2).Width = 4000 End Sub
Private Sub Cmd_XZT_Click()
Sql = "select 类型号=tb_testtype.Typeid,题号=(tb_topicstor.topicid)," & _ "题目名称=topicname,答案=topicanswer,A,B,C,D,E,F " & _ "from tb_topicstor,tb_testtype where tb_testtype.typeid=tb_topicstor.typeid " & _
"and typename='" & Cmd_XZT.Caption & "'" '把查看选择题的SQL 语句赋给
变量Sql
Call FunAdo(Sql) '调用函数执行SQL 语句
DG.Columns(0).Width = 700 '设置DataGrid 的第1列列宽
DG.Columns(1).Width = 500 '设置DataGrid 的第2列列宽
DG.Columns(2).Width = 4000 '设置DataGrid 的第3列列宽
DG.Columns(3).Width = 500 '设置DataGrid 的第4列列宽
End Sub
Private Sub DG_DblClick()
If frm_Manager.Ado1.Recordset.Fields("题号") = "" Then '如果试题不存在 MsgBox "不存在记录, 请您先添加记录", vbOKOnly '提示没有记录
Exit Sub '跳出Sub 过程
Else '如果题库中有试题
Me.Enabled = False '管理窗体不可以用
Bkm = Ado1.Recordset.Bookmark '记录当前DataGrid 的指针的位置
End If
End Sub
Private Sub Form_Load()
Call Cmd_XZT_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("真的要退出 " & Me.Caption & " 吗？", vbYesNo + vbInformation) = vbNo Then '弹出消息对话框询问是否退出系统
Cancel = True '如果消息对话框返回值为常数vbNo ，系统返回值为True Else
cnn.Execute "update tb_user set havein=0 where userid='" & UsId & "'and UserType='1'"
End '如果消息对话框返回值为常数vbNo ，系统返回值为False ，结束程序 End If
End Sub
Private Sub Men_About_Click()
frm_About.Show
End Sub
Private Sub Men_Help_Click()
SendKeys "{F1}"
End Sub
Private Sub Men_SelGrd_Click()
frm_SelGrd.Show '打开查分窗体
Me.Hide '隐藏管理员窗体
End Sub
Private Sub select_Click() '设定参数
On Error GoTo Endsub
frm_param.Show
Me.Hide
Endsub:
End Sub
PrivateSub
T_AddPDT_Click()
On Error GoTo Endsub
frm_PDT.Show
Me.Hide
Endsub:
End Sub
PrivateSub
T_AddTKT_Click()
On Error GoTo Endsub
frm_TKT.Show
Me.Hide
Endsub:
End Sub
Private Sub T_AddXZT_Click()
On Error GoTo Endsub
frm_XZT.Show
Me.Hide
Endsub:
End Sub
Private Sub T_Exit_Click()
Unload Me
End Sub
Private Sub T_Update_Click()
On Error GoTo Endsub
Me.Enabled = False
Endsub:
End Sub
Private Sub User_Click()
On Error GoTo Endsub
frm_UpdateUser.Show
Me.Hide
Endsub:
End Sub
3、学生窗体
1）
2）
3）
Option Explicit
Dim HaveTest As Integer
Private Sub Begin_Click()
Call CmdOk_Click
End Sub
Private Sub CmdOk_Click()
On Error GoTo Err1
frm_Test.Show
Me.Hide
Exit Sub
Err1:
ErrMessageBox "考试窗口打开出错"
End Sub
Private Sub CmdQuit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim rs As New ADODB.Recordset '声明认识rs 为记录集对象
Sql = "select havetest from tb_user where usertype=0" & _
"and userid='" & UsId & "'" '把查询是否参加考试的标识字段赋给变量Sql rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '执行SQL 语句
HaveTest = rs.Fields("HaveTest")
ShowButton
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("真的要退出" & Me.Caption & " 吗？", vbYesNo + vbInformation) = vbNo Then '弹出对话框询问是否退出系统
Cancel = 1
Else
cnn.Execute "update tb_user set havein=0 where userid='" & UsId & "'and UserType='0'"
End
End If
End Sub
Private Sub Img_PswCancel_Click()
Pte_StuPsw.Visible = False
ShowButton
End Sub
Private Sub Img_PswOk_Click()
On Error GoTo Err1 '如果发生错误转向错误处理
Dim rs As New ADODB.Recordset '声明认识rs 为记录集对象
Sql = "select * from TB_User where UserId='" & UsId & "' " & _
"and UserType='0' and UserPsw='" & Txt_StuPsw.Text & "' " '把验证密码的SQL 语句赋给变量Sql
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '执行SQL 语句
If Not rs.RecordCount > 0 Then '如果密码不正确
If MsgBox("密码不正确，请您重新填写！", vbOKCancel + vbCritical) = vbCancel Then '弹出提示框
Pte_StuPsw.Visible = False '如果单击取消回到开始考试的界面
Else '如果单击确定
Txt_StuPsw.Text = "" '清空Txt_StuPsw
Txt_StuPsw.SetFocus '设置Txt_StuPsw获得焦点
End If
Else
Pte_UpdatePsw.Visible = True '显示修改密码的图片框
Txt_Id.Text = UsId '用户帐号中显示用户的帐号
Pte_StuPsw.Visible = False '隐藏输入验证码的图片框
Txt_Psw.Text = "" '清空Txt_Psw
Txt_SecPsw.Text = ""
Txt_Psw.SetFocus '设置Txt_Psw获得焦点
End If
Exit Sub '结束结束Sub 过程
Err1:
ErrMessageBox "校对密码出错" '显示出错信息
End Sub
Private Sub Img_Ok_Click()
On Error GoTo Err1 '如果发生错误就转向错误处理
If Trim(Txt_Psw.Text) = "" Then '如果密码为空
MsgBox "密码不能为空！", vbOKOnly + vbCritical '提示输入密码
ElseIf Trim(Txt_Psw.Text) Trim(Txt_SecPsw.Text) Then '如果两次密码不同 MsgBox "您两次输入的密码不一样！", vbOKOnly + vbCritical '提示重新输入密码
Txt_Psw.Text = "" '清空Txt_Psw
Txt_SecPsw.Text = "" '清空Txt_SecPsw
Txt_Psw.SetFocus '设置Txt_Psw获得焦点
Else '如果两次输入的密码相同且不为空
Sql = "update tb_user set userpsw='" & Txt_Psw.Text & "'" & _
"where userid='" & UsId & "' " '修改密码
cnn.Execute Sql '把密码写入数据库
MsgBox "修改成功！", vbOKOnly + vbInformation '提示修改成功
Pte_UpdatePsw.Visible = False 'Pte_UpdatePsw不可见
ShowButton
End If
Exit Sub '跳出Sub 过程
Err1:
ErrMessageBox "密码修改出错" '显示提示信息
Call Form_Load
End Sub
Private Sub Img_Again_Click()
Txt_Psw.Text = ""
Txt_SecPsw.Text = ""
Txt_Psw.SetFocus
End Sub
Private Sub Img_Cancel_Click()
Pte_UpdatePsw.Visible = False
ShowButton
End Sub
Private Sub Men_AboutTest_Click()
frm_Dialog.Show
End Sub
Private Sub Men_Help_Click()
SendKeys "{F1}"
End Sub
Private Sub Men_Sele_Click()
On Error GoTo Err1
Dim rs As New ADODB.Recordset
Sql = "select grade from tb_grade where stuid='" & UsId & "'"
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly
MsgBox "您的考试成绩是：" & vbCrLf & "" & rs.Fields("grade") & "", vbOKOnly Exit Sub
Err1:
ErrMessageBox "查分失败"
End Sub
Private Sub meu_UpdatePsw_Click()
Pte_StuPsw.Visible = True
Image1.Visible = False '用于标识的图像框不可见
frm_Stu.CmdOk.Visible = False '开始考试的命令按钮不可见
Begin.Visible = False '开始考试菜单不可见
Txt_StuPsw.Text = ""
Txt_StuPsw.SetFocus
End Sub
Private Sub T_About_Click()
frm_About.Show
End Sub
Private Sub T_Exit_Click()
Unload Me
End Sub
Private Sub Txt_Psw_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Txt_SecPsw.SetFocus
End If
End Sub
Private Sub Txt_SecPsw_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Img_Ok_Click
End If
End Sub
Private Sub Txt_StuPsw_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Img_PswOk_Click
End If
End Sub
Private Sub ShowButton()
If HaveTest Then '如果参加考试的字段值为1
Image1.Visible = False '用于标识的图像框不可见
frm_Stu.CmdOk.Visible = False '开始考试的命令按钮不可见 Begin.Visible = False '开始考试菜单不可见
Men_Sele.Visible = True '查分菜单可见
Else '如果参加考试的字段值为0
Image1.Visible = True '用于标识的图像框不可见
CmdOk.Visible = True '开始考试的命令按钮不可见
Begin.Visible = True '开始考试菜单不可见
Men_Sele.Visible = False '查分菜单可见
Pte_StuPsw.Visible = False '验证密码的的图片框不可见 Pte_UpdatePsw.Visible = False '修改码的的图片框不可见 End If
End Sub
一、需求分析
计算机技术没有应用到考试上时，组织一次考试只是要经过五步：人工出
题，考生考试，人工阅卷，成绩评估和试卷分析，这是一项十分繁琐和容易出错的工作，教师的工作量非常的大。很明显，传统的考试方式已经不再适应现代考试的需要。如今，信息技术的迅猛发展，应用不断扩大，教学和虚拟大学等相继出现，这些应用正逐步深入到千家万户，人们迫切要求利用这些技术来进行在线考试，以减少教师的工作负担并提高工作效率，同时提高考试的质量，从而使考试更趋于公正，客观，更加激发学生的兴趣。例如，目前许多国际著名的计算机公司所举办的各种认证考试绝大部分是采用这种形式。
二、数据库设计
1， 概念模型设计（E —R 图）
2、E-R 图转为逻辑模型的方法及过程
在sql 中创建一个新的数据库CET6，以E —R 图中的实体的名称创建表。设计表时，以该E —R 图中的属性为列名，根据实际情况确定其数据类型和长度，在必须唯一的列名处设计主键。在sql 中一共建立七个表来实现CET6模拟考试系统应用程序数据的连接。其中，UserType 表示数据类型，0表示学生，1表示管理员。UserId 表示用户账号，UserName 表示用户姓名，UserPsw 表示用户密码。HaveIn ，HaveTest 分别表示用户是否登录和参加考试。TypeId ，TypeName 分别表示试题类型和试题类型名。XZT_BL，XZT_FZ分别表示选择题的分值和比例。判断题和填空题类推。StudentId 表示考生考号，TopicId 、PaperTopId 分别表示试题在题库和试卷中的编号。TopicName 、TopicAnswer 表示试题题目和答案。
3、逻辑模型
TB_User（用户信息表）
TB_TestType（试题类型表）
TB_Param(系统参数表
)
TB_StuTest(学生考试试卷表
)
TB_Grade(学生分数表
)
TB_Test(试题安排
)
TB_StuTest(学生考试试卷表
)
4、数据库评价
首先，用
sql 设计数据库比较稳定，对数据的要求也比较严格。这样在
编码阶段数据这一块就基本没有不合理的数据出现在应用程序上。减少了运行会出现的错误。但是sql 与应用程序的链接有时比较繁琐而且不易成功。
三、编码实现
1， 登录模块
1）
用户的不同类型进入到不同的界面，主要有一个combox 控件，用于选择用户类型。两个TextBox 控件，Txt_id用于输入账号，Txt_Pse用于输入密码。三个commandButton 控件：cmd_In用于登录系统，Cmd_Again用于清空用户信息重新输入，Cmd_Quit用于退出系统。 程序流程图
2）
3） 登录模块代码
Option Explicit
Public B As Boolean '用户的登录信息是否正确
Private Sub PD()'判断用户登录信息是否正确, 正确B=true,否则B=false Dim rs As New ADODB.Recordset '声明rs 为记录集对象 If Trim(Txt_Id.Text) = "" Then '如果没有输入帐号
MsgBox "没有输入用户账号，请您正确填写！", vbOKCancel + vbCritical Txt_Id.SetFocus '设置焦点在问本框Txt_Id上 ElseIf Trim(Txt_Psw.Text) = "" Then '如果密码为空 MsgBox "没有输入密码，请您正确填写！", vbOKCancel + vbCritical Txt_Psw.SetFocus '设置焦点在问本框Txt_Psw上 Else '
Cmd_In.Default = True '设置Cmd_In按Enter 键触发Click 事件
Sql = "select * from TB_User where UserId='" & Trim(Txt_Id.Text) & "'" & _"and UserType='" & Cbx_UserType.ListIndex & "' " & _"and UserPsw='" & Trim(Txt_Psw.Text) & "' " '把查询用户信息的SQL 语句赋给变量Sql
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '以只读的方式静态的打开Sql 执行的结果的记录集
If Not rs.RecordCount > 0 Then '如果记录集为空 Select Case MsgBox("用户账号或密码不正确，请您正确填写！", vbOKCancel + vbCritical) '显示提示信息
Case vbOK '如果选择了是 B = False
Txt_Id.Text = "" '帐号清空
Txt_Psw.Text = "" '密码清空
Txt_Id.SetFocus '是输入帐号的文本框获得焦点 Case Else '选择了取消 End '结束程序 End Select
Cmd_In.Default = False '设置Cmd_In不是Enter 的默认按钮
ElseIf rs.Fields("HaveIn") = 0 Then '如果记录集不为空且此帐号没被其他用户使用
B = True '用户的登录信息正确 cnn.Execute "update TB_User set HaveIn=1 " & _"where UserId='" & Trim(Txt_Id.Text) & "'" & _"and UserType='" & Cbx_UserType.ListIndex & "'" '设置HaveIn 字段为1，限制其他用户用此帐户登录 UsId = Trim(Txt_Id.Text) '记录用户的帐号 Else '如果记录集不为空但此帐号正在被其他用户使用 MsgBox "用户已经登录！", vbOKOnly + vbCritical '显示提示信息 B = False '用户的登录信息错误 Txt_Id.Text = "" '帐号清空 Txt_Psw.Text = "" '密码清空
Txt_Id.SetFocus '是输入帐号的文本框获得焦点
Cmd_In.Default = False '设置Cmd_In不是Enter 的默认按钮 End If
rs.Close '关闭记录集 End If End Sub
Private Sub Cbx_UserType_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then '如果输入的字符是Enter 键 Txt_Id.SetFocus '设置输入帐号的文本框获得焦点 Else '如果输入的是其它字符
KeyAscii = 0 '返回值为空即不输入任何字符 End If End Sub
Private Sub Cmd_Again_Click() '用户信息输入错误，选择了“重输”按钮，开始重新输入。 Call Form_Load End Sub
Private Sub Cmd_In_Click() '用户填写信息完毕，单击“确定”按钮，开始登录
On Error GoTo Err1 '出现错误转向错误处理
Dim rs As New ADODB.Recordset '声明rs 为记录集对象
Select Case Cbx_UserType.ListIndex 'Select 语句的条件是Cbx_UserType的ListIndex 属性
Case 0 '如果选中的是第一条记录即考生
Call PD '判断考生的帐号和密码是否正确
If B = True Then '如果考生的帐号和密码正确
Sql = "select HaveTest from TB_User where UserType=0" & _
"and UserId='" & Trim(Txt_Id.Text) & "'" '判断考生是否参加过考试
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '执行SQL 语句
If rs.Fields("HaveTest") = False Then '如果考生没有参加过考试
Sql = "delete from TB_Grade where StuId=" & _ "'" & Trim(Txt_Id.Text) & "'" '删除成绩表中考生原有的记录
cnn.Execute Sql '执行SQL 语句
Sql = "insert into TB_Grade(StuId) values" & _
"('" & Trim(Txt_Id.Text) & "')" '把考生的帐号插入到成绩表中
cnn.Execute Sql '执行SQL 语句 End If
frm_Stu.Show '显示考生窗口 Unload Me '卸载本窗体 End If Case 1
If Txt_Id.Text = "admin" And Txt_Psw = "admin" Then '设置超级用户
Unload Me '卸载本窗体
frm_Manager.Show '显示管理员窗体 Else '如果不是超级用户
Call PD '判断管理员的帐号和密码是否正确 If B = True Then '如果帐号和密码正确 Unload Me '卸载本窗体
frm_Manager.Show '显示管理员窗体 End If End If
Case Else '不过没有选择用户的身份 MsgBox " 您没有选择身份，请选择！", vbOKCancel + vbCritical ' 提示选择身份
Cbx_UserType.SetFocus '组合框Cbx_UserType获得焦点 End Select
Exit Sub '跳出Sub 过程 Err1:
ErrMessageBox "打开窗口失败" '显示出错信息 frm_Login.Show '显示登录窗体 End Sub
Private Sub Cmd_Quit_Click()
If MsgBox("真的要退出 " & Me.Caption & " 吗？", vbYesNo + vbInformation) = vbNo Then Exit Sub
End If '弹出对话框询问是否退出系统 End '退出系统 End Sub
Private Sub Form_Load()
Cbx_UserType.Text = "请选择身份" Txt_Id.Text = "" Txt_Psw.Text = "" End Sub
Private Sub Txt_Id_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then '判断如果用户输入的是Enter 键
Txt_Psw.SetFocus '设置Txt_Psw获得焦点 End If End Sub
Private Sub Txt_Psw_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call Cmd_In_Click End If End Sub
2、管理员模块
1）在窗体上添加一个SSTab 控件，上面添加三个commandButton 控件，分别为选择题，填空题，判断题。添加一个DataGrid 控件显示试题，添加一个Ado 控件链接数据库。编写菜单实现各种管理的功能。
2）
3） 代码
Option Explicit
Dim Sql As String '声明模块级变量
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As Long, ByVal lpDirectory As Long, ByVal nShowCmd As Long) As Long Private Function FunAdo(ByVal str As String) '构造连接ADO 的函数 On Error GoTo Err1 '执行过程中如果发生错误转向错误处理 With Ado1 '使用With 结构 .Visible = False 'Ado不可见
.ConnectionString = cnn.ConnectionString '设置Ado 的连接字符串 .CommandType = adCmdText '设置Ado 的命令类型 .RecordSource = str '设置Ado 的记录源 .Refresh '刷新Ado 的记录集 End With '结束With 结构 Exit Function '结束函数 Err1:
ErrMessageBox "与数据库连接失败！" '显示错误信息 Me.Show '显示窗口 End Function
Private Sub Cmd_Cancel_Click() Call Form_Unload(1) End Sub
Private Sub Cmd_PDT_Click()
Sql = "select 类型号=tb_testtype.Typeid,题号=(tb_topicstor.topicid)," & _ "题目名称=topicname,答案=topicanswer " & _ "from tb_topicstor,tb_testtype where tb_testtype.typeid=tb_topicstor.typeid and typename='判断题'" Call FunAdo(Sql)
DG.Columns(0).Width = 700 DG.Columns(1).Width = 500 DG.Columns(2).Width = 4000 DG.Columns(3).Width = 500 End Sub
Private Sub Cmd_TKT_Click()
Sql = "select 类型号=tb_testtype.Typeid,题号=(tb_topicstor.topicid)," & _ "题目名称=topicname,答案=topicanswer " & _ "from tb_topicstor,tb_testtype where tb_testtype.typeid=tb_topicstor.typeid and typename='填空题'" Call FunAdo(Sql)
DG.Columns(0).Width = 700 DG.Columns(1).Width = 500 DG.Columns(2).Width = 4000 End Sub
Private Sub Cmd_XZT_Click()
Sql = "select 类型号=tb_testtype.Typeid,题号=(tb_topicstor.topicid)," & _ "题目名称=topicname,答案=topicanswer,A,B,C,D,E,F " & _ "from tb_topicstor,tb_testtype where tb_testtype.typeid=tb_topicstor.typeid " & _
"and typename='" & Cmd_XZT.Caption & "'" '把查看选择题的SQL 语句赋给
变量Sql
Call FunAdo(Sql) '调用函数执行SQL 语句
DG.Columns(0).Width = 700 '设置DataGrid 的第1列列宽
DG.Columns(1).Width = 500 '设置DataGrid 的第2列列宽
DG.Columns(2).Width = 4000 '设置DataGrid 的第3列列宽
DG.Columns(3).Width = 500 '设置DataGrid 的第4列列宽
End Sub
Private Sub DG_DblClick()
If frm_Manager.Ado1.Recordset.Fields("题号") = "" Then '如果试题不存在 MsgBox "不存在记录, 请您先添加记录", vbOKOnly '提示没有记录
Exit Sub '跳出Sub 过程
Else '如果题库中有试题
Me.Enabled = False '管理窗体不可以用
Bkm = Ado1.Recordset.Bookmark '记录当前DataGrid 的指针的位置
End If
End Sub
Private Sub Form_Load()
Call Cmd_XZT_Click
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("真的要退出 " & Me.Caption & " 吗？", vbYesNo + vbInformation) = vbNo Then '弹出消息对话框询问是否退出系统
Cancel = True '如果消息对话框返回值为常数vbNo ，系统返回值为True Else
cnn.Execute "update tb_user set havein=0 where userid='" & UsId & "'and UserType='1'"
End '如果消息对话框返回值为常数vbNo ，系统返回值为False ，结束程序 End If
End Sub
Private Sub Men_About_Click()
frm_About.Show
End Sub
Private Sub Men_Help_Click()
SendKeys "{F1}"
End Sub
Private Sub Men_SelGrd_Click()
frm_SelGrd.Show '打开查分窗体
Me.Hide '隐藏管理员窗体
End Sub
Private Sub select_Click() '设定参数
On Error GoTo Endsub
frm_param.Show
Me.Hide
Endsub:
End Sub
PrivateSub
T_AddPDT_Click()
On Error GoTo Endsub
frm_PDT.Show
Me.Hide
Endsub:
End Sub
PrivateSub
T_AddTKT_Click()
On Error GoTo Endsub
frm_TKT.Show
Me.Hide
Endsub:
End Sub
Private Sub T_AddXZT_Click()
On Error GoTo Endsub
frm_XZT.Show
Me.Hide
Endsub:
End Sub
Private Sub T_Exit_Click()
Unload Me
End Sub
Private Sub T_Update_Click()
On Error GoTo Endsub
Me.Enabled = False
Endsub:
End Sub
Private Sub User_Click()
On Error GoTo Endsub
frm_UpdateUser.Show
Me.Hide
Endsub:
End Sub
3、学生窗体
1）
2）
3）
Option Explicit
Dim HaveTest As Integer
Private Sub Begin_Click()
Call CmdOk_Click
End Sub
Private Sub CmdOk_Click()
On Error GoTo Err1
frm_Test.Show
Me.Hide
Exit Sub
Err1:
ErrMessageBox "考试窗口打开出错"
End Sub
Private Sub CmdQuit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim rs As New ADODB.Recordset '声明认识rs 为记录集对象
Sql = "select havetest from tb_user where usertype=0" & _
"and userid='" & UsId & "'" '把查询是否参加考试的标识字段赋给变量Sql rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '执行SQL 语句
HaveTest = rs.Fields("HaveTest")
ShowButton
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("真的要退出" & Me.Caption & " 吗？", vbYesNo + vbInformation) = vbNo Then '弹出对话框询问是否退出系统
Cancel = 1
Else
cnn.Execute "update tb_user set havein=0 where userid='" & UsId & "'and UserType='0'"
End
End If
End Sub
Private Sub Img_PswCancel_Click()
Pte_StuPsw.Visible = False
ShowButton
End Sub
Private Sub Img_PswOk_Click()
On Error GoTo Err1 '如果发生错误转向错误处理
Dim rs As New ADODB.Recordset '声明认识rs 为记录集对象
Sql = "select * from TB_User where UserId='" & UsId & "' " & _
"and UserType='0' and UserPsw='" & Txt_StuPsw.Text & "' " '把验证密码的SQL 语句赋给变量Sql
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly '执行SQL 语句
If Not rs.RecordCount > 0 Then '如果密码不正确
If MsgBox("密码不正确，请您重新填写！", vbOKCancel + vbCritical) = vbCancel Then '弹出提示框
Pte_StuPsw.Visible = False '如果单击取消回到开始考试的界面
Else '如果单击确定
Txt_StuPsw.Text = "" '清空Txt_StuPsw
Txt_StuPsw.SetFocus '设置Txt_StuPsw获得焦点
End If
Else
Pte_UpdatePsw.Visible = True '显示修改密码的图片框
Txt_Id.Text = UsId '用户帐号中显示用户的帐号
Pte_StuPsw.Visible = False '隐藏输入验证码的图片框
Txt_Psw.Text = "" '清空Txt_Psw
Txt_SecPsw.Text = ""
Txt_Psw.SetFocus '设置Txt_Psw获得焦点
End If
Exit Sub '结束结束Sub 过程
Err1:
ErrMessageBox "校对密码出错" '显示出错信息
End Sub
Private Sub Img_Ok_Click()
On Error GoTo Err1 '如果发生错误就转向错误处理
If Trim(Txt_Psw.Text) = "" Then '如果密码为空
MsgBox "密码不能为空！", vbOKOnly + vbCritical '提示输入密码
ElseIf Trim(Txt_Psw.Text) Trim(Txt_SecPsw.Text) Then '如果两次密码不同 MsgBox "您两次输入的密码不一样！", vbOKOnly + vbCritical '提示重新输入密码
Txt_Psw.Text = "" '清空Txt_Psw
Txt_SecPsw.Text = "" '清空Txt_SecPsw
Txt_Psw.SetFocus '设置Txt_Psw获得焦点
Else '如果两次输入的密码相同且不为空
Sql = "update tb_user set userpsw='" & Txt_Psw.Text & "'" & _
"where userid='" & UsId & "' " '修改密码
cnn.Execute Sql '把密码写入数据库
MsgBox "修改成功！", vbOKOnly + vbInformation '提示修改成功
Pte_UpdatePsw.Visible = False 'Pte_UpdatePsw不可见
ShowButton
End If
Exit Sub '跳出Sub 过程
Err1:
ErrMessageBox "密码修改出错" '显示提示信息
Call Form_Load
End Sub
Private Sub Img_Again_Click()
Txt_Psw.Text = ""
Txt_SecPsw.Text = ""
Txt_Psw.SetFocus
End Sub
Private Sub Img_Cancel_Click()
Pte_UpdatePsw.Visible = False
ShowButton
End Sub
Private Sub Men_AboutTest_Click()
frm_Dialog.Show
End Sub
Private Sub Men_Help_Click()
SendKeys "{F1}"
End Sub
Private Sub Men_Sele_Click()
On Error GoTo Err1
Dim rs As New ADODB.Recordset
Sql = "select grade from tb_grade where stuid='" & UsId & "'"
rs.Open Sql, cnn, adOpenStatic, adLockReadOnly
MsgBox "您的考试成绩是：" & vbCrLf & "" & rs.Fields("grade") & "", vbOKOnly Exit Sub
Err1:
ErrMessageBox "查分失败"
End Sub
Private Sub meu_UpdatePsw_Click()
Pte_StuPsw.Visible = True
Image1.Visible = False '用于标识的图像框不可见
frm_Stu.CmdOk.Visible = False '开始考试的命令按钮不可见
Begin.Visible = False '开始考试菜单不可见
Txt_StuPsw.Text = ""
Txt_StuPsw.SetFocus
End Sub
Private Sub T_About_Click()
frm_About.Show
End Sub
Private Sub T_Exit_Click()
Unload Me
End Sub
Private Sub Txt_Psw_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Txt_SecPsw.SetFocus
End If
End Sub
Private Sub Txt_SecPsw_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Img_Ok_Click
End If
End Sub
Private Sub Txt_StuPsw_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Call Img_PswOk_Click
End If
End Sub
Private Sub ShowButton()
If HaveTest Then '如果参加考试的字段值为1
Image1.Visible = False '用于标识的图像框不可见
frm_Stu.CmdOk.Visible = False '开始考试的命令按钮不可见 Begin.Visible = False '开始考试菜单不可见
Men_Sele.Visible = True '查分菜单可见
Else '如果参加考试的字段值为0
Image1.Visible = True '用于标识的图像框不可见
CmdOk.Visible = True '开始考试的命令按钮不可见
Begin.Visible = True '开始考试菜单不可见
Men_Sele.Visible = False '查分菜单可见
Pte_StuPsw.Visible = False '验证密码的的图片框不可见 Pte_UpdatePsw.Visible = False '修改码的的图片框不可见 End If
End Sub