VB大作业

VisualBasic 程序设计大作业 课程名称 Visual Basic程序课程设计 题 目 广东工业大学学生信息管理系统 学 院 材料与能源学院 专业班级 13制冷与空调1班 学 号 3113007011 姓 名 黄浊清 联系方式2015年 12月 26日学生信息管理系统1 摘要随着学校的规模不断扩大，学生人数急剧增加，有关学生的各种信息也成倍增长。面对庞大的信息量需要有学生管理系统来提供学生管理工作的效率。通过这样的系统可以做到信息的规范管理，科学统计和快速查询，修改，增加，删除等，从而减少管理方面的工作量。实现学生信息关系的系统化，规范化，自动化，用计算机对学生各种信息进行日常管理。本系统主要包括学生信息查询和信息添加等功能，来初步实现学生信息的计算机化管理，更多相关功能有待以后慢慢完善。这次vb课程设计我选择了学生的信息管理的设计，通过这个系统，无论是学生还是老师领导都可以清楚地看到学生们的信息。系统功能描述：作为一个学生的信息管理系统，首先它必须能根据不同人群使用不同的功能，例如，对于管理员，管理员不单能查看学生信息，还能修改其中的内容。而对于学生，他能通过系统查看自己的基本信息。此外，系统还提供查询的功能，对于管理员，可以通过相关的查询按钮来输入学生的相关信息来查询具体学生的信息。系统设计考虑到软件的可操作性和实用性，将系统的结构设计如下主窗口管理员登陆2. 学生管理系统的设计与实现1.系统的欢迎界面以及代码如下Option Explicit该窗体有两个作用，一为系统启动时的窗体，二为系统运行时的“关于.”窗体，而mbAbout即为标识若mbAbout为true, 则表示为系统启动时的窗体若mbAbout为false，则表示为系统运行时的“关于.”窗体Public mbAbout As BooleanSub UnloadForm() Unload Me 如果当前为系统启动时所显示窗体，则在退出本窗体之后，需要加载登录窗体 If Not mbAbout Then frmLogin.ShowEnd Sub以下各代码，表示：如果点击窗体上的任何部分，或者按下任一个键，都会调用UnloadForm子程序Private Sub Form_Click() UnloadFormEnd SubPrivate Sub Form_KeyPress(KeyAscii As Integer) UnloadFormEnd SubPrivate Sub fraEdge_Click() UnloadFormEnd SubPrivate Sub imgLogo_Click() UnloadFormEnd SubPrivate Sub lblInfo_Click(Index As Integer) UnloadFormEnd Sub2.登陆界面的设计及代码如下（通过数据库连接用户信息登录，不同的用户其权限不同）Option Explicit表示当前用户登录所选择的身份，即用户类型, 0-表示教务管理人员；1-表示学生Dim mnUserType As IntegerPrivate Sub cmdCancel_Click() Unload MeEnd SubPrivate Sub cmdOK_Click() 取得用户输入的用户名和密码 Dim user As String, pwd As String user = txtUser pwd = txtPwd 根据不同的身份，选择不同的表用以查询 Dim r As New ADODB.Recordset Set r = DataEnv.rssqlSeek Dim strSQL As String Select Case mnUserType Case 0: 若身份为管理员 strSQL = select * from admin where name= & user & and pwd= & pwd & Case 1: 若身份为学生 strSQL = select * from student where name= & user & and serial= & pwd & End Select On Error Resume Next 查询DataEnv.rssqlSeek的状态，如果已经打开，则先关闭 If r.State = adStateOpen Then r.Close r.Open strSQL 根据strSQL的内容刷新DataEnv.rssqlSeek 用户密码错误的次数，如果错误次数超过3次，则退出系统 Static nTryCount As Integer If r.EOF Then 登录失败 MsgBox 对不起，无此用户或者密码不正确！请重新输入！, vbCritical, 错误 txtUser.SetFocus txtUser.SelStart = 0 txtUser.SelLength = Len(txtUser) nTryCount = nTryCount + 1 If nTryCount = 3 Then MsgBox 您无权操作本系统!再见！, vbCritical, 无权限 Unload Me End If Else 登陆成功 显示MDI窗体, 并将用户类型和用户名传到MDI窗体中的mnUserType, msUserName中 Load MDIMain With MDIMain .mnUserType = mnUserType .msUserName = pwd .Show End With Unload Me End IfEnd SubPrivate Sub Form_Load() optUserType(0).Value = TrueEnd SubPrivate Sub optUserType_Click(Index As Integer) mnUserType = IndexEnd Sub3. 系统登陆后的界面与模块代码如下Option Explicit表示当前的用户类型0-管理员类型的用户; 1-学生类型的用户Public mnUserType As Integer表示当前登录的用户名Public msUserName As StringPrivate Sub MDIForm_Activate()根据不同的用户类型，使相应的菜单项可见 Select Case mnUserType Case 0: 以管理员身份登录 mnuFind.Visible = True Case 1: 以学生身份登录， 只能查询自己的信息 mnuFind.Visible = False End SelectEnd SubPrivate Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer) If MsgBox(真的要对出本系统吗？, vbQuestion + vbYesNo + vbDefaultButton2, 退出) = vbNo Then Cancel = 1 End IfEnd SubPrivate Sub mnuAbout_Click() 显示“关于.”窗口 Load frmSplash frmSplash.mbAbout = True frmSplash.Show vbModalEnd SubPrivate Sub mnuExit_Click() Unload MeEnd SubPrivate Sub mnuFind_Click() frmStudent.Show frmStudent.cmdSeek.Value = TrueEnd SubPrivate Sub mnuLogin_Click() If MsgBox(若重新登录，所有窗体都将关闭！是否重新登录？, _ vbQuestion + vbYesNo + vbDefaultButton2, 重新登录) = vbYes Then Unload MDIMain frmLogin.Show End IfEnd SubPrivate Sub mnuStudent_Click() If mnUserType = 0 Then 若为管理员用户 frmStudent.Show Else 若为学生类用户 frmView.Show End IfEnd Sub4. 以管理员身份登录后的界面和相关代码如下Option Explicit标识是否能关闭Dim mbClose As Boolean当DataEnv.rsStudent的当前记录发生变化时，刷新所绑定的控件(用户改变了当前记录)Sub RefreshBinding() On Error Resume Next With DataEnv.rsStudent If DataEnv.rssqlSeek.BOF And DataEnv.rssqlSeek.EOF Then 如果不存在任何记录，则清空所有的绑定的内容 txtSerial = txtName = txtBirthday = txtTelephone = txtAddress = txtResume = Else 否则和相应的字段进行绑定 txtSerial = .Fields(serial) txtName = .Fields(name) txtBirthday = .Fields(birthday) txtTelephone = .Fields(tel) txtAddress = .Fields(address) txtResume = .Fields(resume) cboSex.Text = .Fields(sex) dcbClass.Text = .Fields(class) End If End WithEnd Sub在DataEnv.rsStudent中查询serial为sSerial的学籍信息Sub SeekStudent(sSerial As String) If Not (DataEnv.rsStudent.EOF And DataEnv.rsStudent.BOF) Then Dim Temp As String Temp = serial = & & sSerial & DataEnv.rsStudent.MoveFirst DataEnv.rsStudent.Find Temp 刷新所绑定的控件 Call RefreshBinding End IfEnd Sub当改变记录集时，需要刷新用户导航的网格控件Sub RefreshGrid() grdScan.DataMember = grdScan.Refresh DataEnv.rssqlSeek.Requery grdScan.DataMember = sqlSeek grdScan.Refresh 刷新各个绑定控件 Call grdScan_ChangeEnd Sub用以在浏览时，根据当前记录所出的位置不同，来改变个浏览按钮的状态Sub ChangeBrowseState() With DataEnv.rssqlSeek If .State = adStateClosed Then .Open 如果没有任何记录，使某些按钮无效；否则则使这些按钮有效 If .BOF And .EOF Then cmdAdd.Enabled = True cmdEdit.Enabled = False cmdDelete.Enabled = False cmdUpdate.Enabled = False fraBrowse.Enabled = False Else cmdAdd.Enabled = True cmdEdit.Enabled = True cmdDelete.Enabled = True cmdUpdate.Enabled = False fraBrowse.Enabled = True End If 假如处于记录的头部 If .BOF Then If Not .EOF Then DataEnv.rsStudent.MoveFirst cmdPrevious.Enabled = False cmdFirst.Enabled = False Else cmdPrevious.Enabled = True cmdFirst.Enabled = True End If 假如处于记录的尾部 If .EOF Then If Not .BOF Then DataEnv.rsStudent.MoveLast cmdNext.Enabled = False cmdLast.Enabled = False Else cmdNext.Enabled = True cmdLast.Enabled = True End If End With End SubPrivate Sub cboDep_Click() Dim rsClass As New ADODB.Recordset Dim strSQL 根据所选的系的不同，采用不同的SQL语句 If cboDep.ItemData(cboDep.ListIndex) = 0 Then strSQL = select * from class Else strSQL = select * from class where dept_id= & cboDep.ItemData(cboDep.ListIndex) End If rsClass.Open strSQL, DataEnv.Con 将所查到的rsClass中的内容来填充cboClass cboClass.Clear cboClass.AddItem 全部 While Not rsClass.EOF cboClass.AddItem rsClass(Name) rsClass.MoveNext Wend cboClass.ListIndex = 0 rsClass.Close Set rsClass = NothingEnd SubPrivate Sub cmdAdd_Click() 添加记录 fraSeek.Enabled = False fraBrowse.Enabled = False grdScan.Enabled = False DataEnv.rsStudent.AddNew txtBirthday.Text = 1980-01-01” fraInfo.Enabled = True fraBrowse.Enabled = False cmdAdd.Enabled = False cmdEdit.Enabled = False cmdDelete.Enabled = False cmdUpdate.Enabled = True mbClose = False 不能关闭窗口End SubPrivate Sub cmdDelete_Click() 如果出错，则显示错误代码 On Error GoTo errHandler If MsgBox(要删除记录?, vbYesNo + vbQuestion + vbDefaultButton2, 确认) = vbYes Then 通过在DataEnv.Con中执行SQL命令，来删除记录 DataEnv.Con.Execute delete from student where serial = & txtSerial & DataEnv.rsStudent.MoveNext If DataEnv.rsStudent.EOF Then DataEnv.rsStudent.MoveLast 刷新用户导航的网格控件 Call RefreshGrid End If Exit Sub errHandler: MsgBox Err.Description, vbCritical, 错误End SubPrivate Sub cmdEdit_Click() 编辑记录之前，需要设置其他控件的Enabled属性 fraSeek.Enabled = False fraBrowse.Enabled = False grdScan.Enabled = False fraInfo.Enabled = True cmdAdd.Enabled = False cmdEdit.Enabled = False cmdDelete.Enabled = False cmdUpdate.Enabled = True mbClose = False 出于编辑状态，则用户不能关闭窗口End SubPrivate Sub cmdFirst_Click() 移动到记录的头部，并改变各个浏览按钮的状态 DataEnv.rssqlSeek.MoveFirst DataEnv.rssqlSeek.MovePrevious Call ChangeBrowseStateEnd SubPrivate Sub cmdLast_Click() 移动到记录的尾部，并改变各个浏览按钮的状态 DataEnv.rssqlSeek.MoveLast DataEnv.rssqlSeek.MoveNext Call ChangeBrowseStateEnd SubPrivate Sub cmdList_Click() 针对所选的班级，列出班级中所有的学籍信息 Dim strSQL If cboClass.Text = 全部 Then strSQL = from student order by serial Else strSQL = from student where class= & cboClass & order by serial End If DataEnv.rsStudent.Close DataEnv.rsStudent.Open select * & strSQL DataEnv.rssqlSeek.Close DataEnv.rssqlSeek.Open select serial, name & strSQL 刷新用户导航的网格控件，并且根据记录集中记录的数目，来改变各个浏览按钮的状态。 Call RefreshGrid Call ChangeBrowseState Call grdScan_ChangeEnd SubPrivate Sub cmdNext_Click() 移动到记录的下一条 DataEnv.rssqlSeek.MoveNext Call ChangeBrowseStateEnd SubPrivate Sub cmdPrevious_Click() 移动到记录的上一条 DataEnv.rssqlSeek.MovePrevious Call ChangeBrowseStateEnd SubPrivate Sub cmdReport_Click() On Error Resume Next If DataEnv.rsStudent.BOF Then DataEnv.rsStudent.MoveFirst Else DataEnv.rsStudent.MovePrevious DataEnv.rsStudent.MoveNext End If Call RefreshBinding Call ChangeBrowseState fraSeek.Enabled = True fraBrowse.Enabled = True fraInfo.Enabled = False grdScan.Enabled = True mbClose = True End SubPrivate Sub cmdSeek_Click() With frmFind Dim i As Integer 显示查找窗口 Load frmFind 填充查找窗体的字段列表框 .lstFields.Clear For i = 0 To DataEnv.rsStudent.Fields.Count - 1 .lstFields.AddItem (DataEnv.rsStudent(i).Name) Next i .lstFields.ListIndex = 0 .Show 1 If .mbFindFailed Then Exit Sub Dim sTemp As String If LCase(.msFindOp) = like Then sTemp = .msFindField & & .msFindOp & % & .msFindExpr & % Else sTemp = .msFindField & & .msFindOp & & .msFindExpr & End If sTemp = select * from student where & sTemp & order by serial” Unload frmFind End With 查找数据，并刷新用以导航的网格控件 DataEnv.rssqlSeek.Close DataEnv.rssqlSeek.Open sTemp Call RefreshGrid Exit Sub errHandler: MsgBox 没有符合条件的纪录！, vbExclamation, 确认End SubPrivate Sub cmdUpdate_Click() 更新所添加或者修改的记录 On Error GoTo errHandler: Dim str As String str = txtSerial.Text With DataEnv.rsStudent .Fields(Serial) = txtSerial.Text .Fields(name) = txtName.Text .Fields(sex) = cboSex.Text .Fields(class) = dcbClass.Text .Fields(birthday) = txtBirthday.Text .Fields(tel) = txtTelephone.Text .Fields(address) = txtAddress.Text .Fields(resume) = txtResume.Text End With cmdUpdate.Enabled = False fraInfo.Enabled = False mbClose = True If DataEnv.rssqlSeek.State = adStateClosed Then DataEnv.rssqlSeek.Open 刷新右端用以导航的网格控件 Call RefreshGrid 根据记录集中记录的个数，改变各个按钮的状态 Call ChangeBrowseState 定位到刚刚添加或者修改过的记录 DataEnv.rssqlSeek.MoveFirst DataEnv.rssqlSeek.Find serial= & str & fraSeek.Enabled = True fraBrowse.Enabled = True grdScan.Enabled = True Exit Sub errHandler: MsgBox Err.Description, vbCritical, 错误End SubPrivate Sub dcbClass_Click(Area As Integer) If txtSerial = Then txtSerial = dcbClass.Text End IfEnd SubPrivate Sub Form_Load() On Error Resume Next Dim rsDep As New ADODB.Recordset, rsClass As New ADODB.Recordset Set rsDep = DataEnv.rsDepartment Set rsClass = DataEnv.rsClass 从Department表中读取数据，填充cboDep复合框到中 rsDep.Open cboDep.Clear cboDep.AddItem 全部 将各个系的id号作为ItemData附加到复合框中 cboDep.ItemData(0) = 0 While Not rsDep.EOF cboDep.AddItem rsDep(Name) cboDep.ItemData(cboDep.ListCount - 1) = rsDep(id) rsDep.MoveNext Wend cboDep.ListIndex = 0 从class表中读取数据，填充到cboClass复合框中 cboClass.Clear cboClass.AddItem 全部 While Not rsClass.EOF cboClass.AddItem rsClass(Name) rsClass.MoveNext Wend cboClass.ListIndex = 0 cmdList.Value = True fraManage.Enabled = True fraBrowse.Enabled = True fraSeek.Enabled = True grdScan.Enabled = True mbClose = True Call grdScan_ChangeEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If Not mbClose Then MsgBox 数据正被修改，窗口不能关闭, vbCritical, 错误 Cancel = True End IfEnd SubPrivate Sub grdScan_Change() If grdScan.ApproxCount 0 Then Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark) End IfEnd SubPrivate Sub grdScan_RowColChange(LastRow As Variant, ByVal LastCol As Integer) 当前行改变，则动态改变所要显示的记录 If LastRow grdScan.Bookmark Then If grdScan.ApproxCount 0 Then Call SeekStudent(grdScan.Columns(0).CellText(grdScan.Bookmark) End If End IfEnd SubPrivate Sub WriteImage(ByRef Fld As ADODB.Field, DiskFile As String) Dim byteData() As Byte 定义数据块数组 Dim NumBlocks As Long 定义数据块个数 Dim FileLength As Long 标识文件长度 Dim LeftOver As Long 定义剩余字节长度 Dim SourceFile As Long 定义自由文件号 Dim i As Long 定义循环变量 Const BLOCKSIZE = 4096 每次读写块的大小 SourceFile = FreeFile 提供一个尚未使用的文件号 Open DiskFile For Binary Access Read As SourceFile 打开文件 FileLength = LOF(SourceFile) 得到文件长度 If FileLength = 0 Then 判断文件是否存在 Close SourceFile MsgBox DiskFile & 无 内 容 或 不 存 在 ! Else NumBlocks = FileLength BLOCKSIZE 得到数据块的个数 LeftOver = FileLength Mod BLOCKSIZE 得到剩余字节数 Fld.Value = Null ReDim byteData(BLOCKSIZE) 重新定义数据块的大小 For i = 1 To NumBlocks Get SourceFile, , byteData() 读到内存块中 Fld.AppendChunk byteData() 写入FLD Next i ReDim byteData(LeftOver) 重新定义数据块的大小 Get SourceFile, , byteData() 读到内存块中 Fld.AppendChunk byteData() 写入FLD Close SourceFile 关闭源文件 End IfEnd SubPrivate Function ReadImage(blobColumn As ADODB.Field) As String 取得一个临时性文件 Dim strFileName As String strFileName = ImageTmp Dim FileNumber As Integer 文件号 Dim DataLen As Long 文件长度 Dim Chunks As Long 数据块数 Dim ChunkAry() As Byte 数据块数组 Dim ChunkSize As Long 数据块大小 Dim Fragment As Long 零碎数据大小 Dim lngI As Long 计数器 Chunks = DataLen ChunkSize 数据块数 Fragment = DataLen Mod ChunkSize 零碎数据 If Fragment 0 Then 有零碎数据，则先读该数据 ReDim ChunkAry(Fragment - 1) ChunkAry = blobColumn.GetChunk(Fragment) Put FileNumber, , ChunkAry 写入文件 End If ReDim ChunkAry(ChunkSize - 1) 为数据块重新开辟空间 For lngI = 1 To Chunks 循环读出所有块 ChunkAry = blobColumn.GetChunk(ChunkSize) 在数据库中连续读数据块 Put FileNumber, , ChunkAry() 将数据块写入文件中 Next lngI Close FileNumber 关闭文件 Exit FunctionEnd Function5. 查询信息界面和相关代码如下Option ExplicitPublic msFindField As String 查找的字段Public msFindOp As String 查找的运算符Public msFindExpr As String 查找的表达式的值表示用户是否取消查询，如果取消查询则为就为True；否则为FalsePublic mbFindFailed As BooleanPrivate Sub cmdCancel_Click() mbFindFailed = True Me.HideEnd SubPrivate Sub txtExpression_Change() cmdOK.Enabled = Len(lstFields.Text) 0 And Len(lstOperators.Text) 0 And Len(txtExpression.Text) 0End SubPrivate Sub lstFields_Click() cmdOK.Enabled = Len(lstFields.Text) 0 And Len(lstOperators.Text) 0 And Len(txtExpression.Text) 0End SubPrivate