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    


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