frmstudent.frm

一个自己做的电力管理系统,主要用于电力电业行业的管理

         Caption         =   "更新"
         Height          =   375
         Left            =   360
         TabIndex        =   31
         Top             =   1200
         Width           =   1335
      End
      Begin VB.CommandButton cmdAdd 
         Caption         =   "添加"
         Height          =   375
         Left            =   360
         TabIndex        =   30
         Top             =   240
         Width           =   1335
      End
      Begin VB.TextBox txtData 
         Height          =   375
         Index           =   12
         Left            =   120
         TabIndex        =   29
         Top             =   3600
         Width           =   1815
      End
      Begin VB.Line Line1 
         X1              =   0
         X2              =   2040
         Y1              =   2760
         Y2              =   2760
      End
      Begin VB.Label Label13 
         Caption         =   "请在下面输入学号："
         BeginProperty Font 
            Name            =   "新宋体"
            Size            =   9
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00C0C000&
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   3000
         Width           =   1815
      End
   End
End
Attribute VB_Name = "frmStudent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public i As Integer           'i 为输出数据项的文本框数组的下标
Public dataTable As String    'datatable为所要的查询表
Public selectkey As String    'selectKey 为所要查询的关键字

Private Sub Form_Load()
    Me.Combo1.AddItem "女"
    Me.Combo1.AddItem "男"
   Me.txtData(3).Visible = False
   Me.txtData(6).Visible = False
   Me.Combo1.Visible = True
   i = 12
   dataTable = "学生信息表"
   selectkey = "学号"
   MakeCenter Me                    '窗体位于屏幕中间
End Sub

Private Sub cmdAdd_Click()                '添加数据
  Me.cmdDel.Enabled = False               '使删除按钮和更新按钮无效
  Me.cmdUpdata.Enabled = False
  Me.cmdSave.Enabled = True
  Me.Combo1.Visible = True
  Me.txtData(3).Visible = False
End Sub

Private Sub cmdCancel_Click()             '取消
    Me.cmdAdd.Enabled = True
    Me.cmdDel.Enabled = True
    Me.cmdUpdata.Enabled = True
    Me.cmdSave.Enabled = False
End Sub

Private Sub cmdClean_Click()              '清除数据
   Dim j As Integer
   For j = 0 To i
       Me.txtData(j).Text = ""
       Next j
End Sub

Private Sub cmdDel_Click()                    '删除数据
On Error GoTo errh
Dim str As String                              '接受查询语句
Dim Answer As String
Dim j As Integer
If Me.txtData(0).Text = "" Then                             '学号为空时不能删除数据
   MsgBox " 你没有要删除的数据，请查询数据后再删除"
   Exit Sub
End If
 Answer = MsgBox("删除后无法恢复，你可要想好了，确实要删除吗？", vbYesNo, "警告！！")
 If Answer = vbYes Then
    Set rs = New ADODB.Recordset
    MakeConnection                                  '连接数据库
    Set rs.ActiveConnection = CN
    rs.Source = "select * from " & dataTable
    rs.Open                                         '删除信息
    str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
    CN.Execute str
    delConnection                                    '断开数据库
                   '清空纪录
    For j = 0 To i - 1
        Me.txtData(j) = ""
        Next j
        Me.txtAddress.Text = ""
    MsgBox "删除成功！"
    Exit Sub
  Else
     Exit Sub                                     '防止没有操作时，出现错误提示框
 End If
errh:
     MsgBox Err.Description
End Sub

Private Sub cmdExit_Click()             '退出窗体
    Unload Me
End Sub

Private Sub cmdSave_Click()             '保存数据
 On Error GoTo errh
 Dim j As Integer
 Dim str As String
 Dim strLb As String
 Me.Combo1.Visible = False
 Me.txtData(3).Visible = True
 If Me.txtData(0).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label1.Caption, Len(Trim(Me.Label1.Caption)) - 1))
   MsgBox strLb
   Me.txtData(0).SetFocus
   Exit Sub
End If
If Me.txtData(1).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label2.Caption, Len(Trim(Me.Label2.Caption)) - 1))
   MsgBox strLb
   Me.txtData(1).SetFocus
   Exit Sub
End If
If Me.txtData(2).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label3.Caption, Len(Trim(Me.Label3.Caption)) - 1))
   MsgBox strLb
   Me.txtData(2).SetFocus
   Exit Sub
End If
If Me.txtData(4).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label5.Caption, Len(Trim(Me.Label5.Caption)) - 1))
   MsgBox strLb
   Me.txtData(4).SetFocus
   Exit Sub
End If
If Me.txtData(5).Text = "" Then
   strLb = "请输入" & Trim(Left(Me.Label6.Caption, Len(Trim(Me.Label6.Caption)) - 1))
   MsgBox strLb
   Me.txtData(5).SetFocus
   Exit Sub
Else
   Set rs = New ADODB.Recordset
   MakeConnection
   Set rs.ActiveConnection = CN
   rs.Source = "select * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
   rs.Open
   If rs.EOF Then
       delConnection
       MakeConnection
       Set rs = New ADODB.Recordset
       rs.LockType = adLockOptimistic
       rs.CursorType = adOpenKeyset
       rs.Open dataTable, CN, , , adCmdTable
       rs.AddNew
       Me.txtData(3).Text = Me.Combo1.Text            '将数据传入到txtData(3)中然后传入数据库
       Me.txtData(6).Text = Me.txtAddress.Text            '将数据传入到txtData(6)中然后传入数据库
       For j = 0 To i - 1
           rs.Fields(j).Value = Me.txtData(j).Text
           Next j
       rs.Update
       delConnection        '断开连接
       MsgBox "保存在成功！", vbOKOnly, "恭喜你！"
       Exit Sub
   Else
      If Me.txtData(0).Text = rs.Fields(0).Value Then
          MsgBox "数据库中已经存在数据，请重新输入"
          Me.txtData(0).SetFocus
          Exit Sub
      End If
   End If
End If

errh:                         '错误信息
     MsgBox Err.Description
End Sub

Private Sub cmdSelect_Click()       '查询信息
 On Error GoTo errh
If txtData(i).Text = "" Then
    MsgBox "请在框中输入关键的数据，以便查询"
    txtData(i).SetFocus
    Exit Sub
End If
Dim str As String
Dim j As Integer
Set rs = New ADODB.Recordset
   MakeConnection
Set rs.ActiveConnection = CN
rs.Source = " select * from " & dataTable & " where  " & selectkey & "='" & txtData(i).Text & "'"
rs.Open
If rs.EOF Then
    MsgBox "没有找到你所要求的纪录！请重新输入关键字！"
    delConnection
    Me.txtData(i) = ""
    Me.txtData(i).SetFocus
    Exit Sub
Else
   If txtData(i).Text = rs.Fields(0).Value Then
      Me.txtData(3).Visible = True
      Me.Combo1.Visible = False
      For j = 0 To i - 1                             '将数据库的值显示出来
          txtData(j).Text = rs.Fields(j).Value
          Next j
      Me.txtAddress.Text = Me.txtData(6).Text        '将地址显示出来
      delConnection
      MsgBox "找到你要查询的数据"
      Exit Sub
    End If
End If
errh:
     MsgBox Err.Description
End Sub

Private Sub cmdUpdata_Click()
 On Error GoTo errh
 Dim j As Integer
 Dim dataTable As String
 Dim selecKey As String
 Dim str As String
    
    Me.cmdAdd.Enabled = False
    Me.cmdDel.Enabled = False
    Me.cmdSave.Enabled = True
    If Me.txtData(0).Text = "" Then
        MsgBox "你没有要更新的内容，请查询后再更新！"
        Exit Sub
    End If
    Set rs = New ADODB.Recordset       '更新之前，先删除旧的信息
    MakeConnection
    Set rs.ActiveConnection = CN
    rs.Source = "select * from " & dataTable
    rs.Open
    str = "delete * from " & dataTable & " where " & selectkey & "='" & Me.txtData(0).Text & "'"
    CN.Execute str
    delConnection      '断开连接
                       '写入新数据
    MakeConnection
    Set rs = New ADODB.Recordset
    rs.LockType = adLockOptimistic
    rs.CursorType = adOpenKeyset
    rs.Open dataTable, CN, , , adCmdTable
    rs.AddNew
    Me.txtData(3).Text = Me.Combo1.Text               '将数据传入到txtData(3)中然后传入数据库
    Me.txtData(6).Text = Me.txtAddress.Text           '将数据传入到txtData(6)中然后传入数据库
    For j = 0 To i - 1
        rs.Fields(j).Value = Me.txtData(j).Text
        Next j
    rs.Update
    delConnection        '断开连接
    MsgBox "更新成功！", vbOKOnly, "恭喜你！"
    Exit Sub
errh:
         MsgBox Err.Description
End Sub