如何根据域用户名获得域用户中文名称

[laimon]

在本地和用户组中--》用户 里有三列显示，分别是名称，全名，描述。请问怎么根据用户名获得它的全名？？

[lyserver]

Option Explicit

Private Type USER_INFO_10
    usr10_name As Long
    usr10_comment As Long
    usr10_usr_comment As Long
    usr10_full_name As Long
End Type

Private Type USER_INFO
    name As String
    full_name As String
    comment As String
    usr_comment As String
End Type

Private Const ERROR_SUCCESS As Long = 0&
Private Const MAX_COMPUTERNAME As Long = 15
Private Const MAX_USERNAME As Long = 256
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2

Private Declare Function NetUserEnum Lib "netapi32" (servername As Byte, ByVal level As Long, ByVal filter As Long, buff As Long, ByVal buffsize As Long, entriesread As Long, totalentries As Long, resumehandle As Long) As Long
Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Byte, username As Byte, ByVal level As Long, lpBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
Private Declare Function GetUserName Lib "advapi32" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, ByVal nBytes As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long

Sub Main()
    Call DisplayUsers
End Sub

Private Sub DisplayUsers()
    Dim strTmp As String
    Dim bytServername() As Byte
    Dim colUsers As Collection
    Dim udtUserInfo As USER_INFO
    Dim i As Long

    strTmp = GetComputersName()

    If Len(strTmp) > 0 Then
        If InStr(strTmp, "\\") Then
            bytServername = strTmp & Chr$(0)
        Else
            bytServername = "\\" & strTmp & Chr$(0)
        End If
    End If

    Set colUsers = GetUserEnumInfo(bytServername())

    For i = 1 To colUsers.Count
        udtUserInfo = GetUserInfo(bytServername(), colUsers(i) & Chr$(0))
        Debug.Print "用户名： " & udtUserInfo.name
        Debug.Print "全名： " & udtUserInfo.full_name
        Debug.Print "描述： " & udtUserInfo.comment
    Next i
End Sub

Private Function GetUserEnumInfo(ByRef bytServername() As Byte) As Collection
    Dim lngUsers() As Long
    Dim lngBuff As Long
    Dim lngBuffSize As Long
    Dim lngEntriesRead As Long
    Dim lngTotalEntries As Long
    Dim intCnt As Integer
    Dim colUsers As New Collection

    lngBuffSize = 255
    
    If NetUserEnum(bytServername(0), 0, FILTER_NORMAL_ACCOUNT, lngBuff, lngBuffSize, lngEntriesRead, lngTotalEntries, 0&) = ERROR_SUCCESS Then
        ReDim lngUsers(0 To lngEntriesRead - 1) As Long
        CopyMemory lngUsers(0), ByVal lngBuff, lngEntriesRead * 4

        For intCnt = 0 To lngEntriesRead - 1
            colUsers.Add GetPointerToByteStringW(lngUsers(intCnt))
        Next intCnt
        NetApiBufferFree lngBuff
    End If

    Set GetUserEnumInfo = colUsers
End Function

Private Function GetPointerToByteStringW(lpString As Long) As String
    Dim bytBuff() As Byte
    Dim lngSize As Long

    If lpString Then
        lngSize = lstrlenW(lpString) * 2
        If lngSize Then
            ReDim bytBuff(0 To (lngSize - 1)) As Byte
            CopyMemory bytBuff(0), ByVal lpString, lngSize
            GetPointerToByteStringW = bytBuff
        End If
    End If
End Function

Private Function GetComputersName() As String
    Dim strTmp As String
    
    strTmp = Space$(MAX_COMPUTERNAME + 1)

    If GetComputerName(strTmp, Len(strTmp)) <> 0 Then
        GetComputersName = TrimNull(strTmp)
    End If
End Function

Private Function TrimNull(strItem As String) As String
    Dim intPos As Integer

    intPos = InStr(strItem, Chr$(0))

    If intPos Then
        TrimNull = Left$(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function

Private Function GetUserInfo(bytServername() As Byte, bytUsername() As Byte) As USER_INFO
    Dim udtUserInfo As USER_INFO_10
    Dim lngBuff As Long

    If NetUserGetInfo(bytServername(0), bytUsername(0), 10, lngBuff) = ERROR_SUCCESS Then
        CopyMemory udtUserInfo, ByVal lngBuff, Len(udtUserInfo)
        GetUserInfo.name = GetPointerToByteStringW(udtUserInfo.usr10_name)
        GetUserInfo.full_name = GetPointerToByteStringW(udtUserInfo.usr10_full_name)
        GetUserInfo.comment = GetPointerToByteStringW(udtUserInfo.usr10_comment)
        GetUserInfo.usr_comment = GetPointerToByteStringW(udtUserInfo.usr10_usr_comment)
        NetApiBufferFree lngBuff
    End If
End Function

[舉杯邀明月]

动作真快~~~~~~~~~~