frmuseradmin.frm

公司订单管理系统,这对于方便公司管理床单

    
End Sub

'****************************************************************************************************
'*
'*                                   用戶權限設置
'*
'****************************************************************************************************
'用戶權限設置選項
Private Sub optUserAdminA_Click()
    Frame1.Enabled = True
    Frame2.Enabled = False
    Frame3.Enabled = False
    
    optUserAuthorityA1.Enabled = True
    optUserAuthorityA2.Enabled = True
    optUserAuthorityB1.Enabled = False
    optUserAuthorityB2.Enabled = False
    
    txtUserName.BackColor = vbWhite
    txtUserPassword.BackColor = vbWhite
    txtUserPasswordAgain.BackColor = vbWhite
    
    txtNewUserName.BackColor = vbButtonFace
    txtNewUserPassword.BackColor = vbButtonFace
    txtNewUserPasswordAgain.BackColor = vbButtonFace
    txtCurUserName.BackColor = vbButtonFace
End Sub
'脩改用戶權限
Private Sub cmdUpdateUserAuthority_Click()
On Error GoTo ErrorHandler
Dim sUserName As String
Dim sPassWord As String
Dim bIsCurrentUser As Boolean
Dim iUserAuthority As Integer
    If optUserAdminA.Value = True Then
       If Not (Len(txtUserName.Text) > 0) Then
          MsgBox "請輸入用戶名稱", vbExclamation, "提醒"
          Exit Sub
       End If
       If Not (Len(txtUserPassword.Text) > 0) Then
          MsgBox "請輸入用戶密碼", vbExclamation, "提醒"
          Exit Sub
       End If
       If StrComp(Trim$(txtUserPassword.Text), _
                  Trim$(txtUserPasswordAgain.Text), vbBinaryCompare) <> 0 Then
          MsgBox "對不起！兩次輸入的密碼不一緻，請重新輸入", vbExclamation, "提醒"
          txtUserPassword.Text = ""
          txtUserPasswordAgain.Text = ""
          Exit Sub
       End If
       '開始查詢數據
       Set pCmd.ActiveConnection = pCnn
       pCmd.CommandType = adCmdText
       pCmd.CommandText = "SELECT * FROM Administrator"
       Set pRs = pCmd.Execute
       If (Not pRs.BOF) And (Not pRs.EOF) Then
          '驗證用戶和密碼
          sUserName = Trim$(txtUserName.Text)
          sPassWord = Trim$(txtUserPassword.Text)
          bIsCurrentUser = False
          Do While Not pRs.EOF
             If (StrComp(pRs("UserName"), sUserName, vbBinaryCompare) = 0) And _
                (StrComp(pRs("Password"), sPassWord, vbBinaryCompare) = 0) Then
                '找到當前用戶，退齣循環查找.
                bIsCurrentUser = True
                Exit Do
             End If
             pRs.MoveNext
          Loop
          If bIsCurrentUser = True Then
             '設置用戶權限
             If optUserAuthorityA1.Value = True Then     '普通用戶
                iUserAuthority = 0 ' False
             ElseIf optUserAuthorityA2.Value = True Then '管理員
                iUserAuthority = -1 'True
             Else
                iUserAuthority = 0  'False '默認為普通用戶
             End If
             '更改用戶權限
             pCmd.CommandType = adCmdText
             pCmd.CommandText = _
             "UPDATE  Administrator " & _
             "SET " & "Authority='" & iUserAuthority & "' " & _
             "WHERE " & "UserName='" & sUserName & "' AND " & _
                        "Password='" & sPassWord & "'"
             pCmd.Execute
             MsgBox "用戶權限脩改成功！", vbExclamation, "恭喜"
             Set pCmd = Nothing
             Unload Me
          Else
             MsgBox "請驗證輸入的用戶名和密碼", vbExclamation, "權限脩改失敗"
          End If
       Else
          MsgBox "當前用戶管理列表中沒有任何用戶，請和管理員聯繫！", vbExclamation, "權限脩改失敗"
          Set pCmd = Nothing
          Unload Me
       End If
       Set pCmd = Nothing
    End If
Exit Sub
ErrorHandler:
    Set pCmd = Nothing
    MsgBox "用戶權限脩改失敗！" & _
           "[ErrorNumber]" & Err.Number & vbCrLf & _
           "[ErrorDescription ]" & Err.Description, vbCritical, "錯誤"
End Sub

'****************************************************************************************************
'*
'*                                   添加新的用戶
'*
'****************************************************************************************************
'添加新的用戶選項
Private Sub optUserAdminB_Click()
    Frame2.Enabled = True
    Frame1.Enabled = False
    Frame3.Enabled = False
    
    txtNewUserName.BackColor = vbWhite
    txtNewUserPassword.BackColor = vbWhite
    txtNewUserPasswordAgain.BackColor = vbWhite
    
    optUserAuthorityB1.Enabled = True
    optUserAuthorityB2.Enabled = True
    optUserAuthorityA1.Enabled = False
    optUserAuthorityA2.Enabled = False
    
    txtUserName.BackColor = vbButtonFace
    txtUserPassword.BackColor = vbButtonFace
    txtUserPasswordAgain.BackColor = vbButtonFace
    
    txtCurUserName.BackColor = vbButtonFace
End Sub
'創建新的用戶
Private Sub cmdCreateUser_Click()
On Error GoTo ErrorHandler
Dim sUserName As String
Dim sPassWord As String
Dim bIsCurrentUser As Boolean
Dim iUserAuthority As Integer
Dim sUserAuthority As String
    If optUserAdminB.Value = True Then
       If Not (Len(txtNewUserName.Text) > 0) Then
          MsgBox "請輸入新的用戶名", vbExclamation, "提醒"
          Exit Sub
       End If
       If Not (Len(txtNewUserPassword.Text) > 0) Then
          MsgBox "請輸入用戶密碼", vbExclamation, "提醒"
          Exit Sub
       End If
       If StrComp(Trim$(txtNewUserPassword.Text), _
                  Trim$(txtNewUserPasswordAgain.Text), vbBinaryCompare) <> 0 Then
          MsgBox "對不起！兩次輸入的密碼不一緻，請重新輸入", vbExclamation, "提醒"
          txtNewUserPassword.Text = ""
          txtNewUserPasswordAgain.Text = ""
          Exit Sub
       End If
       '開始查詢數據
       Set pCmd.ActiveConnection = pCnn
       pCmd.CommandType = adCmdText
       pCmd.CommandText = "SELECT * FROM Administrator"
       Set pRs = pCmd.Execute
       If (Not pRs.BOF) And (Not pRs.EOF) Then
          '驗證當前用戶是否已經存在
          sUserName = Trim$(txtNewUserName.Text)
          sPassWord = Trim$(txtNewUserPassword.Text)
          bIsCurrentUser = False
          Do While Not pRs.EOF
             If (StrComp(pRs("UserName"), sUserName, vbBinaryCompare) = 0) Then
                '找到當前用戶，退齣循環查找.
                bIsCurrentUser = True
                Exit Do
             End If
             pRs.MoveNext
          Loop
          If Not (bIsCurrentUser = True) Then
             '設置用戶權限
             If optUserAuthorityB1.Value = True Then     '普通用戶
                iUserAuthority = 0 ' False
                sUserAuthority = "普通用戶"
             ElseIf optUserAuthorityB2.Value = True Then '管理員
                iUserAuthority = -1 'True
                sUserAuthority = "管理員"
             Else
                iUserAuthority = 0  'False '默認為普通用戶
                sUserAuthority = "普通用戶"
             End If
             '添加新的用戶
             pCmd.CommandType = adCmdText
             pCmd.CommandText = _
              "INSERT INTO Administrator " & _
                     "(UserName,Password,Authority) " & _
              "VALUES ('" & sUserName & "','" & _
                            sPassWord & "','" & _
                            iUserAuthority & "')"
             pCmd.Execute
             MsgBox "用戶創建成功！詳細用戶信息：" & vbCrLf & _
                    "用戶名：" & sUserName & vbCrLf & _
                    "密碼：" & sPassWord & vbCrLf & _
                    "權限：" & sUserAuthority & vbCrLf & _
                    "請妥善保管好用戶名和密碼，謝謝！", vbExclamation, "恭喜"
             Set pCmd = Nothing
             Unload Me
          Else
             MsgBox "對不起！當前用戶已經存在，請選擇其他的用戶名", vbExclamation, "用戶創建失敗"
          End If
       Else
          MsgBox "當前用戶管理列表中沒有任何用戶，請和管理員聯繫！", vbExclamation, "用戶創建失敗"
          Set pCmd = Nothing
          Unload Me
       End If
       Set pCmd = Nothing
    End If
Exit Sub
ErrorHandler:
    Set pCmd = Nothing
    MsgBox "創建新用戶失敗！" & _
           "[ErrorNumber]" & Err.Number & vbCrLf & _
           "[ErrorDescription ]" & Err.Description, vbCritical, "錯誤"
End Sub

'****************************************************************************************************
'*
'*                                   刪除當前用戶
'*
'****************************************************************************************************
Private Sub optUserAdminC_Click()
    Frame3.Enabled = True
    Frame1.Enabled = False
    Frame2.Enabled = False
    
    txtCurUserName.BackColor = vbWhite
    
    optUserAuthorityA1.Enabled = False
    optUserAuthorityA2.Enabled = False
    optUserAuthorityB1.Enabled = False
    optUserAuthorityB2.Enabled = False
    
    txtUserName.BackColor = vbButtonFace
    txtUserPassword.BackColor = vbButtonFace
    txtUserPasswordAgain.BackColor = vbButtonFace
    
    txtNewUserName.BackColor = vbButtonFace
    txtNewUserPassword.BackColor = vbButtonFace
    txtNewUserPasswordAgain.BackColor = vbButtonFace
End Sub

'刪除當前用戶
Private Sub cmdDeleteUser_Click()
On Error GoTo ErrorHandler
Dim sUserName As String
Dim bIsCurrentUser As Boolean
    If optUserAdminC.Value = True Then
       If Not (Len(txtCurUserName.Text) > 0) Then
          MsgBox "請輸入用戶名稱", vbExclamation, "提醒"
          Exit Sub
       End If
       '開始查詢數據
       Set pCmd.ActiveConnection = pCnn
       pCmd.CommandType = adCmdText
       pCmd.CommandText = "SELECT * FROM Administrator"
       Set pRs = pCmd.Execute
       If (Not pRs.BOF) And (Not pRs.EOF) Then
          '驗證當前用戶是否已經存在
          sUserName = Trim$(txtCurUserName.Text)
          bIsCurrentUser = False
          Do While Not pRs.EOF
             If (StrComp(pRs("UserName"), sUserName, _
                vbBinaryCompare) = 0) Then
                '找到當前用戶，退齣循環查找.
                bIsCurrentUser = True
                sUserName = pRs("UserName")
                Exit Do
             End If
             pRs.MoveNext
          Loop
          If bIsCurrentUser = True Then
             '刪除當前用戶
             pCmd.CommandType = adCmdText
             pCmd.CommandText = "DELETE  * FROM Administrator WHERE " & _
                                "UserName= '" & sUserName & "'"
             pCmd.Execute
             MsgBox "刪除當前用戶成功！", vbExclamation, "恭喜"
             Set pCmd = Nothing
             Unload Me
          Else
             MsgBox "對不起！當前用戶不存在，請輸入其他的用戶名稱", vbExclamation, "用戶刪除失敗"
          End If
       Else
          MsgBox "當前用戶管理列表中沒有任何用戶，請和管理員聯繫！", vbExclamation, "用戶刪除失敗"
          Set pCmd = Nothing
          Unload Me
       End If
       Set pCmd = Nothing
    End If
Exit Sub
ErrorHandler:
    Set pCmd = Nothing
    MsgBox "用戶刪除失敗！" & _
           "[ErrorNumber]" & Err.Number & vbCrLf & _
           "[ErrorDescription ]" & Err.Description, vbCritical, "錯誤"
End Sub

'退齣繫統
Private Sub cmdExit_Click()
    Unload Me
End Sub
Private Sub Form_Terminate()
    Set frmUserAdmin = Nothing
End Sub