frmmanager.frm

该系统是用VB开发的一个人事管理系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmManager 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "登录用户管理"
   ClientHeight    =   6960
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   6465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6960
   ScaleWidth      =   6465
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdReLoad 
      Caption         =   "刷新"
      Height          =   375
      Left            =   3720
      TabIndex        =   10
      Top             =   2520
      Width           =   1575
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   1935
      Left            =   3360
      Picture         =   "frmManager.frx":0000
      ScaleHeight     =   1935
      ScaleWidth      =   2655
      TabIndex        =   9
      Top             =   3600
      Visible         =   0   'False
      Width           =   2655
   End
   Begin VB.CommandButton cmdCanel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   4680
      TabIndex        =   8
      Top             =   5160
      Width           =   855
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   375
      Left            =   3600
      TabIndex        =   7
      Top             =   5160
      Width           =   855
   End
   Begin MSComctlLib.TreeView TreeView 
      Height          =   4935
      Left            =   120
      TabIndex        =   4
      Top             =   720
      Width           =   3015
      _ExtentX        =   5318
      _ExtentY        =   8705
      _Version        =   393217
      Style           =   7
      SingleSel       =   -1  'True
      Appearance      =   1
      OLEDropMode     =   1
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   375
      Left            =   3720
      TabIndex        =   3
      Top             =   3120
      Width           =   1575
   End
   Begin VB.CommandButton cmdEdit 
      Caption         =   "修改组名"
      Height          =   375
      Left            =   3720
      TabIndex        =   2
      Top             =   1920
      Width           =   1575
   End
   Begin VB.CommandButton cmdDel 
      Caption         =   "删除用户组"
      Height          =   375
      Left            =   3720
      TabIndex        =   1
      Top             =   1320
      Width           =   1575
   End
   Begin VB.CommandButton cmdADD 
      Caption         =   "增加用户组"
      Height          =   375
      Left            =   3720
      TabIndex        =   0
      Top             =   720
      Width           =   1575
   End
   Begin VB.TextBox txtInput 
      Height          =   270
      Left            =   4320
      TabIndex        =   12
      Top             =   4080
      Width           =   1600
   End
   Begin VB.TextBox txtpaw 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   4320
      PasswordChar    =   "*"
      TabIndex        =   13
      Top             =   4560
      Width           =   1600
   End
   Begin VB.Label Label3 
      BackColor       =   &H00C0C0C0&
      Caption         =   "密码："
      Height          =   225
      Left            =   3360
      TabIndex        =   11
      Top             =   4560
      Width           =   855
   End
   Begin VB.Label Label2 
      BackColor       =   &H00C0C0C0&
      Caption         =   "用户名："
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   3360
      TabIndex        =   6
      Top             =   4080
      Width           =   855
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "系统用户"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   480
      Width           =   3015
   End
End
Attribute VB_Name = "frmManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mNode
Dim strNode As String
Dim strHNode As String
Dim signNode As Boolean
Dim sign As Integer
Private Sub subPurView()
    Dim mrc As ADODB.Recordset
    Dim rcs As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim IntIndex
    sign = 0
    Picture1.Visible = True
    TreeView.Nodes.Clear
    TreeView.Sorted = False
    Set mNode = TreeView.Nodes.Add
    With mNode
    .Text = "系统登录帐户"
    .Tag = "all"
    .Expanded = True
    End With
    TreeView.LabelEdit = tvwManual
    txtSQL = "select level,用户组 from 权限 "
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    Do Until mrc.EOF
        Set mNode = TreeView.Nodes.Add(1, tvwChild, mrc.Fields(1), CStr(mrc.Fields(1)))
        mNode.Tag = "uGroup"
        mNode.Expanded = True
        IntIndex = mNode.Index
        txtSQL = "select username from manager where level='" & mrc.Fields(0) & "'"
        Set rcs = ExecuteSQL(txtSQL, MsgText)
        Do Until rcs.EOF
            Set mNode = TreeView.Nodes.Add(IntIndex, tvwChild)
            With mNode
            .Text = rcs.Fields(0)
            .Key = rcs.Fields(0)
            .Tag = "user"
            End With
            rcs.MoveNext
        Loop
        mrc.MoveNext
    Loop
'    List1.Enabled = True
'    List2.Enabled = True
'    Check1.Enabled = False
'    Label3.Enabled = False
    TreeView.Enabled = True
    cmdAdd.Enabled = True
    cmdDel.Enabled = False
 '   cmdCancel.Enabled = False
 '   cmdSave.Enabled = False
 '   cmdChange.Enabled = True
    cmdEdit.Enabled = False
    cmdExit.Enabled = True
    cmdReload.Enabled = True
    cmdOK.Enabled = False
    cmdAdd.Caption = "增加用户组"
    cmdDel.Caption = "删除用户组"
End Sub

Private Sub cmdAdd_Click()
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    cmdEdit.Enabled = False
    cmdReload.Enabled = False
    cmdExit.Enabled = False
    TreeView.Enabled = False
    If cmdAdd.Caption = "增加用户组" Then
        Label2.Visible = True
        Label3.Visible = True
        txtInput.Visible = True
        txtpaw.Visible = True
        
        sign = 1
    Else
        'Label2.Caption = "请输入新增用户名："
        sign = 2
    End If
    txtInput.Text = ""
    txtpaw.Text = ""
    txtInput.SetFocus
    Picture1.Visible = False
End Sub

Private Sub cmdCanel_Click()
    cmdAdd.Enabled = True
    cmdDel.Enabled = True
    cmdEdit.Enabled = True
    cmdReload.Enabled = True
    cmdExit.Enabled = True
    TreeView.Enabled = True
    Picture1.Visible = True
    txtInput.Text = ""
    cmdOK.Enabled = False
    TreeView.SetFocus
End Sub

Private Sub cmdDel_Click()
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim intlevel As Integer
If MsgBox("真的要删除" & CStr(strNode) & "吗？", vbOKCancel + vbExclamation, "警告") = vbOK Then
    Select Case cmdDel.Caption
        Case "删除用户组"
            txtSQL = "select level from 权限 where 用户组='" & strNode & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            intlevel = mrc.Fields(0)
            txtSQL = "delete from manager where level='" & intlevel & "'"
            ExecuteSQL txtSQL, MsgText
            txtSQL = "delete from 权限 where 用户组='" & strNode & "'"
            ExecuteSQL txtSQL, MsgText
        Case "删除用户"
            txtSQL = "delete from manager where username='" & strNode & "'"
            ExecuteSQL txtSQL, MsgText
        Case Else
    End Select
    subPurView
End If
TreeView.SetFocus
End Sub

Private Sub cmdEdit_Click()
'    frmMEDialog.Show 1
'    frmMEDialog.Caption = cmdEdit.Caption
'    frmMEDialog.Label1.Caption = "请输入新的名字："
'    frmMEDialog.Text1.Text = strNode
'    frmMDialog.Tag = strNode
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    cmdEdit.Enabled = False
    cmdReload.Enabled = False
    cmdExit.Enabled = False
    TreeView.Enabled = False
    If cmdEdit.Caption = "修改组名" Then
        Label2.Caption = "请输入新的组名："
        sign = 3
    Else
        Label2.Caption = "请输入新的用户名："
        sign = 4
    End If
    txtInput.Text = strNode
    txtInput.SetFocus
    txtInput.SelStart = 0
    txtInput.SelLength = Len(txtInput)
    Picture1.Visible = False
End Sub

Private Sub cmdexit_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim mrc As ADODB.Recordset
    Dim rcs As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim intlevel As Integer
    Select Case sign
        Case 1
            If IsNumeric(txtInput.Text) Then
                MsgBox "请正确输入用户组名", 32, "提示"
                Exit Sub
            Else
                txtSQL = "select 用户组 from 权限 "
                Set mrc = ExecuteSQL(txtSQL, MsgText)
                Do Until mrc.EOF
                    If mrc.Fields(0) = Trim$(txtInput.Text) Then
                        MsgBox "用户组" & Trim$(txtInput.Text) & "已存在", 32, "提示"
                        txtInput.SetFocus
                        txtInput.SelLength = Len(txtInput)
                        txtInput.SelStart = 0
                        Exit Sub
                    End If
                    mrc.MoveNext
                Loop
                txtSQL = "insert into 权限 (用户组,可用模块数) values ('" & Trim$(txtInput.Text) & "','0')"
                ExecuteSQL txtSQL, MsgText
            End If
        Case 2
            If IsNumeric(txtInput.Text) Then
                MsgBox "请正确输入用户名", 32, "提示"
                Exit Sub
            Else
                txtSQL = "select username from manager"
                Set mrc = ExecuteSQL(txtSQL, MsgText)
                Do Until mrc.EOF
                    If mrc.Fields(0) = Trim$(txtInput.Text) Then
                        MsgBox "用户名" & Trim$(txtInput.Text) & "已存在", 32, "提示"
                        txtInput.SetFocus
                        txtInput.SelLength = Len(txtInput)
                        txtInput.SelStart = 0
                        Exit Sub
                    End If
                    mrc.MoveNext
                Loop
                If signNode Then
                    txtSQL = "select level from 权限 where 用户组='" & strHNode & "'"
                    Set rcs = ExecuteSQL(txtSQL, MsgText)
                    intlevel = rcs.Fields(0)
                Else
                    txtSQL = "select level from 权限 where 用户组='" & strNode & "'"
                    Set rcs = ExecuteSQL(txtSQL, MsgText)
                    intlevel = rcs.Fields(0)
                End If
                txtSQL = "insert into manager values ('" & Trim$(txtInput.Text) & "','" & Trim$(txtpaw.Text) & "','" & intlevel & "')"
                ExecuteSQL txtSQL, MsgText
            End If
        Case 3
            If IsNumeric(txtInput.Text) Then
                MsgBox "请正确输入用户组名", 32, "提示"
                Exit Sub
            Else
                txtSQL = "update 权限 set 用户组='" & Trim$(txtInput.Text) & "' where 用户组='" & Trim$(strNode) & "'"
                ExecuteSQL txtSQL, MsgText
            End If
        Case 4
            If IsNumeric(txtInput.Text) Then
                MsgBox "请正确输入用户名", 32, "提示"
                Exit Sub
            Else
                txtSQL = "update manager set username='" & Trim$(txtInput.Text) & "' where username='" & Trim$(strNode) & "'"
                ExecuteSQL txtSQL, MsgText
            End If
        Case Else
    End Select
    subPurView
    TreeView.SetFocus
End Sub

Private Sub cmdReload_Click()
    subPurView
    TreeView.SetFocus
End Sub

Private Sub Form_Load()
    subPurView
End Sub





Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    strNode = Node.Text
    If Node.Tag = "all" Then
        cmdAdd.Enabled = True
        cmdDel.Enabled = False
        cmdEdit.Enabled = False
        cmdAdd.Caption = "增加用户组"
        cmdDel.Caption = "删除用户组"
    End If
    If Node.Tag = "uGroup" Then
        signNode = False
        cmdAdd.Enabled = True
        cmdDel.Enabled = False
        cmdEdit.Enabled = False
        cmdAdd.Caption = "增加用户"
        cmdDel.Caption = "删除用户组"
        cmdEdit.Caption = "修改组名"
        If Node.Text <> "系统管理员" Then
            cmdDel.Enabled = True
            cmdEdit.Enabled = True
        End If
    End If
    If Node.Tag = "user" Then
        signNode = True
        strHNode = Node.Parent.Text
        cmdAdd.Enabled = True
        cmdDel.Enabled = False
        cmdEdit.Enabled = False
        cmdAdd.Caption = "增加用户"
        cmdDel.Caption = "删除用户"
        cmdEdit.Caption = "修改用户名"
        If Node.Text <> "Admin" Then
            cmdDel.Enabled = True
            cmdEdit.Enabled = True
        End If
    End If
End Sub

Private Sub txtInput_Change()
    cmdOK.Enabled = True
    If Trim$(txtInput.Text) = "" Then
        cmdOK.Enabled = False
    End If
End Sub