rl_login.frm

图书管理软件,基本功能已具备

VERSION 5.00
Begin VB.Form RL_Login 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "红杉图书信息管理系统"
   ClientHeight    =   1545
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   3750
   Icon            =   "RL_Login.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   912.837
   ScaleMode       =   0  'User
   ScaleWidth      =   3521.047
   Begin VB.TextBox txt_UserName 
      Height          =   345
      Left            =   1290
      MaxLength       =   10
      TabIndex        =   1
      Top             =   135
      Width           =   2325
   End
   Begin VB.CommandButton cmd_OK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   390
      Left            =   495
      TabIndex        =   4
      Top             =   1020
      Width           =   1140
   End
   Begin VB.CommandButton cmd_Cancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   2100
      TabIndex        =   5
      Top             =   1020
      Width           =   1140
   End
   Begin VB.TextBox txt_Password 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   1290
      MaxLength       =   10
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   525
      Width           =   2325
   End
   Begin VB.Label lbl_AdminName 
      Caption         =   "用户名称(&U)"
      Height          =   270
      Index           =   0
      Left            =   105
      TabIndex        =   0
      Top             =   150
      Width           =   1080
   End
   Begin VB.Label lbl_Password 
      Caption         =   "密码(&P)"
      Height          =   270
      Index           =   1
      Left            =   105
      TabIndex        =   2
      Top             =   540
      Width           =   1080
   End
End
Attribute VB_Name = "RL_Login"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************
'*公司名：华夏学院晨光网络公司
'*系统名：红杉图书信息管理系统
'*程序名：登陆
'*程序ID：RL_Login
'*版本：1.5.3
'*最后修改时间：2005/4/18
'*修改人：cuitianlong
'*
'*-------------------------------------------------------------
'*  [年月日]        [制造者]
'*-------------------------------------------------------------
'*  2005/3/12       cuitianlong
'*
'***************************************************************
Option Explicit

Dim rc As New ADODB.Recordset  '定义记录集

'***************************************************************
'*  窗体加载
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_Load()
    On Error GoTo Form_Load
    
    Me.Caption = App.Title
    '--- 窗体居中设置
    Call Cmn_Form_Center(Me)
    '--- 设置各个控件初始值
    Call Item_Clear
    
    Exit Sub
Form_Load:
    MsgBox "Form_Load()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体退出 [QueryUnload]
'*
'*  [参数]
'*      1：系统参数
'*      2：系统参数
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error GoTo Form_QueryUnload
    
    Exit Sub
Form_QueryUnload:
    MsgBox "Form_QueryUnload()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体卸载 [Unload]
'*
'*  [参数]
'*      1：系统参数
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo Form_Unload
    
    Call Cmn_Ado_DisRecordset(rc) '关闭记录集
    
    Exit Sub
Form_Unload:
    MsgBox "Form_Unload()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体项目清空
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub Item_Clear()
    On Error GoTo Item_Clear
    
    txt_UserName.text = ""
    txt_Password.text = ""
    
    Exit Sub
Item_Clear:
    MsgBox "Item_Clear()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  Form_KeyPress
'*
'*  [参数]
'*      1:系统参数
'*  [返回]
'*      无
'****************************************************************
Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error GoTo Form_KeyPress

    Select Case KeyAscii
    Case vbKeyReturn
        KeyAscii = &H0
        If TypeOf ActiveControl Is CommandButton Then Exit Sub
        
        '--- 焦点移动
        Select Case ActiveControl.hWnd
        Case Else
            SendKeys "{TAB}", True
        End Select
        
    End Select
    
    Exit Sub
Form_KeyPress:
    MsgBox "Form_KeyPress()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  项目检测
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function Item_Check() As Boolean
    On Error GoTo Item_Check
    
    '---返回值初始设置
    Item_Check = False
    Dim S_Check_UserName As String
    Dim S_Check_Password As String
    
    S_Check_UserName = Check_Txt(txt_UserName, 0, 10, "用户名", "系统登陆")
    S_Check_Password = Check_Txt(txt_Password, 0, 10, "密码", "系统登陆")
    
    '[txt_UserName]
    If (False = S_Check_UserName) Then
        txt_UserName.SetFocus
        Exit Function
    End If
    '[txt_Password]
    If (False = S_Check_Password) Then
        txt_Password.SetFocus
        Exit Function
    End If
    
    Item_Check = True
    
    Exit Function
Item_Check:
    MsgBox "Item_Check()---出错", vbCritical, "错误"
End Function

'***************************************************************
'*  cmd_OK_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_OK_Click()
    On Error GoTo cmd_OK_Click
    
    '---项目检测
    If Item_Check() = False Then
        Exit Sub
    End If
    
    Call Data_Get
    
    Exit Sub
cmd_OK_Click:
    MsgBox "cmd_OK_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  cmd_Cancel_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Cancel_Click()
    On Error GoTo cmd_Cancel_Click
    
    '---结束工程
    End
    
    Exit Sub
cmd_Cancel_Click:
    MsgBox "cmd_Cancel_Click()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  数据检测
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'***************************************************************
Private Function Data_Get() As Boolean
    On Error GoTo Data_Get
    
    '---返回值初始设置
    Data_Get = False
    
    Dim S_SQL         As String
    Dim S_txtUsername As String
    Dim S_txtPassword As String
    Dim S_UserGroup   As String
    Dim S_Stop        As String
    
    S_txtUsername = Trim(txt_UserName.text)
    S_txtPassword = Trim(txt_Password.text)
    
    '---鼠标置忙状态
    Me.MousePointer = vbHourglass
    
    '---SQL语句
    S_SQL = ""
    S_SQL = S_SQL & " SELECT UserName,UserPassword,UserGroup,Stop"
    S_SQL = S_SQL & " FROM T_User"
    S_SQL = S_SQL & " WHERE UserName='" & S_txtUsername & "'"
    S_SQL = S_SQL & " AND UserPassword='" & S_txtPassword & "'"
    
    '---执行SQL语句
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    If rc.EOF Then
        MsgBox "用户名或密码不正确", vbInformation, "系统登陆"
        txt_UserName.SetFocus
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    
    S_Stop = rc("Stop") '用户是否停用
    
    If S_Stop = 1 Then
        MsgBox "用户已被停用,请选择其他用户登陆", vbInformation, "系统登陆"
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    S_UserGroup = rc("UserGroup") '读取用户权限
    
    If S_UserGroup = "一般管理员" Then '设置通用变量值
        C_UserGroup = True
    End If
    C_LoginName = rc("username")
    Unload Me
    
    ProgressBar.Show 1
    RL_Main.Show '打开主窗体
    
    '---鼠标置默认状态
    Me.MousePointer = vbDefault
    
    '---正常返回值设置
    Data_Get = True
    
    Exit Function
Data_Get:
    Me.MousePointer = vbDefault
    MsgBox "Data_Get()---出错", vbCritical, "错误"
    
    '---异常终止设置
    Data_Get = False
End Function

'***************************************************************
'*  txt_UserName获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_UserName_GotFocus()
    On Error GoTo txt_UserName_GotFocus

    Call Cmn_Txt_GotFocus(txt_UserName)
    Exit Sub
txt_UserName_GotFocus:
    MsgBox "txt_UserName_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_UserName失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_UserName_LostFocus()
    On Error GoTo txt_UserName_LostFocus

    Call Cmn_Txt_LostFocus(txt_UserName)
    Exit Sub
txt_UserName_LostFocus:
    MsgBox "txt_UserName_LostFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_Password获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_Password_GotFocus()
    On Error GoTo txt_Password_GotFocus

    Call Cmn_Txt_GotFocus(txt_Password)
    Exit Sub
txt_Password_GotFocus:
    MsgBox "txt_UserName_Password()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_Password失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_Password_LostFocus()
    On Error GoTo txt_Password_LostFocus

    Call Cmn_Txt_LostFocus(txt_Password)
    Exit Sub
txt_Password_LostFocus:
    MsgBox "txt_Password_LostFocus()---出错", vbCritical, "错误"
End Sub