Récupérer le Full Name d'un utilisateur réseau en VBA [Résolu]

Récupérer le Full Name d'un utilisateur réseau en VBA [Résolu] - VB/VBA/VBS - Programmation

Marsh Posté le 14-09-2006 à 15:47:27    

Coucou
 
Je cherche la manière pour récupérer le paramètre "Full Name" d'un utilisateur sur un réseau.
 
Je sais qu'il faut utiliser la fonction NetUserGetInfo de la lib netapi32, mais j'y arrive^pô :(
 
Quelqu'un pourrait me filer un coup de main ? C'est pour une macro VBA.


Message édité par agkklr le 15-09-2006 à 08:52:47

---------------
"Mon modèle, c'est moi-même."
Reply

Marsh Posté le 14-09-2006 à 15:47:27   

Reply

Marsh Posté le 14-09-2006 à 19:02:45    

Bonsoir,
 
ici : http://support.microsoft.com/defau [...] r%3B151774 ça peut t'aider?
 
A+

Message cité 1 fois
Message édité par odvj le 14-09-2006 à 19:03:05
Reply

Marsh Posté le 15-09-2006 à 08:52:13    

odvj a écrit :

Bonsoir,
 
ici : http://support.microsoft.com/defau [...] r%3B151774 ça peut t'aider?
 
A+


Yes, ça m'a effectivement tout à fait aidé. C'est chose faite, merci !


---------------
"Mon modèle, c'est moi-même."
Reply

Marsh Posté le 15-09-2006 à 08:54:58    

Pour donner l'idée du truc :

Code :
  1. Option Explicit
  3. Type USER_INFO_10
  4.    usr10_name          As Long
  5.    usr10_comment       As Long
  6.    usr10_usr_comment   As Long
  7.    usr10_full_name     As Long
  8. End Type
  10. Type USER_INFO
  11.    name          As String
  12.    full_name     As String
  13.    comment       As String
  14.    usr_comment   As String
  15. End Type
  17. Const ERROR_SUCCESS As Long = 0&
  18. Const MAX_COMPUTERNAME As Long = 15
  19. Const MAX_USERNAME As Long = 256
  20. Const FILTER_NORMAL_ACCOUNT  As Long = &H2
  22. Declare Function NetGetDCName Lib "netapi32" (ByVal servername As String, ByVal DomainName As String, adrBuffer As Any) As Long
  24. Declare Function NetUserGetInfo Lib "netapi32" _
  25.    (lpServer As Byte, _
  26.    username As Byte, _
  27.    ByVal level As Long, _
  28.    lpBuffer As Long) As Long
  29.    
  30. Declare Function NetApiBufferFree Lib "netapi32" _
  31.   (ByVal Buffer As Long) As Long
  33. Declare Function GetUserName Lib "advapi32" _
  34.    Alias "GetUserNameA" _
  35.   (ByVal lpBuffer As String, _
  36.    nSize As Long) As Long
  37.  
  38. Declare Sub CopyMemory Lib "kernel32" _
  39.    Alias "RtlMoveMemory" _
  40.   (xDest As Any, _
  41.    xSource As Any, _
  42.    ByVal nBytes As Long)
  44. Declare Function lstrlenW Lib "kernel32" _
  45.   (ByVal lpString As Long) As Long
  47. Declare Function StrLen Lib "kernel32" _
  48.    Alias "lstrlenW" _
  49.   (ByVal lpString As Long) As Long
  51. Sub GetUserInfos(i As Integer)
  52.    Dim tmp As String
  53.    Dim bServername() As Byte
  54.    Dim MyDCName As String
  55.    Dim usr As USER_INFO
  56.    Dim bUsername() As Byte
  57.    tmp = VB_NetGetDCName(DCName:=MyDCName, DomainName:="Your domain" )
  58.    If Len(tmp) Then
  59.       bUsername = Cells(i, 4) & Chr$(0)
  60.       If Len(tmp) Then
  61.          If InStr(tmp, "\\" ) Then
  62.             bServername = tmp & Chr$(0)
  63.          Else
  64.             bServername = "\\" & tmp & Chr$(0)
  65.          End If
  66.       End If
  67.       usr = GetUserNetworkInfo(bServername(), bUsername())
  68.       'Cells(i, 4) = usr.name
  69.       Cells(i, 7) = usr.full_name
  70.       Cells(i, 8) = usr.comment
  71.       'Cells(i, 4) = usr.usr_comment
  72.    End If
  75. End Sub
  77. Function VB_NetGetDCName(ByRef DCName As String, Optional ByVal servername As Variant, Optional ByVal DomainName As Variant) As String
  78.     Dim Ret As Long
  79.     Dim adrBuffer As Long
  80.     If IsMissing(servername) Then
  81.         servername = vbNullString
  82.     End If
  83.     If IsMissing(DomainName) Then
  84.         DomainName = vbNullString
  85.     End If
  86.     servername = StrConv(servername, vbUnicode)
  87.     DomainName = StrConv(DomainName, vbUnicode)
  88.     Ret = NetGetDCName(servername, DomainName, adrBuffer)
  89.     If Ret = 0 Then
  90.         DCName = GetPointerToByteStringW(adrBuffer)
  91.         Ret = NetApiBufferFree(ByVal adrBuffer)
  92.     End If
  93.     VB_NetGetDCName = DCName
  94. End Function
  95. Function TrimNull(item As String)
  96.    Dim pos As Integer
  97.    pos = InStr(item, Chr$(0))
  98.    If pos Then
  99.       TrimNull = Left$(item, pos - 1)
  100.    Else
  101.       TrimNull = item
  102.    End If
  103. End Function
  105. Function GetUserNetworkInfo(bServername() As Byte, bUsername() As Byte) As USER_INFO
  106.    Dim usrapi As USER_INFO_10
  107.    Dim buff As Long
  108.    If NetUserGetInfo(bServername(0), bUsername(0), 10, buff) = ERROR_SUCCESS Then
  109.       CopyMemory usrapi, ByVal buff, Len(usrapi)
  110.       GetUserNetworkInfo.name = GetPointerToByteStringW(usrapi.usr10_name)
  111.       GetUserNetworkInfo.full_name = GetPointerToByteStringW(usrapi.usr10_full_name)
  112.       GetUserNetworkInfo.comment = GetPointerToByteStringW(usrapi.usr10_comment)
  113.       GetUserNetworkInfo.usr_comment = GetPointerToByteStringW(usrapi.usr10_usr_comment)
  114.       NetApiBufferFree buff
  115.    End If
  116. End Function
  118. Function GetPointerToByteStringW(lpString As Long) As String
  119.    Dim buff() As Byte
  120.    Dim nSize As Long
  121.    If lpString Then
  122.       nSize = lstrlenW(lpString) * 2
  123.       If nSize Then
  124.          ReDim buff(0 To (nSize - 1)) As Byte
  125.          CopyMemory buff(0), ByVal lpString, nSize
  126.          GetPointerToByteStringW = buff
  127.      End If
  128.    End If
  129. End Function


---------------
"Mon modèle, c'est moi-même."
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed