frmlogin.frm

计算机CAD图纸管理和预览

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form DlgLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "登陆"
   ClientHeight    =   2580
   ClientLeft      =   3630
   ClientTop       =   2355
   ClientWidth     =   4575
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1524.349
   ScaleMode       =   0  'User
   ScaleWidth      =   4295.677
   ShowInTaskbar   =   0   'False
   Begin MSDataListLib.DataCombo txtUserName 
      Height          =   330
      Left            =   1440
      TabIndex        =   5
      Top             =   840
      Width           =   1815
      _ExtentX        =   3201
      _ExtentY        =   582
      _Version        =   393216
      BackColor       =   16777152
      Text            =   ""
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   420
      Left            =   3240
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2040
      Width           =   1095
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   420
      Left            =   1920
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2040
      Width           =   1095
   End
   Begin VB.TextBox txtPassword 
      BackColor       =   &H00FFFFC0&
      Height          =   288
      IMEMode         =   3  'DISABLE
      Left            =   1440
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   1320
      Width           =   1845
   End
   Begin VB.Image Image1 
      Height          =   720
      Left            =   3480
      Picture         =   "frmLogin.frx":08CA
      Top             =   840
      Width           =   720
   End
   Begin VB.Line Line5 
      X1              =   4168.919
      X2              =   4168.919
      Y1              =   354.5
      Y2              =   1063.499
   End
   Begin VB.Line Line4 
      X1              =   3605.552
      X2              =   4168.919
      Y1              =   354.5
      Y2              =   354.5
   End
   Begin VB.Line Line3 
      X1              =   112.673
      X2              =   4168.919
      Y1              =   1063.499
      Y2              =   1063.499
   End
   Begin VB.Line Line2 
      X1              =   112.673
      X2              =   112.673
      Y1              =   354.5
      Y2              =   1063.499
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00000000&
      X1              =   112.673
      X2              =   3718.225
      Y1              =   354.5
      Y2              =   354.5
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "密码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   180
      Index           =   3
      Left            =   240
      TabIndex        =   2
      Top             =   1320
      Width           =   600
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "用户名："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   180
      Index           =   2
      Left            =   240
      TabIndex        =   1
      Top             =   960
      Width           =   795
   End
End
Attribute VB_Name = "DlgLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public LoginSucceeded As Boolean


Private Sub cmdCancel_Click()
    LoginSucceeded = False
    Unload Me
    Unload frmSplash
End Sub

Private Sub cmdOK_Click()

On Error GoTo errh:
    Dim rs As New ADODB.Recordset
    Set rs = New ADODB.Recordset
    Set rs = cn.Execute("SELECT UserName , Password  FROM 技术人员 ")
    If rs.EOF Then
        rs.Close
        Set rs = Nothing
        Unload Me
        Exit Sub
    End If
    rs.MoveFirst
    loginuser = txtUserName.Text
    Dim i As Integer
    '校验是否为超级用户
    Do
        If rs.Fields("UserName") = txtUserName.Text Then
            If rs.Fields("Password") = txtPassword.Text Then
                UserType = True
                LoginSucceeded = True
                rs.Close
                If txtPassword.Text = "Admin" Then IsAdmin = True
                Unload Me
                Load 主菜单
                Unload frmSplash
                Exit Sub
                Exit Do
            End If
        End If
        rs.MoveNext
    Loop Until rs.EOF
    '校验是否为普通用户
    Set rs = cn.Execute("SELECT Username FROM 普通人员 WHERE Username =" & "'" & txtUserName.Text & "'")
    If rs.EOF Then
        MsgBox "无效密码或用户名请重试!", , "Login"
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    Else
        rs.Close
        UserType = False
        LoginSucceeded = True
        Unload Me
        Load 主菜单
        Unload frmSplash
    End If
    
    Exit Sub
errh:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    Dim s As String
    Dim strsql As String
    MakeCenter DlgLogin
    s = MakeConnection()       '创建ADO连接
    If s <> "OK" Then
        MsgBox s, , "数据库连接失败！"
        Unload Me
        Unload frmSplash
        LoginSucceeded = False
    End If
    'Set rctOperatorList = cn.Execute("select * from 技术人员")
    strsql = "select * from 技术人员"
    Call rctOperatorList.open(strsql, cn, adOpenKeyset, adLockOptimistic, -1)
    
    Set txtUserName.RowSource = rctOperatorList
    txtUserName.BoundColumn = "UseID"
    txtUserName.ListField = "UserName"
    txtUserName.BoundText = "16"
   
End Sub
Private Sub txtPassword_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    
    
    If KeyAscii = 13 Then cmdOK_Click
    
End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    
    
    If KeyAscii = 13 Then txtPassword.SetFocus
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    rctOperatorList.Close
    If Not LoginSucceeded Then '如果登陆失败
        cn.Close '释放连接
        Set cn = Nothing
    End If
End Sub