main_mima.frm

宾馆客房管理系统

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Begin VB.Form main_mima 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "酒店客房管理系统"
   ClientHeight    =   2700
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5490
   Icon            =   "main_mima.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2700
   ScaleWidth      =   5490
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Height          =   1215
      Left            =   2160
      TabIndex        =   2
      Top             =   705
      Width           =   3105
      Begin MSDataListLib.DataCombo Dcomczy 
         Height          =   330
         Left            =   960
         TabIndex        =   6
         Top             =   240
         Width           =   2055
         _ExtentX        =   3625
         _ExtentY        =   582
         _Version        =   393216
         Text            =   ""
      End
      Begin VB.TextBox txtpwd 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   315
         IMEMode         =   3  'DISABLE
         Left            =   1005
         MaxLength       =   6
         PasswordChar    =   "*"
         TabIndex        =   3
         Top             =   705
         Width           =   1920
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "操作员： "
         BeginProperty Font 
            Name            =   "黑体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   405
         Left            =   120
         TabIndex        =   5
         Top             =   255
         Width           =   1095
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "密  码：       "
         BeginProperty Font 
            Name            =   "黑体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   4
         Top             =   735
         Width           =   975
      End
   End
   Begin VB.CommandButton cmdquit 
      BackColor       =   &H00FF8080&
      Caption         =   "退出"
      Height          =   400
      Left            =   3720
      TabIndex        =   1
      Top             =   2145
      Width           =   1365
   End
   Begin VB.CommandButton cmdok 
      BackColor       =   &H00FF8080&
      Caption         =   "确定"
      Height          =   400
      Left            =   2355
      TabIndex        =   0
      Top             =   2145
      UseMaskColor    =   -1  'True
      Width           =   1365
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "酒店客房管理系统"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   24
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFC0&
      Height          =   495
      Left            =   720
      TabIndex        =   7
      Top             =   120
      Width           =   4335
   End
   Begin VB.Shape Shape1 
      Height          =   1830
      Left            =   150
      Top             =   705
      Width           =   1830
   End
   Begin VB.Image Image1 
      Height          =   1800
      Left            =   150
      Picture         =   "main_mima.frx":000C
      Stretch         =   -1  'True
      Top             =   720
      Width           =   1830
   End
End
Attribute VB_Name = "main_mima"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'强制变量说明
Option Explicit
'定义数据库连接对象
Dim DBcnn As New ADODB.Connection
'定义数据库中对应于系统用户(qxsz)表的数据集对象
Dim DBrs1 As New ADODB.Recordset
Dim DBrs2 As New ADODB.Recordset
'定义存储sql语句的字符串变量
Dim sqlstr As String
 '定义一个整型变量
 Dim TIM As Integer
 '定义一个字符串变量
 Dim myval As String
Private Sub Form_Load()
 '判断当前数据库连接对象的状态，如果未连接到数据库KFGL，则连接到数据库KFGL
 If DBcnn.State = 0 Then
    Dim connectstr As String
    connectstr = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & _
               App.Path & "\KFGL.mdb;Persist Security Info=False"
    DBcnn.CursorLocation = adUseClient
    DBcnn.Open connectstr
 End If
'判断数据集对象DBrs1和DBrs2的状态，如果是打开状态，则先关闭，
'以防止出现重复打开数据集对象的错误
 If DBrs1.State = 1 Then
    DBrs1.Close
 End If
 If DBrs2.State = 1 Then
    DBrs2.Close
 End If
 '设置并执行SQL语句并返回相应的数据集
 sqlstr = "select * from qxsz"
 DBrs1.Open sqlstr, DBcnn, adOpenStatic, adLockBatchOptimistic
 DBrs2.Open sqlstr, DBcnn, adOpenDynamic, adLockBatchOptimistic
 '设置与操作员信息对应的DataCombo组合框的数据填充字段来源
 Set Dcomczy.RowSource = DBrs1
 Dcomczy.ListField = DBrs1.Fields("操作员").Name
End Sub
Private Sub Form_Activate()
'当记录为零时，进入系统具有所有权限
 If DBrs1.RecordCount = 0 Then
  MsgBox ("请先设置操作员密码和权限！")
  Load main
  main.Show
  Unload Me
 Else
  Dcomczy.SetFocus
 End If
End Sub
Private Sub Dcomczy_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then Dcomczy.SetFocus     '按回车键，txtczy获得焦点
End Sub
Private Sub txtczy_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then cmdok.SetFocus     '按回车键cmdok获得焦点
If KeyCode = vbKeyUp Then Dcomczy.SetFocus
If KeyCode = vbKeyDown Then cmdok.SetFocus
End Sub
Private Sub cmdok_Click()
 'main.StatusBar1.Panels(4).Text = Dcomczy.Text     '赋值给main.StatusBar1.Panels(4).Text
 '判断当前数据集对象DBrs2的记录位置是否在尾部,如果在则移到记录集首部
 If DBrs2.BOF = False Then
   DBrs2.MoveFirst
 End If
 '设置数据集对象DBrs2的Filter属性，以找到用户输入或选择的系统用户名
 sqlstr = "操作员 like '" & Dcomczy.BoundText & "'"
 DBrs2.Filter = sqlstr
 '判断是否存在用户输入或选择的系统用户名
 If DBrs2.EOF Then
   '不存在用户输入或选择的系统用户名，给出错误提示
  MsgBox ("操作员输入错误!")
 Else
  '存在用户输入或选择的系统用户名，判断用户输入的密码是否正确
  sqlstr = "操作员='" & Dcomczy.BoundText & "'"
  DBrs1.Filter = sqlstr
  If Dcomczy.BoundText <> "" And Dcomczy.Text <> "" _
     And txtpwd.Text = DBrs1.Fields("密码") Then
    main.loginname = Dcomczy.Text
    Load main
    main.Show
    Unload Me
  Else
   '判断用户输入错误密码的次数是否超过3次
   If TIM = 3 Then
     '密码输错3次，退出该系统
     myval = MsgBox("密码输入错误,请向系统管理员查询!", 0, "")
     If myval = vbOK Then
       End
     End If
   End If
   If Dcomczy.BoundText = "" Then
     MsgBox ("请输入操作员!")
     Dcomczy.SetFocus
    Else
     If Dcomczy.BoundText <> DBrs1.Fields("操作员") Then
       MsgBox ("查无此操作员,请重新输入操作员!")
       Dcomczy.SetFocus
     Else
      '判断用户是否输入密码
      If txtpwd.Text = "" Then
        '用户没有输入密码，给出错误提示
        MsgBox ("请输入操作员密码!")
        txtpwd.SetFocus
      Else
         '判断用户是否输入正确的密码
        If txtpwd.Text <> DBrs1.Fields("密码") Then
           '用户输入错误的密码，给出错误提示
          MsgBox ("密码错误,请重新输入密码!")
          TIM = TIM + 1
          txtpwd.SetFocus
        End If
       End If
     End If
   End If
 End If
End If
End Sub
Private Sub cmdquit_Click()
  End
End Sub