📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
AutoRedraw = -1 'True
BackColor = &H80000000&
BorderStyle = 1 'Fixed Single
Caption = "银行工作人员登录"
ClientHeight = 1635
ClientLeft = 2835
ClientTop = 3480
ClientWidth = 4290
Icon = "frmLogin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 966.011
ScaleMode = 0 'User
ScaleWidth = 4028.078
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox txtPassword
Height = 288
IMEMode = 3 'DISABLE
Left = 1650
PasswordChar = "*"
TabIndex = 7
Top = 711
Width = 2325
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000000&
BorderStyle = 0 'None
Height = 240
Index = 1
Left = 345
Picture = "frmLogin.frx":0442
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 6
Top = 330
Width = 240
End
Begin VB.ComboBox UserTxt
Appearance = 0 'Flat
BackColor = &H00FFFFFF&
ForeColor = &H00000000&
Height = 300
Left = 1650
TabIndex = 0
Top = 330
Width = 2325
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000000&
BorderStyle = 0 'None
Height = 240
Index = 0
Left = 495
Picture = "frmLogin.frx":058C
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 5
Top = 735
Width = 240
End
Begin VB.CommandButton cmdOK
Caption = "确定(O)"
Default = -1 'True
Height = 390
Left = 1635
Style = 1 'Graphical
TabIndex = 1
Top = 1080
Width = 1140
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 390
Left = 2820
Style = 1 'Graphical
TabIndex = 2
Top = 1080
Width = 1170
End
Begin VB.Line Line4
BorderColor = &H00E0E0E0&
Index = 1
X1 = 4013.994
X2 = 4013.994
Y1 = 17.725
Y2 = 948.286
End
Begin VB.Line Line3
BorderColor = &H00808080&
Index = 1
X1 = 3999.909
X2 = 3999.909
Y1 = 17.725
Y2 = 948.286
End
Begin VB.Line Line4
BorderColor = &H00E0E0E0&
Index = 0
X1 = 14.084
X2 = 14.084
Y1 = 8.862
Y2 = 939.424
End
Begin VB.Line Line3
BorderColor = &H00808080&
Index = 0
X1 = 0
X2 = 0
Y1 = 8.862
Y2 = 957.148
End
Begin VB.Line Line2
BorderColor = &H00E0E0E0&
Index = 1
X1 = 0
X2 = 3999.909
Y1 = 8.862
Y2 = 8.862
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 1
X1 = 0
X2 = 4013.994
Y1 = 0
Y2 = 0
End
Begin VB.Line Line2
BorderColor = &H00E0E0E0&
Index = 0
X1 = 28.168
X2 = 4028.078
Y1 = 957.148
Y2 = 957.148
End
Begin VB.Line Line1
BorderColor = &H00808080&
Index = 0
X1 = 28.168
X2 = 3999.909
Y1 = 948.286
Y2 = 948.286
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名(&U):"
Height = 180
Index = 0
Left = 630
TabIndex = 3
Top = 390
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码(&P):"
Height = 180
Index = 1
Left = 795
TabIndex = 4
Top = 765
Width = 720
End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim LOGINNO As Integer
Dim PassYu(30) As String, strPurView(30), UserID(30) As String
Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
On Error GoTo Err
'检查密码的正确性
Dim X As Long
X = UserTxt.ListIndex
'如果有加密，解密方法放此处，将PassYu(X)数组中的值，
'转换成原来信息
Dim FindStr As String
'将加密口令变回来
Dim shiftStr As String, shiftStrR As Variant, shiftNum As Integer, ili As Integer, SureStr As String
shiftStr = Trim(txtPassword.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
'密匙
'开始查找 sureStr为解除的口令
If SureStr = Decipher(PassYu(X)) Then
UserText = UserTxt.Text
PurView = strPurView(X)
OperatorID = UserID(X)
'密码正确时
frmLogin.MousePointer = 11
CurOperator = UserTxt
Unload Me
frmSplash.Show
Exit Sub
Else
MsgBox "无效的密码，再试一次！", 32, "登录"
LOGINNO = LOGINNO + 1
If LOGINNO > 3 Then
MsgBox "对不起，您不能使用该系统！", 64, "登录失败"
Unload Me
Exit Sub
End If
txtPassword.SetFocus
SendKeys "{Home}+{End}"
End If
Exit Sub
Err:
MsgBox "不对起，您没有访问系统的权限!", vbCritical, "提示："
End
End Sub
Private Sub Form_Load()
On Error Resume Next
Me.Left = Val(GetSetting(App.EXEName, "Login", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "Login", "Top"))
Dim retValue As Long
retValue = SetActiveWindow(Me.hwnd)
Browser = CurDir()
'设计时定义temp dir
'Browser = "D:\Program\Study\文件管理"
If Right(Browser, 1) <> "\" Then
Browser = Browser + "\"
End If
ConData = App.Path & "\dacl.mdb"
Dim db As Database, EF As Recordset, X As Long, i As Long
Dim UserYu(10) As String
Set db = OpenDatabase(ConData, False, False, ConStr)
Set EF = db.OpenRecordset("User", dbOpenTable)
X = EF.RecordCount
Set EF = db.OpenRecordset("User", dbOpenDynaset)
For i = 0 To X - 1
UserYu(i) = EF.Fields(0).Value
If Not IsNull(EF.Fields(1).Value) Then
PassYu(i) = EF.Fields(1).Value
End If
If Not IsNull(EF.Fields(2).Value) Then
strPurView(i) = EF.Fields(2).Value
End If
If Not IsNull(EF.Fields(3).Value) Then
UserID(i) = EF.Fields(3).Value
End If
UserTxt.AddItem UserYu(i), i
EF.MoveNext
Next
EF.Close
db.Close
If X >= 1 Then
UserTxt.ListIndex = 0
End If
LOGINNO = 1
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub
Me.Width = 4410
Me.Height = 2040
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.EXEName, "Login", "Left", Me.Left
SaveSetting App.EXEName, "Login", "Top", Me.Top
End Sub
Private Sub UserTxt_Click()
SendKeys "{Tab}"
End Sub
Private Sub UserTxt_LostFocus()
txtPassword.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -