frmbase.frm

学生信息管理系统

VERSION 5.00
Object = "{D27CDB6B-AE6D-11CF-96B8-444553540000}#1.0#0"; "Flash8a.ocx"
Begin VB.Form frmBase 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "基本表维护"
   ClientHeight    =   5940
   ClientLeft      =   45
   ClientTop       =   405
   ClientWidth     =   4755
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5940
   ScaleWidth      =   4755
   Begin VB.ComboBox cobbasic 
      Height          =   300
      Left            =   1680
      TabIndex        =   7
      Text            =   "cobbasic"
      Top             =   1440
      Width           =   2895
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "基本表信息维护"
      Height          =   3975
      Left            =   120
      TabIndex        =   0
      Top             =   1920
      Width           =   4455
      Begin VB.CommandButton cmdQuit 
         Caption         =   "退出"
         Height          =   375
         Left            =   3480
         TabIndex        =   5
         Top             =   3480
         Width           =   855
      End
      Begin VB.CommandButton cmdShow 
         Caption         =   "显示"
         Height          =   375
         Left            =   3480
         TabIndex        =   4
         Top             =   2280
         Width           =   855
      End
      Begin VB.CommandButton cmdDel 
         Caption         =   "删除"
         Height          =   375
         Left            =   3480
         TabIndex        =   3
         Top             =   2880
         Width           =   855
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加"
         Height          =   375
         Left            =   3480
         TabIndex        =   2
         Top             =   1680
         Width           =   855
      End
      Begin VB.ListBox lstBase 
         Height          =   3480
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   3255
      End
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      Height          =   1215
      Left            =   -200
      TabIndex        =   8
      Top             =   0
      Width           =   5175
      _cx             =   9128
      _cy             =   2143
      FlashVars       =   ""
      Movie           =   ""
      Src             =   ""
      WMode           =   "Window"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   -1  'True
      Base            =   ""
      AllowScriptAccess=   ""
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   0   'False
      BGColor         =   ""
      SWRemote        =   ""
      MovieData       =   ""
      SeamlessTabbing =   -1  'True
      Profile         =   0   'False
      ProfileAddress  =   ""
      ProfilePort     =   0
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "请先选择需要维护的基本信息："
      Height          =   375
      Left            =   120
      TabIndex        =   6
      Top             =   1320
      Width           =   1335
   End
End
Attribute VB_Name = "frmBase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sname As String  '保存输入值
Dim sTable As String '保存表的名称

Private Sub cmdAdd_Click()
If Me.Caption = "基本表维护" Then
MsgBox "请先选择需要维护的基本信息", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If


On Error GoTo errMsg
sname = InputBox("请输入要录入的" & Me.Caption, Me.Caption & "录入", "")
If sname = "" Then
   Exit Sub
End If
Select Case Me.Caption
  Case "学院"
      sTable = "College"

  Case "专业"
      sTable = "Speciality"
  Case "民族"
      sTable = "Nation"
  Case "班级"
      sTable = "Class"
   Case "教师"
    sTable = "Teacher"
   Case "宿舍"
   sTable = "Live"
   Case "课程名称"
     sTable = "Lesson"

End Select
'查询
Set adoRS = adoCon.Execute("Select Count(*) From " & sTable & " Where Name='" & sname & "'")

If adoRS(0) > 0 Then
   MsgBox "名称为：" & sname & "的记录，在" & Me.Caption & "表中已经存在！", vbOKOnly + vbExclamation, "系统提示"
   sname = ""
   Exit Sub
End If

adoCon.Execute ("Insert Into " & sTable & " Values('" & sname & "')")
If sTable = "Class" Then
sql = ""
sql = "Insert Into Class2 "
sql = sql & " Values('" & Trim(sname) & "')"
adoCon.Execute (sql)

End If

If sTable = "Lesson" Then
sql = ""
sql = "Insert Into Lesson2 "
sql = sql & " Values('" & Trim(sname) & "')"
adoCon.Execute (sql)

End If

Set adoRS = adoCon.Execute("Select * From " & sTable & " Order By Name")
'刷新
lstBase.Clear
Do While Not adoRS.EOF
   lstBase.AddItem adoRS(0)
   adoRS.MoveNext
Loop
errMsg:
  If Err.Number <> 0 Then
     MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
     Exit Sub
  End If
End Sub

Private Sub cmddel_Click()
If Me.Caption = "基本表维护" Then
MsgBox "请先选择需要维护的基本信息", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If

On Error GoTo errMsg
Dim sMsg As String
Dim sql, c As String
c = lstBase.Text
If lstBase.Text = "" Then
  Exit Sub
Else
   sMsg = "您真的要删除 " + Trim(lstBase.Text) + "  吗？"
   If MsgBox(sMsg, vbQuestion + vbYesNo, "删除询问") = vbYes Then
      sql = "Delete From " & sTable & " Where Name='" & lstBase.Text & "'"
      
      adoCon.Execute (sql)
      lstBase.RemoveItem lstBase.ListIndex
   End If
   If sTable = "Class" Then
 
   sql = ""
   sql = "Delete From Class2  Where 班级='" & c & "'"
      adoCon.Execute (sql)
          If adoRS.EOF Then
   sql = ""
   sql = "Delete From Spclass  Where 班级='" & c & "'"
      adoCon.Execute (sql)
End If
    
   
   End If
   
     If sTable = "Lesson" Then
 
   sql = ""
   sql = "Delete From Lesson2  Where Name='" & c & "'"
      adoCon.Execute (sql)
          If adoRS.EOF Then
   sql = ""
   sql = "Delete From Splesson  Where 课程='" & c & "'"
      adoCon.Execute (sql)
End If
   
   
   
   
   End If
End If
errMsg:
  If Err.Number <> 0 Then
     MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
     Exit Sub
  End If
End Sub

Private Sub cmdQuit_Click()
Unload Me
End Sub

Private Sub cmdShow_Click()
If Me.Caption = "基本表维护" Then
MsgBox "请先选择需要维护的基本信息", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
On Error GoTo errMsg
Select Case Me.Caption
  Case "学院"
      sTable = "College"
  Case "专业"
      sTable = "Speciality"
  Case "民族"
      sTable = "Nation"
  Case "班级"
        sTable = "Class"
  Case "教师"
    sTable = "Teacher"
  Case "宿舍"
   sTable = "Live"
End Select
Set adoRS = adoCon.Execute("Select * From " & sTable & " Order By Name")
lstBase.Clear
Do While Not adoRS.EOF
   lstBase.AddItem adoRS(0)
   adoRS.MoveNext
Loop
errMsg:
  If Err.Number <> 0 Then
     MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
     Exit Sub
  End If
End Sub
Private Sub cobbasic_Click()
Me.Caption = cobbasic.Text
End Sub

Private Sub Form_Load()
ShockwaveFlash1.Movie = App.Path & "\flash\top.swf"
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 800
sname = ""
sTable = ""
cobbasic.AddItem "学院"
cobbasic.AddItem "专业"
cobbasic.AddItem "班级"
cobbasic.AddItem "教师"
cobbasic.AddItem "民族"
cobbasic.AddItem "宿舍"
cobbasic.ListIndex = 0
Me.Caption = cobbasic.Text
End Sub