Option Explicit

'获得指定用户的信息
Private Declare Function NetUserGetInfo Lib "netapi32" _
                          (lpServer As Byte, _
                          username As Byte, _
                          ByVal level As Long, _
                          lpBuffer As Long) As Long

'列举系统用户的
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

'当您用完系统传回的缓冲器后,应该将它传递到NetApiBufferFree,以释放缓冲器
Private Declare Function NetApiBufferFree Lib "netapi32" _
                          (ByVal Buffer 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 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 = 128
Private Const MAX_USERNAME As Long = 256
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2

Private Sub Form_Load()
    Me.AutoRedraw = True
    Call DisplayUsers
End Sub

Private Sub DisplayUsers()
    Dim strPcName As String
    Dim abytServername() As Byte
    Dim colUsers As Collection
    Dim udtUserInfo As USER_INFO
    Dim i As Long

    strPcName = GetComputersName()

    If Len(strPcName) > 0 Then

        If InStr(strPcName, "\\") Then

            abytServername = strPcName & Chr$(0)

        Else

            abytServername = "\\" & strPcName & Chr$(0)

        End If

    End If

    Set colUsers = GetUserEnumInfo(abytServername())

    For i = 1 To colUsers.Count

        udtUserInfo = GetUserInfo(abytServername(), colUsers(i) & Chr$(0))

        Print "User Name: " & udtUserInfo.name
        Print "User Full Name: " & udtUserInfo.full_name
        Print "Comment: " & udtUserInfo.comment
        Print "User Comment: " & udtUserInfo.usr_comment
        Print
    Next
End Sub

Private Function GetComputersName() As String
    Dim strPcName As String

    strPcName = Space$(MAX_COMPUTERNAME + 1)

    If GetComputerName(strPcName, Len(strPcName)) <> 0 Then

        GetComputersName = TrimNull(strPcName)

    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 GetUserEnumInfo(ByRef abytServername() As Byte) As Collection
    Dim alngUsers() As Long
    Dim Buff As Long
    Dim lngBuffSize As Long
    Dim entriesread As Long
    Dim TotalEntries As Long
    Dim intCnt As Integer
    Dim colUsers As New Collection

    lngBuffSize = 255

    If NetUserEnum(abytServername(0), 0, _
                   FILTER_NORMAL_ACCOUNT, _
                   Buff, lngBuffSize, _
                   entriesread, _
                   TotalEntries, 0&) = ERROR_SUCCESS Then

        'entriesread本机用户数,Buff中指向的地址包含了用户信息
        ReDim alngUsers(0 To entriesread - 1) As Long
        Call CopyMemory(alngUsers(0), ByVal Buff, entriesread * 4)

        For intCnt = 0 To entriesread - 1
            colUsers.Add GetPointerToByteStringW(alngUsers(intCnt))
        Next

        Call NetApiBufferFree(Buff)

    End If

    Set GetUserEnumInfo = colUsers
End Function

Private Function GetUserInfo(abytServername() As Byte, bytUsername() As Byte) As USER_INFO
    Dim udtUserInfo As USER_INFO_10
    Dim Buff As Long
        
    '10使用USER_INFO_10
    If NetUserGetInfo(abytServername(0), bytUsername(0), 10, Buff) = ERROR_SUCCESS Then
        Call CopyMemory(udtUserInfo, ByVal Buff, 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)

        Call NetApiBufferFree(Buff)
    End If
End Function

'指针提取双字节字符
Private Function GetPointerToByteStringW(lpString As Long) As String
    Dim abytBuff() As Byte
    Dim lngSize As Long

    If lpString Then
        lngSize = lstrlenW(lpString) * 2     '双字节

        If lngSize Then

            ReDim abytBuff(0 To (lngSize - 1)) As Byte
            Call CopyMemory(abytBuff(0), ByVal lpString, lngSize)
            GetPointerToByteStringW = abytBuff

        End If
    End If
End Function