企业管理

开发平台：
Visual Basic

Form_Authorization.frm：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0"; "COMCT332.OCX"
Begin VB.Form Frm_Authorization 
   Caption         =   "权限管理"
   ClientHeight    =   6360
   ClientLeft      =   1935
   ClientTop       =   2310
   ClientWidth     =   8925
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   8.25
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   HelpContextID   =   1016
   Icon            =   "Form_Authorization.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6360
   ScaleWidth      =   8925
   Begin ComCtl3.CoolBar CoolBar1 
      Align           =   1  'Align Top
      Height          =   585
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   8925
      _ExtentX        =   15743
      _ExtentY        =   1032
      BandCount       =   1
      _CBWidth        =   8925
      _CBHeight       =   585
      _Version        =   "6.7.8988"
      Child1          =   "Toolbar1"
      MinHeight1      =   525
      Width1          =   3135
      NewRow1         =   0   'False
      Begin MSComctlLib.Toolbar Toolbar1 
         Height          =   525
         Left            =   30
         TabIndex        =   4
         Top             =   30
         Width           =   8805
         _ExtentX        =   15531
         _ExtentY        =   926
         ButtonWidth     =   820
         ButtonHeight    =   926
         Style           =   1
         ImageList       =   "ImageList1"
         _Version        =   393216
         BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
            NumButtons      =   6
            BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Enabled         =   0   'False
               Caption         =   "授权"
               Key             =   "SQ"
               ImageKey        =   "sq"
            EndProperty
            BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Style           =   3
               Object.Width           =   400
            EndProperty
            BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "全选"
               Key             =   "QX"
               ImageIndex      =   7
            EndProperty
            BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "全销"
               Key             =   "QC"
               ImageIndex      =   8
            EndProperty
            BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Style           =   3
            EndProperty
            BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               Caption         =   "退出"
               Key             =   "TC"
               ImageKey        =   "tc"
            EndProperty
         EndProperty
      End
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   3330
      Top             =   1290
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   8
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":038A
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":06AE
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":07BA
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":1F7E
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":285A
            Key             =   "sq"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":2BF6
            Key             =   "tc"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":2F92
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":332C
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4785
      Left            =   3630
      ScaleHeight     =   4785
      ScaleWidth      =   75
      TabIndex        =   2
      Top             =   540
      Visible         =   0   'False
      Width           =   75
   End
   Begin MSComctlLib.ListView lvUser 
      Height          =   4815
      Left            =   3840
      TabIndex        =   1
      Top             =   630
      Width           =   4875
      _ExtentX        =   8599
      _ExtentY        =   8493
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      Checkboxes      =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "是否权限"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "功能说明"
         Object.Width           =   6174
      EndProperty
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   4785
      Left            =   0
      TabIndex        =   0
      Top             =   690
      Width           =   3195
      _ExtentX        =   5636
      _ExtentY        =   8440
      _Version        =   393217
      HideSelection   =   0   'False
      Indentation     =   485
      LabelEdit       =   1
      Style           =   7
      ImageList       =   "ImageList2"
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.ImageList ImageList2 
      Left            =   0
      Top             =   500
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   14
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":36C6
            Key             =   "stb1"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":3B1A
            Key             =   "xttb1"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":3F72
            Key             =   "qx"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":43D2
            Key             =   "kplr"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":4826
            Key             =   "kpgl"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":4C86
            Key             =   "tcxt"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":4FA2
            Key             =   "szk"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":53FA
            Key             =   "gnqx"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":5852
            Key             =   ""
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":5B76
            Key             =   "R1"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":5E92
            Key             =   "R"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":61AE
            Key             =   "stb"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":6A8A
            Key             =   "xttb2"
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Form_Authorization.frx":923E
            Key             =   "xttb"
         EndProperty
      EndProperty
   End
   Begin VB.Image Image1 
      Height          =   4665
      Left            =   3270
      MousePointer    =   9  'Size W E
      Top             =   420
      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
     lvUser.Left = X + 60
     lvUser.Width = Me.Width - (TreeView1.Width + Image1.Width) - 80
     TreeView1.Top = CoolBar1.Height
     lvUser.Top = CoolBar1.Height
     TreeView1.Height = Me.Height - CoolBar1.Height - 400
     lvUser.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 lvUser_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  Toolbar1.Buttons(1).Enabled = True
  AuthTF(Item.Index) = 1
End Sub
Private Sub lvUser_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Me.sa_1, , X + lvUser.Left, Y + lvUser.Top
End If
End Sub
Private Sub QC_Click()
Dim I As Integer
For I = 1 To lvUser.ListItems.Count
 If lvUser.ListItems(I).Checked = False Then
 AuthTF(I) = 1
 lvUser.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 lvUser.ListItems.Count
 lvUser.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
     
     lvUser.ListItems.Clear
     ReDim AuthCode(aDo_auth.RecordCount)
     ReDim AuthTF(aDo_auth.RecordCount)
     
     Do While Not aDo_auth.EOF
       Set mItem = lvUser.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 lvUser.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 lvUser.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 lvUser.ListItems.Count
  lENSTR = Val(Mid(lvUser.ListItems(I).Key, 2, Len(lvUser.ListItems(I).Key)))
 If lvUser.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 lvUser.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 lvUser.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 lvUser.Tag = "G" Then
 Conn_System.Execute "UPDATE " & Me.Tag & ".DBO.System_UserGroup SET AuthorityID='" & Auth_str _
                     & "' WHERE GroupID=" & Group_ID
 
 End If
 If lvUser.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

						