mdiform1.frm

学校田径运动会管理系统是典型的信息管理系统

               Name            =   "宋体"
               Size            =   9
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00008000&
            Height          =   180
            Index           =   4
            Left            =   -74760
            TabIndex        =   20
            Top             =   1320
            Width           =   795
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "用户名："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   9
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00008000&
            Height          =   180
            Index           =   5
            Left            =   -74760
            TabIndex        =   19
            Top             =   840
            Width           =   780
         End
         Begin VB.Label Label3 
            AutoSize        =   -1  'True
            Caption         =   "选择删除用户"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00000080&
            Height          =   210
            Left            =   -74640
            TabIndex        =   13
            Top             =   720
            Width           =   1350
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "用户名："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   9
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00008000&
            Height          =   180
            Index           =   0
            Left            =   240
            TabIndex        =   9
            Top             =   720
            Width           =   780
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "密  码："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   9
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00008000&
            Height          =   180
            Index           =   1
            Left            =   240
            TabIndex        =   8
            Top             =   1200
            Width           =   795
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "确认密码："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   9
               Charset         =   134
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H00008000&
            Height          =   180
            Index           =   2
            Left            =   240
            TabIndex        =   7
            Top             =   1680
            Width           =   975
         End
      End
   End
End
Attribute VB_Name = "用户管理"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim customer_num As Integer
Private Sub Command1_Click(Index As Integer)
If Index = 0 Then '确定
   strsql = "select * from 用户信息"
   Set rs = cnn.Execute(strsql)
   If Text1(0).Text <> "" And Text1(1).Text <> "" And Text1(2).Text <> "" Then
      If Text1(0) <> rs.Fields(0) Then '检查用户名是否存在，不存在则添加
         If Text1(1) = Text1(2) Then '验证密码和确认密码是否一致
            strsql = "insert into 用户信息 values('" & Text1(0).Text & "','" & Text1(1).Text & "')"
            cnn.Execute (strsql)
            MsgBox "用户： " & Text1(0).Text & "添加成功！", vbOKOnly, "添加信息"
            Text1(0).Text = ""
            Text1(1).Text = ""
            Text1(2).Text = ""
         Else '密码和确认密码是否一致
            MsgBox "您输入的密码和确认密码不一致，请重新输入！", vbOKOnly + vbExclamation, "警告"
            Text1(1) = ""
            Text1(2) = ""
         End If
      Else
         MsgBox "该用户已经存在，请更换用户名！", vbOKOnly + vbExclamation, "提示"
         Text1(0).Text = ""
         Text1(1).Text = ""
         Text1(2).Text = ""
      End If
   Else
      MsgBox "您输入的信息不全面，请确认无误后在做“确定”操作！", vbOKOnly + vbExclamation, "警告"
   End If
End If
If Index = 1 Then '重置
   Text1(0).Text = ""
   Text1(1).Text = ""
   Text1(2).Text = ""
   MsgBox "已经重置！", vbOKOnly, "提示"
   Text1(0).SetFocus
End If
If Index = 3 Then '确定修改
   If Text1(5).Text <> "" And Text1(4).Text <> "" And Text1(3).Text <> "" Then
      strsql = "select * from 用户信息 where 用户名='" & Text1(5).Text & "'"
      Set rs = cnn.Execute(strsql)
      If Not rs.EOF Then '存在该用户，则修改
         If Text1(3).Text = Text1(4).Text Then
            strsql = "update 用户信息 set 用户名='" & Text1(5).Text & "',密码='" & Text1(3).Text & "'"
            cnn.Execute (strsql)
            MsgBox "修改成功，请牢记修改后的登录信息！", vbOKOnly, "提示"
         Else
            MsgBox "密码和确认密码不一致！", vbOKOnly + vbExclamation, "警告"
            Text1(3).Text = ""
            Text1(4).Text = ""
            Text1(4).SetFocus
         End If
      Else
         MsgBox "该用户不存在，不可修改！", vbOKOnly + vbExclamation, "警告"
         Text1(5).Text = ""
         Text1(4).Text = ""
         Text1(3).Text = ""
      End If
    End If
End If

If Index = 2 Then '重置
   For i = 3 To 5
      Text1(i).Text = ""
   Next
   Text1(5).SetFocus
End If
End Sub

Private Sub Command2_Click(Index As Integer)
strsql = "select count(*) from 用户信息"
Set rs = cnn.Execute(strsql)
customer_num = rs.Fields(0)
strsql = "select * from 用户信息"
Set rs = cnn.Execute(strsql)
For i = 0 To customer_num - 1
   Combo1.List(i) = rs.Fields(0)
   rs.MoveNext
Next
Combo1.Text = Combo1.List(0)
If Index = 0 Then '确定删除
  If Combo1.Text <> "" Then
     strsql = "select * from 用户信息 where 用户名='" & Combo1.Text & "'"
     Set rs = cnn.Execute(strsql)
     If Not rs.EOF Then '用户存在,则判断是否为最后一位用户，若是则不可删除
        strsql = "select count(*) from 用户信息"
        Set rs = cnn.Execute(strsql)
        customer_num = rs.Fields(0)
        If customer_num > 1 Then '不是最后一位用户则删除
           strsql = "delete from 用户信息 where 用户名='" & Combo1.Text & "'"
           cnn.Execute (strsql)
           MsgBox "已经删除用户 " & Combo1.Text & " ！", vbOKOnly, "提示信息"
        Else '最后一位用户，不可删除
           MsgBox "这是剩下的唯一一位用户，系统不允许删除！", vbOKOnly + vbExclamation, "操作中止"
           Combo1.Text = "用户名"
        End If
     Else
        MsgBox "该用户不存在，操作中止！", vbOKOnly + vbExclamation, "出错"
     End If
  Else
     MsgBox "没有空用户名的用户存在！", vbOKOnly, "提示"
  End If
strsql = "select count(*) from 用户信息" '更新combo1列表
Set rs = cnn.Execute(strsql)
customer_num = rs.Fields(0)
strsql = "select * from 用户信息"
Set rs = cnn.Execute(strsql)
For i = 0 To customer_num - 1
   Combo1.List(i) = rs.Fields(i)
   rs.MoveNext
Next
End If
If Index = 1 Then '取消
   Combo1.Text = "用户名"
   MsgBox "已经取消！", vbOKOnly, "提示"
End If

End Sub

Private Sub MDIForm_Load()
Dim mypath As String, connString As String
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
mypath = App.Path & "/data"  '获取当前路径
If Right(mypath, 1) <> "/" Then mypath = mypath + "/"
cnn.Open "Data Source=" & mypath & "db1.mdb" & ";Provider=Microsoft.Jet.OLEDB.4.0 " '连接并打开数据库
strsql = "select count(*) from 用户信息"
Set rs = cnn.Execute(strsql)
customer_num = rs.Fields(0)
strsql = "select * from 用户信息"
Set rs = cnn.Execute(strsql)
For i = 0 To customer_num - 1
   Combo1.List(i) = rs.Fields(0)
   rs.MoveNext
Next
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
strsql = "select count(*) from 用户信息"
Set rs = cnn.Execute(strsql)
customer_num = rs.Fields(0)
strsql = "select * from 用户信息"
Set rs = cnn.Execute(strsql)
For i = 0 To customer_num - 1
   Combo1.List(i) = rs.Fields(0)
   rs.MoveNext
Next

End Sub