ACCESS II: Código del Módulo bas_seguridad_Sesion

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