Get AD User Group Memberships

unit ActiveDSUtil;

/// Written by Lars Fosdal, 16 DEC 2014, using Delphi XE7
/// Note that calling AD functions is slow.
/// To create ActiveDS_tlb, in the IDE, go View|Installed Type Libraries
/// Find "Active DS Type Library", right click, select Import,
/// use defaults for first page, then "Create Unit" on second page

interface
uses
  Classes, SysUtils, ActiveX, ActiveDS_tlb, web.win.adstypes;

type
  TADGroupList = array of String;
  TAnonParamFunc<TA,TR> = reference to function (const v:TA):TR;

  /// <summary> Enumerates the group memberships of an AD user </summary>
  function EnumADUserGroupMemberships(const aDomain, aUser: String; EnumHandler: TAnonParamFunc<IAdsGroup, Boolean>):Boolean;

  /// <summary> Returns a list of all AD groups for an AD user </summary>
  function GetADUserGroupMemberships(const aDomain, aUser: String):TStringList;

  /// <summary> Checks if an AD user is member of one or more specific groups</summary>
  function UserHasADGroupMembership(const aDomain, aUser: String; const GroupList: TAdGroupList): Boolean;


implementation

function EnumADUserGroupMemberships(const aDomain, aUser: String; EnumHandler: TAnonParamFunc<IADsGroup, Boolean>):Boolean;
var
  hr: HREsult;
  User: IADsUser;
  Enum: IEnumVariant;
  varGroup: OleVariant;
  EnumHelper: LongWord;
begin
  Result := False;
  CoInitialize(nil);
  try
    hr := ADsGetObject('WinNT://'+aDomain+'/'+aUser+',user',IID_IADsUser3 , User);
    if not Failed(hr)
    then begin
      try
        Enum := User.Groups._NewEnum as IEnumVariant;
        while Assigned(Enum) and (Enum.Next(1, varGroup, EnumHelper) = S_OK)
        do begin
          try
            if EnumHandler(IDispatch(varGroup) as IADsGroup)
             then EXIT(True);
          finally
            VariantClear(varGroup);
          end;
        end;
      finally
        User := nil;
      end;
    end;
  finally
    CoUninitialize;
  end;
end;

function GetADUserGroupMemberships(const aDomain, aUser: String):TStringList;
var
  List: TStringList;
begin
  List := TStringList.Create;
  List.BeginUpdate;
  try
    EnumADUserGroupMemberships(aDomain, aUser,
      function(const Group: IAdsGroup):Boolean
      begin
        Result := False;
        List.Add(Group.Name + ' ' + Group.Class_);
      end);
  finally
    List.Sort;
    List.Insert(0, aDomain +'\'+ aUser);
    List.EndUpdate;
    Result := List;
  end;
end;

function UserHasADGroupMembership(const aDomain, aUser: String; const GroupList: TAdGroupList): Boolean;
begin
  Result := EnumADUserGroupMemberships(aDomain, aUser,
      function(const Group: IAdsGroup):Boolean
      var
        GroupName: String;
      begin
        for GroupName in GroupList
        do begin
          Result := CompareText(GroupName, Group.Name) = 0;
          if Result
           then Break; // Return true for first match
        end;
      end);
end;

end.