frmuser.frm

学生信息管理系统

               Top             =   360
               Width           =   1575
            End
            Begin VB.Label Label5 
               Caption         =   "身  份："
               Height          =   255
               Left            =   240
               TabIndex        =   29
               Top             =   720
               Width           =   855
            End
            Begin VB.Label Label9 
               Alignment       =   2  'Center
               Caption         =   "验  证："
               Height          =   255
               Left            =   120
               TabIndex        =   28
               Top             =   1440
               Width           =   960
            End
            Begin VB.Label Label2 
               Alignment       =   2  'Center
               Caption         =   "密  码："
               Height          =   255
               Left            =   120
               TabIndex        =   5
               Top             =   1080
               Width           =   960
            End
            Begin VB.Label Label1 
               Alignment       =   2  'Center
               Caption         =   "用户名："
               Height          =   255
               Left            =   135
               TabIndex        =   3
               Top             =   360
               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 Or Trim(Combo1.Text) = "" 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) & "'"
    sql = sql & ",'" & Trim(Combo1.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
     With Combo1
     .Clear
     .AddItem "管理员"
     .AddItem "学生处"
     .AddItem "教务处"
     .AddItem "人事处"
     .AddItem "财务处"
     .AddItem "学校办公室"

     End With
'删除
 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