frmlogin.frm

用VB编程语言,SQL2000数据库 连接开发系统

VERSION 5.00
Begin VB.Form frmLogin 
   BackColor       =   &H00FFFF00&
   BorderStyle     =   0  'None
   Caption         =   "Login"
   ClientHeight    =   3030
   ClientLeft      =   3405
   ClientTop       =   1680
   ClientWidth     =   4935
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3030
   ScaleWidth      =   4935
   ShowInTaskbar   =   0   'False
   Tag             =   "Login"
   Begin VB.ComboBox comPer 
      Height          =   300
      Left            =   1800
      TabIndex        =   5
      Text            =   "Combo1"
      Top             =   1440
      Width           =   1575
   End
   Begin VB.TextBox txtPass 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   1800
      PasswordChar    =   "*"
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   1920
      Width           =   1575
   End
   Begin VB.CommandButton cmdOkCancel 
      BackColor       =   &H000080FF&
      Caption         =   "确定(&E)"
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   1440
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2400
      Width           =   855
   End
   Begin VB.CommandButton cmdOkCancel 
      BackColor       =   &H000080FF&
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   375
      Index           =   1
      Left            =   2400
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   2400
      Width           =   855
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   975
      Left            =   120
      ScaleHeight     =   945
      ScaleWidth      =   4665
      TabIndex        =   6
      Top             =   120
      Width           =   4695
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "营销管理系统"
         BeginProperty Font 
            Name            =   "黑体"
            Size            =   23.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF0000&
         Height          =   495
         Left            =   840
         TabIndex        =   7
         Top             =   240
         Width           =   3015
      End
   End
   Begin VB.Shape Shape1 
      BorderWidth     =   3
      Height          =   3015
      Left            =   0
      Top             =   0
      Width           =   4935
   End
   Begin VB.Label lblLabels 
      BackStyle       =   0  'Transparent
      Caption         =   "密  码:"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   10.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Index           =   1
      Left            =   600
      TabIndex        =   0
      Tag             =   "&Password:"
      Top             =   1860
      Width           =   840
   End
   Begin VB.Label lblLabels 
      BackStyle       =   0  'Transparent
      Caption         =   "用户名:"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   10.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Index           =   0
      Left            =   588
      TabIndex        =   1
      Tag             =   "&User Name:"
      Top             =   1476
      Width           =   1080
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long


Public OK As Boolean

Dim db1 As ADODB.Connection
Dim rstp1 As ADODB.Recordset
Private Sub cmdOkCancel_Click(Index As Integer)
Dim i As Integer
i = 0
Select Case Index
    Case 0
        If txtPass.Text = "" Or comPer.Text = "" Then
            MsgBox "请选择用户名或输入密码!", 0 + 48, "提示"
            txtPass.SetFocus
            Exit Sub
        End If
        rstp1.MoveFirst
        rstp1.Move comPer.ListIndex
        If comPer = "superuser" Then
        user = True
        Else
        user = False
        End If
        
        If rstp1.Fields("password") = "1" Then
        grd1 = True
        Else
        grd1 = False
        End If
        
        If rstp1.Fields("grade") = "2" Then
        grd2 = True
        Else
        grd2 = False
        End If
        
        If rstp1.Fields("grade") = "3" Then
        grd3 = True
        Else
        grd3 = False
        End If
        
        
        If Val(txtPass.Text) = Val(rstp1.Fields("password")) Then
            'MsgBox "正确"
            OK = True
                     Unload Me
                   
        Else
            MsgBox "密码错误,请重试！", 0 + 16, "错误"
            txtPass.SetFocus
            Exit Sub
        End If
Case 1
    Unload Me
End Select
End Sub

Private Sub Form_Load()

Dim str As String

Set db1 = New ADODB.Connection
db1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\database\trade.mdb;Persist Security Info=False"
Set rstp1 = New ADODB.Recordset
str = "select * from pass"
 rstp1.Open str, db1, adOpenKeyset, adLockOptimistic
rstp1.MoveLast
Rec = rstp1.RecordCount
ReDim Asc(Rec - 1)
rstp1.MoveFirst
For i = 1 To Rec
    comPer.AddItem rstp1.Fields("user")
    Asc(i - 1) = Val(rstp1.Fields("password"))
    rstp1.MoveNext
    If rstp1.EOF Then Exit For
Next
comPer.Text = ""
txtPass.Text = ""
End Sub


Private Sub Form_Unload(Cancel As Integer)
rstp1.Close
db1.Close
End Sub