gdhlogin.frm

齐鲁石化某分公司的数据采集管理系统

VERSION 5.00
Begin VB.Form gdhLogin 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "登录"
   ClientHeight    =   2145
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4650
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2145
   ScaleWidth      =   4650
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   375
      Left            =   1800
      TabIndex        =   5
      Top             =   1680
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   1800
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   1200
      Width           =   1695
   End
   Begin VB.ComboBox Combo1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   1800
      TabIndex        =   0
      Top             =   720
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "轨道衡称重管理系统"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C0C000&
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Top             =   120
      Width           =   2895
   End
   Begin VB.Label Label1 
      Caption         =   "密码"
      Height          =   375
      Index           =   1
      Left            =   720
      TabIndex        =   3
      Top             =   1200
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "用户名"
      Height          =   375
      Index           =   0
      Left            =   720
      TabIndex        =   2
      Top             =   720
      Width           =   855
   End
End
Attribute VB_Name = "gdhLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public LoginSucceeded As Boolean
Public LoginCount As Integer

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call LoginSystem
    End If
End Sub

Private Sub Command1_Click()
    Call Text1_KeyPress(13)
End Sub

Private Sub Form_Load()
    Call LoadUsers
    Call setCenter
End Sub

Function setCenter()
    Dim X0 As Long
    Dim Y0 As Long
    X0 = Screen.Width
    Y0 = Screen.Height
    X0 = (X0 - Me.Width) / 2
    Y0 = (Y0 - Me.Height) / 2
    Me.Move X0, Y0
End Function

Function LoadUsers()
    Dim db As New Adodb.Connection
    Dim rs As New Adodb.Recordset
    Dim Query As String
'    On Error GoTo ok
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\admin.mdb;Jet OLEDB:Database Password=dfrwadmin;"
    If db.State <> 1 Then
        Exit Function
    End If
    
    Query = "select * from users order by 创建时间 ASC"
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        Do While Not rs.EOF
            If Not IsNull(rs.Fields("用户名")) Then
            Combo1.AddItem Trim(rs.Fields("用户名"))
            End If
            rs.MoveNext
        Loop
'        Text1.SetFocus
        rs.Close
        db.Close
'        Combo1.text = "dfrw"
    Else
        If MsgBox("您还未注册,请先注册!", vbOKCancel + vbDefaultButton2) = vbOK Then
            Unload Me
            gdhRegister.Show
        Else
            End
        End If
    End If
    
    Exit Function
ok:
    End
End Function

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    Call LoginSystem
End If
End Sub

Function LoginSystem()
    Dim db As New Adodb.Connection
    Dim rs As New Adodb.Recordset
    Dim Query As String
    
    
    If Trim(Combo1.text) = "" Then
        MsgBox "请填写用户名"
        Exit Function
    End If
'    If Trim(Text1.text) = "" Then
'        MsgBox "请填写密码"
'        Exit Function
'    End If
    
    If (Combo1.text = "DFRW" Or Combo1.text = "dfrw") And Text1.text = "" Then
        AdminIF = True
        SuperAdmin = True
        LoginSucceeded = True
        Me.Hide
        GoTo ok
    End If
    
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\admin.mdb;Jet OLEDB:Database Password=dfrwadmin;"
    If db.State <> 1 Then
        Exit Function
    End If
    
    Query = "select * from users where 用户名='" & Trim(Combo1.text) & "' and 密码='" & Trim(Text1.text) & "'"
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    If Not rs.BOF And Not rs.EOF Then
        Usering_Name = Trim(Combo1.text)
        AdminIF = rs.Fields("类型")
        LoginSucceeded = True
        Me.Hide
        GoTo ok
    End If
    LoginCount = LoginCount + 1
    
    If LoginCount > 3 Then
        LoginSucceeded = False
        End
    End If
    MsgBox "用户名或密码错误,请再试一次!"
ok:
End Function