Geek Answers Handbook

How to determine if a user account is an (indirect) member of an AD group?

How to determine if a user account is a member of an AD group, especially if then the user is not a direct member of the group.

Example:

  • user1 is a member of group 1
  • group1 is a member of group2
  • the result of the function (fictional) of the function IsUserMemberOf('user1', 'group2') must be TRUE

For .NET there is a solution:

 static bool IsUserMemberOf(string userName, string groupName) { using (var ctx = new PrincipalContext(ContextType.Domain)) using (var groupPrincipal = GroupPrincipal.FindByIdentity(ctx, groupName)) using (var userPrincipal = UserPrincipal.FindByIdentity(ctx, userName)) { return userPrincipal.IsMemberOf(groupPrincipal); } }

How can I do this with Delphi (Delphi-2007)?

Decision:

I accept Remko's answer, but since its code does not work in Delphi-2007 (some problems with String / WideString), here is my version of D2007:

 unit Unit1; interface uses // Jedi ApiLib SysUtils, Classes, Windows, JwaActiveDs, JwaAdsTlb, JwaNative, JwaWinNT, JwaWinBase, JwaNtSecApi, JwaNtStatus, JwaWinType; type // Some Helper Types TSidArray = array of PSID; PSidArray = ^TSidArray; TAdsValueArray = array[0..ANYSIZE_ARRAY-1] of ADSVALUE; PAdsValueArray = ^TAdsValueArray; TLsaTranslatedNameArray = array[0..ANYSIZE_ARRAY-1] of LSA_TRANSLATED_NAME; PLsaTranslatedNameArray = ^TLsaTranslatedNameArray; function GetPolicyHandle(const Computer: WideString=''): PLSA_HANDLE; function GetGroupMembership(const AdsPath: WideString; var Groups: TStringList): Boolean; implementation function GetPolicyHandle(const Computer: WideString=''): PLSA_HANDLE; var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; lusSystemName: LSA_UNICODE_STRING; nts: NTSTATUS; dwError: DWORD; begin ZeroMemory(@ObjectAttributes, SizeOf(ObjectAttributes)); RtlInitUnicodeString(@lusSystemName, PWideChar(Computer)); nts := LsaOpenPolicy(@lusSystemName, ObjectAttributes, POLICY_LOOKUP_NAMES, Pointer(Result)); if nts <> STATUS_SUCCESS then begin dwError := LsaNtStatusToWinError(nts); raise EOSError.Create(SysErrorMessage(dwError)); end; end; function GetGroupMembership(const AdsPath: WideString; var Groups: TStringList): Boolean; const Username: PChar = 'Administrator'; Password: PChar = 'password'; var hr: HRESULT; nts: NTSTATUS; PolicyHandle: PLSA_HANDLE; DirObject: IDirectoryObject; Domains: PLSA_REFERENCED_DOMAIN_LIST; Names: PLsaTranslatedNameArray; SidArray: TSidArray; Attributes: array of PChar; AdValue: PAdsValueArray; AdAttrInfo: PADS_ATTR_INFO; dwNumAttributes: DWORD; i: Integer; s: WideString; begin Result := False; Assert(Assigned(Groups)); // Get Lsa Policy Handle PolicyHandle := GetPolicyHandle; try // Open AD object, note that I am using username, password because I am // connecting from a machine that not a domain member. // I am also passing the ADS_SERVER_BIND flag because I am directly // connecting to a specific Domain Controller hr := ADsOpenObject(PWideChar(AdsPath), Username, Password, ADS_SERVER_BIND or ADS_SECURE_AUTHENTICATION, IID_IDirectoryObject, Pointer(DirObject)); if Failed(hr) then Exit; // Attribute array SetLength(Attributes, 1); s := 'tokenGroups'; Attributes[0] := @s[1]; hr := DirObject.GetObjectAttributes(@Attributes[0], Length(Attributes), AdAttrInfo, dwNumAttributes); if Failed(hr) then Exit; // Setup an Array for the PSID's SetLength(SidArray, AdAttrInfo^.dwNumValues); AdValue := PAdsValueArray(AdAttrInfo^.pADsValues); for i := 0 to AdAttrInfo^.dwNumValues-1 do begin // Copy Pointer to Array Assert(AdValue^[i].OctetString.dwLength > 0); SidArray[i] := PSid(AdValue^[i].OctetString.lpValue); end; nts := LsaLookupSids(PolicyHandle, Length(SidArray), @SidArray[0], Domains, PLSA_TRANSLATED_NAME(Names)); if nts >= STATUS_SUCCESS then begin for i := 0 to AdAttrInfo^.dwNumValues - 1 do begin SetLength(s, Names[i].Name.Length div SizeOf(WideChar)); CopyMemory(@s[1], Names[i].Name.Buffer, Names[i].Name.Length); Groups.Add(s); end; // even if nts returns STATUS_NONE_MAPPED or STATUS_SOME_NOT_MAPPED we // must Free the Mem! LsaFreeMemory(Names); LsaFreeMemory(Domains); Result := True; end; FreeAdsMem(AdAttrInfo); finally // Close the Lsa Policy Handle LsaClose(PolicyHandle); end; end; end.
+6
source share
1 answer

The tokenGroups attribute contains an SID array for all groups for which the user is a direct or indirect member. LsaLookupSids can be used to convert an array of SIDs to names in a single call.

Code example:

 uses // Jedi ApiLib JwaActiveDs, JwaAdsTlb, JwaNative, JwaNtSecApi, JwaNtStatus, JwaWinType; type // Some Helper Types TSidArray = array of PSID; PSidArray = ^TSidArray; TAdsValueArray = array[0..ANYSIZE_ARRAY-1] of ADSVALUE; PAdsValueArray = ^TAdsValueArray; TLsaTranslatedNameArray = array[0..ANYSIZE_ARRAY-1] of LSA_TRANSLATED_NAME; PLsaTranslatedNameArray = ^TLsaTranslatedNameArray; function GetPolicyHandle(const Computer: String=''): PLSA_HANDLE; var ObjectAttributes: LSA_OBJECT_ATTRIBUTES; lusSystemName: LSA_UNICODE_STRING; nts: NTSTATUS; dwError: DWORD; begin ZeroMemory(@ObjectAttributes, SizeOf(ObjectAttributes)); RtlInitUnicodeString(@lusSystemName, PChar(Computer)); nts := LsaOpenPolicy(@lusSystemName, ObjectAttributes, POLICY_LOOKUP_NAMES, Pointer(Result)); if nts <> STATUS_SUCCESS then begin dwError := LsaNtStatusToWinError(nts); raise EOSError.Create(SysErrorMessage(dwError)); end; end; function GetGroupMembership(const AdsPath: String; var Groups: TStringList): Boolean; const Username: PChar = 'Administrator'; Password: PChar = 'password'; var hr: HRESULT; nts: NTSTATUS; PolicyHandle: PLSA_HANDLE; DirObject: IDirectoryObject; Domains: PLSA_REFERENCED_DOMAIN_LIST; Names: PLsaTranslatedNameArray; SidArray: TSidArray; Attributes: array of PChar; AdValue: PAdsValueArray; AdAttrInfo: PADS_ATTR_INFO; dwNumAttributes: DWORD; i: Integer; s: String; begin Result := False; Assert(Assigned(Groups)); // Get Lsa Policy Handle PolicyHandle := GetPolicyHandle; try // Open AD object, note that I am using username, password because I am // connecting from a machine that not a domain member. // I am also passing the ADS_SERVER_BIND flag because I am directly // connecting to a specific Domain Controller hr := ADsOpenObject(PChar(AdsPath), Username, Password, ADS_SERVER_BIND or ADS_SECURE_AUTHENTICATION, IID_IDirectoryObject, Pointer(DirObject)); if Failed(hr) then Exit; // Attribute array SetLength(Attributes, 1); Attributes[0] := 'tokenGroups'; hr := DirObject.GetObjectAttributes(@Attributes[0], Length(Attributes), PADS_ATTR_INFO(AdAttrInfo), dwNumAttributes); if Failed(hr) then Exit; // Setup an Array for the PSID's SetLength(SidArray, AdAttrInfo^.dwNumValues); AdValue := PAdsValueArray(AdAttrInfo^.pADsValues); for i := 0 to AdAttrInfo^.dwNumValues-1 do begin // Copy Pointer to Array Assert(AdValue^[i].OctetString.dwLength > 0); SidArray[i] := PSid(AdValue^[i].OctetString.lpValue); end; nts := LsaLookupSids(PolicyHandle, Length(SidArray), @SidArray[0], Domains, PLSA_TRANSLATED_NAME(Names)); if nts >= STATUS_SUCCESS then begin for i := 0 to AdAttrInfo^.dwNumValues - 1 do begin SetLength(s, Names[i].Name.Length div SizeOf(Char)); CopyMemory(@s[1], Names[i].Name.Buffer, Names[i].Name.Length); Groups.Add(s); end; // even if nts returns STATUS_NONE_MAPPED or STATUS_SOME_NOT_MAPPED we // must Free the Mem! LsaFreeMemory(Names); LsaFreeMemory(Domains); Result := True; end; FreeAdsMem(AdAttrInfo); finally // Close the Lsa Policy Handle LsaClose(PolicyHandle); end; end;

Usage example:

 procedure TForm4.Button1Click(Sender: TObject); var Groups: TStringList; bRes: Boolean; i: Integer; begin Groups := TStringList.Create; Groups.Duplicates := dupIgnore; Groups.Sorted := True; try bRes := GetGroupMembership('LDAP://2003DC/CN=Administrator,CN=Users,DC=contoso,DC=com', Groups); if bRes then begin for i := 0 to Groups.Count - 1 do begin Memo1.Lines.Add(Groups[i]); end; end; Memo1.Lines.Add(Format('IsMemberOf Administrators: %s', [BoolToStr(Groups.IndexOf('Administrators') <> -1, True)])); finally Groups.Free; end; end;
+6
source

More articles:


All Articles