Delphi - Find primary email address for an Active Directory user - delphi

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: g.trol#mydomain.com. 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
// (g.trol#yourdomain.com). 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 g.trol#yourdomain.com});
Download from My dropbox