📄 fmlogin.frm
字号:
VERSION 5.00
Begin VB.Form FMLogin
BackColor = &H00C0C0C0&
Caption = "登录"
ClientHeight = 3690
ClientLeft = 60
ClientTop = 345
ClientWidth = 5265
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3690
ScaleWidth = 5265
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Height = 3750
Left = 0
TabIndex = 0
Top = -45
Width = 5265
Begin VB.PictureBox picBG
Appearance = 0 'Flat
BackColor = &H00CC6633&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 1275
Left = 30
ScaleHeight = 1275
ScaleWidth = 5205
TabIndex = 5
TabStop = 0 'False
Top = 45
Width = 5205
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "特瑞飞KTV信息管理系统 演示版"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 285
Index = 3
Left = 600
TabIndex = 8
Top = 510
Width = 4260
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "版权所有 (C) 2007-2008 特瑞飞软件"
Height = 180
Index = 2
Left = 2085
TabIndex = 7
Top = 1035
Width = 2970
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "欢迎使用"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Index = 1
Left = 180
TabIndex = 6
Top = 165
Width = 900
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "特瑞飞KTV信息管理系统 演示版"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 285
Index = 0
Left = 645
TabIndex = 9
Top = 540
Width = 4260
End
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "退出(&E)"
Height = 360
Left = 2445
TabIndex = 4
Top = 2670
Width = 1050
End
Begin VB.CommandButton cmdOK
Caption = "登录(&O)"
Default = -1 'True
Height = 360
Left = 1200
TabIndex = 3
Top = 2670
Width = 1050
End
Begin VB.TextBox TextUserPwd
Height = 300
IMEMode = 3 'DISABLE
Left = 1545
MaxLength = 50
PasswordChar = "*"
TabIndex = 2
Text = "Admin"
Top = 2040
Width = 2175
End
Begin VB.TextBox TextUserName
Height = 300
Left = 1545
MaxLength = 50
TabIndex = 1
Text = "Admin"
Top = 1575
Width = 2175
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "注：默认登录用户:密码 是 Admin:Admin"
ForeColor = &H00C00000&
Height = 180
Index = 6
Left = 960
TabIndex = 12
Top = 3255
Width = 3240
End
Begin VB.Image Image1
Height = 1305
Left = 3855
Picture = "FMLogin.frx":0000
Stretch = -1 'True
Top = 1485
Width = 1050
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "登录密码"
Height = 180
Index = 5
Left = 720
TabIndex = 11
Top = 2100
Width = 720
End
Begin VB.Label lblLogin
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名"
Height = 180
Index = 4
Left = 900
TabIndex = 10
Top = 1650
Width = 540
End
End
End
Attribute VB_Name = "FMLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public iCount As Integer
Private Sub CmdCancel_Click()
If g_DBConn.State = adStateOpen Then
g_DBConn.Close
End If
Unload Me
End Sub
Private Sub CmdOK_Click()
Dim Check As New Recordset
Dim DBStr As String
Dim UsrID As String
Dim UsrPwd As String
Dim bConnSucceed As Boolean
Dim szErrMsg As String
Dim MsgResult As VbMsgBoxResult
'在确认要登录时，再初始化数据库连接
bConnSucceed = InitDatabaseConn(szErrMsg)
If Not bConnSucceed Then
MsgResult = MsgBox("连接数据库失败：" & szErrMsg, vbCritical + vbRetryCancel)
If MsgResult = vbRetry Then
Exit Sub
ElseIf MsgResult = vbCancel Then
End '退出系统
End If
End If
iCount = iCount + 1
If Len(Trim(Me.TextUserName.Text)) <= 0 Then
MsgBox "请输入用户名！"
If iCount >= 3 Then
MsgBox "您输入的错误次数过多,请核实后重新进入本系统!"
g_DBConn.Close
Unload Me
Exit Sub
End If
Exit Sub
End If
UsrID = Trim(Me.TextUserName.Text)
If Len(Trim(Me.TextUserPwd.Text)) <= 0 Then
MsgBox "请输入密码！"
If iCount >= 3 Then
MsgBox "您输入的错误次数过多,请核实后重新进入本系统!"
g_DBConn.Close
Unload Me
Exit Sub
End If
Exit Sub
End If
UsrPwd = Trim(Me.TextUserPwd.Text)
DBStr = "select * from UserInfo where UserID='" & Replace(UsrID, "'", "''") & "'"
Check.Open DBStr, g_DBConn, adOpenStatic, adLockReadOnly, -1
If Check.RecordCount <= 0 Then
MsgBox "找不到该用户，请重新输入！"
Check.Close
Else
Check.MoveFirst
If UsrPwd = Check.Fields("UserPwd").Value Then
g_LoginedUser.ID = UsrID
g_LoginedUser.Type = Check.Fields("UserType").Value
FMMain.Show
Else
MsgBox "密码错误！"
Check.Close
If iCount >= 3 Then
MsgBox "您输入的错误次数过多,请核实后重新进入本系统!"
g_DBConn.Close
Unload Me
Exit Sub
End If
Exit Sub
End If
Check.Close
End If
Unload Me
End Sub
Private Sub Form_Load()
Dim szErrMsg As String
'初始化样式
Call InitVisualStyle
picBG.BackColor = g_VisualStyle.clrTitle
Me.Top = (Screen.Height - Me.Height) / 2 '垂直方向居中
Me.Left = (Screen.Width - Me.Height) / 2 '水平方向居中
If App.PrevInstance Then
MsgBox "系统已经启动！"
'Exit Sub
End If
iCount = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -