frmlogon.frm

多方讨价还价系统

VERSION 5.00
Begin VB.Form frmLogon 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登录系统"
   ClientHeight    =   4020
   ClientLeft      =   7050
   ClientTop       =   4845
   ClientWidth     =   5100
   ControlBox      =   0   'False
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4020
   ScaleWidth      =   5100
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton register 
      Caption         =   "注册"
      Height          =   375
      Left            =   2280
      TabIndex        =   10
      Top             =   3240
      Width           =   855
   End
   Begin VB.ComboBox txtUsername 
      Height          =   300
      Left            =   1680
      TabIndex        =   0
      Top             =   1440
      Width           =   2535
   End
   Begin VB.ComboBox combUsertype 
      Height          =   300
      ItemData        =   "frmLogon.frx":0000
      Left            =   1680
      List            =   "frmLogon.frx":000D
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   2400
      Width           =   2535
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H8000000D&
      BorderStyle     =   0  'None
      Height          =   1095
      Left            =   0
      ScaleHeight     =   1095
      ScaleWidth      =   5055
      TabIndex        =   7
      Top             =   0
      Width           =   5055
      Begin VB.Label Label4 
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "欢迎使用现代物流谈判原型系统"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   18
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H8000000E&
         Height          =   855
         Left            =   120
         TabIndex        =   9
         Top             =   0
         Width           =   4455
      End
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   3600
      TabIndex        =   4
      Top             =   3240
      Width           =   735
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "登录"
      Height          =   375
      Left            =   1080
      TabIndex        =   3
      Top             =   3240
      Width           =   735
   End
   Begin VB.TextBox txtPassword 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   1680
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1920
      Width           =   2535
   End
   Begin VB.Label Label3 
      Caption         =   "登录类型："
      Height          =   375
      Left            =   720
      TabIndex        =   8
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "用 户 名："
      Height          =   375
      Left            =   720
      TabIndex        =   6
      Top             =   1440
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "密    码："
      Height          =   375
      Left            =   720
      TabIndex        =   5
      Top             =   1920
      Width           =   1215
   End
End
Attribute VB_Name = "frmLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
    Dim flag As Boolean
    If txtUsername <> "" And txtPassword <> "" And combUsertype.Text <> "" Then
        Select Case combUsertype.Text
            Case "管理员"
                LogonType = JQL_ADMIN
            Case "买家"
                LogonType = JQL_BUYER
            Case "卖家"
                LogonType = JQL_SALER
        End Select
        flag = CheckUser(txtUsername, txtPassword, LogonType)
        If flag Then
            MsgBox "成功登陆！", vbOKOnly Or vbInformation, "用户登录"
            LogonUser = txtUsername
            SaveRecentUser
            Unload Me
            frmMain.SetLogonType LogonType
        Else
            MsgBox "用户名类型或密码错误！", vbOKOnly Or vbInformation, "用户登录"
        End If
    Else
        MsgBox "请输入正确的登录信息！", vbOKOnly Or vbCritical, "用户登录"
    End If
End Sub

Function CheckUser(uName As String, uPass As String, uType As LogonTypes) As Boolean
    Dim RS
    Set RS = CreateObject("ADODB.RecordSet")
    StrSQL = "select * from " & dbTableNames(LogonType) & " where username = '" & uName & "' and password ='" & uPass & "'"
    RS.Open StrSQL, ConnStr, 1, 1
    CheckUser = Not RS.EOF
    RS.Close
End Function

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdOK.Value = True
    End If
End Sub

Private Sub Form_Load()
    combUsertype.ListIndex = 0
    Dim userStr As String
    Open App.Path & "\config.ini" For Input As #1
    Do Until EOF(1)
        Line Input #1, userStr
        If userStr <> "" Then
            txtUsername.AddItem userStr
        End If
    Loop
    combUsertype.Text = GetSetting("JQL", "config", "lastusertype", "买家")
    txtUsername.Text = GetSetting("JQL", "config", "lastusername", "admin")
    Close #1
End Sub

Private Sub SaveRecentUser()
    Dim userStr As String
    Dim flag As Boolean
    Dim i As Integer
    flag = False
    For i = 0 To txtUsername.ListCount
        flag = flag Or (LogonUser = txtUsername.List(i))
    Next
    If Not flag Then
        If txtUsername.ListCount > 10 Then
            txtUsername.RemoveItem 10
        End If
        txtUsername.AddItem LogonUser, 0
    End If
    Open App.Path & "\config.ini" For Output As #1
    For i = 0 To txtUsername.ListCount
        userStr = txtUsername.List(i)
        Print #1, userStr
    Next
    Close #1
    Call SaveSetting("JQL", "config", "lastusertype", combUsertype.Text)
    Call SaveSetting("JQL", "config", "lastusername", txtUsername.Text)
End Sub

Private Sub register_Click()
    frmregister.Show vbModal
End Sub