Option Explicit

Private Sub cmbAllUser_Change()

End Sub

Private Sub cmdCancle_Click()
Unload Me
End Sub

Private Sub cmdDel_Click()
If Trim(txtPwd.Text) = "" Then
MsgBox "用户密码不允许为空" & Space(5), vbExclamation + vbOKOnly, "输入错误"
txtPwd.SetFocus
Exit Sub
Else
Dim lDelUser As Long
If cmbAllUser.Text = sCurUser Then
If MsgBox("当前用户正在使用，是否删除？", vbYesNo + vbQuestion, "删除用户") = vbYes Then
lDelUser = DelUser(sCurUser, MD5(Trim(txtPwd.Text), 1))
Else
Exit Sub
End If
Else
If MsgBox("确认删除用户" & cmbAllUser.Text & Space(5), vbQuestion + vbYesNo, "确认删除") = vbYes Then
lDelUser = DelUser(cmbAllUser.Text, MD5(Trim(txtPwd.Text), 1))
Else
Exit Sub
End If
End If

Select Case lDelUser
Case "0":
If cmbAllUser.Text = sCurUser Then
MsgBox "当前用户已删除，程序终止" & Space(5), vbInformation + vbOKOnly, "删除成功"
Me.Hide
Unload frmMain
Unload Me
Else
MsgBox "删除用户成功" & Space(5), vbInformation + vbOKOnly, "删除成功"
Unload Me
End If
Case "1":
MsgBox "用户密码错误" & Space(5), vbExclamation + vbOKOnly, "删除失败"
txtPwd.SetFocus
SendKeys "{Home}+{End}"
Exit Sub
Case "2":
MsgBox "程序错误，请重试" & Space(5), vbExclamation + vbOKOnly, "删除失败"
End Select

End If

End Sub
Private Function DelUser(Name As String, Pwd As String) As Long ' 1 --- Password invalid 0 --- ok 2 ---- Err
On Error GoTo DelUserErr

Dim Rs As Recordset
Set Rs = New Recordset

Rs.Open "Select Name,Password from Users where Name='" & Name & "'", cnDB, adOpenKeyset, adLockOptimistic

If Rs!Password = Pwd Then
Rs.Delete adAffectAllChapters
Rs.Close
Set Rs = Nothing
DelUser = 0
Else
Rs.Close
Set Rs = Nothing
DelUser = 1
End If

Exit Function

DelUserErr:
Rs.Close
Set Rs = Nothing
DelUser = 2
End Function
Private Sub Form_Load()
Move (frmMain.Left + (frmMain.Width - Me.Width) / 2), (frmMain.Top + (frmMain.Height - Me.Height) / 2)
ListUser
End Sub
Private Sub ListUser()
On Error GoTo ListErr

Dim Rs As Recordset

Set Rs = New Recordset

Rs.Open "Select Name From Users", cnDB, adOpenForwardOnly, adLockReadOnly

Do While Not Rs.EOF
cmbAllUser.AddItem Rs!Name
Rs.MoveNext
Loop

Rs.Close
Set Rs = Nothing

cmbAllUser.ListIndex = 0
Exit Sub

ListErr:
Rs.Close
Set Rs = Nothing
MsgBox "加载用户列表错误" & Space(5), vbExclamation + vbOKOnly, "加载错误"
Unload Me
End Sub