frmpasswordma.frm

功能强大的个人工作通讯录

         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   4350
      TabIndex        =   0
      Top             =   990
      Width           =   840
   End
End
Attribute VB_Name = "frmPASSWORDMA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub cmdAdd_Click()
On Error GoTo wr

If Replace(newLoginNO, " ", "") = "" Or Replace(Combo1, " ", "") = "" Or Len(newPassword) < 4 Or Passwordconfirm <> newPassword Or Combo1 <> "管理员" And Combo1 <> "高级用户" And Combo1 <> "普通用户" Then
   MsgBox "不能完成添加操作，原因可能：" & Chr(13) & "1、账号为空；" & Chr(13) & "2、权限为空或不正确格式；" & Chr(13) & "3、密码小于4位" & Chr(13) & _
   "4、密码确认与新密码不一致" & Chr(13) & "请确认后再继续操作！", vbOKOnly + 64, "提示"
   Exit Sub
End If

sql = "select * from 权限 where 账户='" & newLoginNO & "'"
Call OpenConn
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
   MsgBox "该用户已经存在，请更换用户名再作尝试。", vbOKOnly + 64, "提示"
   Call CloseConn
   Exit Sub
End If
Call CloseConn

sql = "select * from 权限"
Call OpenConn
rs.Open sql, cn, 3, 3
rs.AddNew
rs.Fields("账户") = newLoginNO
rs.Fields("密码") = Change(newPassword)
rs.Fields("权限") = Combo1
rs.Update
MsgBox "添加成功！", vbOKOnly + 64, "提示"
Call CloseConn

Call add

wr:
If err.Description <> "" Then
    MsgBox "程序运行溢出!", vbOKOnly + vbExclamation, "提示"
End If

End Sub

Private Sub cmdDel_Click()
On Error GoTo wr

If oldLoginNO = "admin" And TopRight <> "超级管理员" Then
    MsgBox "admin为系统管理员，不允许删除操作！", vbExclamation + vbOKOnly, "警告"
    Exit Sub
End If

If MsgBox("是否确定要删除该账户？", vbYesNo, "提示") = vbNo Then
    Exit Sub
End If

sql = "select * from 权限 where 账户='" & oldLoginNO.Caption & "'"
Call OpenConn
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
    rs.Delete
    rs.Update
    MsgBox "删除成功", vbOKOnly + 64, "提示"
End If
Call CloseConn
Call add

wr:
If err.Description <> "" Then
    MsgBox "程序运行溢出!", vbOKOnly + vbExclamation, "提示"
End If

End Sub


Private Sub cmdEdit_Click()
 On Error GoTo wr
 
If oldPassword.Enabled = True Then
   If Change(oldPassword) <> PassWord Then

     MsgBox "旧密码不正确，请确认后再尝试", vbOKOnly + 64, "提示"
    
    Exit Sub
    
    End If

End If


If Replace(Combo1, " ", "") = "" Or Combo1 <> "管理员" And Combo1 <> "普通用户" Then '检查权限是否为空或正确
    MsgBox "权限不能为空或不正确格式，请选择权限后再尝试", vbOKOnly + 64, "提示"
    Exit Sub
End If

If Replace(newLoginNO, " ", "") = "" Then   '检查新账号是否为空
    MsgBox "新账号不能为空，请确认后再尝试", vbOKOnly + 64, "提示"
    Exit Sub
End If

sql = "select * from 权限 where 账户='" & newLoginNO & "'"     '检查修改的账号是否已经存在

Call OpenConn
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 And newLoginNO <> oldLoginNO Then
   MsgBox " 该账户名已经存在，请换另外一个账户名！", vbOKOnly + 64, "提示"
   Call CloseConn
   Exit Sub
End If
Call CloseConn

If Len(newPassword) < 4 Or newPassword <> Passwordconfirm Then
    MsgBox "新密码不能为空或小于4位 或 密码确认与新密码不一致", vbOKOnly + 64, "提示"
    Exit Sub
End If

If MsgBox("你的修改的账户信息：" & Chr(13) & Chr(13) & "  账户名：" & newLoginNO & Chr(13) & Chr(13) & "  密码：" & newPassword & _
Chr(13) & Chr(13) & "权限：" & Combo1 & Chr(13) & Chr(13) & "是否确认修改？", vbYesNo + 64, "确认") = vbYes Then

   
   sql = "select * from 权限 where 账户='" & oldLoginNO & "'"
   
   Call OpenConn
   
   rs.Open sql, cn, 3, 3
   
   If rs.RecordCount > 0 Then
   
        rs.Fields("账户") = newLoginNO
        
        If oldLoginNO = LoginNO Then
            
            QX = Combo1.Text
           
            LoginNO = newLoginNO
            PassWord = Change(newPassword)
        End If
        
        oldLoginNO = newLoginNO
        
        rs.Fields("密码") = Change(newPassword)
        
        
        rs.Fields("权限") = Combo1.Text
             
        rs.Update
         MsgBox "修改成功", vbOKOnly + 64, "提示"
  
   End If
   
   Call CloseConn
End If

Call add

wr:
If err.Description <> "" Then
    MsgBox "程序运行溢出!", vbOKOnly + vbExclamation, "提示"
End If

End Sub

Private Sub Form_Load()

Me.Height = 5025
Me.Width = 8235
Me.Top = Screen.Height / 2 - Me.Height / 2 - 400
Me.Left = Screen.Width / 2 - Me.Width / 2

Combo1.AddItem "管理员"
Combo1.AddItem "高级用户"
Combo1.AddItem "普通用户"

Call add

End Sub

Private Sub add()
On Error GoTo wr

lv.ListItems.clear
lv.ColumnHeaders.clear
lv.ColumnHeaders.add = "账户"
lv.ColumnHeaders.add = "权限"

sql = "select * from 权限"
Call OpenConn
rs.Open sql, cn, 3, 3
If rs.RecordCount > 0 Then
    Do While Not rs.EOF
        Set List = lv.ListItems.add(, , IIf(IsNull(rs.Fields("账户")), "", rs.Fields("账户")))
           List.SubItems(1) = IIf(IsNull(rs.Fields("权限")), "", rs.Fields("权限"))
           rs.MoveNext
    Loop
End If
Call CloseConn

wr:
If err.Description <> "" Then
    MsgBox "加载列表出错!", vbOKOnly + vbExclamation, "提示"
End If
End Sub



Private Sub lv_click()
On Error GoTo wr

oldLoginNO = lv.SelectedItem
newLoginNO.Text = lv.SelectedItem
Combo1.Text = lv.SelectedItem.SubItems(1)

If LoginNO <> "admin" And lv.SelectedItem.SubItems(1) = "管理员" And lv.SelectedItem <> LoginNO And TopRight <> "超级管理员" Then
    MsgBox "同等身份不能操作", vbExclamation + vbOKOnly, "提示"
    cmdEdit.Enabled = False
    cmdDel.Enabled = False
    
    Exit Sub
Else
     cmdEdit.Enabled = True
    cmdDel.Enabled = True
    
End If


If oldLoginNO = "admin" And TopRight <> "超级管理员" Then
  newLoginNO.Enabled = False
  Combo1.Enabled = False
Else
  newLoginNO.Enabled = True
  Combo1.Enabled = True
End If


If lv.SelectedItem.SubItems(1) <> "管理员" Or LoginNO = "admin" And lv.SelectedItem <> LoginNO Or TopRight = "超级管理员" Then
    oldPassword.Text = "无须输入密码"
    oldPassword.Enabled = False
Else
    oldPassword = ""
    oldPassword.Enabled = True
    oldPassword.SetFocus
End If



wr:
If err.Description <> "" Then
    MsgBox "程序运行溢出!", vbOKOnly + vbExclamation, "提示"
End If

End Sub