Para Alber y Antonio Parte 2
Public Property Get Home_Dir_() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Home_Dir_
Home_Dir_ = mvarHome_Dir_
End Property
Public Property Get Usuario() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Usuario
Usuario = mvarUsuario
End Property
Private Function GetStrFromBufferA(sz As String) As String
' Returns the string before first null char encountered (if any) from an ANSII string.
If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
' If sz had no null char, the Left$ function
' above would return a zero length string ("").
GetStrFromBufferA = sz
End If
End Function
Private Function GetStrFromPtrW(lpszW As Long) As String
' Returns an ANSI string from a pointer to a Unicode string.
Dim sRtn As String
sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0) ' 2 bytes/char
' WideCharToMultiByte also returns Unicode string length
Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRtn, Len(sRtn), 0, 0)
GetStrFromPtrW = GetStrFromBufferA(sRtn)
End Function
Public Property Get TextoError() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.TextoError
TextoError = mvarTextoError
End Property
Public Property Let NumError(ByVal vData As Long)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.NumError = 5
mvarNumError = vData
End Property
Public Property Get NumError() As Long
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.NumError
NumError = mvarNumError
End Property
Private Function GetPrimaryDCName(ByVal MName As String, _
ByVal DName As String) As String
Dim Result As Long, DCName As String, DCNPtr As Long
Dim DNArray() As Byte, MNArray() As Byte, DCNArray(100) As Byte
MNArray = MName & vbNullChar
DNArray = DName & vbNullChar
Result = NetGetDCName(MNArray(0), DNArray(0), DCNPtr)
If Result <> 0 Then
Debug.Print "Error: " & Result
Exit Function
End If
Result = PtrToStr(DCNArray(0), DCNPtr)
Result = NetAPIBufferFree(DCNPtr)
DCName = DCNArray()
GetPrimaryDCName = DCName
End Function
Public Sub ObtenerDatosusuario(Optional Usuario As String = "")
Dim Servidor As String, res As Boolean
If Usuario = "" Then Usuario = mvarUsuario
'busco al usuario en el dominio MiDominio
'busco el pdc del dominio
Servidor = GetPrimaryDCName("", "MiDominio")
res = ObtenerDatosUsuarioRed(Servidor, Usuario)
End Sub
Public Property Let Name_(ByVal vData As String)
'se usa al asignar un valor a la propiedad, en la parte izquierda de una asignación.
'Syntax: X.Name_ = 5
mvarName_ = vData
End Property
Public Property Get Name_() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Name_
Name_ = mvarName_
End Property
Public Property Get FullName_() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.FullName_
FullName_ = mvarFullName_
End Property
Public Property Get Comment_() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Comment_
Comment_ = mvarComment_
End Property
Public Property Get Dominio() As String
'se usa al recuperar un valor de una propiedad, en la parte derecha de una asignación.
'Syntax: Debug.Print X.Dominio
Dominio = mvarDominio
End Property
Private Function ObtenerDatosUsuarioRed(ByVal Servidor As String, Usuario As String) As Boolean
Dim bServer() As Byte, bUser() As Byte, BufPtr As Long
Dim res As Long, User_Info As USER_INFO_2
bServer = Servidor & vbNullChar
bUser = Usuario & vbNullChar
res = NetUserGetInfo(bServer(0), bUser(0), 2, BufPtr)
If res = NERR_Success Then
mvarNumError = 0
mvarTextoError = ""
Call MoveMemory(User_Info, ByVal BufPtr, Len(User_Info))
mvarName_ = GetStrFromPtrW(User_Info.Name)
mvarFullName_ = GetStrFromPtrW(User_Info.FullName)
mvarComment_ = GetStrFromPtrW(User_Info.Comment)
mvarHome_Dir_ = GetStrFromPtrW(User_Info.HomeDir)
mvarLogon_server_ = GetStrFromPtrW(User_Info.LogonServer)
mvarPassword_age_ = User_Info.PasswordAge
mvarPriv_ = User_Info.Privilege
Select Case mvarPriv_
Case 0: mvarPrivTxt = "Invitado"
Case 1: mvarPrivTxt = "Usuario"
Case 2: mvarPrivTxt = "Administrador"
End Select
mvarScript_path_ = GetStrFromPtrW(User_Info.ScriptPath)
mvarWorkstations_ = GetStrFromPtrW(User_Info.Workstations)
Else
mvarNumError = res
Select Case res
Case NERR_InvalidComputer: mvarTextoError = "Servidor no válido"
Case NERR_UseNotFound: mvarTextoError = "Usuario no encontrado"
Case Else: mvarTextoError = "Error desconocido"
End Select
mvarName_ = ""
mvarFullName_ = ""
mvarComment_ = ""
mvarHome_Dir_ = ""
mvarLogon_server_ = ""
mvarPassword_age_ = 0
mvarPriv_ = -1
mvarPrivTxt = "Desconocido"
mvarScript_path_ = ""
mvarWorkstations_ = ""
End If
res = NetAPIBufferFree(BufPtr)
End Function
Private Sub Class_Initialize()
Dim sName As String
Dim lNameLen As Long
Dim lReturn As Long
lNameLen = 255
sName = Space(256)
lReturn = GetUserName(sName, lNameLen)
If sName = "" Then
mvarUsuario = "(Desconocido)"
Else
mvarUsuario = Left(sName, InStr(sName, Chr(0)) - 1)
End If
End Sub
'---------------------------------------------------------------------------------
'AQUI TERMINA LA CLASE
Ahora dentro de cualquiera de las hojas que tiene COMO EJEMPLO coloque cualquier procedimiento que llamen cuando necesite por ejemplo
Public Sub MostarDatos()
Dim InfoUsuario As New jrUsuarioNT
InfoUsuario.ObtenerDatosusuario
MsgBox InfoUsuario.Name_
MsgBox InfoUsuario.FullName_
End Sub
Con lo anterior ya queda funcionando lo de las dos preguntas de ustedes asi que ya solo es mirar donde las ban a usar.
Saludos
http://www.theemulator.tk
