form_authorization.frm

宇迪ｅｒｐ,企业erp模块一

      Width           =   105
   End
   Begin VB.Menu sa_1 
      Caption         =   "sa_1"
      Visible         =   0   'False
      Begin VB.Menu QC 
         Caption         =   "全选"
      End
      Begin VB.Menu qwe 
         Caption         =   "-"
      End
      Begin VB.Menu QX 
         Caption         =   "取消"
      End
   End
End
Attribute VB_Name = "Frm_Authorization"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mbMoving As Boolean
Dim mitem As ListItem
Dim Group_ID As String
Dim Group_Authorization As String
Dim AuthCode(): Dim AuthTF()

Private Sub Form_Activate()
Cshgns
Authorization
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If Me.Height < 2000 Then Me.Height = 2000
SizeControls Image1.Left
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Image1
        Picture1.Move .Left, .Top, .Width / 2, .Height
    End With
    Picture1.Visible = True
    mbMoving = True
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    

    If mbMoving Then
        sglPos = X + Image1.Left
        If sglPos < sglSplitLimit Then
            Picture1.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            Picture1.Left = Me.Width - sglSplitLimit
        Else
            Picture1.Left = sglPos
        End If
    End If
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls Picture1.Left
    Picture1.Visible = False
    mbMoving = False
End Sub
Sub SizeControls(X As Single)
    On Error Resume Next
    

    If X < 1000 Then X = 1000
    If X > Me.Width - 1500 Then X = Me.Width - 1500
     TreeView1.Width = X
     Image1.Left = X
     ListView1.Left = X + 60
     ListView1.Width = Me.Width - (TreeView1.Width + Image1.Width) - 80
     TreeView1.Top = CoolBar1.Height
     ListView1.Top = CoolBar1.Height
     TreeView1.Height = Me.Height - CoolBar1.Height - 400
     ListView1.Height = Me.Height - CoolBar1.Height - 400
     Image1.Height = Me.Height - CoolBar1.Height - 400
    
    
End Sub
Private Sub Cshgns()                                                    '初始化系统功能树
 Dim Xtgnbrec As New Recordset
 
 Set Xtgnbrec = Conn_System.Execute("SELECT * FROM " & Me.Tag & ".dbo.xt_xtgnb where rightflag=1 and (gnbm NOT LIKE '99%') order by gnbm")
 TreeView1.Nodes.Add , 4, "T", "宇迪/ERP", "xttb"
 With Xtgnbrec
  Do While Not .EOF
   If .Fields("mjbz") Then
    Set nodX = TreeView1.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "gnqx")
   Else
    If Trim(.Fields("sjgnbm")) = "" Then
    Set nodX = TreeView1.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "R")
     nodX.EnsureVisible
    Else
    Set nodX = TreeView1.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "stb")
    End If
  End If
    nodX.Tag = Xtgnbrec!mjbz
    .MoveNext
  Loop
 End With
End Sub

Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  Toolbar1.Buttons(1).Enabled = True
  AuthTF(Item.Index) = 1
End Sub

Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Me.sa_1, , X + ListView1.Left, Y + ListView1.Top
End If
End Sub

Private Sub QC_Click()
Dim i As Integer
For i = 1 To ListView1.ListItems.Count
 If ListView1.ListItems(i).Checked = False Then
 AuthTF(i) = 1
 ListView1.ListItems(i).Checked = True
 End If
Next i
Toolbar1.Buttons(1).Enabled = True

End Sub

Private Sub QX_Click()
Dim i As Integer
For i = 1 To ListView1.ListItems.Count
 ListView1.ListItems(i).Checked = False
Next i
Toolbar1.Buttons(1).Enabled = True
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
       Case "SQ"
             Auth_Sq
       Case "QX"
            QC_Click
       Case "QC"
            QX_Click
       '-------------------------
       Case "TC"
             Unload Me
End Select
End Sub



Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim Ssql As String, i As Integer
Dim aDo_auth As New Recordset
If Toolbar1.Buttons(1).Enabled = True Then
   YesNoStr = MsgBox("你是否要保存权限?  ", vbYesNo + 32)
   If YesNoStr = vbYes Then
      Auth_Sq
      Else
      Toolbar1.Buttons(1).Enabled = False
   End If
End If

'----------------

i = 1
  Ssql = "SELECT * FROM " & Me.Tag & ".dbo.xt_xtgnb where sjgnbm='" + Mid(Trim(TreeView1.SelectedItem.Key), 2, Len(Trim(TreeView1.SelectedItem.Key)) - 1) + "' and rightflag=1 order by gnbm"
     Set aDo_auth = Conn_System.Execute(Ssql)
     If aDo_auth.RecordCount < 1 Then
        aDo_auth.Close
        Ssql = "SELECT * FROM " & Me.Tag & ".dbo.xt_xtgnb where sjgnbm='" + Mid(Trim(TreeView1.SelectedItem.Key), 2, Len(Trim(TreeView1.SelectedItem.Key)) - 3) + "' and rightflag=1 order by gnbm"
        Set aDo_auth = Conn_System.Execute(Ssql)
     End If
     
     ListView1.ListItems.Clear
     ReDim AuthCode(aDo_auth.RecordCount)
     ReDim AuthTF(aDo_auth.RecordCount)
     
     Do While Not aDo_auth.EOF
       Set mitem = ListView1.ListItems.Add()
       mitem.SubItems(1) = aDo_auth!gnmc
       mitem.Key = "T" & Trim(aDo_auth!Id)
       If aDo_auth!Id <= Len(Group_Authorization) Then
          mitem.Checked = Mid(Group_Authorization, aDo_auth!Id, 1)
       End If
       AuthCode(i) = aDo_auth!gnbm
       i = i + 1
       aDo_auth.MoveNext
     Loop

     aDo_auth.Close
     Set aDo_auth = Nothing
End Sub
Sub Authorization()
Dim aDo_Authorizatin As New Recordset
If ListView1.Tag = "G" Then
  Set aDo_Authorization = Conn_System.Execute("select * from " & Me.Tag & ".dbo.System_UserGroup where GroupName='" & TreeView1.Tag & "'")
  Group_Authorization = "" & aDo_Authorization!AuthorityID
  Group_ID = aDo_Authorization!Groupid
End If
If ListView1.Tag = "U" Then
  Set aDo_Authorization = Conn_System.Execute("select * from " & Me.Tag & ".dbo.Gy_Czygl where czybm='" & TreeView1.Tag & "'")
  Group_Authorization = "" & aDo_Authorization!AuthorityID
  Group_ID = TreeView1.Tag
End If
  
aDo_Authorization.Close
Set aDo_Authorization = Nothing
End Sub
Sub Auth_Sq()
'On Error GoTo error_exit

 Dim i As Integer, h As Integer
 Dim Auth_str As String
 Dim lENSTR As Integer

 Auth_str = Group_Authorization
 
 For i = 1 To ListView1.ListItems.Count
  lENSTR = Val(Mid(ListView1.ListItems(i).Key, 2, Len(ListView1.ListItems(i).Key)))
 If ListView1.ListItems(i).Checked = True Then
    For h = Len(Trim(Auth_str)) To lENSTR - 1
        Auth_str = Trim(Auth_str) & "0"
    Next
    Auth_str = Mid(Auth_str, 1, lENSTR - 1) & "1" & Mid(Auth_str, lENSTR + 1, Len(Auth_str))
 Else
    If Len(Auth_str) >= lENSTR Then
       Auth_str = Mid(Auth_str, 1, lENSTR - 1) & "0" & Mid(Auth_str, lENSTR + 1, Len(Auth_str))
    End If
 End If
 '------------------------------
 Dim aDo_GuCode As New Recordset
 Set aDo_GuCode = Conn_System.Execute("select * from " & Me.Tag & ".dbo.xt_xtgnb where gnbm like '" & Trim(AuthCode(i)) & "%'")
 Do While Not aDo_GuCode.EOF
    If ListView1.ListItems(i).Checked = True Then
    
       If AuthTF(i) = 1 Then
          For h = Len(Trim(Auth_str)) To aDo_GuCode!Id - 1
            Auth_str = Trim(Auth_str) & "0"
          Next
       Auth_str = Mid(Auth_str, 1, aDo_GuCode!Id - 1) & "1" & Mid(Auth_str, aDo_GuCode!Id + 1, Len(Auth_str))
       End If
       
    Else
    
       If Len(Auth_str) >= aDo_GuCode!Id Then
         Auth_str = Mid(Auth_str, 1, aDo_GuCode!Id - 1) & "0" & Mid(Auth_str, aDo_GuCode!Id + 1, Len(Auth_str))
       End If
    End If
    aDo_GuCode.MoveNext
 Loop
 aDo_GuCode.Close
 Set aDo_GuCode = Nothing
 
 
 
'------------------------------
    If ListView1.ListItems(i).Checked = True And AuthTF(i) = 1 Then
        Dim k As Integer
        k = 1
        Do While k < Len(Trim(AuthCode(i))) - 1
           Set aDo_GuCode = Conn_System.Execute("select * from " & Me.Tag & ".dbo.xt_xtgnb where gnbm='" & Mid(Trim(AuthCode(i)), 1, k + 1) & "'")
           Auth_str = Mid(Auth_str, 1, aDo_GuCode!Id - 1) & "1" & Mid(Auth_str, aDo_GuCode!Id + 1, Len(Auth_str))
           aDo_GuCode.Close
           Set aDo_GuCode = Nothing
           k = k + 2
        Loop
    End If

'-------------------------------
Next

 
 '----------------
 If ListView1.Tag = "G" Then
 Conn_System.Execute "UPDATE " & Me.Tag & ".DBO.System_UserGroup SET AuthorityID='" & Auth_str _
                     & "' WHERE GroupID=" & Group_ID
 
 End If
 If ListView1.Tag = "U" Then
  Conn_System.Execute "UPDATE " & Me.Tag & ".DBO.Gy_Czygl SET AuthorityID='" & Auth_str _
                     & "' WHERE czybm='" & Trim(Group_ID) & "'"
 End If
 '-------------------
 Toolbar1.Buttons(1).Enabled = False
 Authorization
 Exit Sub
 
error_exit:
 MsgBox Err.Description, 16
End Sub