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

i'm looking best* method find primary email address logged in active directory user (using getusername logged in username)

i have seen how integrate delphi active directory? couldn't work delphi 2010.

(*best method: eventual application run users not have administrative access machine)

---

edit 1:

reading on this, appears email or mail field not best way go seems might not populated, therefore i'd need use multivalue field of proxyaddresses

the code below works me. extract of class use in production code. didn't proxyaddresses added , seems work, although 1 alternative e-mail address, looking smtp: g.trol@mydomain.com. can't find example more 1 address, may need test happens then.

also, tested in delphi 2007, using type library found somewhere, because had trouble importing it. in code see __midl_0010, __midl___midl_itf_ads_0000_0017 record property of field value. noticed named otherwise in different version of type library, may need make tweaks code suit exact type library import, maybe fix 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;  // 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   begin     if netwkstagetinfo(nil, 100, pointer(pwi)) = 0       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)     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)     result := _adsopenobject(lpszpathname, lpszusername, lpszpassword, dwreserved, riid, pobject)   else     result := error_call_not_implemented; end;  // 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 find user 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 set, reading impossible. return false.   if (useraccountname = '')     exit;    try     // read maximum password age domain.     // do: check if can done adsgetobject instead of vb-like getobject     // root dse.     rootdse        := getobject('ldap://rootdse');     dnsdomain      := rootdse.get('defaultnamingcontext');     domain         := getobject('ldap://' + dnsdomain);      // build array of user properties 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 directorysearch object. unspecified reason, regular     // domain name (yourdomain) needs used instead of 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 sam account name (g.trol) , user principal name       // (g.trol@yourdomain.com). allows user enter username       // in both ways. add cn=* filter out irrelevant objects might       // match principal name.       directorysearch.executesearch(           pwidechar(widestring(               format('(&(cn=*)(|(samaccountname=%0:s)(userprincipalname=%0:s)))',                   [useraccountname]))),           nil,           $ffffffff,           searchresult);        // records       recordcount := 0;        hr := directorysearch.getnextrow(searchresult);       if (hr <> s_ads_nomore_rows)       begin         // 1 row found         inc(recordcount);          // column values row.         // do: code use more general , neater approach!         := low(columns) high(columns)         begin           hr := directorysearch.getcolumn(searchresult, columns[i], columnresult);            if succeeded(hr)           begin             // values columns.             {if sametext(columnresult.pszattrname, 'adspath')               result.useradspath :=                 columnresult.padsvalues.__midl_0010.caseignorestring             else if sametext(columnresult.pszattrname, 'pwdlastset')             begin               lastsetdatetime := ldaptimestamptodatetime(                       columnresult.padsvalues^.__midl_0010.largeinteger) +                   gettimezonecorrection;               expiredatetime := incmillisecond(lastsetdatetime,                   ldapintervaltomsecs(maxpasswordage));               result.userpasswordexpiredatetime := expiredatetime;             end             else if sametext(columnresult.pszattrname, 'displayname')               result.userfullname := columnresult.padsvalues.__midl_0010.caseignorestring             else if sametext(columnresult.pszattrname, 'mail')               result.useremail := columnresult.padsvalues.__midl_0010.caseignorestring             else if sametext(columnresult.pszattrname, 'samaccountname')               result.usershortaccountname := columnresult.padsvalues.__midl_0010.caseignorestring             else if sametext(columnresult.pszattrname, 'userprincipalname')               result.userfullaccountname := columnresult.padsvalues.__midl_0010.caseignorestring             else ..}             if sametext(columnresult.pszattrname, 'proxyaddresses')               showmessage(columnresult.padsvalues.__midl_0010.caseignorestring);              // free column result             directorysearch.freecolumn(columnresult);           end;         end;          // small check if account indeed 1 found.         // no need check exact number. <> 1 = error         hr := directorysearch.getnextrow(searchresult);         if (hr <> s_ads_nomore_rows)           inc(recordcount);       end;        // close search       directorysearch.closesearchhandle(searchresult);        // 1 record found?       if recordcount = 1         result := true       else         showmessagefmt('more 1 account found when searching %s in ' +                        'active directory.', [useraccountname]);            directorysearch := nil;     end;    except     result := false;   end; end;  initialization   netlibhandle := loadlibrary(netapi32dll);   if netlibhandle <> 0     @netwkstagetinfo := getprocaddress(netlibhandle, 'netwkstagetinfo');    adslibhandle := loadlibrary(activedsdll);   if adslibhandle <> 0   begin     @_adsopenobject := getprocaddress(adslibhandle, 'adsopenobject');     @_adsgetobject  := getprocaddress(adslibhandle, 'adsgetobject');   end; finalization   freelibrary(adslibhandle);   freelibrary(netlibhandle); end. 

call this:

getuserinfo('g.trol' {or g.trol@yourdomain.com}); 

download my dropbox