Vill få reda på vilka grupper en användare som loggar in med sitt användarkonto har.

Finns det någon piffig funktion för detta?

Det borde väl finnas ett api antar jag...

Tack
Andreas

Hej

Sökte lite på nätet och hittade en Class som gör det du vill göra. Om du går igenom koden så ser du hur det går till.

Lycka till

//
Janne

Kod i en modul
<code>
Option Explicit

Sub main()
Dim i As Integer
Dim User As CNetUser

Set User = New CNetUser

User.Server = "MyServer"
User.UserName = "MyUser"

For i = 1 To User.GroupCount
Debug.Print User.Group(i)
Next

Set User = Nothing

End Sub
</code>


Kod i klassen CNetUser.
<code>
Option Explicit
'
' Win32 APIs to determine OS information.
'
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
'
' Win32 NetAPIs.
'
Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
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 NetApiBufferFree Lib "netapi32" (ByVal pBuffer 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 Type USER_INFO_3_API
' Level 0 starts here
Name As Long
End Type

Private Type USER_INFO_3
' Level 0 starts here
Name As String
End Type

Private Type GROUP_INFO_2_API
Name As Long
Comment As Long
GroupID As Long
Attributes As Long
End Type

Private Type GROUP_INFO_2
Name As String
Comment As String
GroupID As Long
Attributes As Long
End Type

Private Const FILTER_TEMP_DUPLICATE_ACCOUNT As Long = &H1&
Private Const FILTER_NORMAL_ACCOUNT As Long = &H2&
Private Const FILTER_PROXY_ACCOUNT As Long = &H4&
Private Const FILTER_INTERDOMAIN_TRUST_ACCOUNT As Long = &H8&
Private Const FILTER_WORKSTATION_TRUST_ACCOUNT As Long = &H10&
Private Const FILTER_SERVER_TRUST_ACCOUNT As Long = &H20&

Private Const NERR_Success As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const TIMEQ_FOREVER = -1& '((unsigned long) -1L)
Private Const USER_MAXSTORAGE_UNLIMITED = -1& '((unsigned long) -1L)
Private Const USER_NO_LOGOFF = -1& '((unsigned long) -1L)
Private Const UNITS_PER_DAY = 24
Private Const UNITS_PER_WEEK = UNITS_PER_DAY * 7

Private Const USER_PRIV_MASK = 3
Private Const USER_PRIV_GUEST = 0
Private Const USER_PRIV_USER = 1
Private Const USER_PRIV_ADMIN = 2

Private Const UNLEN = 256 ' Maximum username length
Private Const GNLEN = UNLEN ' Maximum groupname length
Private Const CNLEN = 15 ' Maximum computer name length
Private Const MAXCOMMENTSZ = 256 ' Multipurpose comment length
Private Const LG_INCLUDE_INDIRECT As Long = &H1&

Private m_UserInfo As USER_INFO_3
Private m_UserName As String
Private m_Server As String
Private m_Groups() As String
Private m_LocalGroups() As String
Private m_IsWinNT As Boolean

' *********************************************************
' Initialization
' *********************************************************
Private Sub Class_Initialize()
Dim os As OSVERSIONINFO
os.dwOSVersionInfoSize = Len(os)
Call GetVersionEx(os)

If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
m_IsWinNT = True
End If
End Sub

' *********************************************************
' Public Properties
' *********************************************************
Public Property Get UserName() As String
UserName = m_UserInfo.Name
End Property

Public Property Let UserName(NewVal As String)
m_UserName = NewVal
Me.Refresh
End Property

Public Property Get Server() As String
Server = m_Server
End Property

Public Property Let Server(NewVal As String)
m_Server = NewVal
End Property

Public Property Get GroupCount() As Long
On Error Resume Next
GroupCount = UBound(m_Groups) + 1
End Property

Public Property Get Group(ByVal Index As Long) As String
If Index >= LBound(m_Groups) And Index <= UBound(m_Groups) Then
Group = m_Groups(Index)
End If
End Property

' *********************************************************
' Public Methods
' *********************************************************
Public Function Refresh() As Boolean
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim uUserApi As USER_INFO_3_API
Dim nRet As Long

yUserName = m_UserName & vbNullChar
If m_Server = "" Then
nRet = NetUserGetInfo(ByVal 0&, yUserName(0), 3, lpBuffer)
Else
If InStr(m_Server, "\\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\\" & m_Server & vbNullChar
End If
nRet = NetUserGetInfo(yServer(0), yUserName(0), 3, lpBuffer)
End If

If nRet = NERR_Success Then
CopyMem uUserApi, ByVal lpBuffer, Len(uUserApi)
'
' Transfer data to VB structure
'
m_UserInfo.Name = PointerToStringW(uUserApi.Name)
'
' Return success
'
Refresh = True
End If
'
' Clean up
'
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
RefreshGroups
End If
End Function

Public Function NetTimeToVbTime(NetDate As Long) As Double
Const BaseDate# = 25569 'DateSerial(1970, 1, 1)
Const SecsPerDay# = 86400
NetTimeToVbTime = BaseDate + (CDbl(NetDate) / SecsPerDay)
End Function

Private Sub RefreshGroups()
Dim lpBuffer As Long
Dim yUserName() As Byte
Dim yServer() As Byte
Dim lpGroups() As Long
Dim nRead As Long
Dim nTotal As Long
Dim nRet As Long
Dim i As Long

yUserName = m_UserName & vbNullChar
If m_Server = "" Then
nRet = NetUserGetGroups(ByVal 0&, yUserName(0), 0, lpBuffer, &H4000, nRead, nTotal)
Else
If InStr(m_Server, "\\") = 1 Then
yServer = m_Server & vbNullChar
Else
yServer = "\\" & m_Server & vbNullChar
End If
nRet = NetUserGetGroups(yServer(0), yUserName(0), 0, lpBuffer, &H400, nRead, nTotal)
End If

If nRet = NERR_Success Then
ReDim lpGroups(0 To nRead - 1) As Long
ReDim m_Groups(0 To nRead - 1) As String
CopyMem lpGroups(0), ByVal lpBuffer, nRead * 4
For i = 0 To nRead - 1
m_Groups(i) = PointerToStringW(lpGroups(i))
Next i
End If
'
' Clean up
'
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
End Sub

Private Function PointerToStringW(lpStringW As Long) As String
Dim Buffer() As Byte
Dim nLen As Long

If lpStringW Then
nLen = lstrlenW(lpStringW) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMem Buffer(0), ByVal lpStringW, nLen
PointerToStringW = Buffer
End If
End If
End Function

Private Function PointerToDWord(lpDWord As Long) As Long
Dim nRet As Long
If lpDWord Then
CopyMem nRet, ByVal lpDWord, 4
PointerToDWord = nRet
End If
End Function

</code>

Tackar!