Question

I’m looking for the best* method to find the primary email address for the currently logged in Active Directory user (using GetUserName to get the logged in username)

I have seen How do integrate Delphi with Active Directory? but I couldn’t get this to work with Delphi 2010.

(*best method: the eventual application will be run by users who do not have administrative access to the machine)

---

Edit 1:

Reading up on this, it appears that the email or mail field is probably not the best way to go as it seems it might not be populated, therefore I’d need to use the multivalue field of proxyaddresses

Answer 1

The code below works for me. It is an extract of a class I use in production code. It didn’t get the proxyAddresses but I added that and it seems to work, although I get only one alternative e-mail address, looking like smtp: [e-mail]. I can’t find an example with more that one address, so you may need to test what happens then.

Also, I tested this in Delphi 2007, using a type library I found somewhere, because I had trouble importing it. In the code you see __MIDL_0010, which is a __MIDL___MIDL_itf_ads_0000_0017 record property of the field value. I noticed this was named otherwise in a different version of the type library, so you may need to make some tweaks to this code to suit your exact type library import, an maybe fix some ansi/unicode differences.

uses ActiveX, ComObj, ActiveDs_TLB;

const
  NETAPI32DLL = 'netapi32.dll';
const
  ACTIVEDSDLL = 'activeds.dll';
  ADS_SECURE_AUTHENTICATION = $00000001;
const
  // ADSI success codes
  S_ADS_ERRORSOCCURRED = $00005011;
  S_ADS_NOMORE_ROWS    = $00005012;
  S_ADS_NOMORE_COLUMNS = $00005013;

  // ADSI error codes
  E_ADS_BAD_PATHNAME            = $80005000;
  E_ADS_INVALID_DOMAIN_OBJECT   = $80005001;
  E_ADS_INVALID_USER_OBJECT     = $80005002;
  E_ADS_INVALID_COMPUTER_OBJECT = $80005003;
  E_ADS_UNKNOWN_OBJECT          = $80005004;
  E_ADS_PROPERTY_NOT_SET        = $80005005;
  E_ADS_PROPERTY_NOT_SUPPORTED  = $80005006;
  E_ADS_PROPERTY_INVALID        = $80005007;
  E_ADS_BAD_PARAMETER           = $80005008;
  E_ADS_OBJECT_UNBOUND          = $80005009;
  E_ADS_PROPERTY_NOT_MODIFIED   = $8000500A;
  E_ADS_PROPERTY_MODIFIED       = $8000500B;
  E_ADS_CANT_CONVERT_DATATYPE   = $8000500C;
  E_ADS_PROPERTY_NOT_FOUND      = $8000500D;
  E_ADS_OBJECT_EXISTS           = $8000500E;
  E_ADS_SCHEMA_VIOLATION        = $8000500F;
  E_ADS_COLUMN_NOT_SET          = $80005010;
  E_ADS_INVALID_FILTER          = $80005014;

type
  TNetWkstaGetInfo = function(ServerName: PWideChar; Level: Cardinal;
      out BufPtr: Pointer): Cardinal; stdcall;
  TADsOpenObject   = function (lpszPathName: PWideChar; lpszUserName: PWideChar;
      lpszPassword: PWideChar; dwReserved: DWORD; const riid: TGUID;
      out pObject): HRESULT; stdcall;
  TADsGetObject    = function(PathName: PWideChar; const IID: TGUID; out Void):
      HRESULT; stdcall;

var
  NetLibHandle: THandle;
  NetWkstaGetInfo : TNetWkstaGetInfo;
  AdsLibHandle: THandle;
  _ADsOpenObject : TADsOpenObject;
  _ADsGetObject :TADsGetObject;

// VB-like GetObject function
function GetObject(const Name: String): IDispatch;
var
  Moniker: IMoniker;
  Eaten: integer;
  BindContext: IBindCtx;
  Dispatch: IDispatch;
begin
  OleCheck(CreateBindCtx(0, BindContext));
  OleCheck(MkParseDisplayName(BindContext,
                              PWideChar(WideString(Name)),
                              Eaten,
                              Moniker));
  OleCheck(Moniker.BindToObject(BindContext, nil, IDispatch, Dispatch));

  Result := Dispatch;
end;

// Some network info
type
   PWkstaInfo100 = ^TWkstaInfo100;
   _WKSTA_INFO_100 = record
     wki100_platform_id: DWORD;
     wki100_computername: LPWSTR;
     wki100_langroup: LPWSTR;
     wki100_ver_major: DWORD;
     wki100_ver_minor: DWORD;
   end;
   TWkstaInfo100 = _WKSTA_INFO_100;
   WKSTA_INFO_100 = _WKSTA_INFO_100;

function GetCurrentDomain: String;
var
  pWI: PWkstaInfo100;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    if NetWkstaGetInfo(nil, 100, Pointer(pWI)) = 0 then
      Result := String(pWI.wki100_langroup);
  end;
end;

// ADs...Object function wrappers
function ADsGetObject(PathName: PWideChar; const IID: TGUID;
  out Void): HRESULT;
begin
  if Assigned(_ADsGetObject) then
    Result := _ADsGetObject(PathName, IID, Void)
  else
    Result := ERROR_CALL_NOT_IMPLEMENTED;
end;

function ADsOpenObject(lpszPathName, lpszUserName,
  lpszPassword: PWideChar; dwReserved: DWORD; const riid: TGUID;
  out pObject): HRESULT;
begin
  if Assigned(_ADsOpenObject) then
    Result := _ADsOpenObject(lpszPathName, lpszUserName, lpszPassword, dwReserved, riid, pObject)
  else
    Result := ERROR_CALL_NOT_IMPLEMENTED;
end;

// The main function
function GetUserInfo(UserAccountName: string): Boolean;
var
  // Domain info: Max password age
  RootDSE: Variant;
  Domain: Variant;
  MaxPwdNanoAge: Variant;
  MaxPasswordAge: Int64;
  DNSDomain: String;

  // User info: User directorysearch to find the user by username
  DirectorySearch: IDirectorySearch;
  SearchPreferences: array[0..1] of ADS_SEARCHPREF_INFO;
  Columns: array[0..6] of PWideChar;
  SearchResult: Cardinal;
  hr: HRESULT;
  ColumnResult: ads_search_column;
  // Number of user records found
  RecordCount: Integer;

  LastSetDateTime: TDateTime;
  ExpireDateTime: TDateTime;

  i: Integer;
begin
  Result := False;

  // If no account name is set, reading is impossible. Return false.
  if (UserAccountName = '') then
    Exit;

  try
    // Read the maximum password age from the domain.
    // To do: Check if this can be done with ADsGetObject instead of the VB-like GetObject
    // Get the Root DSE.
    RootDSE        := GetObject('LDAP://RootDSE');
    DNSDomain      := RootDSE.Get('DefaultNamingContext');
    Domain         := GetObject('LDAP://' + DNSDomain);

    // Build an array of user properties to receive.
    Columns[0] := StringToOleStr('AdsPath');
    Columns[1] := StringToOleStr('pwdLastSet');
    Columns[2] := StringToOleStr('displayName');
    Columns[3] := StringToOleStr('mail');
    Columns[4] := StringToOleStr('sAMAccountName');
    Columns[5] := StringToOleStr('userPrincipalName');
    Columns[6] := StringToOleStr('proxyAddresses');

    // Bind to the directorysearch object. For some unspecified reason, the regular
    // domain name (yourdomain) needs to be used instead of the AdsPath (office.yourdomain.us)
    AdsGetObject(PWideChar(WideString('LDAP://' + GetCurrentDomain)), IDirectorySearch, DirectorySearch);
    try
      // Set search preferences.
      SearchPreferences[0].dwSearchPref  := ADS_SEARCHPREF_SEARCH_SCOPE;
      SearchPreferences[0].vValue.dwType := ADSTYPE_INTEGER;
      SearchPreferences[0].vValue.__MIDL_0010.Integer := ADS_SCOPE_SUBTREE;
      DirectorySearch.SetSearchPreference(@SearchPreferences[0], 1);

      // Execute search
      // Search for SAM account name (g.trol) and User Principal name
      // ([e-mail]). This allows the user to enter their username
      // in both ways. Add CN=* to filter out irrelevant objects that might
      // match the principal name.
      DirectorySearch.ExecuteSearch(
          PWideChar(WideString(
              Format('(&(CN=*)(|(sAMAccountName=%0:s)(userPrincipalName=%0:s)))',
                  [UserAccountName]))),
          nil,
          $FFFFFFFF,
          SearchResult);

      // Get records
      RecordCount := 0;

      hr := DirectorySearch.GetNextRow(SearchResult);
      if (hr <> S_ADS_NOMORE_ROWS) then
      begin
        // 1 row found
        Inc(RecordCount);

        // Get the column values for this row.
        // To do: This code could use a more general and neater approach!
        for i := Low(Columns) to High(Columns) do
        begin
          hr := DirectorySearch.GetColumn(SearchResult, Columns[i], ColumnResult);

          if Succeeded(hr) then
          begin
            // Get the values for the columns.
            {if SameText(ColumnResult.pszAttrName, 'AdsPath') then
              Result.UserAdsPath :=
                ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'pwdLastSet') then
            begin
              LastSetDateTime := LDapTimeStampToDateTime(
                      ColumnResult.pAdsvalues^.__MIDL_0010.LargeInteger) +
                  GetTimeZoneCorrection;
              ExpireDateTime := IncMilliSecond(LastSetDateTime,
                  LDapIntervalToMSecs(MaxPasswordAge));
              Result.UserPasswordExpireDateTime := ExpireDateTime;
            end
            else if SameText(ColumnResult.pszAttrName, 'displayName') then
              Result.UserFullName := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'mail') then
              Result.UserEmail := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'sAMAccountName') then
              Result.UserShortAccountName := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else if SameText(ColumnResult.pszAttrName, 'userPrincipalName') then
              Result.UserFullAccountName := ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString
            else ..}
            if SameText(ColumnResult.pszAttrName, 'proxyAddresses') then
              ShowMessage(ColumnResult.pADsValues.__MIDL_0010.CaseIgnoreString);

            // Free the column result
            DirectorySearch.FreeColumn(ColumnResult);
          end;
        end;

        // Small check if this account indeed is the only one found.
        // No need to check the exact number. <> 1 = error
        Hr := DirectorySearch.GetNextRow(SearchResult);
        if (hr <> S_ADS_NOMORE_ROWS) then
          Inc(RecordCount);
      end;

      // Close the search
      DirectorySearch.CloseSearchHandle(SearchResult);

      // Exactly 1 record found?
      if RecordCount = 1 then
        Result := True
      else
        ShowMessageFmt('More than one account found when searching for %s in ' +
                       'Active Directory.', [UserAccountName]);

    finally
      DirectorySearch := nil;
    end;

  except
    Result := False;
  end;
end;

initialization
  NetLibHandle := LoadLibrary(NETAPI32DLL);
  if NetLibHandle <> 0 then
    @NetWkstaGetInfo := GetProcAddress(NetLibHandle, 'NetWkstaGetInfo');

  ADsLibHandle := LoadLibrary(ACTIVEDSDLL);
  if ADsLibHandle <> 0 then
  begin
    @_ADsOpenObject := GetProcAddress(ADsLibHandle, 'ADsOpenObject');
    @_ADsGetObject  := GetProcAddress(ADsLibHandle, 'ADsGetObject');
  end;
finalization
  FreeLibrary(ADsLibHandle);
  FreeLibrary(NetLibHandle);
end.

Call like this:

GetUserInfo('g.trol' {or [e-mail]});

Download from My dropbox