📄 frmgroupin.frm
字号:
VERSION 5.00
Begin VB.Form frmGroupIn
BorderStyle = 1 'Fixed Single
Caption = "用户组管理"
ClientHeight = 4620
ClientLeft = 45
ClientTop = 330
ClientWidth = 7440
Icon = "frmGroupIn.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4620
ScaleWidth = 7440
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
ForeColor = &H80000008&
Height = 270
Left = 120
Picture = "frmGroupIn.frx":08CA
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 10
Top = 120
Width = 270
End
Begin VB.ListBox List1
Height = 2400
ItemData = "frmGroupIn.frx":0C77
Left = 240
List = "frmGroupIn.frx":0C79
MultiSelect = 2 'Extended
TabIndex = 4
Top = 1920
Width = 2415
End
Begin VB.ListBox List2
Height = 2400
Left = 4680
MultiSelect = 2 'Extended
TabIndex = 5
Top = 1920
Width = 2415
End
Begin VB.CommandButton CmdAdd
Caption = "<- 添加"
Height = 375
Left = 3120
TabIndex = 0
Top = 2520
Width = 1215
End
Begin VB.CommandButton CmdDel
Caption = "删除 ->"
Height = 375
Left = 3120
TabIndex = 1
Top = 3120
Width = 1215
End
Begin VB.CommandButton CmdOk
Caption = "确定"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5520
TabIndex = 2
Top = 360
Width = 1695
End
Begin VB.CommandButton CmdCancel
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5520
TabIndex = 3
Top = 840
Width = 1695
End
Begin VB.Label Label1
Caption = "成员:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
TabIndex = 8
Top = 1560
Width = 1095
End
Begin VB.Label Label2
Caption = "非成员:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 9
Top = 1560
Width = 1095
End
Begin VB.Label lblGroupName
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1440
TabIndex = 7
Top = 480
Width = 3015
End
Begin VB.Label LblGroup
Caption = "组名:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 6
Top = 480
Width = 975
End
End
Attribute VB_Name = "frmGroupIn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub CmdAdd_Click()
Dim i As Integer
Dim flag As Boolean
flag = False
If List2.ListCount < 1 Then Exit Sub
If List2.ListIndex >= 0 Then
Do Until flag = True
If List2.ListCount < 1 Then Exit Sub
For i = 0 To List2.ListCount - 1
If List2.Selected(i) = True Then
flag = False
Exit For
Else
flag = True
End If
Next
If flag = False Then
List2.ListIndex = i
List1.AddItem List2.Text
List2.RemoveItem i
End If
Loop
End If
End Sub
Private Sub CmdCancel_Click()
Unload Me
End Sub
Private Sub CmdDel_Click()
Dim i As Integer
Dim flag As Boolean
flag = False
If List1.ListCount < 1 Then Exit Sub
If List1.ListIndex >= 0 Then
Do Until flag = True
If List1.ListCount < 1 Then Exit Sub
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
flag = False
Exit For
Else
flag = True
End If
Next
If flag = False Then
List1.ListIndex = i
List2.AddItem List1.Text
List1.RemoveItem i
End If
Loop
End If
End Sub
Private Sub CmdOk_Click()
Dim i As Integer
Dim str As String
Dim rstUserTemp As ADODB.Recordset
Dim arrayLimit(1000, 2) As String
Dim j, limitNum As Integer
If List1.ListCount < 1 Then
MsgBox "一个组内至少应有一个成员!", 48, "系统提示"
Exit Sub
End If
str = "select distinct treeno,limit from treelimit where groupname='" & Trim(lblGroupName.Caption) & "'"
Set rstUserTemp = Pubsaconn.Execute(str)
limitNum = 0
Do Until rstUserTemp.EOF
limitNum = limitNum + 1
arrayLimit(limitNum, 1) = rstUserTemp!TreeNo
arrayLimit(limitNum, 2) = rstUserTemp!limit
rstUserTemp.MoveNext
Loop
rstUserTemp.Close
str = "delete treelimit where groupname='" & Trim(lblGroupName.Caption) & "'"
Pubsaconn.Execute str, 64
str = "delete from groupuser where groupname='" & lblGroupName & "'"
Pubsaconn.Execute str, 64
Set rstUserTemp = New ADODB.Recordset
For i = 1 To List1.ListCount
List1.ListIndex = i - 1
str = "select distinct username,deparment_c,username_c,password,phoneNo from groupuser where username='" & Trim(List1.Text) & "'"
Set RstUser = Pubsaconn.Execute(str)
str = "insert into groupuser (groupname,username,deparment_C,username_c,password,phoneno ,arrangeorder,tagpsw,field1) values ('" & Trim(lblGroupName.Caption) & "','"
str = str & RstUser(0) & "','" & RstUser(1) & "','" & RstUser(2) & "','"
str = str & RstUser(3) & "','" & RstUser(4) & "',0,'','')"
Set rstUserTemp = Pubsaconn.Execute(str)
For j = 1 To limitNum
str = "insert into treelimit values('" & Trim(arrayLimit(j, 1)) & "',"
str = str & "'" & Trim(lblGroupName.Caption) & "',"
str = str & "'" & RstUser(0) & "',"
str = str & "'" & Trim(arrayLimit(j, 2)) & "')"
Pubsaconn.Execute str, 64
Next
RstUser.Close
Next
Set rstUserTemp = Nothing
Unload Me
End Sub
Private Sub Form_Load()
Dim str As String
Dim i, temp As Integer
lblGroupName.Caption = frmUserMain.GrdGroup.TextMatrix(frmUserMain.GrdGroup.RowSel, 0)
str = "select distinct username from groupuser "
str = str & "where groupname='" & Trim(lblGroupName.Caption) & "'"
Set RstUser = Pubsaconn.Execute(str)
Do Until RstUser.EOF
List1.AddItem RstUser("username"), i
RstUser.MoveNext
i = i + 1
Loop
temp = i
If temp > 0 Then
str = "select distinct username from groupuser "
str = str & "where username!=''"
For i = 1 To temp
List1.ListIndex = i - 1
str = str & " and username!='" & Trim(List1.Text) & "'"
Next
Else
str = "select distinct username from groupuser where groupname='" & Trim(lblGroupName.Caption) & "'"
End If
Set RstUser = Pubsaconn.Execute(str)
i = 0
Do Until RstUser.EOF
List2.AddItem RstUser("username"), i
RstUser.MoveNext
i = i + 1
Loop
'换皮肤
Call LoadSkin(Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetGride frmUserMain.GrdUser, frmUserMain.GrdGroup
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -