Desconexión pasiva de usuarios en bases de datos Access
En los anteriores artículos Información de usuarios conectados (NetWkstaUserEnum y NetUserGetInfo) y Usuarios conectados a base de datos Access (User Roster) habíamos llegado a crear un Administrador de usuarios Access que nos proporcionaba la información de los usuarios que teníamos conectados a una base de datos que nosotros le pasábamos. Los datos que nos mostraba eran los siguientes:
- Hora: Hora de la monitorización
- BD: Usuario de base de datos (para versiones 2007 o posteriores siempre Admin)
- Equipo: Equipo de la red desde el que conecta
- Usuario Windows: Usuario de de la red de Active Directory o de red
- Nombre completo: Nombre completo de Active Directory o de red
- Dominio: Dominio de Active Directory o de red
- Servidor: Servidor al que conecta cada usuario
- Estado de la conexión (conectado/no conectado)
- Cierre forzado (si/no) Base de datos cerrada de forma no habitual
Como decía en el anterior artículo, con esto podría ser suficiente para informar a los usuarios conectados de nuestra intención realizar modificaciones en la base de datos y pedirles que salieran de sus aplicaciones. Pero como todos los desarrolladores sabemos, siempre queda algún usuario conectado que no podemos localizar o que hace caso omiso de nuestras peticiones.
Para solventar este problema, en este artículo voy a explicar el primer tipo de desconexión que tendrá la aplicación de Administración de usuarios, la desconexión pasiva.
Desconexión pasiva
Aunque lo llamemos desconexión pasiva, realmente no se desconecta a los usuarios, simplemente no se les deja volver a conectar. Este tipo de desconexión se suele utilizar al final de la jornada de trabajo, impidiendo así que los usuarios se conecten al empezar la jornada siguiente.
Al igual que en el resto de artículos sobre el Administrador de usuarios, voy a explicar un poco por encima el código que he tenido que modificar para que funciones la desconexión y los problemas que me he encontrado. Os aconsejo que reviséis los anteriores artículos (Información de usuarios conectados (NetWkstaUserEnum y NetUserGetInfo) y Usuarios conectados a base de datos Access (User Roster)) para más información.
Necesitaremos de nuevo los 2 módulos que utilizamos en el anterior artículo, pero esta vez modificaremos el módulo conexiones para que permita la desconexión pasiva. Para ello, necesitaremos declarar la conexión como pública para que siga activa una vez salgamos de la función en la que la abrimos (conexión persistente). Aquí es donde he tenido la mayoría de los problemas.
Empezamos haciendo pública la conexión en la sección de declaraciones de nuestro módulo:
Option Compare Database Option Explicit Public Conexion As New ADODB.Connection 'Para crear la conexión. Tengo que utilizar ADO, aunque no me guste. Lo hago público para que sea persistente (desconexión pasiva)
En otros ejemplos de desconexión pasiva de usuarios he visto que declaran tanto las conexiones como los recordsets como objetos, pero de momento no veo la utilidad de hacerlo, a mí me funciona perfectamente de esta forma.
Una vez declarada la conexión, tenemos que asignarle las propiedades que nos interesan tal y como hacíamos en la anterior versión, pero tenemos que asegurarnos de que no hayamos abierto ya la conexión (permanecerá abierta mientras tengamos activa la aplicación) utilizando la propiedad «state» de las conexiones ADO. Veamos cómo implementarlo:
If Conexion.state = 0 Then
Conexion.Provider = CurrentProject.Connection.Provider 'Por si acaso asignamos el proveedor aunque se supone que será Microsoft ACE OLEDB 12.0
If Len(Trim(Contraseña)) > 0 Then 'Si el usuario mete la contraseña. Si no tiene contraseña funciona bien aunque metas
Conexion.Properties("Jet OLEDB:Database Password") = Contraseña
End If
Conexion.Open "Data Source=" & Fichero
End If
Por supuesto, si seleccionamos un backend nuevo, también tendremos que volver a crear la conexión. Una posible idea es cerrarla al seleccionar el fichero (si no sabéis como crear un filedialog, estaré encantado de contestaros en los comentarios) de la siguiente manera:
If Not Conexion Is Nothing Then
If Conexion.state = 1 Then
Conexion.Close 'Cerramos la conexión. 1 es adStateOpen
End If
Set Conexion = Nothing
End If
Y ahora vamos a establecer la propiedad que hará que se active la desconexión pasiva (he modificado la función principal para que además de recibir el fichero de base de datos y la contraseña, reciba otro parámetro booleano que controle esta propiedad):
Public Function Usuarios_Conectados(ByVal Fichero As String, ByVal Contraseña As String, ByVal Opcion As Boolean)
Y establecemos la propiedad:
'Desconexión pasiva, conectamos y desconectamos
If Opcion = True Then
Conexion.Properties("Jet OLEDB:Connection Control") = 1 'Impedimos que se conecten nuevos usuarios
Else
Conexion.Properties("Jet OLEDB:Connection Control") = 2 'Se permiten las nuevas conexiones
End If
El resto del código debería de ser igual que en la anterior versión, pero hay un problema a la hora de abrir el esquema, que por cierto me hizo perder varias horas. En la anterior versión abríamos el esquema User Roster de la siguiente manera:
Set rsConexiones = Conexion.OpenSchema(schema:=adSchemaProviderSpecific, schemaID:=schemaID) ' Conexión sacada de la web de Microsoft
Declarando la variable schemaID anteriormente:
Dim schemaID As String
'**********************************************************************
'En nuestro caso utilizamos JET_SCHEMA_USERROSTER -> {947bb102-5d43-11d1-bdbf-00c04fb92675}
schemaID = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
'**********************************************************************
Pues bien, de esta forma no funciona siempre (no me preguntéis el motivo) así que después de mucho investigar donde estaba el error, he encontrado esta otra forma de abrirlo que parece que funciona siempre:
Set rsConexiones = Conexion.OpenSchema(adSchemaProviderSpecific, , schemaID) ' Conexión sacada de la web de Microsoft. NO tira con a veces la variable... locura para encontrarlo
'Set rsConexiones = Conexion.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")'Parece que al final funciona la de arriba...
Edito: Parece que finalmente funciona con la versión inicial. Me parece más clara así que la dejo como al principio.
Y con esto ya tenemos la versión de nuestro administrador de usuarios modificada para que permita desconexión pasiva de usuarios. Ahora bastará con llamar a la función Usuarios_Conectados con el tercer parámetro con el valor «TRUE» para que nuestra aplicación empiece con la desconexión pasiva de usuarios.
Tendremos que mantener la aplicación abierta para que se mantenga nuestra desconexión pasiva ya que al cerrarla se pierde la conexión persistente. Así y todo, no estaría de más cerrarla por código al cerrar el formulario:
If Not Conexion Is Nothing Then
If Conexion.state = 1 Then
Conexion.Close 'Cerramos la conexión. 1 es adStateOpen
End If
Set Conexion = Nothing
End If
Aquí os paso los 2 módulos ya implementados, recordad que necesitamos tener una tabla llamada CONEXIONES y llamar a la función pasándole la ruta del fichero, la contraseña (si es necesario) y TRUE/FALSE para activar/desactivar la desconexión pasiva.
Módulo Conexiones
'*************************************************************************************************************************************
'Autor: Arkaitz Arteaga
'Más artículos: www.programadordepalo.com
'Mail de contacto: admin@programadordepalo.com
'Fecha: Enero 2014
'Version: 1.0
'*************************************************************************************************************************************
'Sacado de la web de Microsoft (necesario Microsoft ActiveX Data Objects 2.x Library)
' Para abrir connection.OpenSchema(querytype, criteria, schemaID)
' schemaID -> Hay diferentes tipos, en este caso utilizaremos JET_SCHEMA_USERROSTER -> {947bb102-5d43-11d1-bdbf-00c04fb92675}
'-Nombre del equipo que está utilizando el usuario.
'-Nombre de seguridad, es decir, el identificador de usuario. Siempre va a ser 'admin' a partir de 2007
'-Si el usuario está actualmente conectado a la base de datos.
'-Si la conexión del usuario se terminó con normalidad.
'
'*************************************************************************************************************************************
'*************************************************************************************************************************************
'Copyright: Por favor, no cuesta nada mantener un enlace a mi web en el código.
'Incluso pudes dejar los formularios tal cual, con un enlace a mi web.
'Si vas a utilizar este código con fines lucrativos (es decir, te van a pagar por ello) contacta conmigo por favor.
'*************************************************************************************************************************************
Option Compare Database
Option Explicit
Public Const VERSION As String = "2.2"
Public Conexion As New ADODB.Connection 'Para crear la conexión. Tengo que utilizar ADO, aunque no me guste. Lo hago público para que sea persistente (desconexión pasiva)
Public horaConectado As String 'Hora de la conexión recurrente
Public Function Usuarios_Conectados(ByVal Fichero As String, ByVal Contraseña As String, ByVal Opcion As Boolean)
On Error GoTo AlgoPasa
'Dim Conexion As New ADODB.Connection 'Sin conexión persistente se puede hacer desde aqui
Dim rsConexiones As New ADODB.Recordset 'Para la tabla que tendrá las conexiones
Dim rsConectados As DAO.Recordset 'Para la tabla local que tendrá los usuarios conectados. Ya lo sabéis, no me gusta ADO, ;)
Dim MiBD As DAO.Database 'Muchos criticaréis esta forma, pero así utilizamos ADO y DAO de manera que los no iniciados aprendan
Dim datosWin As USUARIO_FINAL 'Guardo los datos que devuelve la función UsuarioWindows
Dim schemaID As String
'**********************************************************************
'En nuestro caso utilizamos JET_SCHEMA_USERROSTER -> {947bb102-5d43-11d1-bdbf-00c04fb92675}
schemaID = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
'**********************************************************************
If Conexion.state = 0 Then
Conexion.Provider = CurrentProject.Connection.Provider 'Por si acaso asignamos el proveedor aunque se supone que será Microsoft ACE OLEDB 12.0
If Len(Trim(Contraseña)) > 0 Then 'Si el usuario mete la contraseña. Si no tiene contraseña funciona bien aunque metas
Conexion.Properties("Jet OLEDB:Database Password") = Contraseña
End If
Conexion.Open "Data Source=" & Fichero
End If
'Desconexión pasiva, conectamos y desconectamos
If Opcion = True Then
Conexion.Properties("Jet OLEDB:Connection Control") = 1 'Impedimos que se conecten nuevos usuarios
Else
Conexion.Properties("Jet OLEDB:Connection Control") = 2 'Se permiten las nuevas conexiones
End If
Set rsConexiones = Conexion.OpenSchema(adSchemaProviderSpecific, , schemaID) ' Conexión sacada de la web de Microsoft. NO tira con a veces la variable... locura para encontrarlo
'Set rsConexiones = Conexion.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")'Parece que al final funciona la de arriba...
Set MiBD = CurrentDb
CurrentDb.Execute "DELETE * FROM CONEXIONES", dbFailOnError 'Vamos a borrar las conexiones anteriores
Set rsConectados = MiBD.OpenRecordset("CONEXIONES")
While rsConexiones.EOF = False
rsConectados.AddNew
rsConectados("HORA") = Now
rsConectados("USUARIO") = Trim(rsConexiones!LOGIN_NAME)
rsConectados("EQUIPO") = Trim(rsConexiones!COMPUTER_NAME)
rsConectados("CONECTADO") = rsConexiones!CONNECTED
rsConectados("ESTADO") = Trim(rsConexiones!SUSPECT_STATE)
datosWin = UsuarioWindows(rsConectados("EQUIPO")) 'Llamo a la función UsuarioWindows para cada usuario
rsConectados("USUARIO_WINDOWS") = datosWin.info_usuario
rsConectados("NOMBRE_COMPLETO") = datosWin.info_completo
rsConectados("DOMINIO") = datosWin.info_dominio
rsConectados("SERVIDOR") = datosWin.info_servidor
rsConectados.Update
rsConexiones.MoveNext
Wend
rsConectados.Close
Set rsConectados = Nothing
rsConexiones.Close
Set rsConexiones = Nothing
Exit Function
AlgoPasa:
MsgBox ("Error al comprobar las conexiones de usuarios. " & Err.Description), vbCritical, "Error al comprobar las conexiones"
End Function
Módulo redWindows
'*************************************************************************************************************************************
'Autor: Arkaitz Arteaga
'Más artículos: www.programadordepalo.com
'Mail de contacto: admin@programadordepalo.com
'Fecha: Enero 2014
'Version: 1.0
'*************************************************************************************************************************************
'Módulo para mostrar el usuario de Windows. Basado en http://msdn.microsoft.com/en-us/library/windows/desktop/aa370669%28v=vs.85%29.aspx
'De aqui la información de cada usuario http://msdn.microsoft.com/en-us/library/bb706729.aspx y http://support.microsoft.com/kb/151774/es
'OJO, he tenido problemas con las conversiones. Al final pasando a NetUserGetInfo los valores de servidor y de usuario remoto con arrays de bytes funciona.
'También había problemas ya que estaba pasando el equipo remoto en vez del servidor de base de datos de cada usuario
'
'*************************************************************************************************************************************
'*************************************************************************************************************************************
'Copyright: Por favor, no cuesta nada mantener un enlace a mi web en el código.
'Incluso pudes dejar los formularios tal cual, con un enlace a mi web.
'Si vas a utilizar este código con fines lucrativos (es decir, te van a pagar por ello) contacta conmigo por favor.
'*************************************************************************************************************************************
Option Compare Database
Option Explicit
'*************************************************************************************************************************************
'Traduzco que me aclaro mejor
'*************************************************************************************************************************************
Private Const NO_HAY_ERROR As Long = 0& 'Lo ponemos a 0. Se utiliza para comprobar luego que no hay errores
Private Const LONGITUD_PREFERIDA As Long = -1 'Buscando en la web de Microsfot "A constant of type DWORD that is set to –1"
Private Const MAS_DATOS As Long = 234&
Private Type usuario
info_usuario As Long 'Usuario actualmente logeado en esa máquina
info_dominio As Long 'Dominio al que se ha logeado el usuario
info_otros As Long 'En nuestro caso null
info_servidor As Long 'Servidor donde se autenticó el usuario. Muy importante para luego utilizar NetUserGetInfo
End Type
'En este guardo lo que me devuelve NetWkstaUserEnum y NetUserGetInfo, y luego lo devuelvo con la función. Lo hago público para poder dar de alta al llamar
Public Type USUARIO_FINAL
info_usuario As String
info_dominio As String
info_otros As String 'En nuestro caso null
info_servidor As String
'info_comentario As String 'No veo más campos con información, tal vez en otros tipos de redes...
info_completo As String 'Aqui guardo el nombre completo que devuelve NetUserGetInfo
End Type
'Lo mismo para sacar NetUserGetInfo*********Al fin parece que funciona, le estaba pasando el equipo remoto y no el servidor. Le paso level 10
Private Type INFORMACION_USUARIO
info_nombre As Long 'Aqui sale el nombre de usuario
info_ucomentario As Long
info_comentario As Long
info_completo As Long 'Aqui sale el nombre completo
End Type
Private Type INFORMACION_USUARIO_FINAL
info_nombre As String
info_ucomentario As String
info_comentario As String
info_completo As String
End Type
'***********************************************************************************
'Copio tal cual de las declaraciones de Microsoft para la función NetWkstaUserEnum
'***********************************************************************************
Private Declare Function NetWkstaUserEnum Lib "netapi32" _
(ByVal equipo As Long, _
ByVal nivel As Long, _
buffer As Long, _
ByVal longitudp As Long, _
entradasLeidas As Long, _
entradasTotales As Long, _
reanudar As Long) As Long
'***********************************************************************************
'Me daba problemas pasando strings como aparece en la web de Microsoft, tal vez convirtiendo a UNICODE hubiera funcionado.
'Queda por probar hacerlo con strings. Con bytes no hay problema
'***********************************************************************************
Private Declare Function NetUserGetInfo Lib "netapi32" _
(servidor As Byte, _
usuario As Byte, _
ByVal nivel As Integer, _
buffer As Long) As Integer
'***********************************************************************************
'Las copio tal cual de otros ejemplos
'***********************************************************************************
Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal buffer As Long) As Long
Private Declare Sub CopyMemory Lib "Kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, _
ByVal lSize As Long)
Private Declare Function lstrlenW Lib "Kernel32" _
(ByVal lpString As Long) As Long
'***********************************************************************************
'***********************************************************************************
Function UsuarioWindows(NombreEquipo As String) As USUARIO_FINAL
Dim dservidor As Long
Dim entraLeidas As Long
Dim entraTotales As Long
Dim entraReanuda As Long
Dim estado As Long
Dim bufNet As Long
Dim tamaStruct As Long
Dim servidor As String
Dim info1 As usuario
Dim pasaInfo As USUARIO_FINAL
Dim usuInfo As INFORMACION_USUARIO_FINAL
Dim bservidor() As Byte
Dim busuario() As Byte
On Error GoTo algo_pasa
'NombreEquipo = Trim(NombreEquipo) 'No lo quita, será así.
servidor = "\\" & NombreEquipo & vbNullString
dservidor = StrPtr(servidor) 'StrPtr - devuelve la dirección del búfer de cadena UNICODE.
estado = NetWkstaUserEnum(dservidor, _
1, _
bufNet, _
LONGITUD_PREFERIDA, _
entraLeidas, _
entraTotales, _
entraReanuda)
If estado = NO_HAY_ERROR Or _
estado = MAS_DATOS Then
If entraLeidas > 0 Then
tamaStruct = LenB(info1)
CopyMemory info1, ByVal bufNet, tamaStruct
UsuarioWindows.info_usuario = Trim(PasaLoString(info1.info_usuario)) 'Trim por si acaso, aunque no mete mucha historia
UsuarioWindows.info_dominio = Trim(PasaLoString(info1.info_dominio))
UsuarioWindows.info_servidor = Trim(PasaLoString(info1.info_servidor))
bservidor = UsuarioWindows.info_servidor & Chr$(0) 'Convertimos
busuario = UsuarioWindows.info_usuario & Chr$(0)
'************************************************************************************
'No me funciona.... Pues ahora parece que si, le estaba pasando el equipo remoto en vez del servidor
usuInfo = UsuarioWindowsInformacion(bservidor(), busuario())
'************************************************************************************
UsuarioWindows.info_completo = usuInfo.info_completo
Else:
UsuarioWindows.info_usuario = "Posible maquina Win98"
End If
Else:
UsuarioWindows.info_usuario = "Error"
End If
Call NetApiBufferFree(bufNet)
Exit Function
algo_pasa:
MsgBox ("Error al revisar las conexiones a la base de datos" & Err.Description), vbCritical, "Error al revisar las conexiones"
End Function
Private Function UsuarioWindowsInformacion(eServidor() As Byte, eUsuario() As Byte) As INFORMACION_USUARIO_FINAL
'******************************************************
'Modificado de aqui
'http://msdn.microsoft.com/en-us/library/bb706729.aspx
'******************************************************
Dim usuario As INFORMACION_USUARIO
Dim buff As Long
On Error GoTo algo_pasa
If NetUserGetInfo(eServidor(0), eUsuario(0), 10, buff) = NO_HAY_ERROR Then 'es 10 -> Return user and account names and comments. The bufptr parameter points to a USER_INFO_10 structure.
CopyMemory usuario, ByVal buff, Len(usuario)
UsuarioWindowsInformacion.info_nombre = Trim(PasaLoString(usuario.info_nombre))
UsuarioWindowsInformacion.info_completo = Trim(PasaLoString(usuario.info_completo))
UsuarioWindowsInformacion.info_comentario = Trim(PasaLoString(usuario.info_comentario))
UsuarioWindowsInformacion.info_ucomentario = Trim(PasaLoString(usuario.info_ucomentario))
NetApiBufferFree buff
End If
Exit Function
algo_pasa:
MsgBox ("Error al revisar el usuario Windows" & Err.Description), vbCritical, "Error al revisar las conexiones"
End Function
Private Function PasaLoString(ByVal loPasa As Long) As String
''******************************************************
'Tal cual de la web de Microsoft
''******************************************************
Dim tmp() As Byte
Dim tmplon As Long
On Error GoTo algo_pasa
If loPasa <> 0 Then
tmplon = lstrlenW(loPasa) * 2 '2 bytes cada char
If tmplon <> 0 Then
ReDim tmp(0 To (tmplon - 1)) As Byte
CopyMemory tmp(0), ByVal loPasa, tmplon
PasaLoString = tmp
End If
End If
Exit Function
algo_pasa:
MsgBox ("Error al transformar" & Err.Description), vbCritical, "Error al revisar las conexiones"
End Function
Espero que os sirva, pero si tenéis alguna duda, os responderé en los comentarios de la web.
Arkaitz Arteaga
Latest posts by Arkaitz Arteaga (see all)
- Access: Encriptar contraseñas con SHA-256 utilizando biblioteca de clases .NET con C# - 4 mayo, 2014
- Rendimiento de Access contra backend Access en servidor de archivos remoto. Cuarta parte. - 27 abril, 2014
- Rendimiento de Access contra backend Access en servidor de archivos remoto. Aclaración. - 21 abril, 2014
- Utilizar biblioteca de clases .NET en Access. Tercera aproximación a la Interoperabilidad COM - 14 abril, 2014
- Vincular tablas en Access con Visual Basic - 11 abril, 2014