?? 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 + -