Delphi - Найти основной адрес электронной почты для пользователя Active Directory

Question

Я ищу лучший * метод, чтобы найти основной адрес электронной почты для текущего зарегистрированного пользователя Active Directory (с помощью GetUserName получить вошедший пользователь)

Я видел How do integrate Delphi with Active Directory?, но я не мог заставить это работать с Delphi 2010.

(* лучший метод: в конечном итоге приложение будет запускаться пользователями, которые не имеют административный доступ к машине)

---

Edit 1:

Чтение на это, кажется, что поле email или mail, вероятно, не самый лучший путь, как это кажется, что это не может быть населенно, поэтому мне нужно бы использовать многозначное поле из proxyaddresses

Answer 1

Код ниже работает для меня. Это выдержка из класса, который я использую в производственном коде. Он не получил proxyAddresses, но я добавил, что это работает, хотя я получаю только один альтернативный адрес электронной почты, похожий на smtp: g.trol@mydomain.com. Я не могу найти пример с более чем одним адресом, поэтому вам может потребоваться проверить, что происходит тогда.

Кроме того, я тестировал это в Delphi 2007, используя библиотеку типов, которую я нашел где-то, потому что у меня возникли проблемы с импортом. В коде вы видите __MIDL_0010, что является свойством записи __MIDL___MIDL_itf_ads_0000_0017 значения поля. Я заметил, что это было названо иначе в другой версии библиотеки типов, поэтому вам может потребоваться внести некоторые изменения в этот код, чтобы он соответствовал вашему конкретному типу библиотеки типов, возможно, исправить некоторые различия ansi/unicode.

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. 

вызовов, как это:

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

Скачать с My dropbox