VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "超市系統(tǒng)后臺管理－系統(tǒng)登陸（謝有泉）"
   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 MySuperMarket.XPButton cmdServer 
      Height          =   345
      Left            =   3750
      TabIndex        =   4
      Top             =   1410
      Width           =   1095
      _extentx        =   1931
      _extenty        =   609
      caption         =   "服務(wù)器(&S)"
      capalign        =   2
      backstyle       =   2
      font            =   "frmLogin.frx":119A0
      mode            =   0
      value           =   0   'False
      cback           =   -2147483633
   End
   Begin MySuperMarket.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":119C4
      mode            =   0
      value           =   0   'False
      cback           =   -2147483633
   End
   Begin MySuperMarket.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":119E8
      mode            =   0
      value           =   0   'False
      cback           =   -2147483633
   End
   Begin MySuperMarket.FTextBox txtPW 
      Height          =   300
      Left            =   1320
      TabIndex        =   1
      Top             =   1920
      Width           =   2295
      _extentx        =   4048
      _extenty        =   529
      font            =   "frmLogin.frx":11A10
      fontname        =   "宋體"
      fontsize        =   9
      passwordchar    =   "*"
      autoselall      =   -1  'True
   End
   Begin MySuperMarket.FCombo cboUser 
      Height          =   300
      Left            =   1320
      TabIndex        =   0
      Top             =   1440
      Width           =   2295
      _extentx        =   4048
      _extenty        =   529
      font            =   "frmLogin.frx":11A34
      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




Private Sub cboUser_GotFocus()
    cboUser.SelAll
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    '如果還沒有服務(wù)器信息
    If strSQLServer = "" Then
        MsgBox "您必須先設(shè)置 SQL 服務(wù)器信息。", vbInformation
        cmdServer_Click
        Exit Sub
    End If
    If cboUser.Text = "" Then
        MsgBox "請?zhí)顚懹脩裘?quot;, vbInformation
        cboUser.SetFocus
        cboUser.SetF
        Exit Sub
    End If
    If txtPW.Text = "" Then
        MsgBox "請?zhí)顚懨艽a。", 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