企业管理

开发平台：
Visual Basic

Frm_AdUser.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_GroupUser 
   Caption         =   "用户管理"
   ClientHeight    =   5805
   ClientLeft      =   840
   ClientTop       =   2415
   ClientWidth     =   8775
   HelpContextID   =   1015
   Icon            =   "Frm_AdUser.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5805
   ScaleWidth      =   8775
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   6120
      Top             =   1620
      _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         =   "Frm_AdUser.frx":0E42
            Key             =   "G1"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":115E
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":1A3A
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":2316
            Key             =   "U1"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":2632
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":2F0E
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":3DEA
            Key             =   "U"
         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Frm_AdUser.frx":4C3E
            Key             =   "G"
         EndProperty
      EndProperty
   End
   Begin ComCtl3.CoolBar CoolBar1 
      Align           =   1  'Align Top
      Height          =   390
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   8775
      _ExtentX        =   15478
      _ExtentY        =   688
      BandCount       =   1
      _CBWidth        =   8775
      _CBHeight       =   390
      _Version        =   "6.7.8988"
      Child1          =   "Toolbar"
      MinHeight1      =   330
      Width1          =   1.50000e5
      NewRow1         =   0   'False
      Begin MSComctlLib.Toolbar Toolbar 
         Height          =   330
         Left            =   30
         TabIndex        =   4
         Top             =   30
         Width           =   8655
         _ExtentX        =   15266
         _ExtentY        =   582
         ButtonWidth     =   609
         ButtonHeight    =   582
         AllowCustomize  =   0   'False
         Style           =   1
         ImageList       =   "ImageList1"
         DisabledImageList=   "ImageList1"
         HotImageList    =   "ImageList1"
         _Version        =   393216
         BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
            NumButtons      =   1
            BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
               ImageIndex      =   6
               Style           =   5
               Object.Width           =   3
               BeginProperty ButtonMenus {66833FEC-8583-11D1-B16A-00C0F0283628} 
                  NumButtonMenus  =   9
                  BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "NewUser"
                     Text            =   "新增用户(&U)"
                  EndProperty
                  BeginProperty ButtonMenu2 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "NewUserGroup"
                     Text            =   "新增用户组(&G)"
                  EndProperty
                  BeginProperty ButtonMenu3 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Text            =   "-"
                  EndProperty
                  BeginProperty ButtonMenu4 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "Properth"
                     Text            =   "属性"
                  EndProperty
                  BeginProperty ButtonMenu5 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "Authorization"
                     Text            =   "权限"
                  EndProperty
                  BeginProperty ButtonMenu6 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "Del"
                     Text            =   "删除"
                  EndProperty
                  BeginProperty ButtonMenu7 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Text            =   "-"
                  EndProperty
                  BeginProperty ButtonMenu8 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "Refresh"
                     Text            =   "刷新"
                  EndProperty
                  BeginProperty ButtonMenu9 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                     Key             =   "Exit"
                     Text            =   "关闭(&C)"
                  EndProperty
               EndProperty
            EndProperty
         EndProperty
      End
   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          =   45
      Left            =   30
      ScaleHeight     =   45
      ScaleWidth      =   4965
      TabIndex        =   2
      Top             =   2070
      Visible         =   0   'False
      Width           =   4965
   End
   Begin MSComctlLib.ListView lvGroup 
      Height          =   2085
      Left            =   0
      TabIndex        =   1
      Top             =   2970
      Width           =   5685
      _ExtentX        =   10028
      _ExtentY        =   3678
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      _Version        =   393217
      Icons           =   "ImageList1"
      SmallIcons      =   "ImageList1"
      ColHdrIcons     =   "ImageList1"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "用户组"
         Object.Width           =   5292
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "说明"
         Object.Width           =   10583
      EndProperty
   End
   Begin MSComctlLib.ListView lvUser 
      Height          =   1995
      Left            =   0
      TabIndex        =   0
      Top             =   420
      Width           =   5685
      _ExtentX        =   10028
      _ExtentY        =   3519
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      _Version        =   393217
      Icons           =   "ImageList1"
      SmallIcons      =   "ImageList1"
      ColHdrIcons     =   "ImageList1"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "用户名"
         Object.Width           =   5292
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "说明"
         Object.Width           =   10583
      EndProperty
   End
   Begin VB.Image Image1 
      Height          =   135
      Left            =   30
      MousePointer    =   7  'Size N S
      Top             =   2820
      Width           =   5655
   End
   Begin VB.Menu User 
      Caption         =   "User"
      Visible         =   0   'False
      Begin VB.Menu NewUser 
         Caption         =   "添加"
      End
      Begin VB.Menu Properth 
         Caption         =   "属性"
      End
      Begin VB.Menu Authorization 
         Caption         =   "权限"
      End
      Begin VB.Menu Del 
         Caption         =   "删除"
      End
   End
   Begin VB.Menu gurop 
      Caption         =   "group"
      Visible         =   0   'False
      Begin VB.Menu NewUserGroup 
         Caption         =   "添加"
      End
      Begin VB.Menu GroupProperth 
         Caption         =   "属性"
      End
      Begin VB.Menu GroupAuthorization 
         Caption         =   "权限"
      End
      Begin VB.Menu GroupDel 
         Caption         =   "删除"
      End
   End
End
Attribute VB_Name = "Frm_GroupUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public UserGroupName As String
Public Explain As String
Public UserId As String
Dim UserGroupTF As Boolean
Dim mbMoving As Boolean
Dim mItem As ListItem
Dim Requery_TF As Boolean
Private Sub Form_Activate()
    On Error GoTo ERROR_EXIT
    If Requery_TF = True Then Requery_TF = False: Exit Sub
    Dim aDo_Group As New ADODB.Recordset
    Dim aDo_User As New ADODB.Recordset
    Dim mItem  As ListItem
    
    Set aDo_Group = Conn_System.Execute("Select * from " & lvUser.Tag & ".dbo.System_UserGroup")
    lvGroup.ListItems.Clear
    With aDo_Group
        Do While Not .EOF
            Set mItem = lvGroup.ListItems.Add()
            mItem.Text = !GroupName
            mItem.SmallIcon = "G"
            mItem.Icon = "G"
            mItem.SubItems(1) = !Explain
            mItem.Key = "G" & !GroupName
            .MoveNext
        Loop
        .Close
        Set aDo_Group = Nothing
    End With
    
    '--------------------------------
    Set aDo_User = Conn_System.Execute("select * from " & lvUser.Tag & ".dbo.Gy_Czygl ORDER BY czymc")
    lvUser.ListItems.Clear
    With aDo_User
    Do While Not .EOF
        Set mItem = lvUser.ListItems.Add()
        mItem.Text = !czymc
        mItem.SmallIcon = "U"
        mItem.Icon = "U"
        mItem.SubItems(1) = "" & !Explain
        mItem.Key = "T" & Trim(!czybm)
        .MoveNext
    Loop
    .Close
    Set aDo_Group = Nothing
    End With
    Exit Sub
ERROR_EXIT:
    MsgBox Err.Description, 16
    Unload Me
End Sub
Private Sub Form_Load()
    SizeControls Image1.Top
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    If Me.Height < 4000 Then Me.Height = 4000
    SizeControls Image1.Top
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, .Height / 2
    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 = Y + Image1.Top
        If sglPos < sglSplitLimit Then
            Picture1.Top = sglSplitLimit
        ElseIf sglPos > Me.Height - sglSplitLimit Then
            Picture1.Top = Me.Height - sglSplitLimit
        Else
            Picture1.Top = 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.Top
    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.Height - 1500 - Toolbar.Height Then X = Me.Height - 1500 + Toolbar.Height
     lvUser.Height = X - Toolbar.Height
     Image1.Top = X
     lvGroup.Top = X + 140
     lvGroup.Height = Me.Height - (lvUser.Height + Image1.Height + 400) - Toolbar.Height
     lvUser.Width = Me.Width - 100
     lvGroup.Width = Me.Width - 100
     Image1.Width = Me.Width - 100
End Sub
Private Sub lvUser_DblClick()
     If lvUser.ListItems.Count <= 0 Then Exit Sub
     Requery_TF = True
     Frm_NewUser.SSTab.Tag = lvUser.Tag
     Frm_NewUser.Tag = "UE"
     Frm_NewUser.UserCode = Mid(lvUser.SelectedItem.Key, 2, Len(lvUser.SelectedItem.Key))
     Frm_NewUser.Text1(0).Text = Trim(lvUser.SelectedItem.Text)
     Frm_NewUser.Text1(3).Text = lvUser.SelectedItem.SubItems(1)
     Frm_NewUser.Text1(0).Tag = lvUser.SelectedItem.Key
     Frm_NewUser.Show 1
     If UserGroupName <> "" Then
        lvUser.SelectedItem.Text = UserGroupName
        lvUser.SelectedItem.SubItems(1) = Explain
     End If
End Sub
Private Sub lvUser_GotFocus()
    UserGroupTF = True
End Sub
Private Sub lvUser_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        UserGroupTF = True
        PopupMenu Me.User, , X, Y + lvUser.Top
    End If
End Sub
Private Sub lvGroup_DblClick()
    If lvGroup.ListItems.Count <= 0 Then Exit Sub
    
    Requery_TF = True
    Frm_NewUser.SSTab.Tag = lvUser.Tag
    If UserGroupTF = False Then
        Frm_NewUser.Tag = "GE"
        Frm_NewUser.Text2(0).Text = lvGroup.SelectedItem.Text
        Frm_NewUser.Text2(1).Text = lvGroup.SelectedItem.SubItems(1)
        Frm_NewUser.Text2(0).Tag = lvGroup.SelectedItem.Key
        Frm_NewUser.Show 1
        If UserGroupName <> "" Then
            lvGroup.SelectedItem.Text = UserGroupName
            lvGroup.SelectedItem.SubItems(1) = Explain
            lvGroup.SelectedItem.Key = UserGroupName
        End If
    End If
End Sub
Private Sub lvGroup_GotFocus()
    UserGroupTF = False
End Sub
Private Sub lvGroup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        UserGroupTF = False
        PopupMenu Me.gurop, , X, Y + lvGroup.Top
    End If
End Sub
Private Sub NewUser_Click()
    Tool_comm NewUser.Name
End Sub
Private Sub NewUserGroup_Click()
    Tool_comm NewUserGroup.Name
End Sub
Private Sub Properth_Click()
    Tool_comm Properth.Name
End Sub
Private Sub Authorization_Click()
    Tool_comm Authorization.Name
End Sub
Private Sub Del_Click()
    Tool_comm Del.Name
End Sub
Private Sub GroupProperth_Click()
    Tool_comm "Properth"
End Sub
Private Sub GroupAuthorization_Click()
    Tool_comm "Authorization"
End Sub
Private Sub GroupDel_Click()
    Tool_comm "Del"
End Sub
Private Sub Toolbar_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
 Tool_comm ButtonMenu.Key
End Sub
Sub Tool_comm(KeyStr As String)
    Select Case KeyStr
    Case "Exit"
         Unload Me
    Case "NewUserGroup"
         Requery_TF = True
         Frm_NewUser.SSTab.Tag = lvUser.Tag
         Frm_NewUser.Tag = "G"
         Frm_NewUser.Show 1
         If UserGroupName <> "" Then
             Set mItem = lvGroup.ListItems.Add()
             mItem.Text = UserGroupName
             mItem.SmallIcon = "G"
             mItem.Icon = "G"
             mItem.SubItems(1) = Explain
             mItem.Key = UserGroupName
         End If
        
    Case "NewUser"
         Requery_TF = True
         Frm_NewUser.SSTab.Tag = lvUser.Tag
         Frm_NewUser.Tag = "U"
         Frm_NewUser.Show 1
         If UserGroupName <> "" Then
             Set mItem = lvUser.ListItems.Add()
             mItem.Text = Trim(UserGroupName)
             mItem.SmallIcon = "U"
             mItem.Icon = "U"
             mItem.SubItems(1) = Trim(Explain)
             mItem.Key = "T" & UserId
         End If
    
    Case "Properth"
         Requery_TF = True
         Frm_NewUser.SSTab.Tag = lvUser.Tag
         If UserGroupTF = False Then
          If lvGroup.ListItems.Count <= 0 Then Exit Sub
          Frm_NewUser.Tag = "GE"
          Frm_NewUser.Text2(0).Text = lvGroup.SelectedItem.Text
          Frm_NewUser.Text2(1).Text = lvGroup.SelectedItem.SubItems(1)
          Frm_NewUser.Text2(0).Tag = lvGroup.SelectedItem.Key
          Frm_NewUser.Show 1
          If UserGroupName <> "" Then
             lvGroup.SelectedItem.Text = UserGroupName
             lvGroup.SelectedItem.SubItems(1) = Explain
             lvGroup.SelectedItem.Key = UserGroupName
          End If
         End If
         '-----------------
         If UserGroupTF = True Then
          If lvUser.ListItems.Count <= 0 Then Exit Sub
          Frm_NewUser.Tag = "UE"
          Frm_NewUser.UserCode = Mid(lvUser.SelectedItem.Key, 2, Len(lvUser.SelectedItem.Key))
          Frm_NewUser.Text1(0).Text = Trim(lvUser.SelectedItem.Text)
          Frm_NewUser.Text1(3).Text = lvUser.SelectedItem.SubItems(1)
          Frm_NewUser.Text1(0).Tag = lvUser.SelectedItem.Key
          Frm_NewUser.Show 1
          If UserGroupName <> "" Then
             lvUser.SelectedItem.Text = UserGroupName
             lvUser.SelectedItem.SubItems(1) = Explain
          End If
         End If
         
         
    Case "Del"
         On Error GoTo ERR_EXIT
          If UserGroupTF = False And lvGroup.ListItems.Count > 0 Then
          YesNoStr = MsgBox("你是否要删除此组？  ", vbYesNo + 32)
          If YesNoStr = vbNo Then Exit Sub
          
          Conn_System.Execute "delete " & lvUser.Tag & ".dbo.System_UserGroup " _
                           & "where GroupName='" & lvGroup.SelectedItem.Text & "'"
          lvGroup.ListItems.Remove (lvGroup.SelectedItem.Index)
          
          End If
          
          If UserGroupTF = True And lvUser.ListItems.Count > 0 Then
             YesNoStr = MsgBox("你是否要删除此用户？  ", vbYesNo + 32)
             If YesNoStr = vbNo Then Exit Sub
             Conn_System.Execute "delete " & lvUser.Tag & ".dbo.Gy_Czygl " _
                              & "where czymc='" & lvUser.SelectedItem.Text & "'"
             lvUser.ListItems.Remove (lvUser.SelectedItem.Index)
          End If
          
          SendKeys "{left}", True
          Exit Sub
ERR_EXIT:
         MsgBox Err.Description, 16
     Case "Refresh"
         Form_Activate
         
     Case "Authorization"
         Requery_TF = True
         Frm_Authorization.Tag = lvUser.Tag
         If UserGroupTF = False Then
             If lvGroup.ListItems.Count <= 0 Then Exit Sub
             Frm_Authorization.Caption = Frm_Authorization.Caption & "---" & Trim(lvGroup.SelectedItem.Text) & "(组)"
             Frm_Authorization.TreeView1.Tag = lvGroup.SelectedItem.Text
             Frm_Authorization.lvUser.Tag = "G"
         End If
         
         If UserGroupTF = True Then
             If lvUser.ListItems.Count <= 0 Then Exit Sub
             Frm_Authorization.Caption = Frm_Authorization.Caption & "---" & Trim(lvUser.SelectedItem.Text) & "(用户)"
             Frm_Authorization.TreeView1.Tag = Mid(lvUser.SelectedItem.Key, 2, Len(lvUser.SelectedItem.Key))
             Frm_Authorization.lvUser.Tag = "U"
         End If
         
         Frm_Authorization.Show 1
    End Select
End Sub

						