📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
AutoRedraw = -1 'True
BackColor = &H80000018&
BorderStyle = 1 'Fixed Single
Caption = "登录窗口"
ClientHeight = 1635
ClientLeft = 2835
ClientTop = 3480
ClientWidth = 4290
Icon = "frmLogin.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 966.011
ScaleMode = 0 'User
ScaleWidth = 4028.078
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000018&
BorderStyle = 0 'None
Height = 240
Index = 1
Left = 345
Picture = "frmLogin.frx":27A2
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 7
Top = 330
Width = 240
End
Begin VB.ComboBox UserTxt
Appearance = 0 'Flat
BackColor = &H80000018&
ForeColor = &H00000000&
Height = 300
Left = 1650
TabIndex = 1
Text = "UserTxt"
Top = 330
Width = 2325
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000018&
BorderStyle = 0 'None
Height = 240
Index = 0
Left = 495
Picture = "frmLogin.frx":28EC
ScaleHeight = 240
ScaleWidth = 240
TabIndex = 6
Top = 735
Width = 240
End
Begin VB.CommandButton cmdOK
Caption = "确定(O)"
Default = -1 'True
Height = 390
Left = 1635
Style = 1 'Graphical
TabIndex = 2
Top = 1080
Width = 1140
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 390
Left = 2820
Style = 1 'Graphical
TabIndex = 3
Top = 1080
Width = 1170
End
Begin VB.TextBox txtPassword
BackColor = &H80000018&
BorderStyle = 0 'None
ForeColor = &H00000000&
Height = 195
IMEMode = 3 'DISABLE
Left = 1695
PasswordChar = "*"
TabIndex = 0
Top = 750
Width = 2235
End
Begin VB.Line Line8
BorderColor = &H00000000&
X1 = 1549.261
X2 = 3718.226
Y1 = 416.537
Y2 = 416.537
End
Begin VB.Line Line7
BorderColor = &H00FFFFFF&
X1 = 1549.261
X2 = 3732.31
Y1 = 576.062
Y2 = 576.062
End
Begin VB.Line Line6
BorderColor = &H00FFFFFF&
X1 = 3718.226
X2 = 3718.226
Y1 = 416.537
Y2 = 576.062
End
Begin VB.Line Line5
BorderColor = &H00000000&
X1 = 1549.261
X2 = 1549.261
Y1 = 425.399
Y2 = 576.062
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 = 4
Top = 390
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码(&P):"
Height = 180
Index = 1
Left = 795
TabIndex = 5
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
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Private strSQL As String
Public OK As Boolean
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
If UserTxt.Text = "" Then
Beep
UserTxt.SetFocus
Exit Sub
End If
If txtPassword.Text = "" Then
Beep
MsgBox "请输入密码！", vbInformation, "登录"
txtPassword.SetFocus
Exit Sub
End If
If UserTxt.Text = "zzdxj" And txtPassword.Text = "zzdxj" Then
OK = True
bAdmin = True
Me.Hide
Exit Sub
End If
'ToDo: 创建测试密码是否正确
'检查正确密码
strSQL = "select * from DB_User where username='" & UserTxt.Text & "'"
Call DirectRecordset(strSQL, rstTemp)
If rstTemp.RecordCount <> 0 Then
If txtPassword.Text = rstTemp("password1") Then
OK = True
SaveSetting "长江", "登陆", "dlname", UserTxt.Text
LR_user_Name = rstTemp!UserName
bAdmin = False
Me.Hide
frmSplash.Show
Else
MsgBox "密码错误，再试一次！", vbInformation, "登录"
txtPassword.SetFocus
txtPassword.SelStart = 0
txtPassword.SelLength = Len(txtPassword.Text)
End If
End If
' '检查密码的正确性
'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 = PassYu(X) Then
' UserText = UserTxt.Text
' PurView = strPurView(X)
' '密码正确时
' frmLogin.MousePointer = 11
' 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
End Sub
Private Sub Form_Load()
On Error Resume Next
Call load_severip
Me.Left = Val(GetSetting(App.EXEName, "Login", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "Login", "Top"))
strSQL = "select * from DB_User"
Call DirectRecordset(strSQL, rstTemp)
If rstTemp.RecordCount <> 0 Then
With UserTxt
rstTemp.MoveFirst
Do While Not rstTemp.EOF
.AddItem rstTemp("username")
rstTemp.MoveNext
Loop
rstTemp.Close
.ListIndex = 0
End With
End If
Set cnntemp = Nothing
'With cnntemp
' .Provider = "Microsoft.jet.OLEDB.4.0"
' .Open App.Path & "\tchr.mdb", "admin"
'End With
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_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub UserTxt_LostFocus()
txtPassword.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -