frmpower.frm

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

VERSION 5.00
Begin VB.Form frmPower 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "权限管理"
   ClientHeight    =   3735
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5370
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   5370
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox combGroup 
      Height          =   300
      Left            =   1080
      TabIndex        =   6
      Top             =   0
      Width           =   2175
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   255
      Left            =   3360
      TabIndex        =   4
      Top             =   0
      Width           =   1935
   End
   Begin VB.CommandButton cmdDel 
      Caption         =   ">> 删除"
      Height          =   495
      Left            =   2400
      TabIndex        =   3
      Top             =   1920
      Width           =   495
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "<< 添加"
      Height          =   495
      Left            =   2400
      TabIndex        =   2
      Top             =   1080
      Width           =   495
   End
   Begin VB.ListBox ListAll 
      Height          =   2940
      Left            =   3120
      TabIndex        =   1
      Top             =   600
      Width           =   2175
   End
   Begin VB.ListBox ListGroup 
      Height          =   2940
      Left            =   0
      TabIndex        =   0
      Top             =   600
      Width           =   2175
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "所有可用资源树"
      Height          =   255
      Left            =   3120
      TabIndex        =   8
      Top             =   360
      Width           =   2175
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "用户组成员可用资源树"
      Height          =   255
      Left            =   0
      TabIndex        =   7
      Top             =   360
      Width           =   2175
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H00FFC0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "已建用户组："
      Height          =   255
      Left            =   0
      TabIndex        =   5
      Top             =   0
      Width           =   1215
   End
End
Attribute VB_Name = "frmPower"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim idxLevel(30) As Integer
Private Sub subPurView()
    Dim mrc As ADODB.Recordset
    Dim rcs As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim i As Integer
'   combGroup.Locked = True
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    combGroup.Clear
    ListGroup.Clear
    ListAll.Clear
    txtSQL = "select level,用户组 from 权限 where level!='0'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    i = 0
If Not mrc.EOF Then
    Do Until mrc.EOF
        idxLevel(i) = mrc.Fields(0)
        combGroup.AddItem mrc.Fields(1), i
        i = i + 1
        mrc.MoveNext
    Loop
    If i > 0 Then
        combGroup.ListIndex = 0
    End If
    combChangeView idxLevel(0)
End If
    txtSQL = "select * from 权限 where level='0'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    For i = 0 To 5
        If mrc.Fields(i + 3) = True Then
            txtSQL = "select 模块名 from 子模块 where id = '" & (i + 1) & "'"
            Set rcs = ExecuteSQL(txtSQL, MsgText)
            ListAll.AddItem rcs.Fields(0)
        End If
    Next i
End Sub

Private Sub cmdAdd_Click()
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
'   txtSQL = "select 模块名 from 子模块 where id = '" & (ListAll.ListIndex + 1) & "'"
'    Set mrc = ExecuteSQL(txtSQL, MsgText)
'    MsgBox mrc.Fields(0) & "    " & idxLevel(combGroup.ListIndex) & "    " & ListGroup.ListCount, 32, "提示"
'    txtSQL = "update 权限 set 可用模块数 = '" & (ListGroup.ListCount + 1) & "'," & mrc.Fields(0) & " = '1' where level = '" & idxLevel(combGroup.ListIndex) & "'"
'    ExecuteSQL txtSQL, MsgText
'    MsgBox MsgText & "    " & mrc.Fields(0) & "    " & idxLevel(combGroup.ListIndex) & "    " & ListGroup.ListCount, 32, "提示"
    txtSQL = "select * from 权限 where level = '" & idxLevel(combGroup.ListIndex) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If ListGroup.ListCount < 5 Then
        mrc.Fields(2) = ListGroup.ListCount + 1
'    MsgBox MsgText, 32, "提示"
    End If
    mrc.Fields(ListAll.ListIndex + 3) = True
    mrc.Update
'    MsgBox mrc.Fields(ListAll.ListIndex + 3), 32, "提示"
    mrc.Close
    combChangeView idxLevel(combGroup.ListIndex)
    ListAll.SetFocus
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub


Private Sub cmdDel_Click()
    Dim mrc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
'    Dim delID As Integer
    Dim i As Integer
    Dim j As Integer
    j = -1
'    delID = 0
    If MsgBox("真的要删除权限吗？", vbOKCancel + vbInformation, "提示") = vbOK Then
        txtSQL = "select * from 权限 where level = '" & idxLevel(combGroup.ListIndex) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        For i = 0 To 5
            If mrc.Fields(i + 3) = True Then
                j = j + 1
                If j = ListGroup.ListIndex Then
 '                   delID = i
 '                   MsgBox delID, 32, "提示"
                    mrc.Fields(2) = ListGroup.ListCount
                    mrc.Fields(i + 3) = False
                    mrc.Update
                End If
            End If
        Next
        mrc.Close
 '       txtSQL = "select 模块名 from 子模块 where id = '" & delID & "'"
 '       Set mrc = ExecuteSQL(txtSQL, MsgText)
 '       MsgBox mrc.Fields(0) & "    " & idxLevel(combGroup.ListIndex) & "    " & ListGroup.ListCount, 32, "提示"
'        txtSQL = "update 权限 set 可用模块数 = '" & (ListGroup.ListCount - 1) & "'," & mrc.Fields(0) & " = '0' where level = '" & idxLevel(combGroup.ListIndex) & "'"
 '       ExecuteSQL txtSQL, MsgText
 '       MsgBox MsgText & "    " & mrc.Fields(0) & "    " & idxLevel(combGroup.ListIndex) & "    " & ListGroup.ListCount, 32, "提示"
    End If
    combChangeView idxLevel(combGroup.ListIndex)
    ListGroup.SetFocus
End Sub

Private Sub combGroup_Click()
    combChangeView idxLevel(combGroup.ListIndex)
End Sub


Private Sub Form_Load()
    subPurView
End Sub

Private Sub combChangeView(intLev As Integer)
    Dim mrc As ADODB.Recordset
    Dim rcs As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    Dim i As Integer
    cmdAdd.Enabled = False
    cmdDel.Enabled = False
    ListGroup.Clear
    txtSQL = "select * from 权限 where level='" & intLev & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    For i = 0 To 5
        If mrc.Fields(i + 3) = True Then
            txtSQL = "select 模块名 from 子模块 where id = '" & (i + 1) & "'"
            Set rcs = ExecuteSQL(txtSQL, MsgText)
            ListGroup.AddItem rcs.Fields(0)
        End If
    Next i
End Sub

Private Sub ListAll_Click()
    combChangeView idxLevel(combGroup.ListIndex)
    cmdAdd.Enabled = True
    cmdDel.Enabled = False
End Sub

Private Sub ListGroup_Click()
    cmdAdd.Enabled = False
    If ListGroup.ListCount > 0 Then
        cmdDel.Enabled = True
    Else
        cmdDel.Enabled = False
    End If
End Sub