ACCESS II: Login Completo Final

 

 

CÓDIGO bas_seguridad_sesión

Option Compare Database
Option Explicit
 
' Variable privada que controla los intentos de login fallidos
Private bytErrLogin As Byte
Public Sub Block_Usuario(intUsuario As Integer)
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
 
Dim strSQL As String
 
    strSQL = "SELECT dbo_Usuarios.Activo " & _
                "FROM dbo_Usuarios " & _
                "WHERE ID_Usuario = " & intUsuario & ";"
                
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
 
    With rst
        
        ' Modificamos el registro
        .Edit
 
        .Fields("Activo").Value = False
 
        ' Actualizamos el registro
        .Update
    
    End With
    
    ' Cerramos el recordset
    rst.Close
    ' Borramos los objetos
    Set rst = Nothing
    Set dbs = Nothing
 
End Sub
 
'Purpose   : Devuelve el número máximo de intentos fallidos de iniciar
'             sesión en la aplicación.
'-------------------------------------------------------------------------
'
Public Function Get_ErrMaxLogin() As Byte
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
 
Dim strSQL As String
 
    strSQL = "SELECT dbo_Opciones.ID_Opcion, " & _
                    "dbo_Opciones.ErrMaxLogin " & _
                "FROM dbo_Opciones " & _
                "WHERE (((dbo_Opciones.ID_Opcion) = 1));"
                
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
    
    With rst
    
        ' Devolvemos 0 por que no hay registros
        If .RecordCount = 0 Then Get_ErrMaxLogin = 0
        
        ' Devolvemos el número máximo de intentos
        Get_ErrMaxLogin = !ErrMaxLogin
    
    End With
    
    ' Cerramos el recordset
    rst.Close
    ' Borramos los objetos
    Set rst = Nothing
    Set dbs = Nothing
 
End Function
'Procedure:  Comprueba_Intentos
' Purpose   : Comprueba los intentos de inicio de sesión fallidos y actúa
'             en consecuencia.
'-------------------------------------------------------------------------
'
Private Sub Comprueba_Intentos(bytErrLogin As Byte, _
                                intUsuario As Integer)
 
    If bytErrLogin = Get_ErrMaxLogin Then
 
        ' Mostramos el mensaje "Se ha superado el número máximo de intentos
        ' de inicio de sesión"
        MsgBox "Se ha superado el número máximo de intentos de " & _
                "inicio de sesión." & _
                vbCrLf & vbCrLf & _
                "Usuario : """ & Me.cbo_Usuario.Column(1) & """." & _
                vbCrLf & vbCrLf & _
                "El usuario ha sido bloqueado.", _
                vbExclamation, "Inicio de sesión"
            
        ' Bloqueamos al usuario
        Call Block_Usuario(intUsuario)
            
        ' Hacemos log del bloqueo del usuario
        Call Log_Sesion(intUsuario, "El usuario ha sido bloqueado.")
        
        With Me
        
            ' Actualizamos el combobox cbo_Usuario
            .cbo_Usuario.Requery
                
            ' Borramos la contraseña
            .txt_Contraseña = ""
                
            ' Ocultamos la etiqueta
            .lbl_Mensaje.Visible = False
      
        End With
      
    End If
            
End Sub
 
 

CÓDIGO bas_sesión

 

Option Compare Database

'---------------------------------------------------------------------
' Procedure : Log_Sesion
' Author : Witigo (Angel Campos Muñoz)
' Date : 22/09/2014
' Purpose : Inserta un registro en la tabla dbo_logs_sesion con los
' datos de la sesión de usuario
'---------------------------------------------------------------------
'
Public Function Log_Sesion(intUsuario As Integer, _
                           strResultado As String, _
                           Optional strContraseña As String = "")
 


 
   Set dbs = CurrentDb()
   Set rst = dbs.OpenRecordset("dbo_logs_sesion")
 
   With rst
 
      ' Agregamos un registro
      .AddNew
 
      ' Especificamos los campos en los que vamos a insertar
      ' los datos relativos a la sesión de usuario.
      .Fields("Fecha").Value = Now()
      .Fields("Terminal").Value = Environ("Computername")
      .Fields("ID_Usuario").Value = intUsuario
      .Fields("Resultado").Value = strResultado
      .Fields("ContraseñaErronea").Value = strContraseña
 
      ' Actualizamos el registro
      .Update
 
   End With
 
   ' Cerramos el recordset
   rst.Close
 
   ' Borramos los objetos
   Set rst = Nothing
   Set dbs = Nothing
 
End Function



CÓDIGO bas_usuarios

 

Option Compare Database
Option Explicit
 
'---------------------------------------------------------------------
' Procedure : Get_Contraseña
' Author    : Witigo (Angel Campos Muñoz)
' Date      : 22/09/2014
' Purpose   : Obtiene la contraseña del usuario pasado como argumento.
'---------------------------------------------------------------------
'
Public Function Get_Contraseña(intUsuario As Integer) As String
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
 
Dim strSQL As String
 
    strSQL = "SELECT dbo_Usuarios.Contraseña " & _
                "FROM dbo_Usuarios " & _
                "WHERE ID_Usuario = " & intUsuario & ";"
 
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
 
Dim strContraseña As String
    
    If rst.RecordCount <> 0 Then
 
        strContraseña = rst!Contraseña
    
    End If
    
    ' Devolvemos la contraseña
    Get_Contraseña = strContraseña
    
    ' Cerramos el recordset
    rst.Close
    
    ' Borramos los objetos
    Set rst = Nothing
    Set dbs = Nothing
 
End Function

'---------------------------------------------------------------------
' Procedure : Comprueba_Usuario
' Author    : Witigo (Angel Campos Muñoz)
' Date      : 22/09/2014
' Purpose   : Controla si se ha seleccionado un usuario del combobox
'             cbo_Usuario
'---------------------------------------------------------------------
'
Private Function Comprueba_Usuario() As Boolean
 
    If IsNull(Me.cbo_Usuario.Value) = True Then
 
        ' Realizamos mensaje sonoro
        Beep
 
        ' Mostramos mensaje en la etiqueta
        Call MensajeEtiqueta("Debe seleccionar un usuario.")
 
        ' Centramos el foco en el textbox
        Me.cbo_Usuario.SetFocus
 
        ' Devolvemos FALSE por que no hay ningún usuario
        ' seleccinado en el combobox...
        Comprueba_Usuario = False
 
    Else
 
        ' Devolvemos TRUE por que SI hay un usuario
        ' seleccionado en el combobox...
        Comprueba_Usuario = True
 
    End If
 
End Function
 

'---------------------------------------------------------------------
' Procedure : Comprueba_Contraseña
' Author    : Witigo (Angel Campos Muñoz)
' Date      : 22/09/2014
' Purpose   : Controla si se ha introducido una contraseña en el
'             textbox txt_Contraseña
'---------------------------------------------------------------------
'
Private Function Comprueba_Contraseña() As Boolean
 
Dim strContraseña As String
 
    strContraseña = Nz(Me.txt_Contraseña, "")
 
    If strContraseña = "" Then
 
        ' Realizamos mensaje sonoro
        Beep
 
        ' Mostramos mensaje en la etiqueta
        Call MensajeEtiqueta("Introduzca una contraseña.")
 
        ' Centramos el foco en el textbox de la contraseña
        Me.txt_Contraseña.SetFocus
 
        ' Devolvemos FALSE, por que no se ha introducido ninguna
        ' contraseña en el textbox...
        Comprueba_Contraseña = False
 
    Else
 
        ' Devolvemos TRUE, por que hay una contraseña introducida,
        ' sea erronea o no...
        Comprueba_Contraseña = True
 
    End If
    
End Function