Win NT / Get UserGroups Permissions in VB

Answer:
Actually, it's not too difficult in VB. Add the following code to a new Form, and also add a single command button (Command1) and a single listbox (List1):

Option Explicit

Private Const INVALID_HANDLE_VALUE     As Long = -1&
Private Const ERROR_SUCCESS            As Long = 0&
Private Const FORMAT_MESSAGE_FROM_SYSTEM     As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS  As Long = &H200

Private Const ERROR_ACCESS_DENIED      As Long = 5&
Private Const ERROR_INVALID_NAME       As Long = 123&
Private Const ERROR_MORE_DATA          As Long = 234&

Private Const NERR_BASE                As Long = 2100&
Private Const NERR_Success             As Long = 0&
Private Const NERR_GroupNotFound       As Long = NERR_BASE + 120&
Private Const NERR_UserNotFound        As Long = NERR_BASE + 121&
Private Const NERR_InvalidComputer     As Long = NERR_BASE + 251&
Private Const NERR_DCNotFound          As Long = NERR_BASE + 353&

Private Const constComputerNameLen     As Long = 15&
Private Const UNLEN                    As Long = 256& ' Maximum username length

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function NetUserGetGroups Lib "netapi32.dll" (Servername As Byte, username As Byte, ByVal level As Long, Buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal pBuffer As Long) As Long
Private Declare Function GetComputerNameW Lib "kernel32" (lpBuffer As Any, nSize As Long) As Long
Private Declare Function NetGetDCName Lib "netapi32.dll" (Servername As Byte, DomainName As Byte, Buffer As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserNameW Lib "advapi32.dll" (lpBuffer As Byte, nSize As Long) As Long

Private Function CurrentUserName() As String
   Dim Buffer As String
   Dim yBuffer() As Byte
   Dim nRet As Long
   Dim nLen As Long
   Const NameLength = UNLEN + 1
   
   nLen = NameLength * 2
   ReDim yBuffer(0 To nLen - 1) As Byte
   If GetUserNameW(yBuffer(0), nLen) Then
      Buffer = yBuffer
      CurrentUserName = Left(Buffer, nLen - 1)
   End If
End Function

Private Sub Command1_Click()
   Dim p_vntRtn                        As Variant
   Dim p_lngLoop                       As Long
   
   List1.Clear
   
   p_vntRtn = GetNTGroups(CurrentUserName())
   
   If VarType(p_vntRtn) <> vbEmpty Then
      For p_lngLoop = 0 To UBound(p_vntRtn)
         List1.AddItem p_vntRtn(p_lngLoop)
      Next p_lngLoop
   End If
   
End Sub

Private Function GetNTGroups(ByVal xi_strUserID As String) As Variant
On Error Resume Next                   ' Don't accept errors here
   Const p_constProcName               As String = "GetNTGroups"
   Dim p_bytUserName()                 As Byte
   Dim p_bytServerName()               As Byte
   Dim p_astrGroups()                  As String
   Dim p_alngGroups()                  As Long
   Dim p_strPDC_Name                   As String
   Dim p_strTmp                        As String
   Dim p_lngRtn                        As Long
   Dim p_lngBuffer                     As Long
   Dim p_lngEntriesRead                As Long
   Dim p_lngEntriesTotal               As Long
   Dim p_lngLevel                      As Long
   Dim p_lngBufferPtr                  As Long
   Dim p_lngLoop                       As Long
   Dim p_vntReplacementStrings         As Variant
   
   ' Default the return to EMPTY
   GetNTGroups = Empty
   
   ' Get the name of the PDC
   If GetPDC("", "", p_strPDC_Name) = False Then
      ' Already logged in this function -- just exit
      Exit Function
   End If
   
   ' Convert the user name to a byte array
   p_bytUserName = xi_strUserID & vbNullChar
   
   ' Convert the PDC name to a byte array
   If InStr(p_strPDC_Name, "\\") = 1 Then
      p_bytServerName = p_strPDC_Name & vbNullChar
   Else
      p_bytServerName = "\\" & p_strPDC_Name & vbNullChar
   End If
   
   ' Get the groups
   p_lngLevel = 0&
   p_lngBufferPtr = 4096
   p_lngRtn = NetUserGetGroups(p_bytServerName(0), _
                               p_bytUserName(0), _
                               p_lngLevel, _
                               p_lngBuffer, _
                               p_lngBufferPtr, _
                               p_lngEntriesRead, _
                               p_lngEntriesTotal)
      
   ' Check for errors
   If p_lngRtn = NERR_Success Then
      ReDim p_alngGroups(0 To p_lngEntriesRead - 1) As Long
      ReDim p_astrGroups(0 To p_lngEntriesRead - 1) As String
      CopyMem p_alngGroups(0), ByVal p_lngBuffer, p_lngEntriesRead * 4
      For p_lngLoop = 0 To p_lngEntriesRead - 1
         p_astrGroups(p_lngLoop) = PointerToStringW(p_alngGroups(p_lngLoop))
      Next p_lngLoop
   Else
      Select Case p_lngRtn
         Case ERROR_ACCESS_DENIED
            p_strTmp = "Access denied -- insufficient rights to run NetUserGetGroups function."
         Case NERR_InvalidComputer
            p_strTmp = "Invalid computer name for PDC: " & p_strPDC_Name
         Case NERR_UserNotFound
            p_strTmp = "User not found: " & xi_strUserID
         Case Else
            p_strTmp = ReturnApiErrString(p_lngRtn)
      End Select
      
      ' Raise or otherwise handle the error
   End If
   
   ' Free the buffer
   If p_lngBuffer Then
      NetApiBufferFree p_lngBuffer
   End If
   
   GetNTGroups = p_astrGroups
   
On Error GoTo 0
End Function

Public Function ReturnApiErrString(ByVal xi_lngErrorCode As Long) As String
On Error Resume Next                   ' Don't accept an error here!
   Const p_constProcName               As String = "ReturnApiErrString"
   Dim p_strBuffer                     As String
 
   ' ------------------------------------------
   ' Allocate the string, then get the system
   '     to tell us the error message
   '     associated with this error number
   ' ------------------------------------------
   p_strBuffer = String(256, 0)
   FormatMessage FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, xi_lngErrorCode, 0&, p_strBuffer, Len(p_strBuffer), 0&
   
   ' ------------------------------------------
   ' Strip the last null, then the last CrLf
   '     pair if it exists
   ' ------------------------------------------
   p_strBuffer = Left(p_strBuffer, InStr(p_strBuffer, vbNullChar) - 1)
   If Right$(p_strBuffer, 2) = Chr$(13) & Chr$(10) Then
      p_strBuffer = Mid$(p_strBuffer, 1, Len(p_strBuffer) - 2)
   End If
   
   ' ------------------------------------------
   ' Set the return value
   ' ------------------------------------------
   ReturnApiErrString = p_strBuffer

On Error GoTo 0
End Function

Private Function GetPDC(ByVal xi_strServer As String, _
                        ByVal xi_strDomain As String, _
                        ByRef xo_strPDC_Name As String) As Boolean
On Error Resume Next                   ' Don't accept error here
   Const p_constProcName               As String = "GetPDC"
   Dim p_strTmp                        As String
   Dim p_lngRtn                        As Long
   Dim p_lngBufferPtr                  As Long
   Dim p_astrTmp(100)                  As Byte
   Dim p_abytServerName()              As Byte
   Dim p_abytDomainName()              As Byte
   Dim p_vntReplacementStrings         As Variant
    
   ' Move to byte array
   p_abytServerName = xi_strServer & vbNullChar
   p_abytDomainName = xi_strDomain & vbNullChar
            
   ' Get the name of the PDC
   p_lngRtn = NetGetDCName(p_abytServerName(0), _
                           p_abytDomainName(0), _
                           p_lngBufferPtr)
   
   ' ------------------------------------------
   ' Set the return value (zero is success)
   ' ------------------------------------------
   If p_lngRtn = 0 Then
      GetPDC = True
   Else
      GetPDC = False
   
      Select Case p_lngRtn
         Case NERR_DCNotFound
            p_strTmp = "Could not find the domain controller for the current domain."
         Case ERROR_INVALID_NAME
            p_strTmp = "Invalid name for PDC -- the name could not be found."
         Case Else
            p_strTmp = ReturnApiErrString(p_lngRtn)
      End Select
      
      ' Raise or otherwise handle the error
   End If
     
   ' Translate the name
   If p_lngRtn = 0 Then
      xo_strPDC_Name = PointerToStringW(p_lngBufferPtr)
   Else
      xo_strPDC_Name = ""
   End If
   
   NetApiBufferFree p_lngBufferPtr

On Error GoTo 0
End Function

Private Function PointerToStringW(ByVal xi_lngStrPtr As Long) As String
On Error Resume Next                   ' Don't accept error here
   Dim p_abytBuffer()                  As Byte
   Dim p_lngLength                     As Long
   
   If xi_lngStrPtr Then
      
      p_lngLength = lstrlenW(xi_lngStrPtr) * 2
      
      If p_lngLength Then
         ReDim p_abytBuffer(0 To (p_lngLength - 1)) As Byte
         CopyMem p_abytBuffer(0), ByVal xi_lngStrPtr, p_lngLength
         PointerToStringW = p_abytBuffer
      End If
   
   End If
   
On Error GoTo 0
End Function