📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form FrmLogin
BorderStyle = 3 'Fixed Dialog
Caption = "仓储管理_登录"
ClientHeight = 2040
ClientLeft = 3390
ClientTop = 3480
ClientWidth = 4590
ControlBox = 0 'False
ForeColor = &H80000008&
Icon = "FrmLogin.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2040
ScaleWidth = 4590
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer1
Interval = 1000
Left = 4110
Top = 1605
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 408
Left = 2496
TabIndex = 5
Top = 1548
Width = 948
End
Begin VB.CommandButton cmdOk
Caption = "确定"
Height = 408
Left = 1104
TabIndex = 4
Top = 1548
Width = 948
End
Begin VB.TextBox txtPWD
BeginProperty Font
Name = "Symbol"
Size = 10.5
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 3
Top = 972
Width = 2316
End
Begin VB.TextBox txtUser
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1680
TabIndex = 2
Top = 288
Width = 2316
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "密码 :"
Height = 276
Left = 912
TabIndex = 1
Top = 1068
Width = 984
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "用户名:"
Height = 276
Left = 912
TabIndex = 0
Top = 348
Width = 984
End
Begin VB.Image Image2
Height = 480
Left = 285
Picture = "FrmLogin.frx":164A
Top = 870
Width = 480
End
Begin VB.Image Image1
Height = 525
Left = 315
Picture = "FrmLogin.frx":1F14
Stretch = -1 'True
Top = 165
Width = 345
End
End
Attribute VB_Name = "FrmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private cnnDB As New ADODB.Connection
Private rs As New ADODB.Recordset
Dim ShowTime As Integer
Private Sub DBConnection()
'cnnDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & gDBPath & ";Jet OLEDB:Database Password=czlxming;Persist Security Info=False"
cnnDB.ConnectionString = "DSN=Freight"
cnnDB.CommandTimeout = 15
cnnDB.Open
End Sub
Private Sub cmdCancel_Click()
If gLoginStatus = "SYS" Then
Unload Me
Else
End
End If
End Sub
Private Sub cmdOK_Click()
If txtUser.Text = "" Then
MsgBox "请输入用户名", vbExclamation + vbOKOnly, "提示"
txtUser.SetFocus
Exit Sub
End If
If txtPWD.Text = "" Then
MsgBox "请输入密码", vbExclamation + vbOKOnly, "提示"
txtPWD.SetFocus
Exit Sub
End If
If Login(UCase(txtUser.Text), UCase(txtPWD.Text)) = True Then
If gLoginStatus = "SYS" Then
gLoginStatus = "True"
gLogin = 0
gUser = UCase(txtUser.Text)
frmMain.MainBar.Panels(1).Text = gPurview & ":" & gUser
Unload Me
Else
gLogin = 0
gUser = UCase(txtUser.Text)
frmMain.MainBar.Panels(1).Text = gPurview & ":" & gUser
Me.MousePointer = vbHourglass
Unload Me
End If
Else
gLogin = gLogin + 1
MsgBox "用户名或密码错误", vbCritical + vbOKOnly, "错误"
txtUser.Text = ""
txtPWD.Text = ""
txtUser.SetFocus
End If
If gLogin >= 3 And gLoginStatus <> "SYS" Then
End
Else
If gLogin >= 3 Then
gLogin = 0
Unload Me
End If
End If
End Sub
Public Function Login(mUser As String, mPWD As String) As Boolean
Login = False
Set rs = New ADODB.Recordset
rs.Open "select * from Login", cnnDB, adOpenKeyset, adLockOptimistic
Do While Not rs.EOF
If mUser = rs("USERNAME1") And mPWD = DeString(rs("PASSWORD1")) Then
Login = True
gPurview = rs("PURVIEW")
Exit Do
End If
rs.MoveNext
Loop
rs.Close
End Function
Private Sub Form_Load()
DBConnection
End Sub
Private Sub Form_Unload(Cancel As Integer)
cnnDB.Close
Set cnnDB = Nothing
End Sub
Private Sub Timer1_Timer()
ShowTime = ShowTime + 1
If ShowTime = 3 Then
gStart = True '关闭展示窗口
Timer1.Enabled = False
End If
End Sub
Private Sub txtPWD_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtPWD.Text = UCase(txtPWD.Text)
cmdOK_Click
End If
End Sub
Private Sub txtUser_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
txtUser.Text = UCase(txtUser.Text)
txtPWD.SetFocus
End If
End Sub
Private Sub txtUser_LostFocus()
If txtUser.Text <> "" Then
txtUser.Text = UCase(txtUser.Text)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -