vbams-accessactive-directorygroup-membership

vba - Check Active Directory Group Membership Offline


Is there in vba the possibility to check an Active Directory group membership offline?

I have managed the online and offline user credential check (username, password).

Online = Layer 3 connection to company domain network (LAN or Wifi)
Offline = No physical network connection - no LAN, no Wifi

Public Declare Function LogonUser Lib "advapi32" Alias "LogonUserA" _
(ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, _
 ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Const LOGON32_PROVIDER_DEFAULT As Long = 0&
Public Const LOGON32_LOGON_INTERACTIVE As Integer = 2&

Public Function ADUserLogin(ByVal strUsername As String, ByVal strPassword As String, _
                            ByVal strDomain As String) As Boolean

    On Error GoTo ADUserLogin_Error
    Dim tokenHandle As Long
 
    ADUserLogin = LogonUser(strUsername, strDomain, strPassword,  LOGON32_LOGON_INTERACTIVE, _
                            LOGON32_PROVIDER_DEFAULT, tokenHandle)
    CloseHandle tokenHandle
    
    On Error GoTo 0
    Exit Function

ADUserLogin_Error:

    MsgBox "Error " & Err.Number & " (" & Err.description & ") in procedure ADUserLogin, line " & Erl & "."
End Function

But how does it work for the Active Directory group membership?

With kind regards Ronny


Solution

  • I have solved it as follows. When the user logs in online, I check which group he belongs to and save this including the last login date and time. Now the user has 14 days the possibility to log in offline to the database.

    If in the meantime there is a connection to the domain again, I simply check the group membership again and react accordingly.

    If someone knows a better way, I am always open for suggestions. :-)

    Public Function IsMember(ByVal strUsername As String, ByVal strPassword As String, ByVal strGroup As String, Optional ByVal strDomain As String) As Boolean
    10        On Error GoTo IsMember_Error
    
    20        If Not Len(strDomain) <> 0 Or IsNull(strDomain) Then
    30            strDomain = CreateObject("WScript.Network").UserDomain
    40        End If
    
    50        Set objIADS = GetObject("WinNT:").OpenDSObject("WinNT://" & strDomain, strUsername, strPassword, ADS_SECURE_AUTHENTICATION)
    60        Set objIADSUser = objIADS.GetObject("user", strUsername)
    
    70        For Each Member In objIADSUser.Groups
    80            If Member.Class = "Group" Then
    90                If Member.Name = strGroup Then
    100                   IsMember = True
    110                   SaveUserMembership strUsername, strGroup, strDomain, Date, Time
    120                   Exit For
    130               End If
    140           End If
    150       Next
    
    160       On Error GoTo 0
    170       Exit Function
    
    IsMember_Error:
    
    180       MsgBox "Error " & Err.Number & " (" & Err.description & ") in procedure IsMember, line " & Erl & "."
    End Function