frmmain.frm

学生宿舍管理系统vb源码

Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private dbStr As String             'sql语句
Private tPage As Integer            '总页数
Private nPage As Integer            '当前页
Private rst As New ADODB.Recordset  '数据记录集
Private tableName As String         '数据表名
Private ColCount As Long            '列数
Private opType As Integer           '操作类型: 0-查询,1-添加,2-编辑,3-删除


Private Sub cmbEdit_Click()
    '提交修改操作
    If opType <> 2 Then
        MsgBox "当前非编辑状态,无法提交修改!", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    
    Select Case tableName
        Case "student"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text <> "" Then
                    dbStr = "update student set "
                    dbStr = dbStr & "Stu_Name='" & Grid1.Cell(i, 2).Text & "',"
                    dbStr = dbStr & "Stu_Sex='" & Grid1.Cell(i, 3).Text & "',"
                    dbStr = dbStr & "Stu_Enr='" & Grid1.Cell(i, 4).Text & "',"
                    dbStr = dbStr & "Stu_Birth='" & Grid1.Cell(i, 5).Text & "',"
                    dbStr = dbStr & "Stu_Collage='" & Grid1.Cell(i, 6).Text & "',"
                    dbStr = dbStr & "Stu_Major='" & Grid1.Cell(i, 7).Text & "',"
                    dbStr = dbStr & "Stu_Class='" & Grid1.Cell(i, 8).Text & "',"
                    dbStr = dbStr & "Stu_Polit='" & Grid1.Cell(i, 9).Text & "',"
                    dbStr = dbStr & "Stu_Adress='" & Grid1.Cell(i, 10).Text & "',"
                    dbStr = dbStr & "Stu_Tel='" & Grid1.Cell(i, 11).Text & "',"
                    dbStr = dbStr & "Stu_Des='" & Grid1.Cell(i, 12).Text & "' "
                    dbStr = dbStr & "where Stu_Key='" & Grid1.Cell(i, 1).Text & "'"
                    ExecuteSQL dbStr, MsgString
                End If
            Next i
        Case "dorm"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text <> "" Then
                    dbStr = "update dorm set "
                    dbStr = dbStr & "Dor_Sex='" & Grid1.Cell(i, 2).Text & "',"
                    dbStr = dbStr & "Dor_Num='" & Grid1.Cell(i, 3).Text & "',"
                    dbStr = dbStr & "Dor_Fact='" & Grid1.Cell(i, 4).Text & "',"
                    dbStr = dbStr & "Dor_Price='" & Grid1.Cell(i, 5).Text & "',"
                    dbStr = dbStr & "Dor_Tel='" & Grid1.Cell(i, 6).Text & "',"
                    dbStr = dbStr & "Dor_Des='" & Grid1.Cell(i, 7).Text & "' "
                    dbStr = dbStr & "where Dor_Id='" & Grid1.Cell(i, 1).Text & "'"
                    ExecuteSQL dbStr, MsgString
                End If
            Next i
        Case "health"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text <> "" Then
                    dbStr = "update health set "
                    dbStr = dbStr & "Hea_Date='" & Grid1.Cell(i, 2).Text & "',"
                    dbStr = dbStr & "Dor_Id='" & Grid1.Cell(i, 3).Text & "',"
                    dbStr = dbStr & "Hea_Grade='" & Grid1.Cell(i, 4).Text & "',"
                    dbStr = dbStr & "Hea_Name='" & Grid1.Cell(i, 5).Text & "',"
                    dbStr = dbStr & "Hea_Opinion='" & Grid1.Cell(i, 6).Text & "',"
                    dbStr = dbStr & "Hea_Des='" & Grid1.Cell(i, 7).Text & "' "
                    dbStr = dbStr & "where Hea_Id='" & Grid1.Cell(i, 1).Text & "'"
                    ExecuteSQL dbStr, MsgString
                End If
            Next i
        Case "loginin"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text <> "" Then
                    dbStr = "update loginin set "
                    dbStr = dbStr & "UserPassword='" & Grid1.Cell(i, 2).Text & "' "
                    dbStr = dbStr & "where UserName='" & Grid1.Cell(i, 1).Text & "'"
                    ExecuteSQL dbStr, MsgString
                End If
            Next i
    End Select
    MsgBox "修改成功!", vbOKOnly + vbExclamation, "提示"
End Sub

Private Sub cmbPageDown_Click()
    '下一页
    If nPage >= tPage Then
        MsgBox "已至最后页！", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    nPage = nPage + 1
    DataGrid
End Sub

Private Sub cmbPageUp_Click()
    '上一页
    If nPage <= 1 Then
        MsgBox "已至最前页！", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    nPage = nPage - 1
    DataGrid
End Sub

Private Sub cmbSave_Click()
    '提交保存
    Dim i As Long
    Dim j As Long
    Dim useRow As Long
    
    If opType <> 1 Then
        MsgBox "当前非添加数据状态,无法提交保存!", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    
    useRow = 0
    Select Case tableName
        Case "student"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text = "" Then
                    For j = 1 To ColCount
                        If Grid1.Cell(i, j).Text <> "" Then
                            MsgBox "请输入学号!", vbOKOnly + vbExclamation, "提示"
                            Exit Sub
                        End If
                    Next j
                Else
                    dbStr = "select * from student where Stu_key='" & Grid1.Cell(i, 1).Text & "'"
                    ShowRecord dbStr
                    If rst.RecordCount > 0 Then
                        MsgBox "学号" & Grid1.Cell(i, 1).Text & "已存在!", vbOKOnly + vbExclamation, "提示"
                        Exit Sub
                    End If
                    useRow = useRow + 1
                End If
            Next i
            For i = 1 To useRow
                dbStr = "insert into student values('"
                dbStr = dbStr & Grid1.Cell(i, 1).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 2).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 3).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 4).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 5).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 6).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 7).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 8).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 9).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 10).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 11).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 12).Text & "')"
                ExecuteSQL dbStr, MsgString
            Next i
            dbStr = "select * from student"
        Case "dorm"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text = "" Then
                    For j = 1 To ColCount
                        If Grid1.Cell(i, j).Text <> "" Then
                            MsgBox "请输入宿舍号!", vbOKOnly + vbExclamation, "提示"
                            Exit Sub
                        End If
                    Next j
                Else
                    dbStr = "select * from dorm where Dor_Id='" & Grid1.Cell(i, 1).Text & "'"
                    ShowRecord dbStr
                    If rst.RecordCount > 0 Then
                        MsgBox "宿舍号" & Grid1.Cell(i, 1).Text & "已存在!", vbOKOnly + vbExclamation, "提示"
                        Exit Sub
                    End If
                    useRow = useRow + 1
                End If
            Next i
            For i = 1 To useRow
                dbStr = "insert into dorm values('"
                dbStr = dbStr & Grid1.Cell(i, 1).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 2).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 3).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 4).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 5).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 6).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 7).Text & "')"
                ExecuteSQL dbStr, MsgString
            Next i
            dbStr = "select * from dorm"
        Case "visit"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 2).Text = "" Then
                    For j = 1 To ColCount
                        If Grid1.Cell(i, j).Text <> "" Then
                            MsgBox "请输入访客姓名!", vbOKOnly + vbExclamation, "提示"
                            Exit Sub
                        End If
                    Next j
                Else
                    useRow = useRow + 1
                End If
            Next i
            For i = 1 To useRow
                dbStr = "insert into visit values('"
'                dbStr = dbStr & Grid1.Cell(i, 1).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 2).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 3).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 4).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 5).Text & "','"
                dbStr = dbStr & Format(Now, "YYYY-MM-DD") & "','"
                dbStr = dbStr & Format(Now, "HH:MM") & "','"
                dbStr = dbStr & Grid1.Cell(i, 8).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 9).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 10).Text & "','"
                dbStr = dbStr & UserName & "','"
                dbStr = dbStr & Grid1.Cell(i, 12).Text & "')"
                ExecuteSQL dbStr, MsgString
            Next i
            dbStr = "select * from visit"
        Case "health"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 2).Text = "" Then
                    For j = 1 To ColCount
                        If Grid1.Cell(i, j).Text <> "" Then
                            MsgBox "请输入评定日期!", vbOKOnly + vbExclamation, "提示"
                            Exit Sub
                        End If
                    Next j
                Else
                    useRow = useRow + 1
                End If
            Next i
            For i = 1 To useRow
                dbStr = "insert into health values('"
                dbStr = dbStr & Grid1.Cell(i, 2).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 3).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 4).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 5).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 6).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 7).Text & "')"
                ExecuteSQL dbStr, MsgString
            Next i
            dbStr = "select * from health order by Hea_Date desc"
        Case "loginin"
            For i = 1 To Grid1.Rows - 1
                If Grid1.Cell(i, 1).Text = "" Then
                    For j = 1 To ColCount
                        If Grid1.Cell(i, j).Text <> "" Then
                            MsgBox "请输入用户名!", vbOKOnly + vbExclamation, "提示"
                            Exit Sub
                        End If
                    Next j
                Else
                    dbStr = "select * from loginin where UserName='" & Grid1.Cell(i, 1).Text & "'"
                    ShowRecord dbStr
                    If rst.RecordCount > 0 Then
                        MsgBox "用户名" & Grid1.Cell(i, 1).Text & "已存在!", vbOKOnly + vbExclamation, "提示"
                        Exit Sub
                    End If
                    useRow = useRow + 1
                End If
            Next i
            For i = 1 To useRow
                dbStr = "insert into loginin values('"
                dbStr = dbStr & Grid1.Cell(i, 1).Text & "','"
                dbStr = dbStr & Grid1.Cell(i, 2).Text & "')"
                ExecuteSQL dbStr, MsgString
            Next i
            dbStr = "select * from loginin"
    End Select
    ShowRecord dbStr
    DataGrid
    Grid1.Column(1).Locked = True
    opType = 0
    MsgBox "保存成功!", vbOKOnly + vbExclamation, "提示"
End Sub

Private Sub Form_Load()
    Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '注册Grid控件
    With Grid1  '初始化Grid1控件
       .AllowUserResizing = True    '允许用户改变控件大小
       .DisplayFocusRect = False
       .ExtendLastCol = True
       .Appearance = Flat
       .FixedRowColStyle = Flat
       .ScrollBarStyle = Flat
       .DefaultFont.Name = "Tahoma"     '设置默认字体
       .DefaultFont.Size = 8
       .BackColorFixed = RGB(84, 201, 134)
       .BackColorFixedSel = RGB(84, 201, 134)
       .BackColorBkg = RGB(198, 229, 211)
       .BackColorScrollBar = RGB(198, 229, 211)
       .BackColor1 = RGB(231, 235, 247)
       .BackColor2 = RGB(198, 229, 211)
       .GridColor = RGB(148, 190, 231)
       .Column(0).Width = 0
    End With
    
    Me.BackColor = RGB(84, 201, 134)            '设置窗体背景颜色
    Me.Left = (Screen.Width - Me.Width) / 2     '设置窗体显示位置
    Me.Top = (Screen.Height - Me.Height) / 2    '设置窗体显示位置
End Sub

Private Sub ToolBox1_ItemClick(ByVal Item As ActiveXToolBox.TBItem)
    Dim i As Long
    Dim DorId As String
    
    Select Case Item.Key
        Case "StudentInfo"