主窗口.frm

学校机房的上机管理系统.可以安排免费上机,可以收费上机.适合中小型机房.修改后也可以作为网吧管理软件.

      Exit Sub
    End If
    Set r_t = Nothing
End If
'修改数据
rec_base.Fields(0).Value = t2
rec_base.Fields(1).Value = t3
rec_info.Fields(0).Value = t2
rec_info.Fields(1).Value = t6
rec_count.Fields(0).Value = t2
rec_count.Fields(1).Value = Val(T4) + Val(T5)
rec_base.Update
rec_info.Update
rec_count.Update
Text5.Text = Val(Text4.Text) + Val(Text5.Text)
Text2.SetFocus
dg1.Refresh
dg2.Refresh
dg4.Refresh
End Sub

Private Sub current_use_Click()

End Sub

Private Sub DG1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
If iseditting = flase Then Exit Sub
If rec_base.RecordCount = 0 Then
Text2.Text = ""
Text3.Text = ""
Text4.Text = 0
Text5.Text = 0
Text6.Text = ""
Combo1.Text = ""
Exit Sub
End If
Text2.Text = rec_base.Fields(0).Value
Text3.Text = rec_base.Fields(1).Value

     rec_info.MoveFirst
     Do While (rec_info.Fields(0).Value <> Text2.Text) And (rec_info.AbsolutePosition < rec_info.RecordCount)
        rec_info.MoveNext
              
     Loop
     Text6.Text = rec_info.Fields(1).Value
     
     rec_count.MoveFirst
     Do While rec_count.Fields(0).Value <> Text2.Text And rec_count.AbsolutePosition < rec_count.RecordCount
        rec_count.MoveNext
        
     Loop
     Text5.Text = rec_count.Fields(1).Value
     
      rec_class.MoveFirst
     Do While rec_class.Fields(0).Value <> Left(Text2.Text, 7) And rec_class.AbsolutePosition < rec_class.RecordCount
        rec_class.MoveNext
        
     Loop
     Combo1.Text = rec_class.Fields(1).Value
     Text4.Text = 0
End Sub
Private Sub Command5_Click()
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Combo1.Text = ""
Frame1.Visible = False

End Sub

Private Sub delete_Click()
iseditting = False

Form2.Show 1
End Sub



Private Sub edit_Click() '手工输入或编辑
     iseditting = True
     Frame1.Caption = "账户输入或编辑"
     Frame1.Visible = True
If rec_class.RecordCount <> 0 Then
     rec_class.MoveFirst
     i = 0
     Do While Not rec_class.EOF
        Combo1.AddItem rec_class.Fields(1).Value
        Combo1.ItemData(i) = rec_class.Fields(0).Value
        rec_class.MoveNext
        i = i + 1
     Loop
End If
Text2.SetFocus
Command4.Caption = "确定"

End Sub

Private Sub exit_Click()
If MsgBox("要退出系统吗？", vbYesNo + vbInformation, "退出") = vbYes Then
  End
End If
End Sub

Private Sub Form_Load()

Timer1.Enabled = True
Dim mypanel As Panel
Set mypanel = StatusBar1.Panels.add(1, , , sbrDate) '状态栏1显示日期

Set mypanel = StatusBar1.Panels.add(2) '状态栏2显示星期几
Call MyWeekDay

Set mypanel = StatusBar1.Panels.add(3) '状态栏3显示文本消息
mypanel.AutoSize = sbrSpring

Set mypanel = StatusBar1.Panels.add(4)
StatusBar1.Panels(4).Text = "校园机房管理系统 V 1.0"
mypanel.AutoSize = sbrContents

V0 = VScroll1.Value

'打开数据库
Set db = New Connection
db.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Initial Catalog=student;Data Source=127.0.0.1"
'db.Open "Provider=SQLOLEDB.1;Password=1201;Persist Security Info=True;User ID=sa;Initial Catalog=student;Data Source=127.0.0.1"
Set rec_base = New Recordset
Set rec_count = New Recordset
Set rec_info = New Recordset
Set rec_used = New Recordset
Set rec_class = New Recordset
Set rec_sysinfo = New Recordset
With rec_base
   .ActiveConnection = db
   .CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = 3
   .Open "select * from base order by no"
End With
With rec_count
   .ActiveConnection = db
   .CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = 3
   .Open "select * from count order by no"
End With
With rec_class
   .ActiveConnection = db
   .CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = 3
   .Open "select * from class order by class_no"
End With
With rec_info
   .ActiveConnection = db
   .CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = 3
   .Open "select * from info order by no"
End With


Set dg1.DataSource = rec_base
Set dg2.DataSource = rec_count
Set dg4.DataSource = rec_info

Frame1.Visible = False
flag = True
End Sub


Private Sub import_Click()
iseditting = False
import_data_from_excel
dg1.Refresh
dg2.Refresh
iseditting = True
End Sub

Private Sub Matter_Click()
Form7.Show 1
End Sub

Private Sub set_vip_Click()
Form4.Show 1
End Sub


Private Sub student_Click()
Form6.Show 1
End Sub

Private Sub sysedit_Click()
Form5.Show 1
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then Text3.SetFocus
If KeyCode = vbKeyUp Then Text6.SetFocus
If KeyCode = vbKeyLeft And Text2.SelStart = 0 Then Text6.SetFocus
If KeyCode = vbKeyRight And Text2.SelStart = Len(Text2.Text) Then Text3.SetFocus

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)  '学号输入框
'如果没有按回车，则在单击确定按钮时做判定
If KeyAscii = 13 Then
    If Text2.Text = "" Then Exit Sub
'检查该学号是否已存在
 Dim r_t As Recordset
 Set r_t = New Recordset
 With r_t
    .ActiveConnection = db
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = 3
   .Open "select * from base  where no = " & Text2.Text
 End With
  If r_t.RecordCount <= 0 Then
  flag = False
  Else
  flag = True
  End If
  Set r_t = Nothing
  
    If flag = True Then  '学号已存在
     t = Text2.Text
     MsgBox "此学号已存在，可以进行修改", vbInformation, "提示信息"
     rec_base.Find "no = " & t
          
   Else    '新学生
     '先检查输入的合法性
    '1学号中的班级编号是否存在
   r = MsgBox("新学生,是否添加", vbYesNo + vbInformation, "提示信息")
   If r = vbYes Then
    Text2.Text = Trim(Text2.Text)
     If Text2.Text = "" Then Text2.SetFocus
     classno = Left(Text2.Text, 7)
      rec_class.MoveFirst
       check = False
       Do While Not rec_class.EOF And check = False
            If rec_class.Fields(0) = classno Then check = True
            rec_class.MoveNext
         Loop
      If check = False Then   '班级编号部分不对
           answer = MsgBox("此学生所在的班级还没有记录在案，是否自动添加班级？选择否，则请重新输入学号", vbYesNo + vbInformation, "提示信息")
           If answer = vbYes Then
              classname = InputBox("班级编号为：" & classno & "。请输入班级名称：")
              rec_class.AddNew
              rec_class.Fields(0).Value = classno
              rec_class.Fields(1).Value = classname
              rec_class.Update
              Combo1.Text = classname
           Else
               Text2.SetFocus
               Text2.SelStart = 0
               Text2.SelLength = Len(Text2.Text)

               Exit Sub
          End If
     Else
        rec_class.MovePrevious
     End If
      MsgBox "这是一个新的学号，请输入其他相关信息", vbInformation, "提示信息"
      Text5.Text = 0
    Combo1.Text = rec_class.Fields(1).Value
    Else
   flag = True
    End If  'if r=vbyes 的结束
    
   End If   'if keyascii=13的结束
     
 Text3.SetFocus
 Text3.SelStart = 0
 Text3.SelLength = Len(Text3.Text)
End If

  
If KeyAscii < 97 And KeyAscii > 65 Then
   KeyAscii = 0
End If


End Sub

Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then Text4.SetFocus
If KeyCode = vbKeyUp Then Text2.SetFocus
If KeyCode = vbKeyLeft And Text3.SelStart = 0 Then Text2.SetFocus
If KeyCode = vbKeyRight And Text3.SelStart = Len(Text3.Text) Then Text4.SetFocus
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text4.SetFocus
Text4.SelStart = 0
Text4.SelLength = Len(Text4.Text)
End If

End Sub

Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then Text6.SetFocus
If KeyCode = vbKeyUp Then Text3.SetFocus
If KeyCode = vbKeyLeft And Text4.SelStart = 0 Then Text3.SetFocus
If KeyCode = vbKeyRight And Text4.SelStart = Len(Text4.Text) Then Text6.SetFocus
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text6.SetFocus
Text6.SelStart = 0
Text6.SelLength = Len(Text6.Text)
End If

End Sub

Private Sub Text6_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then Command4.SetFocus
If KeyCode = vbKeyUp Then Text4.SetFocus
If KeyCode = vbKeyLeft And Text6.SelStart = 0 Then Text4.SetFocus
If KeyCode = vbKeyRight And Text2.SelStart = Len(Text2.Text) Then Command4.SetFocus
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command4.SetFocus

End Sub
Private Sub Timer1_Timer()
If Myinfo = "" Then
   Myinfo = Space(80) & "欢迎使用校园机房管理系统！"
End If
Myinfo = Right(Myinfo, Len(Myinfo) - 1)
StatusBar1.Panels(3).Text = Myinfo
End Sub
Private Sub MyWeekDay()
Select Case Weekday(Date)
   Case 1
     StatusBar1.Panels(2).Text = "星期日"
   Case 2
     StatusBar1.Panels(2).Text = "星期一"
   Case 3
     StatusBar1.Panels(2).Text = "星期二"
   Case 4
     StatusBar1.Panels(2).Text = "星期三"
   Case 5
     StatusBar1.Panels(2).Text = "星期四"
   Case 6
     StatusBar1.Panels(2).Text = "星期五"
   Case 7
     StatusBar1.Panels(2).Text = "星期六"
End Select
End Sub

Private Sub VScroll1_Change()
 If V0 < VScroll1.Value Then
  Text4 = Val(Text4) - 5
  Else
  Text4 = Val(Text4) + 5
  End If
  V0 = VScroll1.Value
End Sub