📄 frmlogin.frm
字号:
VERSION 5.00
Begin VB.Form frmLogin
BorderStyle = 1 'Fixed Single
Caption = "超市系统后台管理－登陆入口"
ClientHeight = 3135
ClientLeft = 45
ClientTop = 330
ClientWidth = 5220
Icon = "frmLogin.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
Picture = "frmLogin.frx":0E42
ScaleHeight = 209
ScaleMode = 3 'Pixel
ScaleWidth = 348
StartUpPosition = 2 '屏幕中心
Begin SuperMarket.XPButton cmdServer
Height = 345
Left = 3750
TabIndex = 4
Top = 1410
Width = 1095
_ExtentX = 1931
_ExtentY = 609
Caption = "服务器(&S)"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin SuperMarket.XPButton cmdExit
Cancel = -1 'True
Height = 345
Left = 3960
TabIndex = 3
Top = 2640
Width = 1095
_ExtentX = 1931
_ExtentY = 609
Caption = "取消"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin SuperMarket.XPButton cmdOK
Default = -1 'True
Height = 345
Left = 2760
TabIndex = 2
Top = 2640
Width = 1095
_ExtentX = 1931
_ExtentY = 609
Caption = "确定"
CapAlign = 2
BackStyle = 2
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Mode = 0
Value = 0 'False
cBack = -2147483633
End
Begin SuperMarket.FTextBox txtPW
Height = 300
Left = 1320
TabIndex = 1
Top = 1920
Width = 2295
_ExtentX = 4048
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
FontName = "宋体"
FontSize = 9
PasswordChar = "*"
AutoSelAll = -1 'True
End
Begin SuperMarket.FCombo cboUser
Height = 300
Left = 1320
TabIndex = 0
Top = 1440
Width = 2295
_ExtentX = 4048
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ListIndex = -1
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密 码："
Height = 180
Left = 480
TabIndex = 6
Top = 1980
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户名："
Height = 180
Left = 480
TabIndex = 5
Top = 1500
Width = 720
End
Begin VB.Shape Shape1
BackColor = &H00FFF8F0&
BorderColor = &H00C5742F&
Height = 1335
Left = 180
Top = 1140
Width = 4860
End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'超市销售系统
'程序开发：lc_mtt
'CSDN博客：http://blog.csdn.net/lc_mtt/
'个人主页：http://www.3lsoft.com
'邮箱：3lsoft@163.com
'注：此代码禁止用于商业用途。有修改者发我一份，谢谢！
'---------------- 开源世界，你我更进步 ----------------
Private Sub cboUser_GotFocus()
cboUser.SelAll
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
'如果还没有服务器信息
If strSQLServer = "" Then
MsgBox "您必须先设置 SQL 服务器信息。", vbInformation
cmdServer_Click
Exit Sub
End If
If cboUser.Text = "" Then
MsgBox "请填写用户名。", vbInformation
cboUser.SetFocus
cboUser.SetF
Exit Sub
End If
If txtPW.Text = "" Then
MsgBox "请填写密码。", vbInformation
txtPW.SetFocus
Exit Sub
End If
On Error GoTo aaaa
sqlConnect cnMain, strSQLServer, strSQLUser, strSQLPW, strSQLDB
Dim rs As New ADODB.Recordset, strMD5 As String
strMD5 = GetMD5(txtPW.Text)
rs.Open "Select * From [User] Where UserStyle>1", cnMain, 1, 1
If rs.EOF Then
MsgBox "找不到任何用户！", vbCritical
cnMain.Close
Else
Do Until rs.EOF
If StrComp(rs("UserName"), cboUser.Text, 1) = 0 And StrComp(rs("UserPW"), GetMD5(txtPW.Text), 1) = 0 Then
curUserName = rs("UserName")
curUserStyle = CLng(rs("UserStyle"))
cboUser.AddItem curUserName, 0
SaveUserList
frmMain.Icon = Me.Icon
Unload Me
frmMain.Show
Exit Sub
End If
rs.MoveNext
Loop
End If
MsgBox "用户名或密码错误，登陆失败！", vbCritical
cnMain.Close
Exit Sub
aaaa:
MsgBox Err.Description, vbCritical
If cnMain.State = 1 Then cnMain.Close
End Sub
Private Sub cmdServer_Click()
With frmServer
.txtServer.Text = strSQLServer
.txtUser.Text = strSQLUser
If strSQLPW <> "" Then .lbPW.Visible = True
.txtDB.Text = IIf(strSQLDB <> "", strSQLDB, "SuperMarketdb")
.Show 1
End With
End Sub
Private Sub Form_Activate()
On Error Resume Next
cboUser.SetFocus
cboUser.SetF
End Sub
Private Sub Form_Load()
If cnMain.State <> 0 Then cnMain.Close
LoadUserList
If cboUser.ListCount > 0 Then cboUser.ListIndex = 0
End Sub
Public Sub LoadUserList()
On Error GoTo aaaa
Dim strTmp As String, j As Long
Open GetApp & "Files\user.inf" For Input As #1
Do Until EOF(1)
Line Input #1, strTmp
strTmp = Trim(strTmp)
If strTmp <> "" Then
cboUser.AddItem strTmp
j = j + 1
If j >= 10 Then Close #1: Exit Sub
End If
Loop
Close #1
aaaa:
End Sub
Public Sub SaveUserList()
On Error GoTo aaaa
Dim strTmp As String, i As Long, j As Long
If cboUser.ListCount <= 0 Then Exit Sub
For i = 0 To cboUser.ListCount - 1
strTmp = strTmp & cboUser.List(i) & vbCrLf
j = j + 1
If j >= 10 Then Exit For
Next
Open GetApp & "Files\user.inf" For Output As #1
Print #1, strTmp
Close #1
aaaa:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -