怎样判断用户帐号所属的组

Question

怎样在程序中判断某个用户帐号是属于哪个组的呢？有什么API可以实现吗？

Answer 1

'To a form, add a listbox (List1) and five text boxes (Text1 through Text5). Add the following code:
'
'--------------------------------------------------------------------------------
 
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ?1996-2005 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Windows type used to call the Net API
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 to hold the actual strings displayed
Private Type USER_INFO
   name          As String
   full_name     As String
   comment       As String
   usr_comment   As String
End TypePrivate 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 = &H2Private 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
   
Private Declare Function NetApiBufferFree Lib "netapi32" _
  (ByVal Buffer As Long) As LongPrivate 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 LongPrivate 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 LongPrivate Declare Function StrLen Lib "kernel32" _
   Alias "lstrlenW" _
  (ByVal lpString As Long) As Long
Private Sub Form_Load()   Dim tmp As String
   Dim bServername() As Byte
   
   tmp = GetComputersName()  'assure the server string is properly formatted
   If Len(tmp) Then
   
      If InStr(tmp, "\\") Then
         bServername = tmp & Chr$(0)
      Else
         bServername = "\\" & tmp & Chr$(0)
      End If
   
   End If
   
   Text1.Text = tmp   Call GetUserEnumInfo(bServername())
   
End Sub
Private Function GetUserEnumInfo(bServername() As Byte)
  
   Dim users() As Long
   Dim buff As Long
   Dim buffsize As Long
   Dim entriesread As Long
   Dim totalentries As Long
   Dim cnt As Integer
   
   buffsize = 255
   
   If NetUserEnum(bServername(0), 0, _
                   FILTER_NORMAL_ACCOUNT, _
                   buff, buffsize, _
                   entriesread, _
                   totalentries, 0&) = ERROR_SUCCESS Then
   
      ReDim users(0 To entriesread - 1) As Long
      CopyMemory users(0), ByVal buff, entriesread * 4
      
      For cnt = 0 To entriesread - 1
         List1.AddItem GetPointerToByteStringW(users(cnt))
      Next cnt
      
      NetApiBufferFree buff
   
   End IfEnd Function
Private Function GetComputersName() As String  'returns the name of the computer
   Dim tmp As String
   
   tmp = Space$(MAX_COMPUTERNAME + 1)
    
   If GetComputerName(tmp, Len(tmp)) <> 0 Then
      GetComputersName = TrimNull(tmp)
   End If
   
End Function
Private 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
Private 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
      
     'copy the data from buff into the
     'API user_10 structure
      CopyMemory usrapi, ByVal buff, Len(usrapi)
      
     'extract each member and return
     'as members of the UDT
      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
Private Function GetPointerToByteStringW(lpString As Long) As String
  
   Dim buff() As Byte
   Dim nSize As Long
   
   If lpString Then
   
     'its Unicode, so mult. by 2
      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
Private Sub List1_Click()   Dim usr As USER_INFO
   Dim bUsername() As Byte
   Dim bServername() As Byte
   Dim tmp As String
  
  'This assures that both the server
  'and user params have data
   If Len(Text1.Text) And (List1.ListIndex > -1) Then
   
      bUsername = List1.List(List1.ListIndex) & Chr$(0)
   
     'This demo uses the current machine as the
     'server param, which works on NT4 and Win2000.
     'If connected to a PDC or BDC, pass that
     'name as the server, instead of the return
     'value from GetComputerName().
      tmp = Text1.Text
   
     'assure the server string is properly formatted
      If Len(tmp) Then
      
         If InStr(tmp, "\\") Then
            bServername = tmp & Chr$(0)
         Else
            bServername = "\\" & tmp & Chr$(0)
         End If
      
      End If
   
     'Return the user information for the passed
     'user. The return values are assigned directly
     'to the non-API USER_INFO data type that we
     'defined (I prefer UDTs). Alternatively, if
     'you're a 'classy' sort of guy,  the return
     'values could be assigned directly to properties
     'in the function.
      usr = GetUserNetworkInfo(bServername(), bUsername())
      
      Text2.Text = usr.name
      
     'The call may or may not return the
     'full name, comment or usr_comment
     'members, depending on the user's
     'listing in User Manager.
      Text3.Text = usr.full_name
      Text4.Text = usr.comment
      Text5.Text = usr.usr_comment
   
   End IfEnd Sub
 

Answer 2

用整那么复杂吗.
引用WMI,然后测试以下代码Private Sub Form_Click()
Set colGroups = GetObject("WinNT://.")
colGroups.Filter = Array("group")
For Each objGroup In colGroups
    Print "组名: " & objGroup.Name
    For Each objUser In objGroup.Members
        Print vbTab & "包含的用户:" & objUser.Name
    Next
Next
End Sub

Answer 3

.......
用户要是把WMI禁了 就不简单了