Usuarios NT
Raptor
21 de Abril del 2006
Necesito poder manejar los usuarios de NT por medio de aplicaciones Visual Basic, para ser mas especifico, he creado un ActiveX que como parametros lleva un usuario, que no es mas que el usuario que esta logeado como NT, entonces lo que necesito es poder leer los usuarios de NT, obtener el nombre o user name, ese lo comparo a una mi base de datos y obtengo un codigo específico de usuario. Alguien tiene una idea????
averbell
21 de Abril del 2006
Note compliques tanto. Planteatelo de otra forma.
comprueba el nombre de usuario logeado con los usuarios de tu base de datos.
comprueba el nombre de usuario logeado con los usuarios de tu base de datos.
jorge
21 de Abril del 2006
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsNetworkUserFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'**Variables de la clase**
Private isCompatibleNT As Boolean
'******************************************
' DECLARACION DE LAS LIBRERIAS(Begin)
'******************************************
'****Declaración de las librerias API para SystemVersion****
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
'****Declaración de las librerias API para CurrentUser****
'Saca el usuario actual logado de la maquina
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Saca el nombre de la maquina
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Saca la Información del usuario en un buffer que habrá que copiar a una estructura(USER_INFO_)
Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
'Saca los grupos globales de seguridad de usuario actual
Private Declare Function NetUserGetGroups Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long) As Long
'Saca los grupos locales de seguridad de usuario actual
Private Declare Function NetUserGetLocalGroups Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, ByVal Flags As Long, lpBuffer As Long, ByVal MaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long) As Long
'Libera un buffer de esta API
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal pBuffer As Long) As Long
'Librerias de netapi32.dll(No utilizadas)
Private Declare Function NetUserChangePassword Lib "netapi32" (Domain As Any, User As Any, OldPass As Byte, NewPass As Byte) As Long
Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" (yServer As Any, pBuffer As Long) As Long
'****Librerias de utilidad****
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
'Constantes para las librerias
Private Const NERR_NotExistGroups = -1
Private Const NERR_Success = 0
Private Const ERROR_ACCESS_DENIED = 5
Private Const NERR_InvalidComputer = 2351
Private Const NERR_UserNotFound = 2221
Private Const RPC_S_SERVER_UNAVAILABLE = 1722
Private Const ERROR_UNEXP_NET_ERR = 59
Private Const ERROR_LOGON_FAILURE = 1326
Private Const PLATFORM_WIN32s = 0
Private Const PLATFORM_WIN32_WINDOWS = 1
Private Const PLATFORM_WIN32_NT = 2
Private Const USER_PRIV_GUEST = 0
Private Const USER_PRIV_USER = 1
Private Const USER_PRIV_ADMIN = 2
Private Const ERROR_NOT_OS_NTCOMPATIBLE = -255
'Estructura para la información del usuario
'******Tipos de Estructura*****
'Existen varios tipos de estructuras en las que sacar los
'datos. Todas ellas empieazan por USER_INFO_
'En esta se ha optado por USER_INFO_3
'Se establece todo a long para poder ser tratado
' *LogonHours es un array de Bytes (20)
'******Tipos de Estructura*****
Private Type USER_INFO_3
' USER_INFO_0
Name As Long
' USER_INFO_1
Password As Long
PasswordAge As Long
Privilege As Long
HomeDir As Long
Comment As Long
Flags As Long
ScriptPath As Long
' USER_INFO_2
AuthFlags As Long
FullName As Long
UserComment As Long
Parms As Long
Workstations As Long
LastLogon As Long
LastLogoff As Long
AcctExpires As Long
MaxStorage As Long
UnitsPerWeek As Long
LogonHours As Long
BadPwCount As Long
NumLogons As Long
LogonServer As Long
CountryCode As Long
CodePage As Long
' USER_INFO_3
UserID As Long
PrimaryGroupID As Long
Profile As Long
HomeDirDrive As Long
PasswordExpired As Long
End Type
'Estructura para la información del sistema
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'******************************************
' DECLARACION DE LAS LIBRERIAS(End)
'******************************************
'******************************************
' PROPIEDADES(Begin)
'******************************************
'Devuelve el nombre usuario actual
Public Property Get CurrentMachineName() As String
CurrentMachineName = GetCurrentMachineName()
End Property
'Devuelve el nombre de la maquina actual
Public Property Get CurrentUserName() As String
CurrentUserName = GetCurrentUserName()
End Property
'Devuelve un array con los grupos locales a los que pertenece el usuario actual
Public Property Get CurrentUserLocalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CurrentUserLocalGroups = GetCurrentUserLocalGroups(strUserName, strMachineName)
End Property
'Devuelve un array con los grupos globales a los que pertenece el usuario actual
Public Property Get CurrentUserGlobalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CurrentUserGlobalGroups = GetCurrentUserGlobalGroups(strUserName, strMachineName)
End Property
'******************************************************************
'**************PROPIEDADES DE USER_INFO****BEGIN*******************
'******************************************************************
Public Property Get UserName(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
'UserName = GetUserNetInfo(0, strUserName, strMachineName)
UserName = GetCurrentUserName()
End Property
Public Property Get Password(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Password = GetUserNetInfo(1, strUserName, strMachineName)
End Property
Public Property Get PasswordAge(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
PasswordAge = Format(GetUserNetInfo(2, strUserName, strMachineName) / 86400, "0.0")
End Property
Public Property Get Privilege(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
'Privilege recibe uno de los siguientes valores
' USER_PRIV_GUEST = 0 ..> Privilegios de Invitado
' USER_PRIV_USER = 1 ...> Privilegios de Usuario
' USER_PRIV_ADMIN = 2 ..> Privilegios de Administrador
Dim auxPrivilege As Variant
Const USER_PRIV_GUEST = 0
Const USER_PRIV_USER = 1
Const USER_PRIV_ADMIN = 2
auxPrivilege = GetUserNetInfo(3, strUserName, strMachineName)
Select Case auxPrivilege
Case USER_PRIV_ADMIN
Privilege = "Admin"
Case USER_PRIV_USER
Privilege = "User"
Case Else
Privilege = "Guest"
End Select
End Property
Public Property Get HomeDyr(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
HomeDyr = GetUserNetInfo(4, strUserName, strMachineName)
End Property
Public Property Get Comment(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Comment = GetUserNetInfo(5, strUserName, strMachineName)
End Property
Public Property Get Flags(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Flags = GetUserNetInfo(6, strUserName, strMachineName)
End Property
Public Property Get ScriptPath(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
ScriptPath = GetUserNetInfo(7, strUserName, strMachineName)
End Property
Public Property Get AuthFlags(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
AuthFlags = GetUserNetInfo(8, strUserName, strMachineName)
End Property
Public Property Get FullName(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
FullName = GetUserNetInfo(9, strUserName, strMachineName)
End Property
Public Property Get UserComment(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
UserComment = GetUserNetInfo(10, strUserName, strMachineName)
End Property
Public Property Get Parm(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Parm = GetUserNetInfo(11, strUserName, strMachineName)
End Property
Public Property Get Workstations(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Workstations = GetUserNetInfo(12, strUserName, strMachineName)
End Property
Public Property Get LastLogon(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LastLogon = Format(GetUserNetInfo(13, strUserName, strMachineName), "long date")
End Property
Public Property Get LastLogoff(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LastLogoff = Format(GetUserNetInfo(14, strUserName, strMachineName), "long date")
End Property
Public Property Get AcctExpires(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Const TIMEQ_FOREVER = -1&
Dim auxAcctExpires As Variant
auxAcctExpires = GetUserNetInfo(15, strUserName, strMachineName)
If auxAcctExpires = TIMEQ_FOREVER Then
AcctExpires = "Never"
Else
AcctExpires = Format(auxAcctExpires, "long date")
End If
End Property
Public Property Get MaxStorage(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Const USER_MAXSTORAGE_UNLIMITED = -1&
Dim auxMaxStorage As Variant
auxMaxStorage = GetUserNetInfo(16, strUserName, strMachineName)
If auxMaxStorage = USER_MAXSTORAGE_UNLIMITED Then
MaxStorage = "Unlimited"
Else
MaxStorage = auxMaxStorage
End If
End Property
Public Property Get UnitsPerWeek(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
UnitsPerWeek = GetUserNetInfo(17, strUserName, strMachineName)
End Property
'Public Property Get LogonHours(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
' Dim auxLogonHours(0 To 20) As Byte, i As Integer
' auxLogonHours = GetUserNetInfo(18, strUserName, strMachineName)
' For i = 0 To 20 'Numero total del Array de Bytes de USER_INFO_3
' LogonHours = Right("0" & Hex(auxLogonHours(i)), 2)
' Next i
'End Property
Public Property Get LogonHours(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LogonHours = "No funciona bien" ' ...> es el 18
End Property
Public Property Get BadPwCount(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
BadPwCount = GetUserNetInfo(19, strUserName, strMachineName)
End Property
Public Property Get NumLogons(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
NumLogons = GetUserNetInfo(20, strUserName, strMachineName)
End Property
Public Property Get LogonServer(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LogonServer = GetUserNetInfo(21, strUserName, strMachineName)
End Property
Public Property Get CountryCode(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CountryCode = GetUserNetInfo(22, strUserName, strMachineName)
End Property
Public Property Get CodePage(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CodePage = GetUserNetInfo(23, strUserName, strMachineName)
End Property
Public Property Get UserID(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
UserID = GetUserNetInfo(24, strUserName, strMachineName)
End Property
Public Property Get PrimaryGroupID(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
PrimaryGroupID = GetUserNetInfo(25, strUserName, strMachineName)
End Property
Public Property Get Profile(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Profile = GetUserNetInfo(26, strUserName, strMachineName)
End Property
Public Property Get HomeDirDrive(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
HomeDirDrive = GetUserNetInfo(27, strUserName, strMachineName)
End Property
Public Property Get PasswordExpires(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
PasswordExpires = GetUserNetInfo(28, strUserName, strMachineName)
End Property
Public Property Get isWIN32_NT() As Boolean
isWIN32_NT = isCompatibleNT
End Property
'******************************************************************
'**************PROPIEDADES DE USER_INFO****END*********************
'******************************************************************
'******************************************
' PROPIEDADES(End)
'******************************************
'******************************************
' EVENTOS DE LA CLASE(Begin)
'******************************************
Private Sub Class_Initialize()
'Sacar los datos de la maquina
Dim rvOS As OSVERSIONINFO
rvOS.dwOSVersionInfoSize = Len(rvOS)
Call GetVersionEx(rvOS)
If rvOS.dwPlatformId = PLATFORM_WIN32_NT Then
isCompatibleNT = True
Else
isCompatibleNT = False
End If
End Sub
'******************************************
' EVENTOS DE LA CLASE(Begin)
'******************************************
'******************************************
' METODOS PUBLICOS(Begin)
'******************************************
'******************************************
' METODOS PUBLICOS(Begin)
'******************************************
'******************************************
' METODOS PRIVADOS(Begin)
'******************************************
Private Function GetCurrentUserName() As String
Dim strBuffer As String
Const intSize As Long = 255
strBuffer = String(intSize, Chr$(0))
GetUserName strBuffer, intSize
GetCurrentUserName = Replace(strBuffer, Chr$(0), vbNullString)
End Function
Private Function GetCurrentMachineName() As String
Dim strBuffer As String
Const intSize As Long = 255
strBuffer = String(intSize, Chr$(0))
GetComputerName strBuffer, intSize
GetCurrentMachineName = UCase(Replace(strBuffer, Chr$(0), vbNullString))
End Function
Private Function GetCurrentUserLocalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim lpGroups() As Long
Dim nRead As Long
Dim nTotal As Long
Dim nRet As Long
Dim m_Server As String
Dim lpMaxLength As Long
Dim i As Long
'Constantes a pasar a la API
Const Flags& = 0
lpMaxLength = &H4000
If isCompatibleNT Then
yUserName = Trim(strUserName) & vbNullChar
m_Server = Trim(strMachineName)
If Trim(strUserName) = "" Then yUserName = CurrentUserName & vbNullChar
If Trim(strMachineName) = "" Then m_Server = CurrentMachineName
If m_Server = "" Then
nRet = NetUserGetLocalGroups(ByVal 0&, yUserName(0), 0, Flags, lpBuffer, lpMaxLength, nRead, nTotal)
Else
If InStr(m_Server, "\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\" & m_Server & vbNullChar
End If
nRet = NetUserGetLocalGroups(yServer(0), yUserName(0), 0, Flags, lpBuffer, &H400, nRead, nTotal)
End If
'La operación se ha producido con exito
If nRet = NERR_Success Then
ReDim lpGroups(IIf(nTotal = 0, 1, nTotal) - 1) As Long
ReDim arrLocalGroups(IIf(nTotal = 0, 1, nTotal) - 1) As String
CopyMemory lpGroups(0), ByVal lpBuffer, nTotal * 4
i = 0
Do While i < nTotal
arrLocalGroups(i) = Replace(PointerToStringW(lpGroups(i)), Chr$(0), vbNullString)
i = i + 1
Loop
'Si no existen grupos para ese usuario devolvemos la
'constante publica NERR_NotExistGroups = -1
If nTotal = 0 Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_NotExistGroups
End If
ElseIf nRet = ERROR_ACCESS_DENIED Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_ACCESS_DENIED
ElseIf nRet = NERR_InvalidComputer Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_InvalidComputer
ElseIf nRet = NERR_UserNotFound Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_UserNotFound
ElseIf nRet = RPC_S_SERVER_UNAVAILABLE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = RPC_S_SERVER_UNAVAILABLE
ElseIf nRet = ERROR_LOGON_FAILURE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_LOGON_FAILURE
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_UNEXP_NET_ERR
End If
'Limpiamos el buffer de la memoria
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_NOT_OS_NTCOMPATIBLE
End If
'Retornamos el array con los grupos
GetCurrentUserLocalGroups = arrLocalGroups
End Function
Private Function GetCurrentUserGlobalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim lpGroups() As Long
Dim nRead As Long
Dim nTotal As Long
Dim nRet As Long
Dim m_Server As String
Dim lpMaxLength As Long
Dim i As Long
'Constantes a pasar a la API
lpMaxLength = &H4000
If isCompatibleNT Then
yUserName = Trim(strUserName) & vbNullChar
m_Server = Trim(strMachineName)
If Trim(strUserName) = "" Then yUserName = CurrentUserName & vbNullChar
If Trim(strMachineName) = "" Then m_Server = CurrentMachineName
If m_Server = "" Then
nRet = NetUserGetGroups(ByVal 0&, yUserName(0), 0, lpBuffer, lpMaxLength, nRead, nTotal)
Else
If InStr(m_Server, "\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\" & m_Server & vbNullChar
End If
nRet = NetUserGetGroups(yServer(0), yUserName(0), 0, lpBuffer, &H400, nRead, nTotal)
End If
'La operación se ha producido con exito
If nRet = NERR_Success Then
ReDim lpGroups(IIf(nTotal = 0, 1, nTotal) - 1) As Long
ReDim arrLocalGroups(IIf(nTotal = 0, 1, nTotal) - 1) As String
CopyMemory lpGroups(0), ByVal lpBuffer, nTotal * 4
i = 0
Do While i < nTotal
arrLocalGroups(i) = Replace(PointerToStringW(lpGroups(i)), Chr$(0), vbNullString)
i = i + 1
Loop
'Si no existen grupos para ese usuario devolvemos la
'constante publica NERR_NotExistGroups = -1
If nTotal = 0 Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_NotExistGroups
End If
ElseIf nRet = ERROR_ACCESS_DENIED Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_ACCESS_DENIED
ElseIf nRet = NERR_InvalidComputer Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_InvalidComputer
ElseIf nRet = NERR_UserNotFound Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_UserNotFound
ElseIf nRet = RPC_S_SERVER_UNAVAILABLE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = RPC_S_SERVER_UNAVAILABLE
ElseIf nRet = ERROR_LOGON_FAILURE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_LOGON_FAILURE
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_UNEXP_NET_ERR
End If
'Limpiamos el buffer de la memoria
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_NOT_OS_NTCOMPATIBLE
End If
'Retornamos el array con los grupos
GetCurrentUserGlobalGroups = arrLocalGroups
End Function
Private Function GetUserNetInfo(ByVal intPropertyNumber As Integer, Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim m_Server As String
Dim uUserApi As USER_INFO_3
Dim nRet As Long
yUserName = Trim(strUserName) & vbNullChar
m_Server = Trim(strMachineName)
If Trim(strUserName) = "" Then yUserName = CurrentUserName & vbNullChar
If Trim(strMachineName) = "" Then m_Server = CurrentMachineName
'Si no es NT no puedo sacar la información
If isCompatibleNT Then
If m_Server = "" Then
nRet = NetUserGetInfo(ByVal 0&, yUserName(0), 3, lpBuffer)
Else
If InStr(m_Server, "\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\" & m_Server & vbNullChar
End If
nRet = NetUserGetInfo(yServer(0), yUserName(0), 3, lpBuffer)
End If
Else
nRet = RPC_S_SERVER_UNAVAILABLE
End If
If nRet = NERR_Success Then
'Metemos el Buffer devuelto en una estructura tipo USER_INFO_3
CopyMemory uUserApi, ByVal lpBuffer, Len(uUserApi)
Select Case intPropertyNumber
Case 0:
GetUserNetInfo = PointerToStringW(uUserApi.Name)
Case 1:
GetUserNetInfo = PointerToStringW(uUserApi.Password)
Case 2:
GetUserNetInfo = uUserApi.PasswordAge
Case 3:
GetUserNetInfo = uUserApi.Privilege
Case 4:
GetUserNetInfo = PointerToStringW(uUserApi.HomeDir)
Case 5:
GetUserNetInfo = PointerToStringW(uUserApi.Comment)
Case 6:
GetUserNetInfo = uUserApi.Flags
Case 7:
GetUserNetInfo = PointerToStringW(uUserApi.ScriptPath)
Case 8:
GetUserNetInfo = uUserApi.AuthFlags
Case 9:
GetUserNetInfo = PointerToStringW(uUserApi.FullName)
Case 10:
GetUserNetInfo = PointerToStringW(uUserApi.UserComment)
Case 11:
GetUserNetInfo = PointerToStringW(uUserApi.Parms)
Case 12:
GetUserNetInfo = PointerToStringW(uUserApi.Workstations)
Case 13:
GetUserNetInfo = uUserApi.LastLogon
Case 14:
GetUserNetInfo = uUserApi.LastLogoff
Case 15:
GetUserNetInfo = uUserApi.AcctExpires
Case 16:
GetUserNetInfo = uUserApi.MaxStorage
Case 17:
GetUserNetInfo = uUserApi.UnitsPerWeek
Case 18:
CopyMemory GetUserNetInfo(0), ByVal uUserApi.LogonHours, 21
Case 19:
GetUserNetInfo = uUserApi.BadPwCount
Case 20:
GetUserNetInfo = uUserApi.NumLogons
Case 21:
GetUserNetInfo = PointerToStringW(uUserApi.LogonServer)
Case 22:
GetUserNetInfo = uUserApi.CountryCode
Case 23:
GetUserNetInfo = uUserApi.CodePage
Case 24:
GetUserNetInfo = uUserApi.UserID
Case 25:
GetUserNetInfo = uUserApi.PrimaryGroupID
Case 26:
GetUserNetInfo = PointerToStringW(uUserApi.Profile)
Case 27:
GetUserNetInfo = PointerToStringW(uUserApi.HomeDirDrive)
Case 28:
GetUserNetInfo = CBool(uUserApi.PasswordExpired)
End Select
End If
'Limpiamos el buffer de la memoria
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
End Function
'**Devuelve una cadena de texto de un puntero de memoria**
Private Function PointerToStringW(lpStringW As Long) As String
Dim Buffer() As Byte
Dim nLen As Long
If lpStringW Then
nLen = lstrlenW(lpStringW) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMemory Buffer(0), ByVal lpStringW, nLen
PointerToStringW = Buffer
End If
End If
End Function
'******************************************
' METODOS PRIVADOS(Begin)
'******************************************
------------------------------------------------
------------------------------------------------
------------------------------------------------
------------------------------------------------
------------------------------------------------
------------------------------------------------
Copiate esto a un archivo y renombralo a clsNetworkUserFunctions.cls
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsNetworkUserFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'**Variables de la clase**
Private isCompatibleNT As Boolean
'******************************************
' DECLARACION DE LAS LIBRERIAS(Begin)
'******************************************
'****Declaración de las librerias API para SystemVersion****
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
'****Declaración de las librerias API para CurrentUser****
'Saca el usuario actual logado de la maquina
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Saca el nombre de la maquina
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Saca la Información del usuario en un buffer que habrá que copiar a una estructura(USER_INFO_)
Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
'Saca los grupos globales de seguridad de usuario actual
Private Declare Function NetUserGetGroups Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long) As Long
'Saca los grupos locales de seguridad de usuario actual
Private Declare Function NetUserGetLocalGroups Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, ByVal Flags As Long, lpBuffer As Long, ByVal MaxLen As Long, lpEntriesRead As Long, lpTotalEntries As Long) As Long
'Libera un buffer de esta API
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal pBuffer As Long) As Long
'Librerias de netapi32.dll(No utilizadas)
Private Declare Function NetUserChangePassword Lib "netapi32" (Domain As Any, User As Any, OldPass As Byte, NewPass As Byte) As Long
Private Declare Function NetRemoteTOD Lib "NETAPI32.DLL" (yServer As Any, pBuffer As Long) As Long
'****Librerias de utilidad****
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
'Constantes para las librerias
Private Const NERR_NotExistGroups = -1
Private Const NERR_Success = 0
Private Const ERROR_ACCESS_DENIED = 5
Private Const NERR_InvalidComputer = 2351
Private Const NERR_UserNotFound = 2221
Private Const RPC_S_SERVER_UNAVAILABLE = 1722
Private Const ERROR_UNEXP_NET_ERR = 59
Private Const ERROR_LOGON_FAILURE = 1326
Private Const PLATFORM_WIN32s = 0
Private Const PLATFORM_WIN32_WINDOWS = 1
Private Const PLATFORM_WIN32_NT = 2
Private Const USER_PRIV_GUEST = 0
Private Const USER_PRIV_USER = 1
Private Const USER_PRIV_ADMIN = 2
Private Const ERROR_NOT_OS_NTCOMPATIBLE = -255
'Estructura para la información del usuario
'******Tipos de Estructura*****
'Existen varios tipos de estructuras en las que sacar los
'datos. Todas ellas empieazan por USER_INFO_
'En esta se ha optado por USER_INFO_3
'Se establece todo a long para poder ser tratado
' *LogonHours es un array de Bytes (20)
'******Tipos de Estructura*****
Private Type USER_INFO_3
' USER_INFO_0
Name As Long
' USER_INFO_1
Password As Long
PasswordAge As Long
Privilege As Long
HomeDir As Long
Comment As Long
Flags As Long
ScriptPath As Long
' USER_INFO_2
AuthFlags As Long
FullName As Long
UserComment As Long
Parms As Long
Workstations As Long
LastLogon As Long
LastLogoff As Long
AcctExpires As Long
MaxStorage As Long
UnitsPerWeek As Long
LogonHours As Long
BadPwCount As Long
NumLogons As Long
LogonServer As Long
CountryCode As Long
CodePage As Long
' USER_INFO_3
UserID As Long
PrimaryGroupID As Long
Profile As Long
HomeDirDrive As Long
PasswordExpired As Long
End Type
'Estructura para la información del sistema
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'******************************************
' DECLARACION DE LAS LIBRERIAS(End)
'******************************************
'******************************************
' PROPIEDADES(Begin)
'******************************************
'Devuelve el nombre usuario actual
Public Property Get CurrentMachineName() As String
CurrentMachineName = GetCurrentMachineName()
End Property
'Devuelve el nombre de la maquina actual
Public Property Get CurrentUserName() As String
CurrentUserName = GetCurrentUserName()
End Property
'Devuelve un array con los grupos locales a los que pertenece el usuario actual
Public Property Get CurrentUserLocalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CurrentUserLocalGroups = GetCurrentUserLocalGroups(strUserName, strMachineName)
End Property
'Devuelve un array con los grupos globales a los que pertenece el usuario actual
Public Property Get CurrentUserGlobalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CurrentUserGlobalGroups = GetCurrentUserGlobalGroups(strUserName, strMachineName)
End Property
'******************************************************************
'**************PROPIEDADES DE USER_INFO****BEGIN*******************
'******************************************************************
Public Property Get UserName(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
'UserName = GetUserNetInfo(0, strUserName, strMachineName)
UserName = GetCurrentUserName()
End Property
Public Property Get Password(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Password = GetUserNetInfo(1, strUserName, strMachineName)
End Property
Public Property Get PasswordAge(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
PasswordAge = Format(GetUserNetInfo(2, strUserName, strMachineName) / 86400, "0.0")
End Property
Public Property Get Privilege(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
'Privilege recibe uno de los siguientes valores
' USER_PRIV_GUEST = 0 ..> Privilegios de Invitado
' USER_PRIV_USER = 1 ...> Privilegios de Usuario
' USER_PRIV_ADMIN = 2 ..> Privilegios de Administrador
Dim auxPrivilege As Variant
Const USER_PRIV_GUEST = 0
Const USER_PRIV_USER = 1
Const USER_PRIV_ADMIN = 2
auxPrivilege = GetUserNetInfo(3, strUserName, strMachineName)
Select Case auxPrivilege
Case USER_PRIV_ADMIN
Privilege = "Admin"
Case USER_PRIV_USER
Privilege = "User"
Case Else
Privilege = "Guest"
End Select
End Property
Public Property Get HomeDyr(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
HomeDyr = GetUserNetInfo(4, strUserName, strMachineName)
End Property
Public Property Get Comment(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Comment = GetUserNetInfo(5, strUserName, strMachineName)
End Property
Public Property Get Flags(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Flags = GetUserNetInfo(6, strUserName, strMachineName)
End Property
Public Property Get ScriptPath(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
ScriptPath = GetUserNetInfo(7, strUserName, strMachineName)
End Property
Public Property Get AuthFlags(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
AuthFlags = GetUserNetInfo(8, strUserName, strMachineName)
End Property
Public Property Get FullName(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
FullName = GetUserNetInfo(9, strUserName, strMachineName)
End Property
Public Property Get UserComment(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
UserComment = GetUserNetInfo(10, strUserName, strMachineName)
End Property
Public Property Get Parm(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Parm = GetUserNetInfo(11, strUserName, strMachineName)
End Property
Public Property Get Workstations(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Workstations = GetUserNetInfo(12, strUserName, strMachineName)
End Property
Public Property Get LastLogon(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LastLogon = Format(GetUserNetInfo(13, strUserName, strMachineName), "long date")
End Property
Public Property Get LastLogoff(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LastLogoff = Format(GetUserNetInfo(14, strUserName, strMachineName), "long date")
End Property
Public Property Get AcctExpires(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Const TIMEQ_FOREVER = -1&
Dim auxAcctExpires As Variant
auxAcctExpires = GetUserNetInfo(15, strUserName, strMachineName)
If auxAcctExpires = TIMEQ_FOREVER Then
AcctExpires = "Never"
Else
AcctExpires = Format(auxAcctExpires, "long date")
End If
End Property
Public Property Get MaxStorage(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Const USER_MAXSTORAGE_UNLIMITED = -1&
Dim auxMaxStorage As Variant
auxMaxStorage = GetUserNetInfo(16, strUserName, strMachineName)
If auxMaxStorage = USER_MAXSTORAGE_UNLIMITED Then
MaxStorage = "Unlimited"
Else
MaxStorage = auxMaxStorage
End If
End Property
Public Property Get UnitsPerWeek(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
UnitsPerWeek = GetUserNetInfo(17, strUserName, strMachineName)
End Property
'Public Property Get LogonHours(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
' Dim auxLogonHours(0 To 20) As Byte, i As Integer
' auxLogonHours = GetUserNetInfo(18, strUserName, strMachineName)
' For i = 0 To 20 'Numero total del Array de Bytes de USER_INFO_3
' LogonHours = Right("0" & Hex(auxLogonHours(i)), 2)
' Next i
'End Property
Public Property Get LogonHours(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LogonHours = "No funciona bien" ' ...> es el 18
End Property
Public Property Get BadPwCount(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
BadPwCount = GetUserNetInfo(19, strUserName, strMachineName)
End Property
Public Property Get NumLogons(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
NumLogons = GetUserNetInfo(20, strUserName, strMachineName)
End Property
Public Property Get LogonServer(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
LogonServer = GetUserNetInfo(21, strUserName, strMachineName)
End Property
Public Property Get CountryCode(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CountryCode = GetUserNetInfo(22, strUserName, strMachineName)
End Property
Public Property Get CodePage(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
CodePage = GetUserNetInfo(23, strUserName, strMachineName)
End Property
Public Property Get UserID(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
UserID = GetUserNetInfo(24, strUserName, strMachineName)
End Property
Public Property Get PrimaryGroupID(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
PrimaryGroupID = GetUserNetInfo(25, strUserName, strMachineName)
End Property
Public Property Get Profile(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Profile = GetUserNetInfo(26, strUserName, strMachineName)
End Property
Public Property Get HomeDirDrive(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
HomeDirDrive = GetUserNetInfo(27, strUserName, strMachineName)
End Property
Public Property Get PasswordExpires(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
PasswordExpires = GetUserNetInfo(28, strUserName, strMachineName)
End Property
Public Property Get isWIN32_NT() As Boolean
isWIN32_NT = isCompatibleNT
End Property
'******************************************************************
'**************PROPIEDADES DE USER_INFO****END*********************
'******************************************************************
'******************************************
' PROPIEDADES(End)
'******************************************
'******************************************
' EVENTOS DE LA CLASE(Begin)
'******************************************
Private Sub Class_Initialize()
'Sacar los datos de la maquina
Dim rvOS As OSVERSIONINFO
rvOS.dwOSVersionInfoSize = Len(rvOS)
Call GetVersionEx(rvOS)
If rvOS.dwPlatformId = PLATFORM_WIN32_NT Then
isCompatibleNT = True
Else
isCompatibleNT = False
End If
End Sub
'******************************************
' EVENTOS DE LA CLASE(Begin)
'******************************************
'******************************************
' METODOS PUBLICOS(Begin)
'******************************************
'******************************************
' METODOS PUBLICOS(Begin)
'******************************************
'******************************************
' METODOS PRIVADOS(Begin)
'******************************************
Private Function GetCurrentUserName() As String
Dim strBuffer As String
Const intSize As Long = 255
strBuffer = String(intSize, Chr$(0))
GetUserName strBuffer, intSize
GetCurrentUserName = Replace(strBuffer, Chr$(0), vbNullString)
End Function
Private Function GetCurrentMachineName() As String
Dim strBuffer As String
Const intSize As Long = 255
strBuffer = String(intSize, Chr$(0))
GetComputerName strBuffer, intSize
GetCurrentMachineName = UCase(Replace(strBuffer, Chr$(0), vbNullString))
End Function
Private Function GetCurrentUserLocalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim lpGroups() As Long
Dim nRead As Long
Dim nTotal As Long
Dim nRet As Long
Dim m_Server As String
Dim lpMaxLength As Long
Dim i As Long
'Constantes a pasar a la API
Const Flags& = 0
lpMaxLength = &H4000
If isCompatibleNT Then
yUserName = Trim(strUserName) & vbNullChar
m_Server = Trim(strMachineName)
If Trim(strUserName) = "" Then yUserName = CurrentUserName & vbNullChar
If Trim(strMachineName) = "" Then m_Server = CurrentMachineName
If m_Server = "" Then
nRet = NetUserGetLocalGroups(ByVal 0&, yUserName(0), 0, Flags, lpBuffer, lpMaxLength, nRead, nTotal)
Else
If InStr(m_Server, "\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\" & m_Server & vbNullChar
End If
nRet = NetUserGetLocalGroups(yServer(0), yUserName(0), 0, Flags, lpBuffer, &H400, nRead, nTotal)
End If
'La operación se ha producido con exito
If nRet = NERR_Success Then
ReDim lpGroups(IIf(nTotal = 0, 1, nTotal) - 1) As Long
ReDim arrLocalGroups(IIf(nTotal = 0, 1, nTotal) - 1) As String
CopyMemory lpGroups(0), ByVal lpBuffer, nTotal * 4
i = 0
Do While i < nTotal
arrLocalGroups(i) = Replace(PointerToStringW(lpGroups(i)), Chr$(0), vbNullString)
i = i + 1
Loop
'Si no existen grupos para ese usuario devolvemos la
'constante publica NERR_NotExistGroups = -1
If nTotal = 0 Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_NotExistGroups
End If
ElseIf nRet = ERROR_ACCESS_DENIED Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_ACCESS_DENIED
ElseIf nRet = NERR_InvalidComputer Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_InvalidComputer
ElseIf nRet = NERR_UserNotFound Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_UserNotFound
ElseIf nRet = RPC_S_SERVER_UNAVAILABLE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = RPC_S_SERVER_UNAVAILABLE
ElseIf nRet = ERROR_LOGON_FAILURE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_LOGON_FAILURE
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_UNEXP_NET_ERR
End If
'Limpiamos el buffer de la memoria
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_NOT_OS_NTCOMPATIBLE
End If
'Retornamos el array con los grupos
GetCurrentUserLocalGroups = arrLocalGroups
End Function
Private Function GetCurrentUserGlobalGroups(Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim lpGroups() As Long
Dim nRead As Long
Dim nTotal As Long
Dim nRet As Long
Dim m_Server As String
Dim lpMaxLength As Long
Dim i As Long
'Constantes a pasar a la API
lpMaxLength = &H4000
If isCompatibleNT Then
yUserName = Trim(strUserName) & vbNullChar
m_Server = Trim(strMachineName)
If Trim(strUserName) = "" Then yUserName = CurrentUserName & vbNullChar
If Trim(strMachineName) = "" Then m_Server = CurrentMachineName
If m_Server = "" Then
nRet = NetUserGetGroups(ByVal 0&, yUserName(0), 0, lpBuffer, lpMaxLength, nRead, nTotal)
Else
If InStr(m_Server, "\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\" & m_Server & vbNullChar
End If
nRet = NetUserGetGroups(yServer(0), yUserName(0), 0, lpBuffer, &H400, nRead, nTotal)
End If
'La operación se ha producido con exito
If nRet = NERR_Success Then
ReDim lpGroups(IIf(nTotal = 0, 1, nTotal) - 1) As Long
ReDim arrLocalGroups(IIf(nTotal = 0, 1, nTotal) - 1) As String
CopyMemory lpGroups(0), ByVal lpBuffer, nTotal * 4
i = 0
Do While i < nTotal
arrLocalGroups(i) = Replace(PointerToStringW(lpGroups(i)), Chr$(0), vbNullString)
i = i + 1
Loop
'Si no existen grupos para ese usuario devolvemos la
'constante publica NERR_NotExistGroups = -1
If nTotal = 0 Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_NotExistGroups
End If
ElseIf nRet = ERROR_ACCESS_DENIED Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_ACCESS_DENIED
ElseIf nRet = NERR_InvalidComputer Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_InvalidComputer
ElseIf nRet = NERR_UserNotFound Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = NERR_UserNotFound
ElseIf nRet = RPC_S_SERVER_UNAVAILABLE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = RPC_S_SERVER_UNAVAILABLE
ElseIf nRet = ERROR_LOGON_FAILURE Then
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_LOGON_FAILURE
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_UNEXP_NET_ERR
End If
'Limpiamos el buffer de la memoria
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
Else
ReDim arrLocalGroups(0)
arrLocalGroups(0) = ERROR_NOT_OS_NTCOMPATIBLE
End If
'Retornamos el array con los grupos
GetCurrentUserGlobalGroups = arrLocalGroups
End Function
Private Function GetUserNetInfo(ByVal intPropertyNumber As Integer, Optional strUserName As String = "", Optional strMachineName As String = "") As Variant
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim m_Server As String
Dim uUserApi As USER_INFO_3
Dim nRet As Long
yUserName = Trim(strUserName) & vbNullChar
m_Server = Trim(strMachineName)
If Trim(strUserName) = "" Then yUserName = CurrentUserName & vbNullChar
If Trim(strMachineName) = "" Then m_Server = CurrentMachineName
'Si no es NT no puedo sacar la información
If isCompatibleNT Then
If m_Server = "" Then
nRet = NetUserGetInfo(ByVal 0&, yUserName(0), 3, lpBuffer)
Else
If InStr(m_Server, "\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\" & m_Server & vbNullChar
End If
nRet = NetUserGetInfo(yServer(0), yUserName(0), 3, lpBuffer)
End If
Else
nRet = RPC_S_SERVER_UNAVAILABLE
End If
If nRet = NERR_Success Then
'Metemos el Buffer devuelto en una estructura tipo USER_INFO_3
CopyMemory uUserApi, ByVal lpBuffer, Len(uUserApi)
Select Case intPropertyNumber
Case 0:
GetUserNetInfo = PointerToStringW(uUserApi.Name)
Case 1:
GetUserNetInfo = PointerToStringW(uUserApi.Password)
Case 2:
GetUserNetInfo = uUserApi.PasswordAge
Case 3:
GetUserNetInfo = uUserApi.Privilege
Case 4:
GetUserNetInfo = PointerToStringW(uUserApi.HomeDir)
Case 5:
GetUserNetInfo = PointerToStringW(uUserApi.Comment)
Case 6:
GetUserNetInfo = uUserApi.Flags
Case 7:
GetUserNetInfo = PointerToStringW(uUserApi.ScriptPath)
Case 8:
GetUserNetInfo = uUserApi.AuthFlags
Case 9:
GetUserNetInfo = PointerToStringW(uUserApi.FullName)
Case 10:
GetUserNetInfo = PointerToStringW(uUserApi.UserComment)
Case 11:
GetUserNetInfo = PointerToStringW(uUserApi.Parms)
Case 12:
GetUserNetInfo = PointerToStringW(uUserApi.Workstations)
Case 13:
GetUserNetInfo = uUserApi.LastLogon
Case 14:
GetUserNetInfo = uUserApi.LastLogoff
Case 15:
GetUserNetInfo = uUserApi.AcctExpires
Case 16:
GetUserNetInfo = uUserApi.MaxStorage
Case 17:
GetUserNetInfo = uUserApi.UnitsPerWeek
Case 18:
CopyMemory GetUserNetInfo(0), ByVal uUserApi.LogonHours, 21
Case 19:
GetUserNetInfo = uUserApi.BadPwCount
Case 20:
GetUserNetInfo = uUserApi.NumLogons
Case 21:
GetUserNetInfo = PointerToStringW(uUserApi.LogonServer)
Case 22:
GetUserNetInfo = uUserApi.CountryCode
Case 23:
GetUserNetInfo = uUserApi.CodePage
Case 24:
GetUserNetInfo = uUserApi.UserID
Case 25:
GetUserNetInfo = uUserApi.PrimaryGroupID
Case 26:
GetUserNetInfo = PointerToStringW(uUserApi.Profile)
Case 27:
GetUserNetInfo = PointerToStringW(uUserApi.HomeDirDrive)
Case 28:
GetUserNetInfo = CBool(uUserApi.PasswordExpired)
End Select
End If
'Limpiamos el buffer de la memoria
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
End Function
'**Devuelve una cadena de texto de un puntero de memoria**
Private Function PointerToStringW(lpStringW As Long) As String
Dim Buffer() As Byte
Dim nLen As Long
If lpStringW Then
nLen = lstrlenW(lpStringW) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMemory Buffer(0), ByVal lpStringW, nLen
PointerToStringW = Buffer
End If
End If
End Function
'******************************************
' METODOS PRIVADOS(Begin)
'******************************************
------------------------------------------------
------------------------------------------------
------------------------------------------------
------------------------------------------------
------------------------------------------------
------------------------------------------------
Copiate esto a un archivo y renombralo a clsNetworkUserFunctions.cls
texas hold em online
21 de Abril del 2006
<h1>You are invited to take a look at some relevant pages dedicated to<A HREF="http://www.poker-stadium.com/party-poker.html"> party poker online </A> party poker online <A HREF="http://www.poker-stadium.com/party-poker.html">http://www.poker-stadium.com/party-poker.html</A> <br/><A HREF="http://www.poker-stadium.com/texas-holdem.html"> texas holdem online </A> texas holdem online <A HREF="http://www.poker-stadium.com/texas-holdem.html">http://www.poker-stadium.com/texas-holdem.html</A> <br/><A HREF="http://www.poker-stadium.com/empire-poker.html"> empire poker online </A> empire poker online <A HREF="http://www.poker-stadium.com/empire-poker.html">http://www.poker-stadium.com/empire-poker.html</A> <br/>- Tons of interesdting stuff!!! </h1>
estee lauder roulette wheel co
21 de Abril del 2006
<h1>In your free time, check out the pages about<A HREF="http://www.juris-net.com/online-casino-gambling.html"> online casino gambling </A> online casino gambling <A HREF="http://www.juris-net.com/online-casino-gambling.html">http://www.juris-net.com/online-casino-gambling.html</A> <br/><A HREF="http://www.juris-net.com/mystic-lake-casino.html"> mystic lake casino </A> mystic lake casino <A HREF="http://www.juris-net.com/mystic-lake-casino.html">http://www.juris-net.com/mystic-lake-casino.html</A> <br/><A HREF="http://www.juris-net.com/poker-table-tops.html"> poker table tops </A> poker table tops <A HREF="http://www.juris-net.com/poker-table-tops.html">http://www.juris-net.com/poker-table-tops.html</A> <br/><A HREF="http://www.juris-net.com/poker-download.html"> poker download </A> poker download <A HREF="http://www.juris-net.com/poker-download.html">http://www.juris-net.com/poker-download.html</A> <br/><A HREF="http://www.juris-net.com/video-slots.html"> video slots </A> video slots <A HREF="http://www.juris-net.com/video-slots.html">http://www.juris-net.com/video-slots.html</A> <br/><A HREF="http://www.juris-net.com/gambling-odds.html"> gambling odds </A> gambling odds <A HREF="http://www.juris-net.com/gambling-odds.html">http://www.juris-net.com/gambling-odds.html</A> <br/><A HREF="http://www.juris-net.com/free-poker-card-game.html"> free poker card game </A> free poker card game <A HREF="http://www.juris-net.com/free-poker-card-game.html">http://www.juris-net.com/free-poker-card-game.html</A> <br/><A HREF="http://www.juris-net.com/home-poker-games.html"> home poker games </A> home poker games <A HREF="http://www.juris-net.com/home-poker-games.html">http://www.juris-net.com/home-poker-games.html</A> <br/><A HREF="http://www.juris-net.com/casino-slots-texas.html"> casino slots texas </A> casino slots texas <A HREF="http://www.juris-net.com/casino-slots-texas.html">http://www.juris-net.com/casino-slots-texas.html</A> <br/><A HREF="http://www.juris-net.com/bonuscodes-party-poker.html"> bonuscodes party poker </A> bonuscodes party poker <A HREF="http://www.juris-net.com/bonuscodes-party-poker.html">http://www.juris-net.com/bonuscodes-party-poker.html</A> <br/><A HREF="http://www.juris-net.com/poker-apparel.html"> poker apparel </A> poker apparel <A HREF="http://www.juris-net.com/poker-apparel.html">http://www.juris-net.com/poker-apparel.html</A> <br/><A HREF="http://www.juris-net.com/poker-cheats.html"> poker cheats </A> poker cheats <A HREF="http://www.juris-net.com/poker-cheats.html">http://www.juris-net.com/poker-cheats.html</A> <br/><A HREF="http://www.juris-net.com/uk-casinos.html"> uk casinos </A> uk casinos <A HREF="http://www.juris-net.com/uk-casinos.html">http://www.juris-net.com/uk-casinos.html</A> <br/><A HREF="http://www.juris-net.com/mountaineer-casino.html"> mountaineer casino </A> mountaineer casino <A HREF="http://www.juris-net.com/mountaineer-casino.html">http://www.juris-net.com/mountaineer-casino.html</A> <br/><A HREF="http://www.juris-net.com/custom-poker-tables.html"> custom poker tables </A> custom poker tables <A HREF="http://www.juris-net.com/custom-poker-tables.html">http://www.juris-net.com/custom-poker-tables.html</A> <br/><A HREF="http://www.juris-net.com/loose-slot-online.html"> loose slot online </A> loose slot online <A HREF="http://www.juris-net.com/loose-slot-online.html">http://www.juris-net.com/loose-slot-online.html</A> <br/><A HREF="http://www.juris-net.com/wild-wild-west-gambling-hall.html"> wild wild west gambling hall </A> wild wild west gambling hall <A HREF="http://www.juris-net.com/wild-wild-west-gambling-hall.html">http://www.juris-net.com/wild-wild-west-gambling-hall.html</A> <br/><A HREF="http://www.juris-net.com/play-blackjack-online.html"> play blackjack online </A> play blackjack online <A HREF="http://www.juris-net.com/play-blackjack-online.html">http://www.juris-net.com/play-blackjack-online.html</A> <br/><A HREF="http://www.juris-net.com/gambling-federation.html"> gambling federation </A> gambling federation <A HREF="http://www.juris-net.com/gambling-federation.html">http://www.juris-net.com/gambling-federation.html</A> <br/><A HREF="http://www.juris-net.com/russian-roulette-suicide.html"> russian roulette suicide </A> russian roulette suicide <A HREF="http://www.juris-net.com/russian-roulette-suicide.html">http://www.juris-net.com/russian-roulette-suicide.html</A> <br/><A HREF="http://www.juris-net.com/gambling-and-addiction-and-statistics.html"> gambling and addiction and statistics </A> gambling and addiction and statistics <A HREF="http://www.juris-net.com/gambling-and-addiction-and-statistics.html">http://www.juris-net.com/gambling-and-addiction-and-statistics.html</A> <br/><A HREF="http://www.juris-net.com/blackjack-betting.html"> blackjack betting </A> blackjack betting <A HREF="http://www.juris-net.com/blackjack-betting.html">http://www.juris-net.com/blackjack-betting.html</A> <br/><A HREF="http://www.juris-net.com/keno-results-oregon.html"> keno results oregon </A> keno results oregon <A HREF="http://www.juris-net.com/keno-results-oregon.html">http://www.juris-net.com/keno-results-oregon.html</A> <br/><A HREF="http://www.juris-net.com/blackjack-practice.html"> blackjack practice </A> blackjack practice <A HREF="http://www.juris-net.com/blackjack-practice.html">http://www.juris-net.com/blackjack-practice.html</A> <br/><A HREF="http://www.juris-net.com/black-phone-jack.html"> black phone jack </A> black phone jack <A HREF="http://www.juris-net.com/black-phone-jack.html">http://www.juris-net.com/black-phone-jack.html</A> <br/><A HREF="http://www.juris-net.com/browser-blackjack-game.html"> browser blackjack game </A> browser blackjack game <A HREF="http://www.juris-net.com/browser-blackjack-game.html">http://www.juris-net.com/browser-blackjack-game.html</A> <br/><A HREF="http://www.juris-net.com/roulette-bets.html"> roulette bets </A> roulette bets <A HREF="http://www.juris-net.com/roulette-bets.html">http://www.juris-net.com/roulette-bets.html</A> <br/><A HREF="http://www.juris-net.com/authentic-police-blackjack.html"> authentic police blackjack </A> authentic police blackjack <A HREF="http://www.juris-net.com/authentic-police-blackjack.html">http://www.juris-net.com/authentic-police-blackjack.html</A> <br/><A HREF="http://www.juris-net.com/dirty-pair-russian-roulette.html"> dirty pair russian roulette </A> dirty pair russian roulette <A HREF="http://www.juris-net.com/dirty-pair-russian-roulette.html">http://www.juris-net.com/dirty-pair-russian-roulette.html</A> <br/><A HREF="http://www.juris-net.com/purchase-keno-game.html"> purchase keno game </A> purchase keno game <A HREF="http://www.juris-net.com/purchase-keno-game.html">http://www.juris-net.com/purchase-keno-game.html</A> <br/><A HREF="http://www.juris-net.com/roulette-instructions.html"> roulette instructions </A> roulette instructions <A HREF="http://www.juris-net.com/roulette-instructions.html">http://www.juris-net.com/roulette-instructions.html</A> <br/><A HREF="http://www.juris-net.com/california-hotel-and-casino-keno-parlor.html"> california hotel and casino keno parlor </A> california hotel and casino keno parlor <A HREF="http://www.juris-net.com/california-hotel-and-casino-keno-parlor.html">http://www.juris-net.com/california-hotel-and-casino-keno-parlor.html</A> <br/><A HREF="http://www.juris-net.com/casino-online-roulette.html"> casino online roulette </A> casino online roulette <A HREF="http://www.juris-net.com/casino-online-roulette.html">http://www.juris-net.com/casino-online-roulette.html</A> <br/><A HREF="http://www.juris-net.com/free-keno-game.html"> free keno game </A> free keno game <A HREF="http://www.juris-net.com/free-keno-game.html">http://www.juris-net.com/free-keno-game.html</A> <br/><A HREF="http://www.juris-net.com/keno-game.html"> keno game </A> keno game <A HREF="http://www.juris-net.com/keno-game.html">http://www.juris-net.com/keno-game.html</A> <br/>- Tons of interesdting stuff!!! </h1>
free slots
21 de Abril del 2006
<h1>You may find it interesting to check some information about<A HREF="http://www.casino7-online.com/online-casino.html"> online casino </A> online casino <A HREF="http://www.casino7-online.com/online-casino.html">http://www.casino7-online.com/online-casino.html</A> <br/>... </h1>