rl_administrator.frm

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

'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Delete_Click()
    On Error GoTo cmd_Delete_Click
    
    '---删除数据函数
    Call Data_Del
    '---表格控件加载
    Call Fr_Mshf
    '---项目初始
    Call Item_Clear
    
    '---设置用户名文本框可编辑
    txt_UserName.Enabled = True
    
    Exit Sub
cmd_Delete_Click:
    MsgBox "cmd_Delete_Click()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'*  cmd_Quit_Click
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub cmd_Quit_Click()
    On Error GoTo cmd_Quit_Click
    
    Unload Me
    
    Exit Sub
cmd_Quit_Click:
    MsgBox "cmd_Quit_Click()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  msh_User_Click 写当前行标记
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Private Sub msh_User_Click()
    On Error GoTo msh_User_Click
    
    txt_UserName.Enabled = False
    
    Dim i As Integer
    
    msh_User.Redraw = False
    
    For i = 0 To msh_User.Rows - 1
        msh_User.TextMatrix(i, 0) = ""               '清除表格控件最左边的选定当前行标志"→"
    Next
    msh_User.TextMatrix(msh_User.RowSel, 0) = " →"  '标出表格控件最左边的选定当前行标志"→"
    msh_User.Redraw = True
    
    C_UserName = ""
    
    C_UserName = msh_User.TextMatrix(msh_User.RowSel, 1)
    
    Call Data_Get
    
    Exit Sub
msh_User_Click:
    MsgBox "msh_User_Click()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  数据查看
'*
'*  [参数]
'*      无
'*  [返回]
'*      实行状况
'*      True：成功
'*      False：失败
'****************************************************************
Private Function Data_Get() As Boolean
    On Error GoTo Data_Get
    
    Data_Get = False
    
    Dim S_UserName As String
    Dim S_SQL      As String
         
    '---选中用户名
    S_UserName = Trim(C_UserName)
            
    Me.MousePointer = vbHourglass
    
    S_SQL = ""
    S_SQL = S_SQL & " SELECT Username,UserPassword,UserGroup,Name,TelNumber,UserRegisterDate,Stop"
    S_SQL = S_SQL & " From T_User"
    S_SQL = S_SQL & " WHERE Username='" & S_UserName & "'"
        
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    '---数据库字段写到窗体控件中
    '[txt_UserName]
    txt_UserName.text = rc("username")
    '[txt_Password]
    txt_Password.text = rc("userPassword")
    '[cbo_UserGroup]
    cbo_UserGroup.text = rc("usergroup")
    '[txt_Name]
    txt_Name.text = rc("name")
    '[txt_TelNumber]
    txt_TelNumber.text = rc("telnumber")
    '[dtp_UserRegisterDate]
    dtp_UserRegisterDate.Value = rc("UserRegisterDate")
    '[chk_Stop]
    chk_Stop.Value = rc("stop")
    
    '---鼠标状态置为正常
    Me.MousePointer = vbDefault
    
    Data_Get = True
    
    Exit Function
Data_Get:
    Me.MousePointer = vbDefault
    MsgBox "Data_Get()---出错", vbCritical, "错误"
    '--- 返回值：异常终了设定
    Data_Get = False
End Function

'***************************************************************
'*  数据插入
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'***************************************************************
Private Function Data_Insert() As Boolean
    On Error GoTo Data_Insert
    
    '---返回值初始设置
    Data_Insert = False
    
    Dim S_SQL              As String
    Dim S_UserName         As String
    Dim S_Password         As String
    Dim S_UserGroup        As String
    Dim S_Name             As String
    Dim S_TelNumber        As String
    Dim S_UserRegisterDate As String
    Dim S_Stop             As String
    
    txt_UserName.Enabled = True
    
    S_UserName = Trim(txt_UserName.text)
    S_Password = Trim(txt_Password.text)
    
    '---鼠标置忙状态
    Me.MousePointer = vbHourglass
    
    '---检测用户名是否已经存在
    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_UserName & "'"
    
    '---执行SQL语句
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    If rc.EOF Then

    Else
        '---用户名已存在执行以下操作
        MsgBox "此用户已存在，请重新输入用户名", , "管理员设置"
        txt_UserName.SetFocus
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    S_UserName = Trim(txt_UserName.text)
    S_Password = Trim(txt_Password.text)
    S_UserGroup = Trim(cbo_UserGroup.text)
    S_Name = Trim(txt_Name.text)
    S_TelNumber = Trim(txt_TelNumber.text)
    S_UserRegisterDate = Trim(dtp_UserRegisterDate.Value)
    S_Stop = Trim(chk_Stop.Value)
    
    '---鼠标置忙状态
    Me.MousePointer = vbHourglass
    
    '---数据插入语句
    S_SQL = ""
    S_SQL = S_SQL & "INSERT INTO T_User("
    S_SQL = S_SQL & "UserName,"
    S_SQL = S_SQL & "UserPassword,"
    S_SQL = S_SQL & "UserGroup,"
    S_SQL = S_SQL & "Name,"
    S_SQL = S_SQL & "TelNumber,"
    S_SQL = S_SQL & "UserRegisterDate,"
    S_SQL = S_SQL & "Stop"
    S_SQL = S_SQL & ")VALUES("
    S_SQL = S_SQL & "'" & S_UserName & "',"
    S_SQL = S_SQL & "'" & S_Password & "',"
    S_SQL = S_SQL & "'" & S_UserGroup & "',"
    S_SQL = S_SQL & "'" & S_Name & "',"
    S_SQL = S_SQL & "'" & S_TelNumber & "',"
    S_SQL = S_SQL & "'" & S_UserRegisterDate & "',"
    S_SQL = S_SQL & "" & S_Stop & ""
    S_SQL = S_SQL & ")"
    
    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定添加数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    '---鼠标置默认状态
    Me.MousePointer = vbDefault
 
    '---正常返回值设置
    Data_Insert = True
    Call Item_Clear '各项目清空
    
    '---将焦点设置到用户名文本框
    txt_UserName.SetFocus
    
    Exit Function
Data_Insert:
    Me.MousePointer = vbDefault
    MsgBox "Data_Insert()---出错", vbCritical, "错误"
    
    '---异常终止设置
    Data_Insert = False
End Function

'****************************************************************
'*  数据修改
'*
'*  [参数]
'*      无
'*  [返回]
'*      实行状况
'*      True：成功
'*      False：失败
'****************************************************************
Private Function Data_Upd() As Boolean
    On Error GoTo Data_Upd
    Data_Upd = False
        
    Dim S_SQL       As String
    Dim S_UserName  As String
    Dim S_Name      As String
    Dim S_TelNumber As String
    Dim S_UserGroup As String
    Dim S_Stop      As String
    
    S_UserName = Trim(txt_UserName.text)
    S_Name = Trim(txt_Name.text)
    S_UserGroup = Trim(cbo_UserGroup.text)
    S_TelNumber = Trim(txt_TelNumber.text)
    S_Stop = chk_Stop.Value
    
    Me.MousePointer = vbHourglass
              
    S_SQL = ""
    S_SQL = S_SQL & " UPDATE T_User SET"
    S_SQL = S_SQL & " UserGroup = '" & S_UserGroup & "',"
    S_SQL = S_SQL & " Name = '" & S_Name & "',"
    S_SQL = S_SQL & " TelNumber= '" & S_TelNumber & "',"
    S_SQL = S_SQL & " Stop=" & S_Stop & ""
    S_SQL = S_SQL & " WHERE UserName='" & S_UserName & "'"
    
    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定修改数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
    
    Me.MousePointer = vbDefault
    
    Call Fr_Mshf
    
    Data_Upd = True
    Exit Function
Data_Upd:
    Me.MousePointer = vbDefault
    MsgBox "Data_Upd()---出错", vbCritical, "错误"
    '--- 返回值：异常终了设定
    Data_Upd = False
End Function

'****************************************************************
'*  数据删除
'*
'*  [参数]
'*      无
'*  [返回]
'*      实行状况
'*      True：成功
'*      False：失败
'****************************************************************
Private Function Data_Del() As Boolean
    On Error GoTo Data_Del
    Data_Del = False
        
    Dim S_SQL      As String
    Dim S_UserName As String
            
    Me.MousePointer = vbHourglass
    
    S_UserName = msh_User.TextMatrix(msh_User.RowSel, 1) '选择当前行的用户名
                
    S_SQL = ""
    S_SQL = S_SQL & "DELETE FROM T_User"
    S_SQL = S_SQL & " WHERE UserName='" & S_UserName & "'"
    
    Dim YesNo As Integer
    
    '---执行SQL语句前确认
    YesNo = MsgBox("确定删除数据吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        '---执行数据插入语句
        Call Cmn_Ado_Execute(S_SQL)
    Else
        Me.MousePointer = vbDefault
        Exit Function
    End If
    
         
    Me.MousePointer = vbDefault
    
    Data_Del = True
    Exit Function
Data_Del:
    Me.MousePointer = vbDefault
    MsgBox "Data_Del()---出错", vbCritical, "错误"
    '--- 返回值：异常终了设定
    Data_Del = 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_Password_GotFocus()---出错", 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

'***************************************************************
'*  txt_Name获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_Name_GotFocus()
    On Error GoTo txt_Name_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_Name)
    
    Exit Sub
txt_Name_GotFocus:
    MsgBox "txt_Name_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_Name失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_Name_LostFocus()
    On Error GoTo txt_Name_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_Name)
    
    Exit Sub
txt_Name_LostFocus:
    MsgBox "txt_Name_LostFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_TelNumber获得焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_TelNumber_GotFocus()
    On Error GoTo txt_TelNumber_GotFocus
    
    Call Cmn_Txt_GotFocus(txt_TelNumber)
    
    Exit Sub
txt_TelNumber_GotFocus:
    MsgBox "txt_TelNumber_GotFocus()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  txt_TelNumber失去焦点
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub txt_TelNumber_LostFocus()
    On Error GoTo txt_TelNumber_LostFocus
    
    Call Cmn_Txt_LostFocus(txt_TelNumber)
    
    Exit Sub
txt_TelNumber_LostFocus:
    MsgBox "txt_TelNumber_LostFocus()---出错", vbCritical, "错误"
End Sub