📄 frmuserauth.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmUserAuth
BorderStyle = 3 'Fixed Dialog
Caption = "操作员权限设置"
ClientHeight = 6195
ClientLeft = 45
ClientTop = 615
ClientWidth = 9690
Icon = "frmUserAuth.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6195
ScaleWidth = 9690
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
WhatsThisButton = -1 'True
WhatsThisHelp = -1 'True
Begin MSComctlLib.ImageList ilsToolbar
Left = 4320
Top = 180
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 2
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":0442
Key = "Save"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":0986
Key = "Exit"
EndProperty
EndProperty
End
Begin MSComctlLib.Toolbar tbr
Align = 1 'Align Top
Height = 570
Left = 0
TabIndex = 2
Top = 0
Width = 9690
_ExtentX = 17092
_ExtentY = 1005
ButtonWidth = 820
ButtonHeight = 953
Appearance = 1
Style = 1
ImageList = "ilsToolbar"
DisabledImageList= "ilsToolbar"
HotImageList = "ilsToolbar"
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 3
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存"
Key = "Save"
ImageIndex = 1
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "Exit"
ImageIndex = 2
EndProperty
EndProperty
End
Begin MSComctlLib.ImageList ilsTvw
Left = 3480
Top = 240
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 17
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":0DE2
Key = "ZW"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":1236
Key = "CX"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":1550
Key = "System"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":19A4
Key = "GD"
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":1DF8
Key = "BB"
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":2114
Key = "FX"
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":2568
Key = "CF"
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":2884
Key = "MR"
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":3160
Key = "SF"
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":35B8
Key = "Collapse"
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":3A0C
Key = "Expand"
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":3E60
Key = "UnSelected"
EndProperty
BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":42B4
Key = "Selected"
EndProperty
BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":4708
Key = "Labor"
EndProperty
BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":4B5C
Key = "GZ"
EndProperty
BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":4FBC
Key = "FZ"
EndProperty
BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmUserAuth.frx":5116
Key = "MB"
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView tvwAuth
Height = 5550
Left = 3720
TabIndex = 0
Top = 600
WhatsThisHelpID = 42
Width = 5955
_ExtentX = 10504
_ExtentY = 9790
_Version = 393217
HideSelection = 0 'False
LabelEdit = 1
Style = 7
Checkboxes = -1 'True
ImageList = "ilsTvw"
Appearance = 1
End
Begin MSComctlLib.ListView lvwUser
Height = 5580
Left = 0
TabIndex = 1
Top = 585
WhatsThisHelpID = 42
Width = 3705
_ExtentX = 6535
_ExtentY = 9843
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.Menu mnuFile
Caption = "文件"
Begin VB.Menu mnuExit
Caption = "退出"
End
End
Begin VB.Menu mnuOperate
Caption = "操作"
Begin VB.Menu mnuSave
Caption = "保存"
Shortcut = ^S
End
End
End
Attribute VB_Name = "frmUserAuth"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Private m_sAccountID As String
Dim m_adoRst As ADODB.Recordset
Dim m_adoCmd As ADODB.Command
Dim m_sSQL As String
Dim m_sOldUserID As String
Dim m_aryLoad() As String
Dim m_bLoad As Boolean
Public Property Let usAccountID(ByVal sID As String)
m_sAccountID = sID
End Property
Public Property Get usAccountID() As String
usAccountID = m_sAccountID
End Property
Private Sub Form_Activate()
If m_bLoad = True Then
lvwUser.SetFocus
If Not lvwUser.SelectedItem Is Nothing Then
LoadAuth lvwUser.SelectedItem.text
End If
m_bLoad = False
End If
End Sub
Private Sub Form_Load()
Dim i As Long
Dim iIndex As Integer
Dim rSt As ADODB.Recordset
Dim ItmX As ListItem
Dim Nodx As Node
Dim sKey As String
glo.frmProg.ShowProgress 0
glo.frmProg.SetMsg "正在导入权限目录..."
glo.frmProg.Show
'在窗体标题上显示当前进行权限设置的账套号及名称
Me.Caption = Me.Caption & " - 账套“" & GetAccountName(Me.usAccountID) & _
"[" & Me.usAccountID & "]”"
'打开权限目录数据集
Set m_adoRst = New ADODB.Recordset
m_adoRst.CursorLocation = adUseClient
m_adoRst.Open "select * from tSYS_Auth order by AuthID", _
gloSys.cnnSys, adOpenStatic, adLockReadOnly
glo.frmProg.ShowProgress 5
'设置一个模块级的 ADODB.Command 对象
Set m_adoCmd = New ADODB.Command
m_adoCmd.ActiveConnection = gloSys.cnnSys
m_adoCmd.CommandType = adCmdText
With tvwAuth
With .Nodes
Set Nodx = .Add(, , "R", "权限设置", "System")
Nodx.Bold = True
Nodx.Expanded = True
Nodx.Tag = Nodx.Key
Set rSt = New Recordset
rSt.Open "Select * from tSYS_Subsys where subsysid='CX' or subsysid='FX' or subsysid='MR' or subsysid='BB' or subsysid='CF' " & _
"or subsysid='GZ' or subsysid='GD' or subsysid='SF' or subsysid='FZ' or subsysid='ZW'", gloSys.cnnSys, adOpenKeyset, adLockOptimistic
iIndex = 1
ReDim m_aryLoad(1 To 1)
While rSt.EOF = False
ReDim Preserve m_aryLoad(1 To iIndex)
If FindImageFromilsTvw(rSt.Fields("SubsysID").Value) Then
sKey = rSt.Fields("SubsysID").Value
Else
sKey = "Labor"
End If
If rSt.Fields("subsysid") = "FZ" Then
Dim sID As String, b As Boolean
b = CheckLicence(sID)
If sID = "01" Then
Set Nodx = .Add("R", tvwChild, rSt.Fields("SubsysID").Value, rSt.Fields("SubsysID").Value + "=项目管理", sKey)
Else
Set Nodx = .Add("R", tvwChild, rSt.Fields("SubsysID").Value, rSt.Fields("SubsysID").Value + "=辅助管理", sKey)
End If
Else
Set Nodx = .Add("R", tvwChild, rSt.Fields("SubsysID").Value, rSt.Fields("SubsysID").Value + "=" + rSt.Fields("SubsysName").Value, sKey)
End If
Nodx.Checked = False
Nodx.Tag = CStr(iIndex)
Nodx.Sorted = True
Nodx.Expanded = True
Nodx.ForeColor = vbBlue
Nodx.BackColor = vbInfoBackground
'设置子系统数组
m_aryLoad(iIndex) = rSt.Fields("SubsysID").Value
iIndex = iIndex + 1
rSt.MoveNext
Wend
rSt.Close
End With
End With
glo.frmProg.ShowProgress 10
'装入子系统
For i = LBound(m_aryLoad) To UBound(m_aryLoad)
Call LoadTvw(m_aryLoad(i))
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -