Detect status of current user

[stevendudson]

Is there an API that would tell me groups in which the current user is a member of. Or better still, whether the current user is an administrator?

Cheers.

[Frans C]

If you are talking about Win NT or win 2000 computers, you can use NetGroupEnum.

[Steve Stunning]

Greetings and Salutations,

This will do it.



Option Explicit

Private Declare Function NetUserGetGroups Lib "netapi32" _
(lpServer As Any, UserName As Byte, ByVal Level As Long, _
lpBuffer As Long, ByVal PrefMaxLen As Long, lpEntriesRead As _
Long, lpTotalEntries As Long) As Long

Private Declare Function NetUserGetLocalGroups _
Lib "netapi32.dll" (lpServer As Any, UserName As Byte, _
ByVal Level As Long, ByVal Flags As Long, lpBuffer As Long, _
ByVal MaxLen As Long, lpEntriesRead As Long, _
lpTotalEntries As Long) As Long


Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, _
ByVal Length As Long)

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal pBuffer As Long) As Long

Public Function GetUserGroups(ByVal ServerName As String, _
ByVal UserName As String, Optional bLocalGroups _
As Boolean = False) As String()

'******************************************************
'DESCRIPTION: RETURNS A STRING ARRAY OF NT GROUPS A GIVEN
' USER BELONGS TO ON A GIVEN SERVER

'PARAMETERS:

'ServerName: Name of Server
'UserName: Name of User
'bLocalGroups (Optional): if True returns local groups. Defaults
' to false, meaning that global groups are returned

'RETURNS: If Successful, a string array of each NT group
' UserName belongs to on ServerName. Otherwise,
' returns a 1 element array with "" as the only
' element

'REQUIRES:
' -- Windows NT4 or Windows 2000

' -- VB 6 because string array is returned
' (though it would be easy to modify for VB5)
' -- Assumes Option Base 1 is not set

'EXAMPLE: dim sUserArray() as String, iCtr as integer
' sUserArray = GetUserGroups("MyServer", "JoeUser")
' If sUserArray(0) <> "" then
' For iCtr = 0 to Ubound(sUserArray)
' debug.print sUserArray(ictr)
' Next
' End if
'***********************************************************


Dim bytUser() As Byte
Dim bytServer() As Byte

Dim lBuffer As Long
Dim lEntries As Long
Dim lMaxLen As Long
Dim lTotalEntries As Long
Dim lRet As Long
Dim lGroups() As Long
Dim sGroups() As String
Dim bytBuffer() As Byte
Dim iCtr As Integer
Dim lLen As Long

If bLocalGroups Then
ServerName = vbNullChar
Else
If Left(ServerName, 2) <> "\\" Then ServerName = _
"\\" & ServerName

End If

bytServer = ServerName & vbNullChar
bytUser = UserName & vbNullChar

If bLocalGroups Then
lRet = NetUserGetLocalGroups(bytServer(0), bytUser(0), 0, 0, _
lBuffer, 1024, lMaxLen, lTotalEntries)

Else
lRet = NetUserGetGroups(bytServer(0), bytUser(0), 0, _
lBuffer, 1024, lMaxLen, lTotalEntries)

End If

If lRet = 0 And lMaxLen > 0 Then
ReDim lGroups(lMaxLen - 1) As Long
ReDim sGroups(lMaxLen - 1) As String
CopyMemory lGroups(0), ByVal lBuffer, lMaxLen * 4
For iCtr = 0 To lMaxLen - 1
lLen = lstrlenW(lGroups(iCtr)) * 2
If lLen > 0 Then
ReDim bytBuffer(lLen - 1) As Byte
CopyMemory bytBuffer(0), ByVal lGroups(iCtr), _
lLen
sGroups(iCtr) = bytBuffer

End If
Next
Else
ReDim sGroups(0) As String
End If

If lBuffer > 0 Then NetApiBufferFree (lBuffer)
GetUserGroups = sGroups

End Function