📄 operationer.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Operationer
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "操作员配置"
ClientHeight = 3405
ClientLeft = 45
ClientTop = 330
ClientWidth = 5115
Icon = "Operationer.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3405
ScaleWidth = 5115
ShowInTaskbar = 0 'False
Begin VB.PictureBox Picture1
BackColor = &H00C0C0C0&
Height = 750
Left = 60
ScaleHeight = 690
ScaleWidth = 4935
TabIndex = 10
Top = 75
Width = 4995
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 双击选定的帐号"
Height = 180
Left = 540
TabIndex = 14
Top = 405
Width = 1530
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "删除自己的帐号："
ForeColor = &H000000C0&
Height = 180
Left = 150
TabIndex = 13
Top = 150
Width = 1440
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "=> 输入各项之后,按保存"
ForeColor = &H00000000&
Height = 180
Left = 2835
TabIndex = 12
Top = 405
Width = 1980
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "添加新的帐号"
ForeColor = &H000000C0&
Height = 180
Left = 2610
TabIndex = 11
Top = 150
Width = 1080
End
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "取消(&C)"
Height = 375
Left = 3870
TabIndex = 4
Top = 2805
Width = 1110
End
Begin VB.CommandButton Command1
Caption = "保存(S)"
Enabled = 0 'False
Height = 375
Left = 2700
TabIndex = 3
Top = 2805
Width = 1110
End
Begin VB.TextBox Text3
Height = 300
IMEMode = 3 'DISABLE
Left = 3360
MaxLength = 20
PasswordChar = "*"
TabIndex = 2
Top = 2115
Width = 1530
End
Begin VB.TextBox Text2
Height = 300
IMEMode = 3 'DISABLE
Left = 3360
MaxLength = 20
PasswordChar = "*"
TabIndex = 1
Top = 1770
Width = 1530
End
Begin VB.TextBox Text1
Height = 300
Left = 3360
MaxLength = 5
TabIndex = 0
Top = 1380
Width = 1530
End
Begin VB.Frame Frame1
Caption = "操作员列表"
Height = 2100
Left = 120
TabIndex = 5
Top = 1155
Width = 2385
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 1650
Left = 135
TabIndex = 6
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.Line Line4
X1 = 2640
X2 = 4980
Y1 = 2670
Y2 = 2670
End
Begin VB.Line Line3
BorderColor = &H00FFFFFF&
X1 = 2640
X2 = 4980
Y1 = 2685
Y2 = 2685
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
X1 = 45
X2 = 5055
Y1 = 870
Y2 = 870
End
Begin VB.Line Line1
X1 = 45
X2 = 5055
Y1 = 855
Y2 = 855
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "重复："
Height = 180
Left = 2760
TabIndex = 9
Top = 2175
Width = 615
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "口令："
Height = 180
Left = 2760
TabIndex = 8
Top = 1830
Width = 615
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "姓名："
Height = 180
Left = 2760
TabIndex = 7
Top = 1425
Width = 615
End
End
Attribute VB_Name = "Operationer"
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
If UserStr = UserText Then
Grid1.Text = sureStr
Else
Grid1.Text = "********"
End If
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()
Operationer.HelpContextID = 5
Operationer.Left = (MDIForm1.Width - Operationer.Width) / 2
Operationer.Top = (MDIForm1.Height - Operationer.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
If UserStr = UserText Then
Grid1.Text = sureStr
Else
Grid1.Text = "********"
End If
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 Or Grid1.Text <> UserText 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
If UserStr = UserText Then
Grid1.Text = sureStr
Else
Grid1.Text = "********"
End If
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 + -