agkklr | Pour donner l'idée du truc :
Code :
- Option Explicit
- Type USER_INFO_10
- usr10_name As Long
- usr10_comment As Long
- usr10_usr_comment As Long
- usr10_full_name As Long
- End Type
- Type USER_INFO
- name As String
- full_name As String
- comment As String
- usr_comment As String
- End Type
- Const ERROR_SUCCESS As Long = 0&
- Const MAX_COMPUTERNAME As Long = 15
- Const MAX_USERNAME As Long = 256
- Const FILTER_NORMAL_ACCOUNT As Long = &H2
- Declare Function NetGetDCName Lib "netapi32" (ByVal servername As String, ByVal DomainName As String, adrBuffer As Any) As Long
- Declare Function NetUserGetInfo Lib "netapi32" _
- (lpServer As Byte, _
- username As Byte, _
- ByVal level As Long, _
- lpBuffer As Long) As Long
-
- Declare Function NetApiBufferFree Lib "netapi32" _
- (ByVal Buffer As Long) As Long
- Declare Function GetUserName Lib "advapi32" _
- Alias "GetUserNameA" _
- (ByVal lpBuffer As String, _
- nSize As Long) As Long
-
- Declare Sub CopyMemory Lib "kernel32" _
- Alias "RtlMoveMemory" _
- (xDest As Any, _
- xSource As Any, _
- ByVal nBytes As Long)
- Declare Function lstrlenW Lib "kernel32" _
- (ByVal lpString As Long) As Long
- Declare Function StrLen Lib "kernel32" _
- Alias "lstrlenW" _
- (ByVal lpString As Long) As Long
- Sub GetUserInfos(i As Integer)
- Dim tmp As String
- Dim bServername() As Byte
- Dim MyDCName As String
- Dim usr As USER_INFO
- Dim bUsername() As Byte
- tmp = VB_NetGetDCName(DCName:=MyDCName, DomainName:="Your domain" )
- If Len(tmp) Then
- bUsername = Cells(i, 4) & Chr$(0)
- If Len(tmp) Then
- If InStr(tmp, "\\" ) Then
- bServername = tmp & Chr$(0)
- Else
- bServername = "\\" & tmp & Chr$(0)
- End If
- End If
- usr = GetUserNetworkInfo(bServername(), bUsername())
- 'Cells(i, 4) = usr.name
- Cells(i, 7) = usr.full_name
- Cells(i, 8) = usr.comment
- 'Cells(i, 4) = usr.usr_comment
- End If
- End Sub
- Function VB_NetGetDCName(ByRef DCName As String, Optional ByVal servername As Variant, Optional ByVal DomainName As Variant) As String
- Dim Ret As Long
- Dim adrBuffer As Long
- If IsMissing(servername) Then
- servername = vbNullString
- End If
- If IsMissing(DomainName) Then
- DomainName = vbNullString
- End If
- servername = StrConv(servername, vbUnicode)
- DomainName = StrConv(DomainName, vbUnicode)
- Ret = NetGetDCName(servername, DomainName, adrBuffer)
- If Ret = 0 Then
- DCName = GetPointerToByteStringW(adrBuffer)
- Ret = NetApiBufferFree(ByVal adrBuffer)
- End If
- VB_NetGetDCName = DCName
- End Function
- Function TrimNull(item As String)
- Dim pos As Integer
- pos = InStr(item, Chr$(0))
- If pos Then
- TrimNull = Left$(item, pos - 1)
- Else
- TrimNull = item
- End If
- End Function
- Function GetUserNetworkInfo(bServername() As Byte, bUsername() As Byte) As USER_INFO
- Dim usrapi As USER_INFO_10
- Dim buff As Long
- If NetUserGetInfo(bServername(0), bUsername(0), 10, buff) = ERROR_SUCCESS Then
- CopyMemory usrapi, ByVal buff, Len(usrapi)
- GetUserNetworkInfo.name = GetPointerToByteStringW(usrapi.usr10_name)
- GetUserNetworkInfo.full_name = GetPointerToByteStringW(usrapi.usr10_full_name)
- GetUserNetworkInfo.comment = GetPointerToByteStringW(usrapi.usr10_comment)
- GetUserNetworkInfo.usr_comment = GetPointerToByteStringW(usrapi.usr10_usr_comment)
- NetApiBufferFree buff
- End If
- End Function
- Function GetPointerToByteStringW(lpString As Long) As String
- Dim buff() As Byte
- Dim nSize As Long
- If lpString Then
- nSize = lstrlenW(lpString) * 2
- If nSize Then
- ReDim buff(0 To (nSize - 1)) As Byte
- CopyMemory buff(0), ByVal lpString, nSize
- GetPointerToByteStringW = buff
- End If
- End If
- End Function
|
---------------
"Mon modèle, c'est moi-même."
|