ihms_login.frm

医院小型HIS信息管理系统

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "欢迎使用智能医院管理系统"
   ClientHeight    =   1920
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   3750
   Icon            =   "IHMS_Login.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1134.399
   ScaleMode       =   0  'User
   ScaleWidth      =   3521.047
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cboUserName 
      Height          =   315
      ItemData        =   "IHMS_Login.frx":6852
      Left            =   1320
      List            =   "IHMS_Login.frx":6854
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   360
      Width           =   2295
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   390
      Left            =   495
      TabIndex        =   4
      Top             =   1260
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   2100
      TabIndex        =   5
      Top             =   1260
      Width           =   1140
   End
   Begin VB.TextBox txtPassword 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1290
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   765
      Width           =   2325
   End
   Begin VB.Data datUsers 
      Caption         =   "IHMS_Users"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   300
      Left            =   120
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   0
      Visible         =   0   'False
      Width           =   3540
   End
   Begin VB.Label lblLabels 
      Caption         =   "您的名称(&U):"
      Height          =   270
      Index           =   0
      Left            =   105
      TabIndex        =   1
      Top             =   390
      Width           =   1080
   End
   Begin VB.Label lblLabels 
      Caption         =   "您的密码(&P):"
      Height          =   270
      Index           =   1
      Left            =   105
      TabIndex        =   2
      Top             =   780
      Width           =   1080
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：06/02/21
'描    述：智能医院管理系统  Version 1.0
'网    站：http://www.mndsoft.com/
'e-mail  ：[e-mail]
'OICQ    ：88382850
'****************************************************************************
Option Explicit

Private Sub cmdCancel_Click()
    'set the global var to false
    'to denote a failed login
    LoginSucceeded = False
    Me.Hide
End Sub

Private Sub cmdOK_Click()
 'check for correct password
 LoginSucceeded = False
 With datUsers.Recordset
    .MoveFirst
    Do While Not .EOF And Not LoginSucceeded
        If (cboUserName = .Fields("user")) And Trim(txtPassword) = .Fields("pass") Then
            'Login authenticated
            MsgBox "登录成功. 欢迎进入系统.", vbInformation, "欢迎"
            LoginSucceeded = True
            Call ConfigMenus(cboUserName)
            Unload Me
        End If
        .MoveNext
    Loop
    If LoginSucceeded = False Then
        MsgBox "登录失败, 请重新登录!", vbExclamation, "失败"
        txtPassword.SetFocus
        SendKeys "{Home}+{End}"
    End If
 End With
End Sub

Private Sub Form_Load()
 datUsers.DatabaseName = App.Path & "\IHMS_97.mdb"
 datUsers.RecordSource = "IHMS_Users"
 datUsers.Refresh
 
 'populate cboUserName
 Dim x As Integer
 With datUsers.Recordset
    .MoveFirst
    x = 0
    Do
        cboUserName.List(x) = .Fields("user")
        .MoveNext
        x = x + 1
    Loop Until .EOF
 End With
End Sub