📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
Caption = "登录窗口"
ClientHeight = 3075
ClientLeft = 2340
ClientTop = 1980
ClientWidth = 6240
Icon = "frmLogin.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3075
ScaleWidth = 6240
Begin VB.CommandButton cmdExit
Caption = "退 出"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3360
Style = 1 'Graphical
TabIndex = 4
Top = 2280
Width = 1095
End
Begin VB.CommandButton cmdLogin
Caption = "登 录"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1800
Style = 1 'Graphical
TabIndex = 3
Top = 2280
Width = 1095
End
Begin VB.TextBox txtPassword
BackColor = &H8000000F&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2749
TabIndex = 2
Top = 1680
Width = 1695
End
Begin VB.TextBox txtUserName
BackColor = &H8000000F&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 2749
TabIndex = 1
Top = 1080
Width = 1695
End
Begin VB.Label lblPassword
Alignment = 1 'Right Justify
Caption = "密 码 "
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1796
TabIndex = 6
Top = 1725
Width = 855
End
Begin VB.Label lblUserName
Alignment = 1 'Right Justify
Caption = "用户名 "
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1796
TabIndex = 5
Top = 1110
Width = 855
End
Begin VB.Label lblTitle
Alignment = 2 'Center
BackColor = &H80000005&
Caption = "红太阳中心学员信息系统"
BeginProperty Font
Name = "幼圆"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 0
TabIndex = 0
Top = 240
Width = 6255
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 Sub cmdExit_Click()
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
'退出程序
End
End Sub
Private Sub cmdLogin_Click()
'验证: 用户名和密码不能为空,也不能大于16个字符
If txtUserName.Text = "" Or txtPassword.Text = "" Or Len(Trim(txtUserName.Text)) > 16 Or Len(Trim(txtPassword.Text)) > 16 Then
MsgBox "输入正确的用户名和密码！", vbOKOnly + vbCritical, "警告"
Else
'获取用户名和密码,放入变量 strUserName,strPassword
strUserName = Trim(txtUserName.Text)
strPassword = Trim(txtPassword.Text)
'用户名和密码符合录入标准,连接数据库
'GetInfo函数 见模块MdlConnection
Call GetInfo
'连接数据库的字串
strConnect = "Provider=SQLOLEDB.1;Persist Security Info=True;Initial Catalog=" & strdbName & ";Data Source=" & strHostName
'打开数据库连接, ConOpen函数 见模块MdlConnection
'Set con = New ADODB.Connection
'con.Open strConnect, dbUserName, dbPassword
ConOpen con, strConnect, strdbUserName, strdbPassword
'如果记录集是打开的,则关闭之
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
'打开记录集, 使用查询字串strFind, RsOpen函数 见模块MdlConnection
'Set rs = New ADODB.Recordset
'rs.Open strFind, con, adOpenDynamic, adLockOptimistic, adCmdText
strFind = "select sysuser.username,sysuser.password,sysuser.ccode,sysuserpermit.pid" _
& " from sysuserpermit inner join sysuser on sysuser.uid=sysuserpermit.uid" _
& " where sysuser.username='" & strUserName & "' and sysuser.password='" & strPassword & "'"
'strFind = "select pid from sysuser inner join sysuserpermit on sysuser.uid=sysuserpermit.uid where sysuser.username='" & strUserName & "' and sysuser.[password]='" & strPassword & "'"
RsOpen rs, con, strFind, "adcmdtext"
'如果该用户名和密码不存在或不正确则警告之,存在则关闭登录窗体,进入主窗体
If rs.BOF And rs.EOF Then
MsgBox "请输入正确的用户名和密码!", vbOKOnly + vbExclamation, "提示"
Exit Sub
Else
strPassword = rs!Password
'验证密码大小写是否错误
If StrComp(strPassword, txtPassword.Text, vbBinaryCompare) <> 0 Then
MsgBox "密码错误!", vbOKOnly + vbExclamation, "提示"
Exit Sub
Else
'获得权限PID,进入主窗体
intUserPermit = CInt(rs!PID)
strCenterCode = rs!ccode
MDIFrmMain.Show
Unload Me
End If
End If
End If
End Sub
Private Sub Form_Activate()
'窗体激活时设置焦点
txtUserName.SetFocus
End Sub
Private Sub Form_Load()
'避免程序重复执行
If App.PrevInstance Then
MsgBox "该程序已在执行中！", vbOKOnly + vbInformation, " 程序信息"
End
End If
'窗体背景色设为白色 GetColor函数 见模块MdlSystem
Me.BackColor = GetColor
'设置 lblTitle 的字体 华文行楷 字号26 粗 斜体
lblTitle.FontName = "华文行楷"
lblTitle.FontSize = 26
lblTitle.FontBold = True
lblTitle.FontItalic = True
'按钮 文本框 标签框 控件的背景色设为白色
cmdLogin.BackColor = GetColor
cmdExit.BackColor = GetColor
txtUserName.BackColor = GetColor
txtPassword.BackColor = GetColor
lblUserName.BackColor = GetColor
lblPassword.BackColor = GetColor
'设置密码的掩码为#
txtPassword.PasswordChar = "*"
'记录集状态标记设为False
rsFlag = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'关闭记录集,RsClose函数 见模块MdlConnection
RsClose rs
End Sub
Private Sub txtpassword_KeyPress(KeyAscii As Integer)
'验证输入的字符，只能输入字母、数字或退格
If KeyAscii = 32 Then KeyAscii = 0
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or (KeyAscii > 57 And KeyAscii < 65) Or (KeyAscii > 90 And KeyAscii < 97) Or (KeyAscii > 122) Then
KeyAscii = 0
MsgBox "密码错误！", vbOKOnly + vbCritical, "警告"
End If
End Sub
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
'验证输入的字符，只能输入字母、数字或退格
If KeyAscii = 32 Then KeyAscii = 0
If (KeyAscii > 0 And KeyAscii < 8) Or (KeyAscii > 8 And KeyAscii < 48) Or (KeyAscii > 57 And KeyAscii < 65) Or (KeyAscii > 90 And KeyAscii < 97) Or (KeyAscii > 122) Then
KeyAscii = 0
MsgBox "用户名必须是字母或数字！", vbOKOnly + vbCritical, "警告"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -