sys_login.frm

小型客户管理系统

VERSION 5.00
Begin VB.Form Sys_Login 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "系统登录"
   ClientHeight    =   3135
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   4095
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3135
   ScaleWidth      =   4095
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2895
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3855
      Begin VB.ComboBox DB_Use 
         Height          =   300
         Left            =   1440
         Style           =   2  'Dropdown List
         TabIndex        =   10
         Top             =   1800
         Width           =   2000
      End
      Begin VB.CommandButton cmdCancel 
         Cancel          =   -1  'True
         Caption         =   "取消"
         Height          =   375
         Left            =   2640
         TabIndex        =   8
         Top             =   2280
         Width           =   800
      End
      Begin VB.CommandButton cmdOK 
         Caption         =   "确认"
         Default         =   -1  'True
         Height          =   375
         Left            =   1800
         TabIndex        =   7
         Top             =   2280
         Width           =   800
      End
      Begin VB.TextBox User_password 
         Height          =   270
         IMEMode         =   3  'DISABLE
         Left            =   1440
         PasswordChar    =   "*"
         TabIndex        =   6
         Text            =   "admin"
         Top             =   1320
         Width           =   2000
      End
      Begin VB.ComboBox User_name 
         Height          =   300
         Left            =   1440
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   840
         Width           =   2000
      End
      Begin VB.ComboBox User_dept 
         Height          =   300
         Left            =   1440
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   360
         Width           =   2000
      End
      Begin VB.Label Label4 
         Caption         =   "使用数据库"
         Height          =   255
         Left            =   360
         TabIndex        =   9
         Top             =   1860
         Width           =   975
      End
      Begin VB.Label Label3 
         Caption         =   "密码"
         Height          =   255
         Left            =   360
         TabIndex        =   3
         Top             =   1360
         Width           =   795
      End
      Begin VB.Label Label2 
         Caption         =   "用户名"
         Height          =   255
         Left            =   360
         TabIndex        =   2
         Top             =   880
         Width           =   795
      End
      Begin VB.Label Label1 
         Caption         =   "所属部门"
         Height          =   255
         Left            =   360
         TabIndex        =   1
         Top             =   400
         Width           =   795
      End
   End
End
Attribute VB_Name = "Sys_Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private UserRs As New ADODB.Recordset
Private TmpDbPath As String
Private Fs As New FileSystemObject

Private Sub cmdCancel_Click()
Unload Me
End
End Sub

Private Sub cmdOK_Click()
If MainDB_Open Then
   MainDB.Close
   MainDB_Open = False
End If


If DB_Use.Text = "本地数据库" Then
   DataBasePath = TmpDbPath
Else
   If Fs.FileExists(App.Path & "\indata\InDB.mdb") Then
      DataBasePath = App.Path & "\indata\InDB.mdb"
   Else
      MsgBox "不存在导入的外部数据库,请检查", vbExclamation, "警告"
      Exit Sub
   End If
End If

'程序一起动就打开数据库
Set MainDB = New ADODB.Connection
MainDB.CursorLocation = adUseClient
MainDB.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DataBasePath & ""
MainDB_Open = True

Set UserRs = Nothing
UserRs.Open "select * from User_BASE where 部门名称='" & User_dept.Text & "' and 用户名='" & User_name.Text & "' and 密码='" & User_password.Text & "'", SysLogDB, adOpenStatic, adLockOptimistic
If UserRs.RecordCount = 1 Then
   UserDept = User_dept.Text
   UserName = User_name.Text
   UseDataBase = DB_Use.Text
   Unload Me
   
   MDIForm1.Show
Else
   MsgBox "用户名或密码不正确", vbExclamation, "警告"
End If
End Sub

Private Sub Form_Load()
DB_Use.AddItem "本地数据库"
DB_Use.AddItem "导入数据库"
DB_Use.ListIndex = 0

User_dept.Clear
User_name.Clear
TmpDbPath = DataBasePath

'程序一起动就打开系统数据库
If Fs.FileExists(App.Path & "\Sys_LogDB.mdb") Then
   Set SysLogDB = New ADODB.Connection
   SysLogDB.CursorLocation = adUseClient
   SysLogDB.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & "\Sys_LogDB.mdb" & ""
   SysLogDB_Open = True
   Set UserRs = Nothing
   UserRs.Open "select 部门名称 from User_BASE group by 部门名称", SysLogDB, adOpenStatic, adLockOptimistic
   If UserRs.RecordCount <> 0 Then
      UserRs.MoveFirst
      While Not UserRs.EOF
            User_dept.AddItem UserRs!部门名称
            UserRs.MoveNext
      Wend
   End If
Else
   MsgBox "丢失系统数据文件,程序结束", vbExclamation, "警告"
   If SysLogDB_Open Then
      SysLogDB.Close
      SysLogDB_Open = False
   End If
   End
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
If MainDB_Open Then
   'MainDB.Close
End If
End Sub


Private Sub User_dept_Click()
User_name.Clear
Set UserRs = Nothing
UserRs.Open "select * from User_BASE where 部门名称='" & User_dept.Text & "'", SysLogDB, adOpenStatic, adLockOptimistic
If UserRs.RecordCount <> 0 Then
   UserRs.MoveFirst
   While Not UserRs.EOF
         User_name.AddItem UserRs!用户名
         UserRs.MoveNext
   Wend
End If
End Sub