📄 form2staff.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{E2690E23-9719-101B-9306-0020AF234C9D}#4.1#0"; "CSCMD32.OCX"
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form Form2staff
BorderStyle = 1 'Fixed Single
Caption = "操作员管理"
ClientHeight = 3765
ClientLeft = 45
ClientTop = 330
ClientWidth = 1905
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form2"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3765
ScaleWidth = 1905
Begin MSAdodcLib.Adodc Adodc2
Height = 330
Left = 120
Top = 2760
Visible = 0 'False
Width = 1575
_ExtentX = 2778
_ExtentY = 582
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 2
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "FILE NAME=C:\My Documents\花寨子2000.udl"
OLEDBString = ""
OLEDBFile = "C:\My Documents\花寨子2000.udl"
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "功能库"
Caption = "Adodc2"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc Adodc1
Height = 330
Left = 120
Top = 2280
Visible = 0 'False
Width = 1575
_ExtentX = 2778
_ExtentY = 582
ConnectMode = 3
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 2
LockType = 3
CommandType = 2
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 2
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "FILE NAME=C:\My Documents\花寨子2000.udl"
OLEDBString = ""
OLEDBFile = "C:\My Documents\花寨子2000.udl"
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = "操作员库"
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSDataListLib.DataList DataList1
Bindings = "Form2staff.frx":0000
Height = 1740
Left = 120
TabIndex = 5
Top = 1920
Width = 1695
_ExtentX = 2990
_ExtentY = 3069
_Version = 393216
ListField = "操作员"
BoundColumn = "操作员"
Object.DataMember = ""
End
Begin VB.Timer Timer1
Left = 1440
Top = 1320
End
Begin CSCmdLibCtl.CSCmdBtn Command2
Height = 615
Left = 1080
OleObjectBlob = "Form2staff.frx":0039
TabIndex = 4
Top = 720
Width = 735
End
Begin CSCmdLibCtl.CSCmdBtn Command1
Height = 615
Left = 120
OleObjectBlob = "Form2staff.frx":0536
TabIndex = 3
Top = 720
Width = 735
End
Begin VB.TextBox Text1
Height = 375
IMEMode = 1 'ON
Left = 720
TabIndex = 1
Top = 120
Width = 1095
End
Begin VB.Label Label1
Caption = "姓名："
Height = 255
Left = 120
TabIndex = 0
Top = 225
Width = 615
End
Begin VB.Label Label2
Caption = "已有的操作员："
Height = 375
Left = 120
TabIndex = 2
Top = 1545
Width = 1455
End
End
Attribute VB_Name = "Form2staff"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim labelp1 As Label
Dim labelp2 As Label
Dim labelp3 As Label
Dim labelp4 As Label
Dim flagname As String '姓名通用
Dim flagpassword As String '密码通用
Dim linep1 As Line
Dim linep2 As Line
Dim dflag1 As Boolean '标记第一次扩展及第二次扩展
Dim dflag2 As Boolean
Dim nflag As Boolean '标记新旧用户
Dim dflag As Boolean
Private WithEvents textp1 As TextBox
Attribute textp1.VB_VarHelpID = -1
Private WithEvents textp2 As TextBox
Attribute textp2.VB_VarHelpID = -1
Private WithEvents List1 As ListBox
Attribute List1.VB_VarHelpID = -1
Private WithEvents comd1 As CSCmdBtn
Attribute comd1.VB_VarHelpID = -1
Private WithEvents comd2 As CSCmdBtn
Attribute comd2.VB_VarHelpID = -1
Private WithEvents list2 As ListBox
Attribute list2.VB_VarHelpID = -1
Dim cnn1 As ADODB.Connection
Dim rstable1 As ADODB.Recordset
Dim strcnn As String
Dim entrydate As Date
Private Sub comd1_Click() '添加 恢复
Dim pstring As String
Dim lpoint As Integer
If comd1.Caption = "添 加" Then
lpoint = List1.ListIndex
pstring = List1.List(List1.ListIndex)
List1.RemoveItem List1.ListIndex
List1.AddItem " ", lpoint
list2.AddItem pstring
comd1.Enabled = False
comd2.Enabled = True
Else
pstring = list2.List(list2.ListIndex)
list2.RemoveItem list2.ListIndex
Select Case pstring
Case "用户档案录入"
If List1.List(0) <> "用户档案录入" Then
List1.RemoveItem 0
List1.AddItem pstring, 0
End If
Case "操作员管理"
If List1.List(1) <> "操作员管理" Then
List1.RemoveItem 1
List1.AddItem pstring, 1
End If
Case "密码管理"
If List1.List(2) <> "密码管理" Then
List1.RemoveItem 2
List1.AddItem pstring, 2
End If
Case "价格管理"
If List1.List(3) <> "价格管理" Then
List1.RemoveItem 3
List1.AddItem pstring, 3
End If
Case "预设地址"
If List1.List(4) <> "预设地址" Then
List1.RemoveItem 4
List1.AddItem pstring, 4
End If
Case "收费"
If List1.List(5) <> "收费" Then
List1.RemoveItem 5
List1.AddItem pstring, 5
End If
Case "单项查询"
If List1.List(6) <> "单项查询" Then
List1.RemoveItem 6
List1.AddItem pstring, 6
End If
Case "组合查询"
If List1.List(7) <> "组合查询" Then
List1.RemoveItem 7
List1.AddItem pstring, 7
End If
Case "模糊查询"
If List1.List(8) <> "模糊查询" Then
List1.RemoveItem 8
List1.AddItem pstring, 8
End If
Case "日收费查询"
If List1.List(9) <> "日收费查询" Then
List1.RemoveItem 9
List1.AddItem pstring, 9
End If
Case "月收费查询"
If List1.List(10) <> "月收费查询" Then
List1.RemoveItem 10
List1.AddItem pstring, 10
End If
Case "欠费查询"
If List1.List(11) <> "欠费查询" Then
List1.RemoveItem 11
List1.AddItem pstring, 11
End If
Case "生成日报表"
If List1.List(12) <> "生成日报表" Then
List1.RemoveItem 12
List1.AddItem pstring, 12
End If
Case "生成月报表"
If List1.List(13) <> "生成月报表" Then
List1.RemoveItem 13
List1.AddItem pstring, 13
End If
Case "自助报表"
If List1.List(14) <> "自助报表" Then
List1.RemoveItem 14
List1.AddItem pstring, 14
End If
Case "报表查询"
If List1.List(15) <> "报表查询" Then
List1.RemoveItem 15
List1.AddItem pstring, 15
End If
Case "修改用户档案"
If List1.List(16) <> "修改用户档案" Then
List1.RemoveItem 16
List1.AddItem pstring, 16
End If
Case "改变操作员"
If List1.List(17) <> "改变操作员" Then
List1.RemoveItem 17
List1.AddItem pstring, 17
End If
Case "操作记录"
If List1.List(18) <> "操作记录" Then
List1.RemoveItem 18
List1.AddItem pstring, 18
End If
End Select
comd1.Enabled = False
If list2.ListCount = 0 Then '赋值权限为空时，确认·不可用
comd2.Enabled = False
Else
comd2.Enabled = True
End If
End If
End Sub
Private Sub comd2_Click() '确认
If nflag Then '同名
rstable1.Filter = "姓名='" & flagname & "'"
rstable1.MoveFirst
Do While Not rstable1.EOF
rstable1.Delete adAffectCurrent
rstable1.MoveNext
rstable1.UpdateBatch adAffectAllChapters
Loop
End If
rstable1.Filter = adFilterNone
Dim i As Integer
i = 0
Do While i <= list2.ListCount - 1
rstable1.AddNew
rstable1.Fields(1).Value = flagname
rstable1.Fields(2).Value = list2.List(i)
rstable1.UpdateBatch adAffectCurrent
i = i + 1
Loop
nflag = False '初始化新旧标记
dflag = False
flagname = ""
Unload Me
End Sub
Private Sub Command1_Click() '添加 确定
If flagname = "" Then
flagname = Text1.Text '记住姓名
End If
If nflag = False Then '添加
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(1).Value = Text1.Text
Adodc1.Recordset.Update
DataList1.Refresh
DataList1.ReFill
DataList1.BoundText = flagname
Else '确认
DataList1.BoundText = flagname
End If
Text1.Text = ""
Command1.Enabled = False
dflag1 = True '第一次扩展为真
Timer1.Interval = 10
Form2staff.Controls.Add "vb.line", "linep1"
With Form2staff.Controls("linep1")
.Visible = True
.BorderColor = &H80000003
.BorderStyle = 6
.X1 = Form2staff.Width - 100
.Y1 = 0
.X2 = Form2staff.Width - 100
.Y2 = Form2staff.Height
End With
End Sub
Private Sub Command2_Click() '删除
Adodc1.Recordset.Move DataList1.SelectedItem - 1, 1
Adodc1.Recordset.Delete
Adodc1.Recordset.Update
Adodc1.Recordset.Requery
DataList1.Refresh
DataList1.ReFill
rstable1.Filter = "姓名='" & flagname & "'"
rstable1.MoveFirst
Do While Not rstable1.EOF
rstable1.Delete
rstable1.MoveNext
rstable1.UpdateBatch adAffectAllChapters
Loop
rstable1.Filter = adFilterNone
Command2.Enabled = False
End Sub
Private Sub DataList1_Click()
If dflag = False Then
Command2.Enabled = True
Command1.Enabled = True
Command1.Caption = "确 定"
flagname = DataList1.Text
Adodc1.Recordset.MoveFirst
Adodc1.Recordset.Find "操作员='" & Trim(DataList1.Text) & "'", , adSearchForward, 1
flagpassword = Adodc1.Recordset.Fields(2).Value '记住此人密码
nflag = True
End If
End Sub
Private Sub Form_Load()
Command1.Enabled = False '添加
Command2.Enabled = False '删除
'初使化二次扩展的标记
dflag1 = False
dflag2 = False
'初始化新旧用户的标记
nflag = False
dflag = False
strcnn = "provider=microsoft.jet.oledb.3.51;data source=c:\my documents\花寨子早.mdb;" 'initial catalog=pubs;user id=zw;password=;"
Set cnn1 = New ADODB.Connection
cnn1.Open strcnn
Set rstable1 = New ADODB.Recordset
rstable1.Open "功能选择库", cnn1, adOpenKeyset, adLockBatchOptimistic, adCmdTable
entrydate = Now()
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Text1.IMEMode = 2
Call history(staff, entrydate, Me.Caption, Now())
End Sub
Private Sub Label1_Click()
End Sub
Private Sub List1_Click() '所有权限单击
If List1.List(List1.ListIndex) <> " " Then
comd1.Enabled = True
comd1.Picture = LoadPicture("c:\my documents\Arw06rt.ico")
comd1.Caption = "添 加"
End If
End Sub
Private Sub List1_DblClick() '所有权限双击
Dim pstring As String
Dim lpoint As Integer
If List1.List(List1.ListIndex) <> " " Then
lpoint = List1.ListIndex
pstring = List1.List(List1.ListIndex)
List1.RemoveItem List1.ListIndex
List1.AddItem " ", lpoint
list2.AddItem pstring
comd1.Enabled = False
comd2.Enabled = True
End If
End Sub
Private Sub list2_Click() '赋值权限单击
comd1.Enabled = True
comd1.Picture = LoadPicture("c:\my documents\Arw06lt.ico")
comd1.Caption = "恢 复"
End Sub
Private Sub list2_DblClick() '赋值权限双击
Dim pstring As String
pstring = list2.List(list2.ListIndex)
list2.RemoveItem list2.ListIndex
Select Case pstring
Case "用户档案录入"
If List1.List(0) <> "用户档案录入" Then
List1.RemoveItem 0
List1.AddItem pstring, 0
End If
Case "操作员管理"
If List1.List(1) <> "操作员管理" Then
List1.RemoveItem 1
List1.AddItem pstring, 1
End If
Case "密码管理"
If List1.List(2) <> "密码管理" Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -