📄 frmoperator.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmOperator
BorderStyle = 3 'Fixed Dialog
Caption = "用户管理"
ClientHeight = 3600
ClientLeft = 45
ClientTop = 615
ClientWidth = 6120
Icon = "frmOperator.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
NegotiateMenus = 0 'False
ScaleHeight = 3600
ScaleWidth = 6120
ShowInTaskbar = 0 'False
Begin VB.ComboBox cmbAuthority
Height = 300
ItemData = "frmOperator.frx":0442
Left = 4365
List = "frmOperator.frx":0452
Style = 2 'Dropdown List
TabIndex = 3
Top = 2355
Width = 1530
End
Begin VB.Frame Frame1
Caption = "操作员列表"
ForeColor = &H00800000&
Height = 2160
Left = 210
TabIndex = 12
Top = 1185
Width = 3375
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 1695
Left = 120
TabIndex = 6
ToolTipText = "双击显示菜单!"
Top = 315
Width = 3135
_ExtentX = 5530
_ExtentY = 2990
_Version = 393216
Cols = 3
FixedCols = 0
ForeColor = 0
ForeColorFixed = 64
BackColorSel = 14737632
ForeColorSel = 255
BackColorBkg = 12632256
GridColorFixed = 8421504
AllowBigSelection= 0 'False
FocusRect = 0
FillStyle = 1
ScrollBars = 2
SelectionMode = 1
AllowUserResizing= 3
BorderStyle = 0
Appearance = 0
End
Begin VB.Line Line8
BorderColor = &H00FFFFFF&
X1 = 105
X2 = 3270
Y1 = 2010
Y2 = 2010
End
Begin VB.Line Line7
BorderColor = &H00FFFFFF&
X1 = 3255
X2 = 3255
Y1 = 315
Y2 = 2025
End
Begin VB.Line Line6
BorderColor = &H00808080&
X1 = 105
X2 = 3270
Y1 = 300
Y2 = 300
End
Begin VB.Line Line5
BorderColor = &H00808080&
X1 = 105
X2 = 105
Y1 = 315
Y2 = 2010
End
End
Begin VB.TextBox Text1
Height = 300
Left = 4365
MaxLength = 5
TabIndex = 0
Top = 1305
Width = 1530
End
Begin VB.TextBox Text2
Height = 300
IMEMode = 3 'DISABLE
Left = 4365
MaxLength = 20
PasswordChar = "*"
TabIndex = 1
Top = 1650
Width = 1530
End
Begin VB.TextBox Text3
Height = 300
IMEMode = 3 'DISABLE
Left = 4365
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 1995
Width = 1530
End
Begin VB.CommandButton Command1
Caption = "保存(S)"
Enabled = 0 'False
Height = 375
Left = 3660
TabIndex = 4
Top = 2970
Width = 1110
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "关闭(&C)"
Height = 375
Left = 4830
TabIndex = 5
Top = 2970
Width = 1110
End
Begin VB.PictureBox Picture1
BackColor = &H0000C000&
Height = 750
Left = 165
ScaleHeight = 690
ScaleWidth = 5715
TabIndex = 7
ToolTipText = "操作提示"
Top = 180
Width = 5775
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "添加新的帐号"
ForeColor = &H00FFFFFF&
Height = 180
Left = 2520
TabIndex = 11
Top = 120
Width = 1080
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 输入各项之后,按保存"
ForeColor = &H00000000&
Height = 180
Left = 2835
TabIndex = 10
Top = 405
Width = 1980
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "删除存在的帐号："
ForeColor = &H00FFFFFF&
Height = 180
Left = 150
TabIndex = 9
Top = 150
Width = 1440
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 双击选定的帐号"
Height = 180
Left = 540
TabIndex = 8
Top = 405
Width = 1530
End
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "权限："
ForeColor = &H000000C0&
Height = 180
Index = 1
Left = 3765
TabIndex = 16
Top = 2415
Width = 540
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名："
Height = 180
Left = 3765
TabIndex = 15
Top = 1350
Width = 615
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "口令："
Height = 180
Left = 3765
TabIndex = 14
Top = 1710
Width = 615
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "重复："
Height = 180
Index = 0
Left = 3765
TabIndex = 13
Top = 2055
Width = 615
End
Begin VB.Menu MnuOperate
Caption = "帐号操作"
Begin VB.Menu MnuAdd
Caption = "添加帐号"
End
Begin VB.Menu Line02
Caption = "-"
End
Begin VB.Menu MnuDelete
Caption = "删除帐号"
End
Begin VB.Menu Line01
Caption = "-"
Visible = 0 'False
End
End
Begin VB.Menu MnuReturn
Caption = "关闭选择"
Begin VB.Menu MnuAuthority
Caption = "返回首页"
End
End
End
Attribute VB_Name = "frmOperator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DelNO As Integer, UserStr As String
Private Sub cmbAuthority_Change()
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub cmbAuthority_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{Tab}"
End If
End Sub
Private Sub Command1_Click()
If InStr(1, Trim(Text1.Text), "'", vbTextCompare) Then
MsgBox "操作员姓名之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
Text1.SetFocus
Exit Sub
End If
On Error Resume Next
'校对数据库是否已经存在该操作员
Dim EF As Recordset
Dim RecStr As String
Conn.BeginTrans
Set EF = New Recordset
RecStr = "select * from users where uid='" & Trim(Text1.Text) & "'"
EF.Open RecStr, Conn, adOpenKeyset, adLockOptimistic
If Not EF.EOF Then
EF.Close
MsgBox "操作员< " & Trim(Text1.Text) & " >已经存在,不能继续! ", vbInformation
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
EF.Close
'保存记录
RecStr = "Insert into Users (UID,PWD,权限) values('" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "','" & cmbAuthority.Text & "')"
Conn.Execute RecStr
Conn.CommitTrans
'刷新记录
LoadOperator
Text1.Text = "" '刷新数据
Text2.Text = ""
Text3.Text = ""
Text1.SetFocus
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
frmOperator.HelpContextID = 5
'安装操作员
LoadOperator
cmbAuthority.ListIndex = 0
End Sub
Private Sub Grid1_DblClick()
If Grid1.Text = "" Then
MnuDelete.Enabled = False
MnuAuthority.Enabled = False
Else
MnuDelete.Enabled = True
MnuAuthority.Enabled = True
End If
PopupMenu MnuOperate
End Sub
Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Grid1.Text = "" Then
MnuDelete.Enabled = False
MnuAuthority.Enabled = False
Else
MnuDelete.Enabled = True
MnuAuthority.Enabled = True
End If
If Button = 2 Then
PopupMenu MnuOperate
End If
End Sub
Private Sub MnuAdd_Click()
Text1.SetFocus
End Sub
Private Sub MnuAuthority_Click()
GetStatus "返回首页"
Unload Me
End Sub
Private Sub MnuDelete_Click()
DeleteRecord
End Sub
Private Sub MnuOperate_Click()
GetStatus "帐号删除、添加操作"
End Sub
Private Sub Text1_Change()
If Trim(Text1.Text) <> "" Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Trim(Text1.Text) <> "" Then
SendKeys "{tab}"
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub Text3_LostFocus()
If Trim(Text3.Text) <> Trim(Text2.Text) Then
MsgBox "两次口令不符，请重新再来 ", vbOKOnly + 64, "口令不符"
Text2.Text = ""
Text3.Text = ""
Text2.SetFocus
End If
End Sub
Private Sub DeleteRecord()
On Error Resume Next
If Grid1.Text = "" Then Exit Sub
If DelNO = 1 Then
MsgBox "仅剩下当前用户了,不能继续,请注意! ", vbOKOnly + 32, "不能删除"
Exit Sub
End If
Dim Qp As Integer
Qp = MsgBox("真的要删除[" & Grid1.Text & "]操作员吗（Y/N）？", vbYesNo + 16 + vbDefaultButton2, "确认删除")
If Qp = 7 Then
Exit Sub
End If
Dim RecStr As String
RecStr = "Delete From Users Where UID='" & Grid1.Text & "'"
Conn.Execute RecStr
'刷新记录
LoadOperator
End Sub
Private Sub LoadOperator()
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 3
Grid1.FormatString = "^ 操作员 |^ 口令 |^ 权限 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Grid1.ColWidth(2) = 1130
Dim EF As Recordset, HH As Integer
Dim shiftStr As String, shiftStrL As String, shiftStrR As String
Dim shiftNum As Integer, ili As Integer
Dim tempStr As String, SureStr As String
Dim Qy As Integer
Set EF = New Recordset
EF.Open "select * from users", Conn, adOpenKeyset, adLockOptimistic
' If Not EF.EOF And Not EF.BOF Then
DelNO = EF.RecordCount
Grid1.Rows = EF.RecordCount + 4
HH = 1
EF.MoveFirst
Do While Not EF.EOF
Grid1.Row = HH
Grid1.Col = 0
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(0).Value) Then
Grid1.Text = EF.Fields(0).Value
UserStr = Grid1.Text
End If
Grid1.Row = HH
Grid1.Col = 1
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(1).Value) Then
'解口令为可视
shiftStr = Trim(EF.Fields(1).Value)
shiftNum = Len(shiftStr)
ili = 1
SureStr = ""
Qy = 0
For ili = 1 To shiftNum
shiftStrR = Mid(shiftStr, ili, 1)
shiftStrR = Asc(shiftStrR)
shiftStrR = shiftStrR + 3
shiftStrR = Chr(shiftStrR)
SureStr = SureStr & shiftStrR
Next
'因为是超级用户,所以可以看见所有的帐号密码,但是密码已经经过加密处理
Grid1.Text = SureStr
End If
Grid1.Row = HH
Grid1.Col = 2
Grid1.CellAlignment = 1
If Not IsNull(EF.Fields(2).Value) Then
Grid1.Text = EF.Fields(2).Value
End If
EF.MoveNext
HH = HH + 1
Loop
EF.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 2
Grid1.Visible = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -