专家坐堂-像下图的多级授权代码的shouquan函数该怎么写呢？Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  像下图的多级授权代码的shouquan函数该怎么写呢？  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=22907)

--  作者：akzzwj
--  发布时间：2012/8/27 10:42:00
--  像下图的多级授权代码的shouquan函数该怎么写呢？

此主题相关图片如下：20122261741993274.jpg

--  作者：akzzwj
--  发布时间：2012/8/27 13:24:00
--

目录树形式的授权,案例中的窗口和控件的事件代码.

窗口的AfterLoad事件代码为:

Dim trv1 As WinForm.TreeView = e.Form.Controls("TreeView1")
Dim trv2 As WinForm.TreeView = e.Form.Controls("TreeView2")
trv1.BuildTree("授权","分组|权限")
For Each u As UserInfo In Users
    If u.Type = UserTypeEnum.User Then
        If trv2.Nodes.Contains(u.Group) = False Then
            trv2.Nodes.Add(u.Group)
        End If
        trv2.Nodes(u.Group).Nodes.Add(u.Name)
    End If
Next
Trv1.Nodes(0).Expand()
trv2.ExpandAll()

左边目录树的AfterSelectNode事件代码：

Dim trv1 As WinForm.TreeView = e.Form.Controls("TreeView1")
Dim trv2 As WinForm.TreeView = e.Form.Controls("TreeView2")
Dim dr As DataRow
If e.node.Level = 0 Then
    dr = DataTables("授权").Find("分组 = \'" & e.Node.Name & "\' And 权限 Is Null")
Else
    dr = DataTables("授权").Find("分组 = \'" & e.Node.ParentNode.Name & "\' And 权限 = \'" & e.Node.Name & "\'")
End If
Dim nms As New List(of String)
If dr IsNot Nothing AndAlso dr.IsNull("用户") = False
    nms.AddRange(dr("用户").Split(","))
End If
For Each nd As WinForm.TreeNode In trv2.AllNodes
    nd.Checked = nms.Contains(nd.Name)
Next

左边目录树的AfterEditNode事件代码：

If e.NewText = "" Then
    e.Cancel = True
ElseIf e.Node.Level = 0 Then \'重命名分组
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    dr = dt.Find("分组 = \'" & e.NewText & "\' And 权限 Is Null" ) \'判断新输入的分组是否存在
    If dr IsNot Nothing \'如果存在,取消输入.
        MessageBox.Show("此分组已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        e.cancel = True
    Else
        For Each dr In dt.Select("分组 = \'" & e.Node.Name & "\'" ) \'重命名分组
            dr("分组") = e.NewText
        Next
        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.
    End If
ElseIf e.Node.Level = 1 \'重命名权限
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    Dim fz As String = e.Node.ParentNode.Name \'获得分组名
    dr = dt.Find("分组 = \'" & fz & "\' And 权限 = \'" & e.NewText & "\'" ) \'判断新输入的权限是否存在
    If dr IsNot Nothing \'如果存在,取消输入.
        MessageBox.Show("此权限已经存在!", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)
        e.Cancel = True
    Else
        dr = dt.Find("分组 = \'" & fz & "\' And 权限 = \'" & e.Node.Name & "\'" ) \'找出对应的行
        dr("权限") = e.NewText \'重命名权限
        e.Node.Name = e.NewText \'使得节点的名称和标题保持一致.
    End If
End If

--  作者：akzzwj
--  发布时间：2012/8/27 13:24:00
--

右边目录树的AfterCheckNode事件：

Dim trv1 As WinForm.TreeView = e.Form.Controls("TreeView1")
Dim trv2 As WinForm.TreeView = e.Form.Controls("TreeView2")
Dim nd1 As WinForm.TreeNode = trv1.SelectedNode
Dim dr As DataRow
If trv2.Focused AndAlso nd1 IsNot Nothing Then \'一定要判断焦点是否在此目录树
    If nd1.Level = 0 Then
        dr = DataTables("授权").Find("分组 = \'" & nd1.Name & "\' And 权限 Is Null")
    Else
        dr = DataTables("授权").Find("分组 = \'" & nd1.ParentNode.Name & "\' And 权限 = \'" & nd1.Name & "\'")
    End If
    If dr IsNot Nothing Then
        Dim nms As String
        For Each nd2 As WinForm.TreeNode In trv2.AllNodes
            If nd2.Checked Then
                nms = nms & "," & nd2.Name
            End If
        Next
        If nms > "" Then
            dr("用户") = nms.Trim(",")
        Else
            dr("用户") = Nothing
        End If
    End If
End If

增加分类按钮的代码：

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")
Dim i As Integer
trv.Select()
Do
    i = i+ 1
    Dim nm As String = "分组" & i
    If trv.Nodes.Contains(nm) = False
        Dim dr As DataRow = DataTables("授权").AddNew
        Dim nd As WinForm.TreeNode = trv.Nodes.Add(nm)
        dr("分组") = nm
        trv.SelectedNode = nd
        trv.BeginEdit
        Exit Do
    End If
Loop

增加权限按钮的代码：

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")
Dim pd As WinForm.TreeNode = trv.SelectedNode
trv.Select()
If pd.Level = 1 Then
    pd = pd.ParentNode
End If
Dim i As Integer
Do
    i = i+ 1
    Dim nm As String = "权限" & i
    If pd.Nodes.Contains(nm) = False
        Dim nd As WinForm.TreeNode = pd.Nodes.Add(nm)
        Dim dr As DataRow = DataTables("授权").AddNew()
        dr("分组") = pd.name
        dr("权限") = nm
        trv.SelectedNode = nd
        trv.BeginEdit
        Exit Do
    End If
Loop

删除按钮的代码：

Dim trv As WinForm.TreeView = e.Form.Controls("TreeView1")
Dim nd As WinForm.TreeNode = trv.SelectedNode
trv.Select()
If nd Is Nothing Then
    Return
End If
If nd.Level = 0 Then \'删除分组
    Dim dt As DataTable = DataTables("授权")
    If MessageBox.Show("确定要删除此分组码?","提示",MessageBoxButtons.YesNo,MessageBoxIcon.Question) = DialogResult.Yes Then
        For Each dr As DataRow In dt.Select("分组 = \'" & nd.Name & "\'" )
            dr.Delete
        Next
        nd.Delete
    End If
ElseIf nd.Level = 1 \'删除权限
    Dim dt As DataTable = DataTables("授权")
    Dim dr As DataRow
    Dim fz As String = nd.ParentNode.Name \'获得分组名
    dr = dt.Find("分组 = \'" & fz & "\' And 权限 = \'" & nd.Name & "\'" ) \'找出对应的行
    dr.Delete
    nd.Delete
End If

--  作者：akzzwj
--  发布时间：2012/8/27 13:24:00
--

4、增加一个自定义函数，函数名为ShouQuan，代码为：

If User.Type <> UserTypeEnum.User Then \' 如果是开发者或者管理员
    Return True \'则具备所有权限
End If
Dim dt As DataTable = DataTables("授权")
Dim dr As DataRow
\'首先判断分组的授权用户是否包括此用户或此用户所属的分组
dr = dt.Find("分组 = \'" & args(0) & "\' And 权限 Is Null" )
If dr Is Nothing Then
    MessageBox.show("不存在名为""" & args(0) & "分组!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return False
End If
If dr.IsNull("用户") = False Then
    Dim nms() As String = dr("用户").Split(",")
    For Each nm As String In nms
        If nm = User.Group OrElse nm = User.Name Then \'如果授权用户包括登录用户所属的分组或其用户名
            Return True \'返回True
        End If
    Next
End If
\'然后判断权限的授权用户是否包括此用户或此用户所属的分组
If Args(1) = "" Then
    Return False
End If
dr = dt.Find("分组 = \'" & args(0) & "\' And 权限 = \'" & args(1) & "\'")
If dr Is Nothing Then
    MessageBox.show("不存在名为""" & args(1) & "权限!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
    Return False
End If
If dr.IsNull("用户") = False Then
    Dim nms() As String = dr("用户").Split(",")
    For Each nm As String In nms
        If nm = User.Group OrElse nm = User.Name Then \'如果授权用户包括登录用户所属的分组或其用户名
            Return True \'返回True
        End If
    Next
End If
Return False

请教，狐狸爸爸，如上图所述的多级授权，请问上述这些代码该如何修改呢？

--  作者：akzzwj
--  发布时间：2012/8/27 16:40:00
--
狐狸爸爸帮我看一下啊我上午提交的问题。这个很急