frmlogin.frm

小型超市管理系统.

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "超市系统后台管理－登陆入口"
   ClientHeight    =   3390
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5145
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmLogin.frx":0E42
   ScaleHeight     =   226
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   343
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   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
      font            =   "frmLogin.frx":42AE
      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
      font            =   "frmLogin.frx":42D2
      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
      font            =   "frmLogin.frx":42FA
      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
      font            =   "frmLogin.frx":431E
      listindex       =   -1
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "密  码："
      Height          =   180
      Left            =   480
      TabIndex        =   5
      Top             =   1980
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      Height          =   180
      Left            =   480
      TabIndex        =   4
      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
Private Sub cboUser_GotFocus()
    cboUser.SelAll
End Sub
Private Sub Cmdexit_Click()
    Unload Me
End Sub

Private Sub cmdok_Click()
On Error GoTo err
   '链接数据库
    sqlConnect cnMain
    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
err:
    '出错处理 弹出出错信息 关闭CnMain
    MsgBox err.Description, vbCritical
    If cnMain.State = 1 Then cnMain.Close
End Sub

Private Sub cmdServer_Click()
'使frmServer 中的文本框都有相应的内容
    With frmServer
    
        .txtServer.Text = "."
        .Txtuser.Text = "sa"
        If strSQLPW <> "" Then .lbPW.Visible = True
        .txtDB.Text = IIf(strSQLDB <> "", strSQLDB, "sqloledb")
        .Show 1
    End With
End Sub

Private Sub Form_Activate()
'窗体从新处于活动状态的事件 cboUser 获得焦点
On Error Resume Next
    cboUser.SetFocus
    cboUser.SetF
End Sub

Private Sub Form_Load()
  Dim cnTest As New ADODB.Connection
    sqlConnect cnTest
    If cnMain.State <> 0 Then cnMain.Close
    LoadUserList
    If cboUser.ListCount > 0 Then cboUser.ListIndex = 0
End Sub
' 从user.inf文件中读取用户信息列表 并存到 cboUser中
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 err
    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
err:
End Sub