基于VB的学生管理系统设计与实现

登陆系统
对于这类系统如果谁都能登陆到本系统的话，系统里面的数据将非常的危险和有可能会受到蓄意破坏者的攻击了。考虑到数据的安全性，用户必须拥有密码才能够登陆到本系统的主页面。
2．3．2、主页面有5个菜单。分别为。系统管理，学生档案管理，班级管理，课程管理，成绩管理。
对于这个主页面。我们可以完成所有对学生档案的管理，修改，查询。方便登陆的用户进行一系列的操作，提供了方便。
2．4各个模块的功能
系统管理：系统菜单包括有两个功能
添加用户
对于一个系统来说，永远不可能只是存在一个用户，用户的添加体现了这个系统的方便灵活性，适合多人来使用。所有设计了这个功能是理所当然的。
学生档案管理：包括添加档案菜单，档案浏览菜单。
档案添加
正如一个添加用户一样。永远不可能只是存在一个学生的学籍信息，学生毕业后会有新的学生进来，自然要添加新的学生学籍信息。这个菜单恰好提供这个功能，
档案浏览
当我们将学生的学籍信息存放在数据库中，最大的方便就是我们有需要知道学生的学籍信息时能够及时查询到。因为人的记忆有限，不可能记得住所有学生的学籍信息以及相关的一系列资料，所以就要靠查询学籍信息来实现了。这个菜单的功能最大的优点就是方便。 think58.com [资料来源：http://THINK58.com]
班级管理单：包括班级浏览菜单，班级添加菜单
     班级添加菜单
    每一年，学校都会增见新的年级，因此就会有新的班级信息添加。
    班级浏览菜单
可以方便学校统一浏览班级的信息 本文来自think58 [资料来源：http://www.THINK58.com]

课程管理菜单：包括基本课程设置，基本课程设置
  可以对课程的信息进行修改增加
班级课程设置
   可以选择班级相应的课程。
成绩管理菜单：包括添加添加成绩，修改成就，查询成绩。
考试类型设置
不同的功课自然有不同的成绩。我们针对这个提前对考试类型做下设置。方便学校同学老师查成绩。
    成绩添加
    现今的教育 ，学生的成绩是体现学生在学校的表现之一。也可以作为对学生评价的准则之一。因次添加学生的成绩是比较重要的一个功能。
成绩浏览
一个完成的学生管理系统，自然要提供学生的查询，方便学生和老师
2．5 数据库设计
2．5．1数据库表的建立
系统数据库名称为StudengMIS。其中包括①allkecheng②cj③class
④classkecheng⑤kaoshileixing⑥userinfo⑦xj
第三章 系统实现
3.1公共模块
 Module1模块主要三个函数组成，函数EXECUTESQL用于执行响应的SQL命令，函数CONNSTRING用于连接字符串，函数EXECUTEQX用于检查权限。代码如下：
Public modi As Boolean
Public classmodi As Boolean
Public xuefeimodi As Boolean
Public txtsql As String
Public find As Boolean

内容来自think58 [资料来源：THINK58.com]

Public classfind As Boolean
Public xuefeifind As Boolean
Public username As String
Public qxstr As String think58

'执行相应的SQL命令
Public Function ExecuteSQL(ByVal sql As String) As ADODB.Recordset
    Dim mycon As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set mycon = New ADODB.Connection
    mycon.ConnectionString = connstring
    mycon.Open
    Dim stokens() As String
    On Error GoTo exectuesql_error
    stokens = Split(sql)
    If InStr("INSER,DELETE,UPDATE", UCase(stokens(0))) Then
        mycon.Execute sql
    Else
        Set rst = New ADODB.Recordset
        rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = rst
    End If
exectuesql_exit:
    Set rst = Nothing
    Set mycon = Nothing [资料来源：http://www.THINK58.com]
    Exit Function
exectuesql_error:
    Resume exectuesql_exit
End Function

[资料来源：http://www.THINK58.com]

'连接字符串，用户可以根据自己的数据库进行修改相应参数
Public Function connstring() As String
    connstring = "Provider=SQLOLEDB.1;Persist Security Info=False;UID=sa;PWD=12345;Initial Catalog=StudentMIS;Data Source=(local)"
End Function

think58

[版权所有：http://think58.com]

'检查用户的权限
Public Function Executeqx(ByVal txt As Integer) As String
    Dim sql As String
    Dim mycon As ADODB.Connection
    Dim rst As ADODB.Recordset
    Set mycon = New ADODB.Connection
    mycon.ConnectionString = connstring
    mycon.Open
    Set rst = New ADODB.Recordset
    sql = "select admin from userinfo where username='" & username & "'"
    rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
    If rst.EOF = True Then
        MsgBox "非法用户！", vbExclamation + vbOKOnly, "警告"
        Executeqx = "nothing"
        Exit Function
    End If
    If rst.Fields(0) = "y" Then
        Executeqx = "admin"
        Exit Function 内容来自think58 [资料来源：http://THINK58.com]
    End If
    rst.Close
    sql = "select readonly from userinfo where username='" & username & "'"
    rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
    If rst.Fields(0) = "y" Then
        Executeqx = "readonly"
        Exit Function
    End If
    Select Case txt
      Case 1
        sql = "select qx1 from userinfo where username='" & username & "'"
      Case 2
        sql = "select qx2 from userinfo where username='" & username & "'"
      Case 3
        sql = "select qx3 from userinfo where username='" & username & "'"
    
    End Select

内容来自think58 [资料来源：http://www.THINK58.com]

    On Error GoTo exectuesql_error think58.com

    Set rst = New ADODB.Recordset
    rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
    If rst.Fields(0) = "y" Then
        Executeqx = "true"
    Else
        Executeqx = "false"
    End If
exectuesql_exit:
    Set rst = Nothing
    Set mycon = Nothing
    Exit Function
exectuesql_error:
    Resume exectuesql_exit think58

[来源：http://www.think58.com]

End Function
3．2登陆系统
   这个模块主要有确定跟取消组成。确定按纽的主要功能是检查用户名和用户密码是否正确。以及确定权限。取消按纽则是退出该功能。代码如下
Private Sub Command1_Click()
    Dim mrc As ADODB.Recordset
    txtsql = "select username from userinfo where username='" & Trim(Text1.Text) & "'"
    Set mrc = ExecuteSQL(txtsql)
    If mrc.EOF = True Then
        MsgBox " 用户名错误！", vbExclamation + vbOKOnly, "警告"
        Text1.SetFocus
        Text1.SelStart = 0
        Text1.SelLength = Len(Text1.Text)
        Exit Sub
    End If
    username = mrc.Fields(0)
    txtsql = "select username from userinfo where password='" & Trim(Text2.Text) & "'"
    Set mrc = ExecuteSQL(txtsql) think58.com [资料来源：THINK58.com]
    If mrc.EOF = True Then
        MsgBox " 密码错误！", vbExclamation + vbOKOnly, "警告"
        Text2.SetFocus
        Text2.SelStart = 0
        Text2.SelLength = Len(Text2.Text)
        Exit Sub
    End If think58好，好think58 [资料来源：http://THINK58.com]

    MDIForm1.Show
    Unload Me
End Sub think58好，好think58 [资料来源：http://www.THINK58.com]

Private Sub Command2_Click()
    Unload Me
End Sub 内容来自think58

[资料来源：http://www.THINK58.com]

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Text2.SetFocus
    End If
End Sub

[资料来源：www.THINK58.com]

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Command1.SetFocus
    End If
End Sub
3．3系统管理
   这个模块的功能主要是添加用户。并且设置权限。代码如下

think58好，好think58 [资料来源：http://think58.com]

Private Sub Command1_Click()
If Trim(Text1(0).Text) = "" Then
 MsgBox "用户名不能为空！", vbExclamation + vbOKOnly, "警告"
 Text1(0).SetFocus
 Exit Sub
End If
If Trim(Text1(1).Text) = "" Then
 MsgBox "密码不能为空！", vbExclamation + vbOKOnly, "警告"
 Text1(1).SetFocus
 Exit Sub
End If
If Trim(Text1(2).Text) = "" Then
 MsgBox "确认密码不能为空！", vbExclamation + vbOKOnly, "警告"
 Text1(2).SetFocus
 Exit Sub
End If
If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then
 MsgBox "确认密码不正确！", vbExclamation + vbOKOnly, "警告"
 Text1(2).SetFocus
 Exit Sub
End If
Dim aa As Integer
aa = 0
If Option1(2).Value = True Then
 For i = 0 To 3
 If Check1(i).Value = 1 Then
   aa = 1
   Exit For
 End If
Next i
If aa = 0 Then
 MsgBox " 普通用户至少要有一项权限！", vbExclamation + vbOKOnly, "警告"
Exit Sub
End If
End If 本文来自think58 [资料来源：http://www.THINK58.com]

Dim mrc As ADODB.Recordset
txtsql = "select * from userinfo where username='" & Trim(Text1(0).Text) & "'"
Set mrc = ExecuteSQL(txtsql)
If mrc.EOF = False Then
  MsgBox " 已存在该用户！", vbExclamation + vbOKOnly, "警告"
  Text1(0).SetFocus
  Text1(0).SelStart = 0
  Text1(0).SelLength = Len(Text1(0).Text)
  Exit Sub
End If
txtsql = "select * from userinfo"
Set mrc = ExecuteSQL(txtsql)
mrc.AddNew
  mrc.Fields(0) = Trim(Text1(0).Text)
  mrc.Fields(1) = Trim(Text1(1).Text)
For i = 0 To 2
  If Option1(i).Value = True Then
    Select Case i
    Case 0
    mrc.Fields("admin") = "y"
    Case 1
      mrc.Fields("readonly") = "y"
    Case 2
      For j = 0 To 2
         If Check1(j).Value = 1 Then
          Select Case j 内容来自think58 [资料来源：www.THINK58.com]
            Case 0
              mrc.Fields("qx1") = "y"
              Case 1
                 mrc.Fields("qx2") = "y"
               Case 2
                mrc.Fields("qx3") = "y"
           End Select
          End If
        Next j
    End Select
  [资料来源：http://THINK58.com]

   End If
 
Next i
   mrc.Update
   MsgBox " 用户添加成功！", vbExclamation + vbOKOnly, "警告"
   Text1(0).Text = ""
   Text1(1).Text = ""
   Text1(2).Text = ""
End Sub [版权所有：http://think58.com]

Private Sub Command2_Click()
Unload Me
End Sub [版权所有：http://think58.com]

Private Sub Form_Load() 内容来自think58 [资料来源：http://THINK58.com]

Option1(2).Value = True
End Sub copyright think58 [资料来源：http://THINK58.com]

Private Sub Form_Resize()
Text1(0).SetFocus
End Sub think58好，好think58 [版权所有：http://think58.com]

Private Sub Option1_Click(Index As Integer)
If Index <> 2 Then
For i = 0 To 2
  Check1(i).Enabled = False
Next i
Else
For i = 0 To 2
  Check1(i).Enabled = True
Next i
End If
End Sub
3．4学生档案管理
   档案添加窗体的主要功能是录入学生的基本档案。代码如下
Dim txtsql1 As String
Private Sub Combo1_Click(Index As Integer)
    Dim mrc As ADODB.Recordset
    txtsql1 = "select 专业,年制 from class where 班级='" & Trim(Combo1(1).Text) & "'"
    Set mrc = ExecuteSQL(txtsql1)
    mrc.Close
End Sub think58好，好think58

[资料来源：www.THINK58.com]

Private Sub Combo1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then [版权所有：http://think58.com]

        SendKeys "{TAB}"
    End If
End Sub [资料来源：www.THINK58.com]

Private Sub Command1_Click()
    For j = 0 To 7
        If Text1(j) = "" Then
            ss = MsgBox(Label1(j).Caption & "不能为空！", vbExclamation + vbOKOnly, "警告")
            Text1(j).SetFocus
            Text1(j).SelStart = 0
            Text1(j).SelLength = Len(Text1(j).Text)
            Exit Sub
        End If

copyright think58

[来源：http://www.think58.com]

    Next 内容来自think58

    Dim mrc As ADODB.Recordset [来源：http://www.think58.com]

    txtsql1 = "select * from xj where 学号='" & Trim(Text1(0).Text) & "'"
    Set mrc = ExecuteSQL(txtsql1)
    If modi = False Then
        If mrc.EOF = False Then
            sss = MsgBox("已经存在该学号的记录,学号不能重复！", vbExclamation + vbOKOnly, "警告")
            Text1(0).SetFocus
            Text1(0).SelStart = 0
            Text1(0).SelLength = Len(Text1(0).Text)
            mrc.Close
            Exit Sub
        End If
    End If think58.com [来源：http://think58.com]

    If Not IsDate(Text1(2).Text) Then '判断是否日期格式
        ssss = MsgBox("应输入日期 mm-dd-yy", vbInformation + vbOKOnly, "警告")
        Text1(2).SetFocus
        Text1(2).SelStart = 0
        Text1(2).SelLength = Len(Text1(2).Text)
        Exit Sub
    End If
    If Not IsDate(Text1(6).Text) Then
        ssss = MsgBox("应输入日期 mm-dd-yy", vbInformation + vbOKOnly, "警告")
        Text1(6).SetFocus
        Text1(6).SelStart = 0
        Text1(6).SelLength = Len(Text1(6).Text)
        Exit Sub
    End If

    If modi = True Then [版权所有：http://think58.com]

        txtsql1 = "update   xj  set 学号='" & Trim(Text1(0).Text) & "',姓名='" & Trim(Text1(1).Text) & "',性别='" & Trim(Combo1(0).Text) & "',班级='" & Trim(Combo1(1).Text) & "',出生年月='" & Trim(Text1(2).Text) & "' ,家庭住址='" & Trim(Text1(3).Text) & "' ,邮政编码='" & Trim(Text1(4).Text) & "' ,联系电话='" & Trim(Text1(5).Text) & "' ,入学时间='" & Trim(Text1(6).Text) & "',备注='" & Trim(Text1(7).Text) & "'where 学号='" & Trim(Form3.MSF1.TextMatrix(Form3.MSF1.Row, 1)) & "'"
        Set mrc = ExecuteSQL(txtsql1)
        txtsql1 = "update   cj set 学号='" & Trim(Text1(0).Text) & "' where 学号='" & Trim(Form3.MSF1.TextMatrix(Form3.MSF1.Row, 1)) & "'"
        Set mrc = ExecuteSQL(txtsql1)
        txtsql1 = "update   jf set 学号='" & Trim(Text1(0).Text) & "' where 学号='" & Trim(Form3.MSF1.TextMatrix(Form3.MSF1.Row, 1)) & "'" 'Set mrc = ExecuteSQL(txtsql1) [资料来源：http://think58.com]
        Unload Me
        Exit Sub
    End If 本文来自think58 [资料来源：http://THINK58.com]

    txtsql1 = "select * from xj " 本文来自think58 [来源：http://www.think58.com]

    Set mrc = ExecuteSQL(txtsql1) 内容来自think58

[版权所有：http://think58.com]

    mrc.AddNew think58.com

[版权所有：http://think58.com]

    For i = 4 To 9

[版权所有：http://think58.com]

        mrc.Fields(i) = Text1(i - 2).Text
    Next i
    mrc.Fields(0) = Trim(Text1(0).Text)
    mrc.Fields(1) = Trim(Text1(1).Text) copyright think58 [来源：http://www.think58.com]

    mrc.Fields(2) = Trim(Combo1(0).Text)
    mrc.Fields(3) = Trim(Combo1(1).Text)
    mrc.Update
    Set mrc = Nothing

think58.com

[资料来源：http://think58.com]

[来源：http://www.think58.com]

    For j = 0 To 7
        Text1(j) = ""
    Next
End Sub [资料来源：http://www.THINK58.com]

Private Sub Command2_Click()
    Unload Me think58.com

[资料来源：THINK58.com]

End Sub think58

[资料来源：http://www.THINK58.com]

Private Sub Form_Activate()
    Text1(0).SetFocus
    Form1.load1
End Sub

Public Sub load1()
    Dim mrc As ADODB.Recordset
    txtsql1 = "select DISTINCT 班级 from class order by 班级"
    Set mrc = ExecuteSQL(txtsql1)
    If mrc.EOF Then
        ddd = MsgBox("请先设置班级部署！", "警告")
        mrc.Close
        Exit Sub
    End If
    Combo1(1).Clear
    mrc.MoveFirst
    Do While Not mrc.EOF
        Combo1(1).AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Combo1(1).ListIndex = 0
    Combo1(0).ListIndex = 0
    If modi Then  '如果是修改状态
        Me.Caption = "修改"
        txtsql1 = "select * from xj where 学号='" & Trim(Form3.MSF1.TextMatrix(Form3.MSF1.Row, 1)) & "'" think58 [资料来源：www.THINK58.com]
        Set mrc = ExecuteSQL(txtsql1)
        mrc.MoveFirst
        For i = 4 To 9
            Text1(i - 2).Text = mrc.Fields(i)
        Next i
        Text1(0).Text = mrc.Fields(0)
        Text1(1).Text = mrc.Fields(1)
        Combo1(0).Text = mrc.Fields(2)
        Combo1(1).Text = mrc.Fields(3)
        mrc.Close
    Else
        Me.Caption = "登记"
        For i = 2 To 7
            Text1(i).Text = ""
        Next i
        Text1(6).Text = Date think58 [资料来源：http://THINK58.com]
        Text1(0).Text = ""
        Text1(1).Text = ""

本文来自think58

    End If
End Sub

本文来自think58 [版权所有：http://think58.com]

[资料来源：http://think58.com]

Private Sub Text1_GotFocus(Index As Integer)
    If Index = 6 Then

think58好，好think58 [资料来源：THINK58.com]

        Text1(6).SelStart = 0
        Text1(6).SelLength = Len(Text1(6).Text) 本文来自think58

    End If
End Sub think58.com

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then 内容来自think58

        SendKeys "{TAB}"
    End If
End Sub
档案浏览窗体的功能是能够查询学生的基本信息。代码如下
Public printstr As String
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long copyright think58 [资料来源：http://think58.com]

Public Sub showtitle()
 MSF1.Clear
  Dim i As Integer
  With MSF1
    .Cols = 14
    .TextMatrix(0, 1) = "学号"
    .TextMatrix(0, 2) = "姓名"
    .TextMatrix(0, 3) = "性别"
    .TextMatrix(0, 4) = "年级"
    .TextMatrix(0, 5) = "班级"
    .TextMatrix(0, 6) = "专业"
    .TextMatrix(0, 7) = "年制"
    .TextMatrix(0, 8) = "出生年月"
    .TextMatrix(0, 9) = "家庭住址"
    .TextMatrix(0, 10) = "邮政编码"
    .TextMatrix(0, 11) = "联系电话"
    .TextMatrix(0, 12) = "入学时间"
    .TextMatrix(0, 13) = "备注"
    .ColWidth(0) = 200
    .ColWidth(1) = 500
    .ColWidth(2) = 700
    .ColWidth(3) = 500
    .ColWidth(4) = 1000
    .ColWidth(5) = 800

copyright think58

[来源：http://think58.com]

    .ColWidth(6) = 700
    .ColWidth(7) = 800
    .ColWidth(8) = 800
    .ColWidth(9) = 3000
    .ColWidth(10) = 800
    .ColWidth(11) = 1000
    .ColWidth(12) = 800
    .ColWidth(13) = 6000
    .FixedRows = 1
    For i = 1 To 13
      .ColAlignment(i) = 0
    Next i
    .FillStyle = flexFillSingle
    .Col = 0
    .Row = 0
    .RowSel = 1
    .ColSel = .Cols - 1
    .CellAlignment = 4
    .Row = 1
    End With
End Sub

think58好，好think58

[资料来源：THINK58.com]

Private Sub Form_Activate()
If find = True Then
Form4.ZOrder
End If
If find = True Then
  Exit Sub
ElseIf modi = True Then
showdata
 ' TreeView1_DblClick
  modi = False
Else
  tree
End If
End Sub 本文来自think58

[资料来源：http://think58.com]

Public Sub showdata() 内容来自think58 [资料来源：http://think58.com]

Dim j As Integer
Dim i As Integer 本文来自think58 [资料来源：http://think58.com]

Dim mrc As ADODB.Recordset
Set mrc = New ADODB.Recordset
 Set mrc = ExecuteSQL(txtsql)
 If mrc.EOF = False Then
   mrc.MoveFirst
   With MSF1
    .Rows = 50
    .Row = 1
    Do While Not mrc.EOF
     .Rows = .Rows + 1
     For i = 1 To mrc.Fields.Count
      .TextMatrix(.Row, i) = mrc.Fields(i - 1)
     Next i
      .Row = .Row + 1
     mrc.MoveNext
    Loop
 End With
 Else
   If find = True Then
   Form3.Hide
   Form4.Show
   zzz = MsgBox("对不起，没有此学生的档案记录！", vbOKOnly, "查询")
   Form4.ZOrder (0)
   Form4.Text1(0).SetFocus
  
   End If
 End If
  Set mrc = Nothing
End Sub

think58 [来源：http://think58.com]

[资料来源：http://THINK58.com]

Private Sub Form_Unload(Cancel As Integer)
If find = True Then
  find = False
  Form4.Text1(0).SetFocus
End If
End Sub [资料来源：http://think58.com]

Public Sub tree()
TreeView1.Nodes.Clear
Dim nodex As Node
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim str As String
Dim a As String
a = "年级"
'TreeView1.LineStyle = tvwRootLines
str = "select distinct 年级 from class order by 年级"
Set mrc = ExecuteSQL(str)
str = "select distinct 年级,班级 from class order by 年级,班级"
Set mrc1 = ExecuteSQL(str)
mrc.MoveFirst
Do Until mrc.EOF
  mrc1.MoveFirst
  Set nodex = TreeView1.Nodes.add(, , a, mrc.Fields(0), 1, 1)
  Do While Not mrc1.EOF
   If mrc1.Fields(0) = mrc.Fields(0) Then
     Set nodex = TreeView1.Nodes.add(a, tvwChild, , mrc1.Fields(1), 2, 2)
   End If
   mrc1.MoveNext
  Loop
  a = a & "1"
  mrc.MoveNext
Loop
 mrc1.Close
 mrc.Close
 Set mrc = Nothing
  Set mrc1 = Nothing
End Sub
本文来自think58

[资料来源：http://think58.com]