学生管理系统

第一章 概述
1．1  开发背景
现在的社会日新月异，发展的非常快。学校的发展也是非常的快了，而且每年都有不同的要求。学生的量也非常的大，资料可能经常性的发生更换，原来手工的管理模式就显的不怎么的合适了。而且手工的数据是存放在多处的，没有使用统一管理的模式，数据整理非常的麻烦，统计也困难,很多的情况下，老师都是在重复一些相同的工作。做一些相似的报表，这样不但降低了工作效率，而且非常的容易出错。在这种条件下，使用微机管理就显的非常的合适了。只要你正确的录入，统计，报表输出一点问题都没有的。
学生做为学校的最主要的管理对象，学生档案管理系统就成了学校信息化管理系统中中不可缺少的部分，它的内容对于学校的管理者说都至关重要。但一直以来人们使用传统人工的方式进行学生的档案管理，这种管理方式存在着许多缺点,如:效率低,容易出错，格式不规范。另外时间一长，不容易进行统计和分析。
随着科学技术的不断提高,计算机科学日渐成熟，其强大的功能已为人们深刻认识，它已进入人类社会的各个领域并发挥着越来越重要的作用。作为计算机应用的一部分，使用计算机对学生档案进行管理，具有手工管理所无法比拟的优点。例如:检索迅速、查找方便、可靠性高、存储量大、寿命长、成本低等。这些优点能够极大地提高学校学生档案管理的效率。因此，开发这样一套管理软件成为很有必要的事情。而且只要软件的设计合理，可以为学校提供合理的管理模式。 [资料来源：http://www.THINK58.com]

1．2  开发运行环境 内容来自think58 [版权所有：http://think58.com]

在操作系统方面，虽然现在Linux的发展速度非常的快，但是对于大多数的使用者来说，操作显然没有微软的WINDOWS那么的流行和傻瓜化。而且现在计算机的运算速度已经不能和以前相提并论了，而且硬件的价格也一天天的在下降了，所以也不用为了节省整体的造价而改用硬件要求很低的DOS系统了。所以我们决定该档案管理系统将运行在强大的工具来协助管理人员轻松地进行与数据库的连接和管理。
综上所述，我们选择了Visual Basic+SQL来开发整个系统。

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

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

第三章 系统实现
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
Public classfind As Boolean
Public xuefeifind As Boolean
Public username As String
Public qxstr As String

'执行相应的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 think58好，好think58 [版权所有：http://think58.com]
    Exit Function
exectuesql_error:
    Resume exectuesql_exit
End Function

think58好，好think58

[来源：http://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]

[资料来源：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://www.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

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

    On Error GoTo exectuesql_error 本文来自think58

[版权所有：http://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

[资料来源：http://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.com [来源：http://think58.com]

    MDIForm1.Show
    Unload Me
End Sub 本文来自think58

[资料来源：THINK58.com]

Private Sub Command2_Click()
    Unload Me
End Sub [资料来源：http://think58.com]

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

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

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

[资料来源：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 [资料来源：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

[资料来源：http://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
 

本文来自think58 [资料来源：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 内容来自think58 [资料来源：THINK58.com]

Private Sub Form_Load() think58 [来源：http://think58.com]

Option1(2).Value = True
End Sub

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

Private Sub Form_Resize()
Text1(0).SetFocus
End Sub think58.com [资料来源：www.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 [来源：http://www.think58.com]

Private Sub Combo1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then

内容来自think58

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

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

        SendKeys "{TAB}"
    End If
End Sub 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 think58 [版权所有：http://think58.com]

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

    Dim mrc As ADODB.Recordset [资料来源：http://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

    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 think58

[资料来源：THINK58.com]

    If modi = True Then [资料来源：www.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) think58.com

        Unload Me
        Exit Sub
    End If [来源：http://www.think58.com]

    txtsql1 = "select * from xj "

    Set mrc = ExecuteSQL(txtsql1) 内容来自think58 [来源：http://think58.com]

    mrc.AddNew [资料来源：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) [资料来源：http://THINK58.com]

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

    For j = 0 To 7
        Text1(j) = ""
    Next
End Sub

内容来自think58 [来源：http://think58.com]

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

Private Sub Command2_Click()
    Unload Me

End Sub 本文来自think58

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)) & "'"

copyright think58

        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

copyright think58

        Text1(0).Text = ""
        Text1(1).Text = "" think58 [来源：http://www.think58.com]

    End If
End Sub

think58

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

        Text1(6).SelStart = 0
        Text1(6).SelLength = Len(Text1(6).Text) think58.com

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

    End If
End Sub

think58.com

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

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then [资料来源：http://www.THINK58.com]

        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

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 think58.com [资料来源：http://www.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.com

[资料来源：www.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 copyright think58

Public Sub showdata() copyright think58 [资料来源：www.THINK58.com]

Dim j As Integer
Dim i As Integer think58好，好think58 [资料来源：http://www.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 copyright think58 [资料来源：http://www.THINK58.com]

Private Sub Form_Unload(Cancel As Integer)
If find = True Then
  find = False
  Form4.Text1(0).SetFocus
End If
End Sub

think58好，好think58

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

[来源：http://www.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 copyright think58 [资料来源：THINK58.com]

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

think58好，好think58

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

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

End Sub 内容来自think58

Private Sub MSF1_Click() think58好，好think58 [来源：http://www.think58.com]

End Sub

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

Private Sub TreeView1_DblClick()
On Error GoTo ss
If TreeView1.SelectedItem.Index = 0 Then
MSF1.Clear
Exit Sub
End If
txtsql = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)

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

   txtsql = "select xj.学号,xj.姓名,xj.性别,class.年级,xj.班级,class.专业,class.年制,xj.出生年月,xj.家庭住址,xj.邮政编码,xj.联系电话,xj.入学时间,xj.备注 from xj inner join class on xj.班级=class.班级  where xj.班级='" & txtsql & "' or 年级='" & txtsql & "' order by class.年级 ,class.班级 ,xj.学号 "
   printstr = txtsql
Me.Caption = "浏览学生档案"
Me.showtitle
Me.showdata
Exit Sub
ss:
MSF1.Clear
End Sub copyright think58

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

3．5班级管理
班级添加窗体代码如下
Dim strClassstr As String copyright think58 [资料来源：http://www.THINK58.com]

'使此窗体可以应用于“添加”和“修改”两种状态。
Public Sub classload()
    Dim mrc As ADODB.Recordset

    If classmodi Then  '如果是修改状态
        Me.Caption = "修改班级设置"
        classstr = "select * from class where 班级='" & Trim(Formclass2.MSF1.TextMatrix(Formclass2.MSF1.Row, 2)) & "'"
        Set mrc = ExecuteSQL(classstr)
        mrc.MoveFirst
        For i = 0 To 6
            Text1(i).Text = mrc.Fields(i)
        Next i
        mrc.Close
    Else
        Me.Caption = "添加班级设置"
        For i = 0 To 6
            Text1(i).Text = ""
        Next i

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

    End If
End Sub
'根据条件，确定是否可以“添加”或“修改”班级信息。
Private Sub Command1_Click()
    For j = 0 To 5
        If Text1(j) = "" Then
            ss = MsgBox(Label2(j).Caption & "不能为空！", vbExclamation + vbOKOnly, "警告")
            Text1(j).SetFocus
            Text1(j).SelStart = 0
            Text1(j).SelLength = Len(Text1(j).Text)
            Exit Sub
        End If 内容来自think58

    Next
    Dim mrc As ADODB.Recordset
    If classmodi = False Then
        classstr = "select * from class where 班级='" & Trim(Text1(1).Text) & "'"
        Set mrc = ExecuteSQL(classstr)
        If mrc.EOF = False Then
            sss = MsgBox("已经存在该班级的设置,不能重复！", vbonly, "警告")
            Text1(1).SetFocus
            Text1(1).SelStart = 0
            Text1(1).SelLength = Len(Text1(1).Text)
            mrc.Close
            Exit Sub
        End If 内容来自think58

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

    End If

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

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

    classstr = "delete * from class where 班级='" & Trim(Text1(1).Text) & "'"
    Set mrc = ExecuteSQL(classstr)
    classstr = "select * from class "
    Set mrc = ExecuteSQL(classstr) copyright think58 [资料来源：THINK58.com]

    mrc.AddNew
    For i = 0 To 6
        If Text1(6).Text = "" Then
            Text1(6).Text = "无"
        End If
        mrc.Fields(i) = Text1(i).Text
    Next i
    mrc.Update
    If classmodi Then
        Unload Me
        'Formclass2.classshowtitle
        'Formclass2.classshowdata
    Else
        For j = 0 To 6
            Text1(j) = ""
        Next
        'MDIForm1.classbrowse_Click
    End If
End Sub

内容来自think58

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

Private Sub Command2_Click()
    Unload Me
End Sub think58.com [资料来源：http://think58.com]

Private Sub Form_Activate()
    Text1(0).SetFocus
End Sub
班级浏览窗体代码如下
Public strPrintstr As String

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

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

'显示MSFlexGrid的标题
Public Sub classshowtitle()
    Dim i As Integer
    MSF1.Clear
    With MSF1
        .Cols = 8
        .TextMatrix(0, 1) = "年级"
        .TextMatrix(0, 2) = "班级"
        .TextMatrix(0, 3) = "教室"
        .TextMatrix(0, 4) = "年制"
        .TextMatrix(0, 5) = "专业"
        .TextMatrix(0, 6) = "班主任"
        .TextMatrix(0, 7) = "备注"
        .ColWidth(0) = 100
        .ColWidth(1) = 1300
        .ColWidth(2) = 1200
        .ColWidth(3) = 800
        .ColWidth(4) = 800

        .ColWidth(5) = 800
        .ColWidth(6) = 800
        .ColWidth(7) = 5000 [资料来源：http://THINK58.com]

        .FixedRows = 1
        For i = 1 To 7
            .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 [资料来源：http://THINK58.com]

'显示MSFlexGrid的内容
Public Sub classshowdata()
    Dim j As Integer
    Dim i As Integer think58好，好think58

[资料来源：THINK58.com]

    Dim mrc1 As ADODB.Recordset
    Set mrc1 = ExecuteSQL(Trim(txtsql))
    If mrc1.EOF = False Then
        mrc1.MoveFirst
        With MSF1
            .Rows = 1
            Do While Not mrc1.EOF
                .Rows = .Rows + 1
                For i = 1 To mrc1.Fields.Count
                    .TextMatrix(.Rows - 1, i) = mrc1.Fields(i - 1)
                Next i
                mrc1.MoveNext

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

            Loop
            mrc1.Close
        End With
    Else 本文来自think58 [来源：http://www.think58.com]

        If classfind = True Then
            Formclass2.Hide
            Formclass3.Show
            zzz = MsgBox("对不起，没有此班级的档案记录！", vbOKOnly, "查询")
            Formclass3.ZOrder (0)
            Formclass3.Text1(0).SetFocus
        End If
    End If
End Sub [资料来源：www.THINK58.com]

Private Sub Form_Activate()
    If classfind = True Then
        Formclass3.ZOrder 0
    End If
    If classfind = True Then
        Exit Sub
    ElseIf classmodi = True Then
        classshowdata
        ' TreeView1_DblClick
        classmodi = False
    Else
        classtree
    End If
    'If classfind = True Then
    '  Exit Sub
    'Else
    '  MDIForm1.clabrowse
    'End If
End Sub copyright think58

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

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

'显示Treeview的内容
Public Sub classtree()
    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

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

                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]

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) 内容来自think58 [版权所有：http://think58.com]

End Sub

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

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single) [资料来源：www.THINK58.com]

End Sub 本文来自think58 [来源：http://think58.com]

'建立Treeview和MSFlexGrid的联系
Private Sub TreeView1_DblClick()
    On Error GoTo ss
    If TreeView1.SelectedItem.Index = 0 Then
        MSF1.Clear
        Exit Sub
    End If
    txtsql = TreeView1.Nodes.Item(TreeView1.SelectedItem.Index)

内容来自think58 [版权所有：http://think58.com]

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

    txtsql = " select * from class where 年级='" & Trim(txtsql) & "' or 班级='" & Trim(txtsql) & "' order by 年级 ,班级 "
    printstr = txtsql
    Me.Caption = "浏览班级"
    Me.classshowtitle
    Me.classshowdata
    Exit Sub
ss:
    MSF1.Clear
End Sub
3．6课程管理
基本课程设置窗体代码如下
Public Sub kechengshowtitle()
 MSF1.Clear
  Dim i As Integer
  With MSF1
    .Cols = 3
    .TextMatrix(0, 1) = "课程名称"
    .TextMatrix(0, 2) = "教材"
   
    .ColWidth(0) = 0
    .ColWidth(1) = 1000
    .ColWidth(2) = 2000
  
    .FixedRows = 1
   
    .FillStyle = flexFillSingle
    .Col = 0
    .Row = 0
    .RowSel = 1 think58好，好think58 [来源：http://www.think58.com]
    .ColSel = .Cols - 1
    .CellAlignment = 4
    .Row = 1
    End With
End Sub think58好，好think58

Private Sub Command1_Click()
Unload Me
End Sub

本文来自think58

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

Private Sub Command2_Click()
qxstr = Executeqx(4)
  If qxstr = "readonly" Then
  ss = MsgBox("对不起，你是只读用户不能添加记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
  Exit Sub
   End If
If Command2.Caption = "确定" Then
  If Text1.Text = "" Then
     sssss = MsgBox("课程名称不能为空！", vbOKOnly + vbExclamation, "警告")
     Text1.SetFocus
     Exit Sub
  End If
    If Text2.Text = "" Then
     sssss = MsgBox("教材不能为空！", vbOKOnly + vbExclamation, "警告")
     Text2.SetFocus
     Exit Sub
  End If
  
 
  Adodc1.RecordSource = "select * from allkecheng where 课程名称='" & Trim(Text1.Text) & "'"
  Adodc1.Refresh
  If Adodc1.Recordset.EOF = False Then
   sssss = MsgBox("已经存在该课程名称！", vbOKOnly + vbExclamation, "警告")

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

    Text1.SetFocus
     Text1.SelStart = 0
     Text1.SelLength = Len(Text1.Text)
    Exit Sub
   Else
  Adodc1.Recordset.AddNew
  Adodc1.Recordset.Fields(0) = Text1.Text
  Adodc1.Recordset.Fields(1) = Text2.Text
  Adodc1.Recordset.Update
  Command2.Caption = "增加"
  Command3.Enabled = True
   Command4.Enabled = True
 Text1.Text = ""
 Text2.Text = ""
  Text1.Enabled = False
   Text2.Enabled = False
 kechengshowtitle
 kechengshowdata
 
 End If
Else
    Text1.Enabled = True
   Text2.Enabled = True
   Text1.Text = ""
    Text2.Text = ""
    Text1.SetFocus
   kechengshowtitle
   kechengshowdata
   Command2.Caption = "确定"
   Command3.Enabled = False
   Command4.Enabled = False

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

End If
End Sub think58 [资料来源：http://THINK58.com]

Private Sub Command3_Click()
qxstr = Executeqx(4)
  If qxstr = "readonly" Then
  ss = MsgBox("对不起，你是只读用户不能添加记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
  Exit Sub
   End If
If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
   sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
Else
  If MsgBox("确定要删除 课程名称 为 " & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & " 的记录吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
  Adodc1.RecordSource = "select * from allkecheng where 课程名称='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
  Adodc1.Refresh
  Adodc1.Recordset.Delete
  Text1.Text = ""
   Text2.Text = ""
  kechengshowtitle
  kechengshowdata
  End If
End If
End Sub think58 [资料来源：http://THINK58.com]

Private Sub Command4_Click()
qxstr = Executeqx(4)
  If qxstr = "readonly" Then
  ss = MsgBox("对不起，你是只读用户不能修改记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
  Exit Sub
   End If
If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
   sssss = MsgBox("你还没有选择记录！", vbOKOnly + vbExclamation, "警告")
Else
 If Command4.Caption = "确定" Then
  If Text1.Text = "" Then
     sssss = MsgBox("课程名称不能为空！", vbOKOnly + vbExclamation, "警告")
     Text1.SetFocus
     Exit Sub
  End If
    If Text2.Text = "" Then
     sssss = MsgBox("教材不能为空！", vbOKOnly + vbExclamation, "警告")
     Text2.SetFocus
     Exit Sub
    End If
  Adodc1.RecordSource = "select * from allkecheng where 课程名称='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'" think58好，好think58 [资料来源：http://THINK58.com]
  Adodc1.Refresh
   Adodc1.Recordset.Fields(0) = Text1.Text
    Adodc1.Recordset.Fields(1) = Text2.Text
   Adodc1.Recordset.Update
    Text1.Text = ""
   Text2.Text = ""
   kechengshowtitle
   kechengshowdata
  Command4.Caption = "修改"
   Command2.Enabled = True
   Command3.Enabled = True
   Text1.Enabled = False
   Text2.Enabled = False
Else
   Text1.Enabled = True
   Text2.Enabled = True
   Text1.SetFocus
   Command4.Caption = "确定"
   Command2.Enabled = False
   Command3.Enabled = False
End If
End If
End Sub

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

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

Private Sub Form_Load()

think58好，好think58

Adodc1.ConnectionString = connstring
kechengshowtitle
kechengshowdata
End Sub copyright think58

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

Public Sub kechengshowdata()
Dim j As Integer
Dim i As Integer

[资料来源：THINK58.com]

Dim mrc As ADODB.Recordset
Adodc1.RecordSource = "select * from allkecheng order by 课程名称"
Adodc1.Refresh
 If Adodc1.Recordset.EOF = False Then
   Adodc1.Recordset.MoveFirst
   With MSF1
   .Rows = 15
     .Row = 2
  
    Do While Not Adodc1.Recordset.EOF
     .Rows = .Rows + 1
     For i = 1 To Adodc1.Recordset.Fields.Count
      .TextMatrix(.Row - 1, i) = Adodc1.Recordset.Fields(i - 1)
     Next i
     .Row = .Row + 1
     Adodc1.Recordset.MoveNext
    Loop
 End With
End If
End Sub [资料来源：http://www.THINK58.com]

Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

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

End Sub 内容来自think58

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

Private Sub MSF1_Click()
If Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) = "" Then
   Text1.Text = ""
   Text2.Text = ""
Else
  Adodc1.RecordSource = "select * from allkecheng where 课程名称='" & Trim(Me.MSF1.TextMatrix(MSF1.Row, 1)) & "'"
  Adodc1.Refresh
   Text1.Text = Adodc1.Recordset.Fields(0)
   Text2.Text = Adodc1.Recordset.Fields(1)
End If
End Sub copyright think58 [资料来源：www.THINK58.com]

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  Text2.SetFocus
End If
End Sub
班级课程设置代码如下
Private Sub MSF1_Click()

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

End Sub

think58

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

Private Sub Combo1_Click(Index As Integer)
    Dim mrc As ADODB.Recordset
    If Index = 0 Then
        txtsql = "select   DISTINCT 专业 from class where 年级='" & Trim(Combo1(0).Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            Combo1(1).Text = ""
            Combo1(2).Text = ""
            Exit Sub
        End If
        Combo1(1).Clear
        mrc.MoveFirst
        Do Until mrc.EOF
            Combo1(1).AddItem mrc.Fields(0) think58好，好think58

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

            mrc.MoveNext
        Loop
        Combo1(1).ListIndex = 0
        txtsql = "select   DISTINCT 年制 from class where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            Combo1(2).Text = ""
            Exit Sub
        End If
        Combo1(2).Clear
        mrc.MoveFirst
        Do Until mrc.EOF
            Combo1(2).AddItem mrc.Fields(0)

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

            mrc.MoveNext
        Loop
        Combo1(2).ListIndex = 0
    ElseIf Index = 1 Then
        txtsql = "select   DISTINCT 年制 from class where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            Combo1(0).Text = ""
            Combo1(2).Text = ""
            Exit Sub
        End If
        Combo1(2).Clear
        mrc.MoveFirst

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

        Do Until mrc.EOF
            Combo1(2).AddItem mrc.Fields(0)
            mrc.MoveNext
        Loop
        Combo1(2).ListIndex = 0
    End If
End Sub [资料来源：http://THINK58.com]

Private Sub Combo1_DropDown(Index As Integer)
    If Index = 0 Then
        Dim mrc As ADODB.Recordset

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

        txtsql = "select  DISTINCT 年级  from class "
        Set mrc = ExecuteSQL(txtsql)
        mrc.MoveFirst
        Combo1(0).Clear
        Do While Not mrc.EOF
            Combo1(0).AddItem mrc.Fields(0) 内容来自think58 [资料来源：www.THINK58.com]

            mrc.MoveNext
        Loop
        Combo1(0).ListIndex = 0
    End If
End Sub think58.com

[资料来源：THINK58.com]

Private Sub Command1_Click()
    qxstr = Executeqx(4)
    If qxstr = "readonly" Then
        ss = MsgBox("对不起，你是只读用户不能添加记录，请与管理员联系！", vbInformation + vbOKOnly, " 警告")
        Exit Sub
    End If
    If List2.ListCount = 0 Then
        ssss = MsgBox("你还没有选择课程！", vbInformation + vbOKOnly, "警告")
        Exit Sub
    End If
    Dim mrc As ADODB.Recordset
    txtsql = "select * from classkecheng where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "'and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & Trim(Combo1(3).Text) & "'"
    Set mrc = ExecuteSQL(txtsql)
    If mrc.EOF = False Then
        sss = MsgBox("已存在该班级本学期课程设置和成绩记录，" & Chr(10) & Chr(13) & "继续会导致以上的成绩丢失,继续吗？！", vbOKCancel + vbExclamation, "警告") 本文来自think58

        If sss = vbCancel Then
            Exit Sub
        Else
            txtsql = "delete * from classkecheng where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "'and 年制='" & Trim(Combo1(2).Text) & "' and 学期='" & Trim(Combo1(3).Text) & "'"
            Set mrc = ExecuteSQL(txtsql)
            txtsql = "delete * from cj where 学号 in(select DISTINCT xj.学号 from xj inner join class on xj.班级=class.班级 where 年级='" & Trim(Combo1(0).Text) & "' and 专业='" & Trim(Combo1(1).Text) & "'and 年制='" & Trim(Combo1(2).Text) & "')  and 学期='" & Trim(Combo1(3).Text) & "'"
            Set mrc = ExecuteSQL(txtsql)

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

        End If
    End If
    txtsql = "select * from classkecheng"
    Set mrc = ExecuteSQL(txtsql)
    For i = o To List2.ListCount - 1
        mrc.AddNew
        mrc.Fields(0) = Trim(Combo1(0).Text)
        mrc.Fields(1) = Trim(Combo1(1).Text)
        mrc.Fields(2) = Trim(Combo1(2).Text)
        mrc.Fields(3) = Trim(Combo1(3).Text)
        mrc.Fields(4) = Trim(List2.List(i))
        mrc.Update
    Next i
    ssss = MsgBox("课程设置成功！", vbInformation + vbOKOnly, "提示")
End Sub

本文来自think58

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

Private Sub Command2_Click()
    Unload Me
End Sub think58.com

Private Sub Command3_Click()
    Dim i As Integer
    i = 0
    Do While i < List1.ListCount
think58好，好think58 [来源：http://www.think58.com]