15 febrero, 2014

Información de usuarios conectados – NetWkstaUserEnum y NetUserGetInfo

conectados

Como lo prometido es deuda, sigo con la explicación del desarrollo de la aplicación de Administración de Usuarios. En el anterior artículo sobre User Roster, nos quedamos con nuestra primera versión de la aplicación que ya mostraba la cantidad de usuarios conectados, la máquina desde la que se conectaban, el estado y el usuario de Access (admin a partir de Access 2007).

Como comentaba en el artículo, esto nos da bastante poca información (a no ser que nos sepamos los nombres de equipo de nuestra red) sobre el usuario que está conectado. Por ello voy a introducir 2 funciones de la librería netapi32 (netapi32.dll), NetWkstaUserEnum y NetUserGetInfo. En el artículo sobre Identificación de usuario de Windows y máquina de red ya hablamos sobre las APIs de Windows, así que si queréis algo más de información, hechadle un vistazo.

Como es un tema bastante complejo y os puede resultar hasta aburrido, voy a comentar un poco el funcionamiento de las APIs, los posibles problemas y las variantes de cada llamada para la gente a la que le interese. Para el resto de la gente, pongo al final del artículo, un ejemplo de función al que le pasas el nombre de un equipo de la red (que hemos sacado con User Roster para cada usuario conectado) y te devuelve una estructura con todos los datos que queremos (las estructuras también las declararé así que no os preocupéis).

La primera, NetWkstaUserEnum nos da información sobre los usuarios conectados a una máquina que le pasemos. En nuestro caso nos dará información sobre los usuarios conectados a los equipos que hemos sacado con nuestra primera versión de la aplicación de Administración de usuarios. Veamos la declaración de la función:

'***********************************************************************************
'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

Los parámetros importantes son:

  • equipo: equipo de cada usuario
  • nivel: 0 ó 1. Nosotros le pasaremos 1 para que devuelva más datos (luego lo explico)
  • entradas leidas: Si cuando la llamemos es 0, no se ha podido leer, posible equipo windows 98
  • buffer: Aqui estrá el resultado si todo va bien

Como decía antes, llamaremos a la función con el parámetro nivel=1 que hará que la función nos devuelva una estructura de este tipo:

'***********************************************************************************
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
'***********************************************************************************

EDITO: Veo que muchos entráis en el post porque la función os devuelve 5. Si NetWkstaUserEnum devuelve 5, significa que hay un problema de restricciones de acceso y de privilegios en la red. Consultad con vuestro administrador de sistemas.

Que guardaremos, una vez convertida a cadena de texto, en esta estructura (aprovecho y ya guardo también los datos de NetUserGetInfo, además la declaro como pública para poder utilizarla en la llamada):

'***********************************************************************************
'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... Investigad
  info_completo      As String 'Aqui guardo el nombre completo que devuelve NetUserGetInfo
End Type
'***********************************************************************************

El uso de NetUserGetInfo es muy parecido pero me costó sudor y lágrimas lograr que mostrara lo que andaba buscando, que sobre todo era el nombre completo del usuario de red. Vamos con la declaración:

'***********************************************************************************
Private Declare Function NetUserGetInfo Lib "netapi32" _
  (servidor As Byte, _
   usuario As Byte, _
   ByVal nivel As Integer, _
   buffer As Long) As Integer
'***********************************************************************************

En este punto es donde venían los problemas. En este caso, el servidor que le tenía que pasar a la función no era la máquina de cada usuario, sino el servidor donde se había autenticado (por eso es importante lo que nos devuelve NetWkstaUserEnum). El resto es parecido:

  • usuario: Usuario de Windows del que queremos información
  • nivel: Le paso 10. He probado otros niveles y no consigo más información (alguna vez el path de script. Si os interesa podéis jugar con esto
  • buffer: el resultado estará aqui si todo va bien

Al pasarle el parametro nivel=10, nos devolverá una estructura de este tipo:

'***********************************************************************************
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
'***********************************************************************************

Que guardaremos una vez convertida en esta estructura:

'***********************************************************************************
Private Type INFORMACION_USUARIO_FINAL
   info_nombre           As String
   info_ucomentario      As String
   info_comentario       As String
   info_completo         As String
End Type
'***********************************************************************************

En principio parece fácil, pero el mayor problema son los tipos de datos y las conversiones. Para hacerlas utilizaremos otras 3 funciones de 2 APIs. Aqui van las declaraciones:

'***********************************************************************************
'Las copio tal cual de otros ejemplos de Microsoft
'***********************************************************************************

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
'***********************************************************************************

Y con todos estos datos, vamos con el ejemplo que os había prometido. La función se llama UsuarioWindows y tiene esta forma:

Function UsuarioWindows(NombreEquipo As String) As USUARIO_FINAL

Así que una posible llamada (por ejemplo para llenar un recordset sería:

datosWin = UsuarioWindows(rsConectados("EQUIPO"))

Donde datoswin tendríamos que declararla de la siguiente manera:

Dim datosWin As USUARIO_FINAL

Y en rsConectados(«EQUIPO») estaría uno de los equipos conectados a nuestra base de datos (le vamos pasando todos con un bucle). La función nos devuelve una estructura (datoswin) con los siguientes datos:

  • Usuario de Windows
  • Nombre completo de usuario de red
  • Dominio
  • Servidor de autenticación
  • Comentarios (en el caso de la red de mi trabajo, viene vacío)

Para hacerlo más sencillo, retomaremos el módulo de la primera versión de la aplicación de Administración de usuarios (a la que simplemente le pasamos la ruta del backend y la contraseña si fuera necesario y nos llena una tabla llamada «CONEXIONES») y lo modificaremos para que guarde todos los valores. YO lo tengo separado en 2 módulos, pero eso es decisión de cada uno:

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 = "1.2"

Public Function Usuarios_Conectados(ByVal Fichero As String, ByVal Contraseña As String)

On Error GoTo AlgoPasa

Dim Conexion As New ADODB.Connection     'Para crear la conexión. Tengo que utilizar ADO, aunque no me guste
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}"
    '**********************************************************************

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
Set rsConexiones = Conexion.OpenSchema(schema:=adSchemaProviderSpecific, schemaID:=schemaID) ' Conexión sacada de la web de Microsoft

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
    
     
    Usuarios_Conectados = rsConectados.RecordCount
    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.

photo credit: onkel_wart (thomas lieser) via photopin cc

The following two tabs change content below.
My Twitter profileMy Facebook profileMy Google+ profile

Arkaitz Arteaga

Administrador at Programador de Palo
Llevo más de 10 años programando, sobre todo en Visual Basic y con bases de datos Access. Para mí, VBA y Access siguen siendo herramientas muy potentes. He desarrollado varios proyectos con PHP y MySql. Si sumo las webs que he tenido, probablemente pasaría de 100. Ahora prefiero dedicar todo mi esfuerzo a este blog (aunque sigo manteniendo unas cuantas...). Trabajo en la administración pública (si, soy funcionario), pero he trabajado en pequeñas empresas e incluso en una "grande" de las telecomunicaciones. Ultimamente estoy bastante metido en abrirme nuevos horizontes con C# y .NET. Renovarse o morir!

Artículos Relacionados:

  1. 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 […]...
  2. Ocultar tablas en Access remoto – DB_HIDDENOBJECT y SetHiddenAttribute El otro día llegó a mis manos unas base de datos Access con las tablas ocultas y recordé una función que colgó el Búho en su día para ocultar y volver a mostrar tablas: 'Por el Buho Function OcultaDesoculta(Ocultar As Boolean) Dim Tablas As TableDef For Each Tablas In CurrentDb.TableDefs If Ocultar = True Then […]...
  3. Encriptar base de datos Access con VBA – Proteger con contraseña Una de las tareas más tediosas del administrador de bases de datos Access es la tarea de encriptar/desencriptar una base de datos ya que tienes que acceder en modo exclusivo para poder realizarla. Aunque parezca algo sencillo, el tener que salir de la base de datos sin salir de Access, seleccionar de nuevo desde el […]...
  4. Usuarios conectados a base de datos Access – User Roster Si alguna vez habéis desarrollado una aplicación multiusuario en Access, sabréis que una de las dificultades de no utilizar otro tipo de plataformas más orientadas a cliente-servidor (Sql Server, Oracle, etc) viene a la hora de realizar modificaciones en el Backend de nuestra aplicación (ver artículo sobre Dividir bases de datos Access). Cuando hacemos cambios […]...
  5. Microsoft Virtual Academy – Efecto Picada Como sabéis, últimamente estoy intentando expandirme un poco y empezando a explorar nuevas herramientas. Como comentaba en el artículo sobre Abrir la mente hay que mantenerse actualizado e irse formando en la nuevas herramientas que van surgiendo, sobre todo en una profesión tan cambiante como la nuestra. Podemos ver esta necesidad de formación continua como […]...

Deja una respuesta