frmuser.frm

这是别人的数据库课程设计

            Begin VB.TextBox txtUser 
               Height          =   285
               Left            =   1170
               MaxLength       =   10
               TabIndex        =   4
               Text            =   "txtUser"
               Top             =   405
               Width           =   1575
            End
            Begin VB.Label Label9 
               Alignment       =   2  'Center
               Caption         =   "验  证："
               Height          =   255
               Left            =   90
               TabIndex        =   28
               Top             =   1305
               Width           =   1095
            End
            Begin VB.Label Label2 
               Alignment       =   2  'Center
               Caption         =   "密  码："
               Height          =   255
               Left            =   135
               TabIndex        =   5
               Top             =   855
               Width           =   960
            End
            Begin VB.Label Label1 
               Alignment       =   2  'Center
               Caption         =   "用户名："
               Height          =   255
               Left            =   135
               TabIndex        =   3
               Top             =   450
               Width           =   975
            End
         End
      End
   End
End
Attribute VB_Name = "FrmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdAddCancel_Click()
Unload Me
End Sub

'注册用户
Private Sub CmdAddOK_Click()
Dim SQL As String
If Trim(txtUser.Text) = Empty Or Trim(txtPassword.Text) = Empty Then
   MsgBox "用户名和密码都不能为空，请重新输入！", vbOKCancel + vbCritical, "系统提示"
   txtUser.Text = ""
   txtPassword.Text = ""
   txtOkPassword.Text = ""
   txtUser.SetFocus
   Exit Sub
End If
Set adoRS = adoCon.Execute("select Count(*) from login where Name='" & Trim(txtUser.Text) & "'")
If adoRS(0) > 0 Then
    MsgBox "名称为： " & Trim(txtUser.Text) & "的用户已经存，请重新输入用户名！", vbOKOnly + vbExclamation, "系统提示"
    txtUser.Text = ""
    txtPassword.Text = ""
    txtOkPassword.Text = ""
    txtUser.SetFocus
    Exit Sub
End If
If Trim(txtPassword.Text) = Trim(txtOkPassword.Text) Then
    SQL = "insert into Login values('" & Trim(txtUser.Text) & "'"
    SQL = SQL & ",'" & Trim(txtPassword.Text) & "')"
    adoCon.Execute SQL
    MsgBox "系统用户设置成功,恭喜，恭喜！", vbInformation, "系统提示"
    
    txtUser.Text = ""
    txtPassword.Text = ""
    txtOkPassword.Text = ""
    txtUser.SetFocus
    adoRS.Close
    Set adoRS = Nothing
Else
    MsgBox "你两次输入的密码不符，请重新确认！", vbCritical, "系统提示"

    txtPassword.Text = ""
    txtOkPassword.Text = ""
End If
End Sub
Private Sub CmdDelCancel_Click()
Unload Me
End Sub

'删除用户
Private Sub CmdDelOk_Click()
Dim sFlag As String
Dim SQL As String
If Trim(txtDelPassword.Text) = Empty Then
   MsgBox "请输入正确密码后再删除用户！", vbOKOnly + vbInformation, "系统提示"
   txtDelPassword.SetFocus
   Exit Sub
End If
SQL = "select count(*) from login where name='" & Trim(CobDelUser.Text) & "'"
SQL = SQL & " And Password='" & Trim(txtDelPassword.Text) & "'"

Set adoRS = adoCon.Execute(SQL)
If adoRS(0) = 0 Then
   MsgBox "用户密码输入错误，请核实！", vbCritical, "系统提示"
   txtDelPassword.SelStart = 0
   txtDelPassword.SelLength = Len(Trim(txtDelPassword.Text))
   txtDelPassword.SetFocus
   Exit Sub
End If
   sFlag = MsgBox("你真的要删除：" & CobDelUser.Text & "用户吗？", vbYesNo + vbQuestion, "系统提示")
   If sFlag = vbYes Then
   SQL = "delete from login where Name="
   SQL = SQL & "'" & Trim(CobDelUser.Text) & "'"
   SQL = SQL & " And Password='" & Trim(txtDelPassword.Text) & "'"
      adoCon.Execute SQL
   CobDelUser.RemoveItem CobDelUser.ListIndex
   CobDelUser.ListIndex = 0
   txtDelPassword.Text = ""
   adoRS.Close
  Else
  txtDelPassword.Text = ""
  Exit Sub
  End If

  
End Sub
Private Sub CmdUpdateCancel_Click()
Unload Me
End Sub
'修改用户密码
Private Sub CmdUpdateOk_Click()
If Trim(txtReNewPassword.Text) = Trim(txtNewPassword.Text) And Trim(txtNewPassword.Text) <> "" Then
    SQL = "update Login set password='" & Trim(txtReNewPassword.Text) & "'"
    SQL = SQL & " where Name='" & Trim(CobUpdateUser.Text) & "'"
    adoCon.Execute SQL
    MsgBox "用户密码修改完毕，下次请用新密码登录！", vbokonmly + vbInformation, "系统提示"
    txtNewPassword.Text = ""
    txtNewPassword.Locked = True
    txtReNewPassword.Text = ""
    txtReNewPassword.Locked = True
    txtOldPassword.Text = ""
    CobUpdateUser.SetFocus
  Else
    MsgBox "修改密码失败，请核实后再修改！", vbCritical, "系统提示"
 End If
End Sub

Private Sub Form_Activate()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2 - 800
'初始设置添加用户
     txtUser.Text = ""
     txtPassword.Text = ""
     txtOkPassword.Text = ""
     FrmUser.txtUser.SetFocus
'删除用户
 Set adoRS = adoCon.Execute("select * from login")
     With CobDelUser
       .Clear
       While Not adoRS.EOF
         .AddItem adoRS(0)
         adoRS.MoveNext
       Wend
         .ListIndex = 0
     End With
     CobDelUser.SetFocus
     txtDelPassword.Text = ""
'修改密码
 Set adoRS = adoCon.Execute("select * from login")
     With CobUpdateUser
       .Clear
       While Not adoRS.EOF
         .AddItem adoRS(0)
         adoRS.MoveNext
       Wend
         .ListIndex = 0
     End With
     CobUpdateUser.SetFocus
     txtOldPassword.Text = ""
     txtNewPassword.Text = ""
     txtReNewPassword.Text = ""
     txtNewPassword.Locked = True
     txtReNewPassword.Locked = True
End Sub


'点击选项卡时,对各选项卡进行控件设置.
Private Sub StabUser_Click(PreviousTab As Integer)
 Select Case StabUser.Tab
   Case 0   '注册用户
     txtUser.Text = ""
     txtPassword.Text = ""
     txtOkPassword.Text = ""
     txtUser.SetFocus
   Case 1  '删除用户
     Set adoRS = adoCon.Execute("select * from login")
     With CobDelUser
       .Clear
       While Not adoRS.EOF
         .AddItem adoRS(0)
         adoRS.MoveNext
       Wend
         .ListIndex = 0
     End With
     CobDelUser.SetFocus
     txtDelPassword.Text = ""
   Case 2   '修改密码
    Set adoRS = adoCon.Execute("select * from login")
     With CobUpdateUser
       .Clear
       While Not adoRS.EOF
         .AddItem adoRS(0)
         adoRS.MoveNext
       Wend
         .ListIndex = 0
     End With
     CobUpdateUser.SetFocus
     txtOldPassword.Text = ""
     txtNewPassword.Text = ""
     txtReNewPassword.Text = ""
     txtNewPassword.Locked = True
     txtReNewPassword.Locked = True
 End Select
End Sub

Private Sub txtNewPassword_GotFocus()
  Dim SQL As String
  SQL = "select count(*) from Login where"
  SQL = SQL & " Name='" & Trim(CobUpdateUser.Text) & "'"
  SQL = SQL & " And Password='" & Trim(txtOldPassword.Text) & "'"
  Set adoRS = adoCon.Execute(SQL)
   If adoRS(0) = 0 Then
      MsgBox "你输入的用户密码不对，请核实", vbCritical, "系统提示"
      txtOldPassword.SetFocus
      Exit Sub
    End If
    txtNewPassword.Locked = False
End Sub

'判断新密码是否是空,新密码不能为空
Private Sub txtReNewPassword_GotFocus()
Dim SQL As String
If Trim(txtNewPassword.Text) = Empty Then
   MsgBox "请先输入新密码！", vbOKOnly + vbExclamation, "系统提示"
   txtNewPassword.SetFocus
   Exit Sub
End If
txtReNewPassword.Locked = False
txtNewPassword.Locked = True
End Sub