Height          =   180
         Left            =   360
         TabIndex        =   17
         Top             =   2400
         Width           =   1080
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "密  碼："
         Height          =   180
         Left            =   360
         TabIndex        =   16
         Top             =   915
         Width           =   720
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "用戶名："
         Height          =   180
         Left            =   360
         TabIndex        =   15
         Top             =   435
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "確  認："
         Height          =   180
         Left            =   360
         TabIndex        =   14
         Top             =   1395
         Width           =   720
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "類  型："
         Height          =   180
         Left            =   360
         TabIndex        =   13
         Top             =   1875
         Width           =   720
      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 cmdAdd_Click()
    cmdOK.caption = "添加"
    freItem.caption = " 添加用戶 "
    txtUser.Text = ""
    txtPW.Text = ""
    txtPW2.Text = ""
    lbPW.Visible = False
    LoadcboStyle
    cboStyle.ListIndex = 0
    ShowItemFrame True
    txtUser.SetFocus
End Sub

Private Sub cmdDel_Click()
On Error GoTo aaaa
    Dim Item As ListItem
    Set Item = List1.SelectedItem
    Dim j As Long
    j = CLng(Left$(Item.SubItems(2), 1))
    If j >= curUserStyle And curUserStyle <> 4 Then
        MsgBox "您沒有權限刪除該用戶！", vbExclamation
        List1.SetFocus
        Exit Sub
    End If
    If StrComp(curUserName, Item.SubItems(1), 1) = 0 Then
        MsgBox "不能刪除自己。", vbInformation
        Exit Sub
    End If
    If MsgBox("確定刪除這個用戶嗎： [" & MID$(Item.SubItems(2), 3) & "] " & Item.SubItems(1), vbInformation + vbOKCancel) = vbCancel Then Exit Sub
    cnMain.Execute "Delete From [User] Where UserName='" & Item.SubItems(1) & "'"
    SetSB 2, "刪除用戶 " & Item.SubItems(1) & " 成功."
    List1.ListItems.Remove Item.Index
    List1.SetFocus
Exit Sub
aaaa:
    MsgBox Err.Description, vbCritical
End Sub

Private Sub cmdEdit_Click()
On Error GoTo aaaa
    Dim Item As ListItem
    Set Item = List1.SelectedItem
    Dim j As Long
    j = CLng(Left$(Item.SubItems(2), 1))
    If j >= curUserStyle And curUserStyle <> 4 Then
        MsgBox "您沒有權限編輯該用戶！", vbExclamation
        List1.SetFocus
        Exit Sub
    End If
    If StrComp(curUserName, Item.SubItems(1), 1) = 0 Then cboStyle.Enabled = False
    
    txtUser.Text = Item.SubItems(1)
    txtUser.Tag = Item.SubItems(1)
    txtPW.Text = ""
    txtPW2.Text = ""
    LoadcboStyle
    cboStyle.ListIndex = j - 1
    
    lbPW.Visible = True
    cmdOK.caption = "修改"
    freItem.caption = " 修改用戶 "
    ShowItemFrame True
    txtUser.SetFocus
Exit Sub
aaaa:
    MsgBox Err.Description, vbCritical
End Sub

Private Sub cmdExit_Click()
    ShowItemFrame False
    List1.SetFocus
End Sub

Private Sub cmdOK_Click()
On Error GoTo aaaa
    If txtUser.Text = "" Then
        MsgBox "必須填寫用戶名。", vbInformation
        txtUser.SetFocus
        Exit Sub
    End If
    If cmdOK.caption = "添加" Then
        If txtPW.Text = "" Then
            MsgBox "必須填寫密碼。", vbInformation
            txtPW.SetFocus
            Exit Sub
        End If
        If txtPW2.Text = "" Then
            MsgBox "必須填寫確認密碼。", vbInformation
            txtPW2.SetFocus
            Exit Sub
        End If
    End If
    If txtPW.Text <> txtPW2.Text Then
        MsgBox "密碼前后不一致。", vbInformation
        txtPW2.SetFocus
        Exit Sub
    End If
    If cmdOK.caption = "添加" Then
        cnMain.Execute "insert [User] values('" & txtUser.Text & "','" & GetMD5(txtPW.Text) & "'," & CStr(cboStyle.ListIndex + 1) & ")"
        LoadUserList
        SetSB 2, "添加用戶 " & txtUser.Text & " 成功."
    Else
        If txtPW.Text = "" Then
            cnMain.Execute "UPDATE [User] SET UserName='" & txtUser.Text & "',UserStyle=" & CStr(cboStyle.ListIndex + 1) & " Where UserName='" & txtUser.Tag & "'"
        Else
            cnMain.Execute "UPDATE [User] SET UserName='" & txtUser.Text & "',UserPW='" & GetMD5(txtPW.Text) & "',UserStyle=" & CStr(cboStyle.ListIndex + 1) & " Where UserName='" & txtUser.Tag & "'"
        End If
        List1.SelectedItem.SubItems(1) = txtUser.Text
        List1.SelectedItem.SubItems(2) = cboStyle.Text
        SetSB 2, "修改用戶 " & txtUser.Text & " 成功."
    End If
    cmdExit_Click
Exit Sub
aaaa:
    MsgBox "操作失敗，可能是該用戶名已經存在！", vbCritical
End Sub

Private Sub Form_Load()
    Me.WindowState = 2
    imgIcon.Picture = frmMain.cmdLeft(6).Picture
    '讀取用戶數據列表
    LoadUserList
End Sub

'加載cboStyle
Private Sub LoadcboStyle()
    Dim i As Long
    cboStyle.Clear
    For i = 1 To 4
        If i <= 2 Or curUserStyle = 4 Then cboStyle.AddItem i & "－" & GetUserStyleString(i)
    Next
End Sub

'讀取用戶數據列表
Public Sub LoadUserList()
    Dim Item As ListItem, lngUserStyle As Long
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    List1.ListItems.Clear
    rs.Open "Select * From [User] order by UserID Desc", cnMain, 1, 1
    Do Until rs.EOF
        lngUserStyle = rs("UserStyle")
        Set Item = List1.ListItems.Add(, , rs("UserID"), , lngUserStyle)
        Item.SubItems(1) = rs("UserName")
        Item.SubItems(2) = lngUserStyle & "－" & GetUserStyleString(lngUserStyle)
        rs.MoveNext
    Loop
    SetSB 2, "共 " & rs.RecordCount & " 條用戶員記錄."
End Sub

Public Function GetUserStyleString(ByVal lngUserStyle As Long) As String
    Select Case lngUserStyle
    Case 1
        GetUserStyleString = "員工"
    Case 2
        GetUserStyleString = "初級管理員"
    Case 3
        GetUserStyleString = "中級管理員"
    Case 4
        GetUserStyleString = "高級管理員"
    End Select
End Function

Public Sub ShowItemFrame(ByVal b As Boolean)
    List1.Visible = Not b
    freItem.Visible = b
    cmdDel.Enabled = Not b
    cmdEdit.Enabled = Not b
    cmdAdd.Enabled = Not b
End Sub

Private Sub Form_Resize()
On Error Resume Next
    List1.Width = Width / 15 - 40
    List1.Height = Height / 15 - 116
    PicTop.Width = Width / 15 - 16
    Cls
    Line (2, 2)-(Width / 15 - 14, Height / 15 - 29), 10921638, B
End Sub

Private Sub List1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
    With List1
        If (ColumnHeader.Index - 1) = .SortKey Then
            .SortOrder = 1 - .SortOrder
            .Sorted = True
        Else
            .Sorted = False
            .SortOrder = 0
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
        End If
    End With
End Sub

Private Sub List1_DblClick()
On Error GoTo aaaa
    Dim j As Long
    j = List1.SelectedItem.Index
    cmdEdit_Click
aaaa:
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo aaaa
    If KeyCode = vbKeyDelete Then
        Dim j As Long
        j = List1.SelectedItem.Index
        cmdDel_Click
    End If
aaaa:
End Sub