📄 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 = 3540
ClientLeft = 45
ClientTop = 330
ClientWidth = 5190
Icon = "frmOperator.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3540
ScaleWidth = 5190
ShowInTaskbar = 0 'False
Begin VB.Frame Frame1
Caption = "操作员列表"
Height = 2100
Left = 165
TabIndex = 11
Top = 1260
Width = 2385
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 1650
Left = 135
TabIndex = 5
ToolTipText = "双击删除自己帐号,下次启动时生效!"
Top = 330
Width = 2100
_ExtentX = 3704
_ExtentY = 2910
_Version = 65541
FixedCols = 0
BackColorSel = 14737632
ForeColorSel = 12582912
BackColorBkg = 12632256
AllowBigSelection= 0 'False
FocusRect = 0
ScrollBars = 2
SelectionMode = 1
AllowUserResizing= 3
End
End
Begin VB.TextBox Text1
Height = 300
Left = 3405
MaxLength = 5
TabIndex = 0
Top = 1485
Width = 1530
End
Begin VB.TextBox Text2
Height = 300
IMEMode = 3 'DISABLE
Left = 3405
MaxLength = 20
PasswordChar = "*"
TabIndex = 1
Top = 1875
Width = 1530
End
Begin VB.TextBox Text3
Height = 300
IMEMode = 3 'DISABLE
Left = 3405
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 2220
Width = 1530
End
Begin VB.CommandButton Command1
Caption = "保存(S)"
Enabled = 0 'False
Height = 375
Left = 2745
TabIndex = 3
Top = 2910
Width = 1110
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3915
TabIndex = 4
Top = 2910
Width = 1110
End
Begin VB.PictureBox Picture1
BackColor = &H00C0C0C0&
Height = 750
Left = 105
ScaleHeight = 690
ScaleWidth = 4935
TabIndex = 6
Top = 180
Width = 4995
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "添加新的帐号"
ForeColor = &H000000C0&
Height = 180
Left = 2610
TabIndex = 10
Top = 150
Width = 1080
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 输入各项之后,按保存"
ForeColor = &H00000000&
Height = 180
Left = 2835
TabIndex = 9
Top = 405
Width = 1980
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "删除自己的帐号："
ForeColor = &H000000C0&
Height = 180
Left = 150
TabIndex = 8
Top = 150
Width = 1440
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 双击选定的帐号"
Height = 180
Left = 540
TabIndex = 7
Top = 405
Width = 1530
End
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名："
Height = 180
Left = 2805
TabIndex = 14
Top = 1530
Width = 615
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "口令："
Height = 180
Left = 2805
TabIndex = 13
Top = 1935
Width = 615
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "重复："
Height = 180
Left = 2805
TabIndex = 12
Top = 2280
Width = 615
End
Begin VB.Line Line1
X1 = 90
X2 = 5100
Y1 = 960
Y2 = 960
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
X1 = 90
X2 = 5100
Y1 = 975
Y2 = 975
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
X1 = 2685
X2 = 5025
Y1 = 2790
Y2 = 2790
End
Begin VB.Line Line4
X1 = 2685
X2 = 5025
Y1 = 2775
Y2 = 2775
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 Command1_Click()
'校对数据库是否已经存在该操作员
Dim DB As Database, EF As Recordset, RecStr As String
Set DB = OpenDatabase(UserData)
Set EF = DB.OpenRecordset("Main", dbOpenDynaset)
RecStr = "操作员='" & Trim(Text1.Text) & "'"
EF.FindFirst RecStr
If Not EF.NoMatch Then
EF.Close
DB.Close
MsgBox "操作员< " & Trim(Text1.Text) & " >已经存在,不能继续! ", vbInformation
Text1.Text = ""
Text1.SetFocus
Exit Sub
End If
EF.Close
DB.Close
'UserText = Text1.Text
'保存
'如果要加密的话，请将 Text2.text 的文本加密!
'别忘记在登录时，要进行解密!
Dim shiftStr As String, shiftStrR As Variant, shiftNum As Integer, ili As Integer, sureStr As String
shiftStr = Trim(Text2.Text)
shiftNum = Len(shiftStr)
ili = 1
sureStr = ""
For ili = 1 To shiftNum
shiftStrR = Mid(shiftStr, ili, 1)
shiftStrR = Asc(shiftStrR)
shiftStrR = shiftStrR - 3
shiftStrR = Chr(shiftStrR)
sureStr = sureStr & shiftStrR
Next
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 2
Grid1.FormatString = "^ 操作员 |^ 口令 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Set DB = OpenDatabase(UserData)
RecStr = "Insert into Main (操作员,口令) values('" & Trim(Text1.Text) & "','" & Trim(sureStr) & "')"
DB.Execute RecStr
DB.Close
Dim HH As Integer
sureStr = ""
shiftStr = ""
shiftStrL = ""
shiftStrR = ""
shiftNum = 0
ili = 0
Tempstr = ""
Qy = 0
Set DB = OpenDatabase(UserData)
Set EF = DB.OpenRecordset("MAIN", dbOpenTable)
DelNO = EF.RecordCount
Grid1.Rows = EF.RecordCount + 4
Set EF = DB.OpenRecordset("Select * From MAIN", dbOpenDynaset)
HH = 1
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
EF.MoveNext
HH = HH + 1
Loop
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 1
Grid1.Visible = True
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text1.SetFocus
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
frmOperator.HelpContextID = 5
frmOperator.Left = (MDIForm1.Width - frmOperator.Width) / 2
frmOperator.Top = (MDIForm1.Height - frmOperator.Height) / 2 - 1500
'配置网格
Grid1.Visible = False
Grid1.Cols = 2
Grid1.FormatString = "^ 操作员 |^ 口令 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Dim DB As Database, EF As Recordset, HH As Integer
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, Tempstr As String, sureStr As String, Qy As Integer
Set DB = OpenDatabase(UserData)
Set EF = DB.OpenRecordset("MAIN", dbOpenTable)
DelNO = EF.RecordCount
Grid1.Rows = EF.RecordCount + 4
Set EF = DB.OpenRecordset("Select * From MAIN", dbOpenDynaset)
HH = 1
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
EF.MoveNext
HH = HH + 1
Loop
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 1
Grid1.Visible = True
End Sub
Private Sub Grid1_DblClick()
If Grid1.Text = "" Or Grid1.MouseRow = 0 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, "确认删除")
If Qp = 7 Then
Exit Sub
End If
Dim DB As Database, RecStr As String
Set DB = OpenDatabase(UserData)
RecStr = "Delete * From Main Where 操作员='" & Grid1.Text & "'"
DB.Execute RecStr
DB.Close
'配置网格
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 2
Grid1.FormatString = "^ 操作员 |^ 口令 "
Grid1.ColWidth(0) = 800
Grid1.ColWidth(1) = 1210
Dim EF As Recordset, HH As Integer
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, Tempstr As String, sureStr As String, Qy As Integer
Set DB = OpenDatabase(UserData)
Set EF = DB.OpenRecordset("MAIN", dbOpenTable)
DelNO = EF.RecordCount
Grid1.Rows = EF.RecordCount + 4
Set EF = DB.OpenRecordset("Select * From MAIN", dbOpenDynaset)
HH = 1
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
EF.MoveNext
HH = HH + 1
Loop
DB.Close
Grid1.Col = 0
Grid1.Row = 1
Grid1.ColSel = 1
Grid1.Visible = True
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -